Tcl Source Code

Changes On Branch tip-636-tcl9-644
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Changes In Branch tip-636-tcl9-644 Excluding Merge-Ins

This is equivalent to a diff from db4e5a6372 to dc07baa584

2023-07-07
02:56
merge TIP #636 (tip-636-tcl9-644) check-in: 91c2f411e7 user: griffin tags: trunk, main
2023-07-06
21:37
merge trunk Closed-Leaf check-in: dc07baa584 user: griffin tags: tip-636-tcl9-644
19:12
merge trunk check-in: 66df8231f9 user: griffin tags: tip-636-tcl9-644
2023-07-05
15:10
Merge 8.7 check-in: c835fededf user: jan.nijtmans tags: trunk, main
2022-11-06
05:20
Sync with trunk check-in: 6a10d9194c user: griffin tags: tip-636-tcl9-644
2022-11-05
23:35
Sync with trunk Closed-Leaf check-in: db4e5a6372 user: griffin tags: tip-636-tcl9
11:49
Merge 8.7. lreplace4 bcc instruction and FLT_MAX fix check-in: 4014e2a164 user: apnadkarni tags: trunk, main
2022-11-02
22:33
TIP 636 for Tcl 9 check-in: b78cb72678 user: griffin tags: tip-636-tcl9

Changes to .fossil-settings/ignore-glob.

44
45
46
47
48
49
50

51
52
53

54
55
56
57
58
59
60
libtommath/etc/*
libtommath/demo/*
libtommath/*.out
libtommath/*.tex
macosx/configure
unix/autoMkindex.tcl
unix/dltest.marker

unix/dltest/*.bundle
unix/dltest/*.dll
unix/dltest/*.dylib

unix/dltest/*.o
unix/dltest/*.sl
unix/dltest/*.so
unix/tcl.pc
unix/tclIndex
unix/Tcl-Info.plist
unix/Tclsh-Info.plist







>



>







44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
libtommath/etc/*
libtommath/demo/*
libtommath/*.out
libtommath/*.tex
macosx/configure
unix/autoMkindex.tcl
unix/dltest.marker
unix/dltest/embtest
unix/dltest/*.bundle
unix/dltest/*.dll
unix/dltest/*.dylib
unix/dltest/*.exe
unix/dltest/*.o
unix/dltest/*.sl
unix/dltest/*.so
unix/tcl.pc
unix/tclIndex
unix/Tcl-Info.plist
unix/Tclsh-Info.plist

Changes to .github/workflows/linux-build.yml.

1

2






3
4
5
6
7
8
9
name: Linux

on: [push]






permissions:
  contents: read
jobs:
  gcc:
    runs-on: ubuntu-22.04
    strategy:
      matrix:

>
|
>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
name: Linux
on:
  push:
    branches:
    - "main"
    - "core-8-branch"
    - "core-8-6-branch"
    tags:
    - "core-**"
permissions:
  contents: read
jobs:
  gcc:
    runs-on: ubuntu-22.04
    strategy:
      matrix:
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

    defaults:
      run:
        shell: bash
        working-directory: unix
    steps:
      - name: Checkout
        uses: actions/checkout@v3

      - 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








>










>



>



>





>



>



>



>
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
    defaults:
      run:
        shell: bash
        working-directory: unix
    steps:
      - name: Checkout
        uses: actions/checkout@v3
        timeout-minutes: 5
      - 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 }}
        timeout-minutes: 5
      - name: Build
        run: |
          make all
        timeout-minutes: 5
      - name: Build Test Harness
        run: |
          make tcltest
        timeout-minutes: 5
      - name: Run Tests
        run: |
          make test
        env:
          ERROR_ON_FAILURES: 1
        timeout-minutes: 30
      - name: Test-Drive Installation
        run: |
          make install
        timeout-minutes: 5
      - name: Create Distribution Package
        run: |
          make dist
        timeout-minutes: 5
      - name: Convert Documentation to HTML
        run: |
          make html-tcl
        timeout-minutes: 5

Changes to .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
64
65
66

name: macOS

on: [push]






permissions:
  contents: read
jobs:
  xcode:
    runs-on: macos-11
    defaults:
      run:
        shell: bash
        working-directory: macosx
    steps:
      - name: Checkout
        uses: actions/checkout@v3

      - 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
    strategy:
      matrix:
        cfgopt:
          - ""
          - "--disable-shared"
          - "--enable-symbols"
          - "--enable-symbols=mem"
          - "--enable-symbols=all"
    defaults:
      run:
        shell: bash
        working-directory: unix
    steps:
      - name: Checkout
        uses: actions/checkout@v3

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


>
|
>
>
>
>
>
>












>







|
>





>

















>









|

>




|
>






>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
name: macOS
on:
  push:
    branches:
    - "main"
    - "core-8-branch"
    - "core-8-6-branch"
    tags:
    - "core-**"
permissions:
  contents: read
jobs:
  xcode:
    runs-on: macos-11
    defaults:
      run:
        shell: bash
        working-directory: macosx
    steps:
      - name: Checkout
        uses: actions/checkout@v3
        timeout-minutes: 5
      - name: Prepare
        run: |
          touch tclStubInit.c tclOOStubInit.c tclOOScript.h
        working-directory: generic
      - name: Build
        run: make all
        env:
          CFLAGS: -arch x86_64 -arch arm64
        timeout-minutes: 15
      - name: Run Tests
        run: make test styles=develop
        env:
          ERROR_ON_FAILURES: 1
          MAC_CI: 1
        timeout-minutes: 15
  clang:
    runs-on: macos-11
    strategy:
      matrix:
        cfgopt:
          - ""
          - "--disable-shared"
          - "--enable-symbols"
          - "--enable-symbols=mem"
          - "--enable-symbols=all"
    defaults:
      run:
        shell: bash
        working-directory: unix
    steps:
      - name: Checkout
        uses: actions/checkout@v3
        timeout-minutes: 5
      - 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-dtrace --enable-framework ${CFGOPT} "--prefix=$HOME/install" || (cat config.log && exit 1)
        env:
          CFLAGS: -arch x86_64 -arch arm64
          CFGOPT: ${{ matrix.cfgopt }}
        timeout-minutes: 5
      - name: Build
        run: |
          make all tcltest
        env:
          CFLAGS: -arch x86_64 -arch arm64
        timeout-minutes: 15
      - name: Run Tests
        run: |
          make test
        env:
          ERROR_ON_FAILURES: 1
          MAC_CI: 1
        timeout-minutes: 15

Changes to .github/workflows/onefiledist.yml.

1

2





3
4
5
6
7
8
9
10
11

12
13
14
15
16
17
18
name: Build Binaries

on: [push]





permissions:
  contents: read
jobs:
  linux:
    name: Linux
    runs-on: ubuntu-20.04
    defaults:
      run:
        shell: bash

    steps:
      - name: Checkout
        uses: actions/checkout@v3
      - name: Prepare
        run: |
          touch generic/tclStubInit.c generic/tclOOStubInit.c
          mkdir 1dist

>
|
>
>
>
>
>









>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
name: Build Binaries
on:
  push:
    branches:
    - "main"
    - "core-8-branch"
    tags:
    - "core-**"
permissions:
  contents: read
jobs:
  linux:
    name: Linux
    runs-on: ubuntu-20.04
    defaults:
      run:
        shell: bash
    timeout-minutes: 10
    steps:
      - name: Checkout
        uses: actions/checkout@v3
      - name: Prepare
        run: |
          touch generic/tclStubInit.c generic/tclOOStubInit.c
          mkdir 1dist
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
          path: 1dist/*.tar
  macos:
    name: macOS
    runs-on: macos-11
    defaults:
      run:
        shell: bash

    steps:
      - name: Checkout
        uses: actions/checkout@v3
      - name: Checkout create-dmg
        uses: actions/checkout@v3
        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"







>


















|







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
          path: 1dist/*.tar
  macos:
    name: macOS
    runs-on: macos-11
    defaults:
      run:
        shell: bash
    timeout-minutes: 10
    steps:
      - name: Checkout
        uses: actions/checkout@v3
      - name: Checkout create-dmg
        uses: actions/checkout@v3
        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 arm64" >> $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"
102
103
104
105
106
107
108

109
110
111
112
113
114
115
          path: 1dist/*.dmg
  win:
    name: Windows
    runs-on: windows-2019
    defaults:
      run:
        shell: msys2 {0}

    env:
      CC: gcc
      CFGOPT: --disable-symbols --disable-shared
    steps:
      - name: Install MSYS2
        uses: msys2/setup-msys2@v2
        with:







>







110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
          path: 1dist/*.dmg
  win:
    name: Windows
    runs-on: windows-2019
    defaults:
      run:
        shell: msys2 {0}
    timeout-minutes: 10
    env:
      CC: gcc
      CFGOPT: --disable-symbols --disable-shared
    steps:
      - name: Install MSYS2
        uses: msys2/setup-msys2@v2
        with:

Changes to .github/workflows/win-build.yml.

1

2






3
4
5
6
7
8
9
name: Windows

on: [push]






permissions:
  contents: read
env:
  ERROR_ON_FAILURES: 1
jobs:
  msvc:
    runs-on: windows-2022

>
|
>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
name: Windows
on:
  push:
    branches:
    - "main"
    - "core-8-branch"
    - "core-8-6-branch"
    tags:
    - "core-**"
permissions:
  contents: read
env:
  ERROR_ON_FAILURES: 1
jobs:
  msvc:
    runs-on: windows-2022
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
          - "OPTS=static"
          - "OPTS=symbols"
          - "OPTS=symbols STATS=compdbg,memdbg"
    # Using powershell means we need to explicitly stop on failure
    steps:
      - name: Checkout
        uses: actions/checkout@v3

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

  gcc:
    runs-on: windows-2022
    defaults:
      run:
        shell: msys2 {0}
        working-directory: win
    strategy:







>


>






>






>






>







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
          - "OPTS=static"
          - "OPTS=symbols"
          - "OPTS=symbols STATS=compdbg,memdbg"
    # Using powershell means we need to explicitly stop on failure
    steps:
      - name: Checkout
        uses: actions/checkout@v3
        timeout-minutes: 5
      - name: Init MSVC
        uses: ilammy/msvc-dev-cmd@v1
        timeout-minutes: 5
      - name: Build ${{ matrix.cfgopt }}
        run: |
          &nmake -f makefile.vc ${{ matrix.cfgopt }} all
          if ($lastexitcode -ne 0) {
             throw "nmake exit code: $lastexitcode"
          }
        timeout-minutes: 5
      - name: Build Test Harness ${{ matrix.cfgopt }}
        run: |
          &nmake -f makefile.vc ${{ matrix.cfgopt }} tcltest
          if ($lastexitcode -ne 0) {
             throw "nmake exit code: $lastexitcode"
          }
        timeout-minutes: 5
      - name: Run Tests ${{ matrix.cfgopt }}
        run: |
          &nmake -f makefile.vc ${{ matrix.cfgopt }} test
          if ($lastexitcode -ne 0) {
             throw "nmake exit code: $lastexitcode"
          }
        timeout-minutes: 30
  gcc:
    runs-on: windows-2022
    defaults:
      run:
        shell: msys2 {0}
        working-directory: win
    strategy:
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
    # Using powershell means we need to explicitly stop on failure
    steps:
      - name: Install MSYS2
        uses: msys2/setup-msys2@v2
        with:
          msystem: MINGW64
          install: git mingw-w64-x86_64-toolchain make

      - name: Checkout
        uses: actions/checkout@v3

      - name: Prepare
        run: |
          touch tclStubInit.c tclOOStubInit.c tclOOScript.h
          mkdir "${HOME}/install dir"
        working-directory: generic
      - name: Configure ${{ matrix.cfgopt }}
        run: |
          ./configure ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1)
        env:
          CFGOPT: --enable-64bit ${{ matrix.cfgopt }}

      - name: Build
        run: make all

      - name: Build Test Harness
        run: make tcltest

      - name: Run Tests
        run: make test


# If you add builds with Wine, be sure to define the environment variable
# CI_USING_WINE when running them so that broken tests know not to run.







>


>










>


>


>


>



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
    # Using powershell means we need to explicitly stop on failure
    steps:
      - name: Install MSYS2
        uses: msys2/setup-msys2@v2
        with:
          msystem: MINGW64
          install: git mingw-w64-x86_64-toolchain make
        timeout-minutes: 10
      - name: Checkout
        uses: actions/checkout@v3
        timeout-minutes: 5
      - 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 }}
        timeout-minutes: 5
      - name: Build
        run: make all
        timeout-minutes: 5
      - name: Build Test Harness
        run: make tcltest
        timeout-minutes: 5
      - name: Run Tests
        run: make test
        timeout-minutes: 30

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

49
50
51
52
53
54
55

56
57
58
59
60
61
62
libtommath/etc/*
libtommath/demo/*
libtommath/*.out
libtommath/*.tex
macosx/configure
unix/autoMkindex.tcl
unix/dltest.marker

unix/tcl.pc
unix/tclIndex
unix/pkgs/*
win/Debug*
win/Release*
win/*.manifest
win/pkgs/*







>







49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
libtommath/etc/*
libtommath/demo/*
libtommath/*.out
libtommath/*.tex
macosx/configure
unix/autoMkindex.tcl
unix/dltest.marker
unix/dltest/embtest
unix/tcl.pc
unix/tclIndex
unix/pkgs/*
win/Debug*
win/Release*
win/*.manifest
win/pkgs/*

Deleted ChangeLog.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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
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
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
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
5805
5806
5807
5808
5809
5810
5811
5812
5813
5814
5815
5816
5817
5818
5819
5820
5821
5822
5823
5824
5825
5826
5827
5828
5829
5830
5831
5832
5833
5834
5835
5836
5837
5838
5839
5840
5841
5842
5843
5844
5845
5846
5847
5848
5849
5850
5851
5852
5853
5854
5855
5856
5857
5858
5859
5860
5861
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
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
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
6449
6450
6451
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
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
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
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
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
A NOTE ON THE CHANGELOG:
Starting in early 2011, Tcl source code has been under the management of
fossil, hosted at https://core.tcl-lang.org/tcl/ .  Fossil presents a "Timeline"
view of changes made that is superior in every way to a hand edited log file.
Because of this, many Tcl developers are now out of the habit of maintaining
this log file.  You may still find useful things in it, but the Timeline is
a better first place to look now.
============================================================================

2013-09-19  Don Porter  <[email protected]>

	*** 8.6.1 TAGGED FOR RELEASE ***

	* generic/tcl.h:	Bump version number to 8.6.1.
	* library/init.tcl:
	* unix/configure.in:
	* win/configure.in:
	* unix/tcl.spec:
	* README:

	* unix/configure:	autoconf-2.59
	* win/configure:

2013-09-19  Donal Fellows  <[email protected]>

	* doc/next.n (METHOD SEARCH ORDER): Bug [3606943]: Corrected
	description of method search order.

2013-09-18  Donal Fellows  <[email protected]>

	Bump TclOO version to 1.0.1 for release.

2013-09-17  Donal Fellows  <[email protected]>

	* generic/tclBinary.c (BinaryEncodeUu, BinaryDecodeUu): [Bug 2152292]:
	Corrected implementation of the core of uuencode handling so that the
	line length processing is correctly applied.
	***POTENTIAL INCOMPATIBILITY***
	Existing code that was using the old versions and working around the
	limitations will now need to do far less. The -maxlen option now has
	strict limits on the range of supported lengths; this is a limitation
	of the format itself.

2013-09-09  Donal Fellows  <[email protected]>

	* generic/tclOOMethod.c (CloneProcedureMethod): [Bug 3609693]: Strip
	the internal representation of method bodies during cloning in order
	to ensure that any bound references to instance variables are removed.

2013-09-01  Donal Fellows  <[email protected]>

	* generic/tclBinary.c (BinaryDecodeHex): [Bug b98fa55285]: Ensure that
	whitespace at the end of a string don't cause the decoder to drop the
	last decoded byte.

2013-08-03  Donal Fellows  <[email protected]>

	* library/auto.tcl: [Patch 3611643]: Allow TclOO classes to be found
	by the autoloading mechanism.

2013-08-02  Donal Fellows  <[email protected]>

	* generic/tclOODefineCmds.c (ClassSuperSet): Bug [9d61624b3d]: Stop
	crashes when emptying the superclass slot, even when doing elaborate
	things with metaclasses.

2013-08-01  Harald Oehlmann  <[email protected]>

	* tclUnixNotify.c (Tcl_InitNotifier): Bug [a0bc856dcd]: Start notifier
	thread again if we were forked, to solve Rivet bug 55153.

2013-07-05  Kevin B. Kenny  <[email protected]>

	* library/tzdata/Africa/Casablanca:
	* library/tzdata/America/Asuncion:
	* library/tzdata/Antarctica/Macquarie:
	* library/tzdata/Asia/Gaza:
	* library/tzdata/Asia/Hebron:
	* library/tzdata/Asia/Jerusalem:
	http://www.iana.org/time-zones/repository/releases/tzdata2013d.tar.gz

2013-07-03  Jan Nijtmans  <[email protected]>

	* unix/tclXtNotify.c: Bug [817249]: bring tclXtNotify.c up to date with
	Tcl_SetNotifier() change.

2013-07-02  Jan Nijtmans  <[email protected]>

	* unix/tcl.m4:  Bug [32afa6e256]: dirent64 check is incorrect in tcl.m4
	* unix/configure: (thanks to Brian Griffin)

2013-06-27  Jan Nijtmans  <[email protected]>

	* generic/tclConfig.c: Bug [9b2e636361]: Tcl_CreateInterp() needs
	* generic/tclMain.c:   initialized encodings.

2013-06-18  Jan Nijtmans  <[email protected]>

	* generic/tclEvent.c: Bug [3611974]: InitSubsystems multiple thread
	issue.

2013-06-17  Jan Nijtmans  <[email protected]>

	* generic/regc_locale.c: Bug [a876646efe]: re_expr character class
	[:cntrl:] should contain \u0000 - \u001f

2013-06-09  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmdsSZ.c (TclCompileTryCmd): [Bug 779d38b996]:
	Rewrote the [try] compiler to generate better code in some cases and
	to behave correctly in others; when an error happens during the
	processing of an exception-trap clause or a finally clause, the
	*original* return options are now captured in a -during option, even
	when fully compiled.

2013-06-05  Donal K. Fellows  <[email protected]>

	* generic/tclExecute.c (INST_EXPAND_DROP): [Bugs 2835313, 3614226]:
	New opcode to allow resetting the stack to get rid of an expansion,
	restoring the stack to a known state in the process.
	* generic/tclCompile.c, generic/tclCompCmds.c: Adjusted the compilers
	for [break] and [continue] to get stack cleanup right in the majority
	of cases.
	* tests/for.test (for-7.*): Set of tests for these evil cases.

2013-06-04  Jan Nijtmans  <[email protected]>

	* unix/tcl.m4: Eliminate NO_VIZ macro as current zlib uses HAVE_HIDDEN
	instead. One more last-moment fix for FreeBSD by Pietro Cerutti

2013-06-03  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c: fix for perf bug detected by Kieran
	(https://groups.google.com/forum/?fromgroups#!topic/comp.lang.tcl/vfpI3bc-DkQ),
	diagnosed by dgp to be a close relative of [Bug 781585], which was
	fixed by commit	[f46fb50cb3]. This bug was introduced by myself in
	commit [cbfe055d8c].

2013-06-03  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmds.c (TclCompileBreakCmd, TclCompileContinueCmd):
	Added code to allow [break] and [continue] to be issued as a jump (in
	the most common cases) rather than using the more expensive exception
	processing path in the bytecode engine. [Bug 3614226]: Partial fix for
	the issues relating to cleaning up the stack when dealing with [break]
	and [continue].

2013-05-27 Harald Oehlmann  <[email protected]>

	* library/msgcat/msgcat.tcl: [Bug 3036566]: Also get locale from
	registry key HCU\Control Panel\Desktop : PreferredUILanguages to honor
	installed language packs on Vista+.
	Bumped msgcat version to 1.5.2

2013-05-22  Andreas Kupries  <[email protected]>

	* tclCompile.c: Removed duplicate const qualifier causing the HP
	native cc to error out.

2013-05-22  Donal K. Fellows  <[email protected]>

	* generic/tclUtf.c (TclUtfCasecmp): [Bug 3613609]: Replace problematic
	uses of strcasecmp with a proper UTF-8-aware version. Affects both
	[lsearch -nocase] and [lsort -nocase].

2013-05-22  Donal K. Fellows  <[email protected]>

	* doc/file.n: [Bug 3613671]: Added note to portability section on the
	fact that [file owned] does not produce useful results on Windows.

2013-05-20  Donal K. Fellows  <[email protected]>

	* unix/tclUnixFCmd.c (DefaultTempDir): [Bug 3613567]: Corrected logic
	for checking return code of access() system call, which was inverted.

2013-05-19  Jan Nijtmans  <[email protected]>

	* unix/tcl.m4:     Fix for FreeBSD, and remove support for older
	* unix/configure:  FreeBSD versions. Patch by Pietro Cerutti.

2013-05-18  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmdsGR.c: Split tclCompCmds.c again to keep size of
	code down.

2013-05-16  Jan Nijtmans  <[email protected]>

	* generic/tclBasic.c: Add panic in order to detect incompatible
	mingw32 sys/stat.h and sys/time.h headers.

2013-05-13  Jan Nijtmans  <[email protected]>

	* compat/zlib/*: Upgrade to zlib 1.2.8

2013-05-10  Donal K. Fellows  <[email protected]>

	Optimizations and general bytecode generation improvements.
	* generic/tclCompCmds.c (TclCompileAppendCmd, TclCompileLappendCmd):
	(TclCompileReturnCmd): Make these generate bytecode in more cases.
	(TclCompileListCmd): Make this able to push a literal when it can.
	* generic/tclCompile.c (TclSetByteCodeFromAny, PeepholeOptimize):
	Added checks to see if we can apply some simple cross-command-boundary
	optimizations, and defined a small number of such optimizations.
	(TclCompileScript): Added the special ability to compile the list
	command with expansion ([list {*}blah]) into bytecode that does not
	call an external command.

2013-05-06  Jan Nijtmans  <[email protected]>

	* generic/tclStubInit.c: Add support for Cygwin64, which has a 64-bit
	* generic/tclDecls.h: "long" type. Binary compatibility with win64
	requires that all stub entries use 32-bit long's, therefore the need
	for various wrapper functions/macros. For Tcl 9 a better solution is
	needed, but that cannot be done without introducing binary
	incompatibility.

2013-04-30  Andreas Kupries  <[email protected]>

	* library/platform/platform.tcl (::platform::LibcVersion):
	* library/platform/pkgIndex.tcl: Followup to the 2013-01-30 change.
	The RE become too restrictive again. SuSe added a timestamp after the
	version. Loosened up a bit. Bumped package to version 1.0.12.

2013-04-29  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmds.c (TclCompileArraySetCmd): Generate better code
	when the list of things to set is a literal.

2013-04-25  Jan Nijtmans  <[email protected]>

	* generic/tclDecls.h: Implement Tcl_NewBooleanObj, Tcl_DbNewBooleanObj
	and Tcl_SetBooleanObj as macros using Tcl_NewIntObj, Tcl_DbNewLongObj
	and Tcl_SetIntObj. Starting with Tcl 8.5, this is exactly the same, it
	only eliminates code duplication.
	* generic/tclInt.h: Eliminate use of NO_WIDE_TYPE everywhere: It's
	exactly the same as TCL_WIDE_INT_IS_LONG

2013-04-19  Jan Nijtmans  <[email protected]>

	* generic/tclDecls.h: Implement many Tcl_*Var* functions and
	Tcl_GetIndexFromObj as (faster/stack-saving) macros around resp their
	Tcl_*Var*2 equivalent and Tcl_GetIndexFromObjStruct.

2013-04-12  Jan Nijtmans  <[email protected]>

	* generic/tclDecls.h: Implement Tcl_Pkg* functions as
	(faster/stack-saving) macros around Tcl_Pkg*Ex functions.

2013-04-08  Don Porter  <[email protected]>

	* generic/regc_color.c:	[Bug 3610026]: Stop crash when the number of
	* generic/regerrs.h:	"colors" in a regular expression overflows a
	* generic/regex.h:	short int.  Thanks to Heikki Linnakangas for
	* generic/regguts.h:	the report and the patch.
	* tests/regexp.test:

2013-04-04  Reinhard Max  <[email protected]>

	* library/http/http.tcl (http::geturl): Allow URLs that don't have a
	path, but a query query, e.g. http://example.com?foo=bar
	* Bump the http package to 2.8.7.

2013-03-22  Venkat Iyer <[email protected]>
	* library/tzdata/Africa/Cairo: Update to tzdata2013b.
	* library/tzdata/Africa/Casablanca:
	* library/tzdata/Africa/Gaborone:
	* library/tzdata/Africa/Tripoli:
	* library/tzdata/America/Asuncion:
	* library/tzdata/America/Barbados:
	* library/tzdata/America/Bogota:
	* library/tzdata/America/Costa_Rica:
	* library/tzdata/America/Curacao:
	* library/tzdata/America/Nassau:
	* library/tzdata/America/Port-au-Prince:
	* library/tzdata/America/Santiago:
	* library/tzdata/Antarctica/Palmer:
	* library/tzdata/Asia/Aden:
	* library/tzdata/Asia/Hong_Kong:
	* library/tzdata/Asia/Muscat:
	* library/tzdata/Asia/Rangoon:
	* library/tzdata/Asia/Shanghai:
	* library/tzdata/Atlantic/Bermuda:
	* library/tzdata/Europe/Vienna:
	* library/tzdata/Pacific/Easter:
	* library/tzdata/Pacific/Fiji:
	* library/tzdata/Asia/Khandyga: (new)
	* library/tzdata/Asia/Ust-Nera: (new)
	* library/tzdata/Europe/Busingen: (new)

2013-03-21  Don Porter  <[email protected]>

	* library/auto.tcl: [Bug 2102614]: Add ensemble indexing support to
	* tests/autoMkindex.test: [auto_mkindex].  Thanks Brian Griffin.

2013-03-19  Don Porter  <[email protected]>

	* generic/tclFCmd.c: [Bug 3597000]: Consistent [file copy] result.
	* tests/fileSystem.test:

2013-03-19  Jan Nijtmans  <[email protected]>

	* win/tclWinFile.c: [Bug 3608360]: Incompatible behaviour of "file
	exists".

2013-03-18  Donal K. Fellows  <[email protected]>

	* tests/cmdAH.test (cmdAH-19.12): [Bug 3608360]: Added test to ensure
	that we never ever allow [file exists] to do globbing.

2013-03-12  Jan Nijtmans  <[email protected]>

	* unix/tcl.m4: Patch by Andrew Shadura, providing better support for
	three architectures they have in Debian.

2013-03-11  Don Porter  <[email protected]>

	* generic/tclCompile.c:	[Bugs 3607246,3607372]: Unbalanced refcounts
	* generic/tclLiteral.c:	of literals in the global literal table.

2013-03-06  Don Porter  <[email protected]>

	* generic/regc_nfa.c:	[Bugs 3604074,3606683]: Rewrite of the
	* generic/regcomp.c:	fixempties() routine (and supporting routines)
	to completely eliminate the infinite loop hazard. Thanks to Tom Lane
	for the much improved solution.

2013-02-28  Don Porter  <[email protected]>

	* generic/tclLiteral.c:	Revise TclReleaseLiteral() to tolerate a NULL
	interp argument.

	* generic/tclCompile.c:	Update callers and revise mistaken comments.
	* generic/tclProc.c:

2013-02-27  Jan Nijtmans  <[email protected]>

	* generic/regcomp.c:	[Bug 3606139]: missing error check allows
	* tests/regexp.test:    regexp to crash Tcl. Thanks to Tom Lane for
	providing the test-case and the patch.

2013-02-26  Donal K. Fellows  <[email protected]>

	* tests/chanio.test (chan-io-28.7): [Bug 3605120]: Stop test from
	hanging when run standalone.

2013-02-26  Jan Nijtmans  <[email protected]>

	* generic/tclObj.c: Don't panic if Tcl_ConvertToType is called for a
	type that doesn't have a setFromAnyProc, create a proper error message.

2013-02-25  Donal K. Fellows  <[email protected]>

	* tests/binary.test (binary-41.*): [Bug 3605721]: Test independence
	fixes. Thanks to Rolf Ade for pointing out the problem.

2013-02-25  Don Porter  <[email protected]>

	* tests/assocd.test:	[Bugs 3605719,3605720]: Test independence.
	* tests/basic.test:	Thanks Rolf Ade for patches.

2013-02-23  Jan Nijtmans  <[email protected]>

	* compat/fake-rfc2553.c: [Bug 3599194]: compat/fake-rfc2553.c is
	broken.

2013-02-22  Don Porter  <[email protected]>

	* generic/tclAssembly.c:	Shift more burden of smart cleanup
	* generic/tclCompile.c:		onto the TclFreeCompileEnv() routine.
	Stop crashes when the hookProc raises an error.

2013-02-20  Don Porter  <[email protected]>

	* generic/tclNamesp.c:	[Bug 3605447]: Make sure the -clear option
	* tests/namespace.test:	to [namespace export] always clears, whether
	or not new export patterns are specified.

2013-02-20  Jan Nijtmans  <[email protected]>

	* win/tclWinDde.c: [Bug 3605401]: Compiler error with latest mingw-w64
	headers.

2013-02-19  Jan Nijtmans  <[email protected]>

	* generic/tclTrace.c:  [Bug 2438181]: Incorrect error reporting in
	* tests/trace.test:    traces. Test-case and fix provided by Poor
	Yorick.

2013-02-15  Don Porter  <[email protected]>

	* generic/regc_nfa.c:	[Bug 3604074]: Fix regexp optimization to
	* tests/regexp.test:	stop hanging on the expression
	((((((((a)*)*)*)*)*)*)*)* .  Thanks to Bjørn Grathwohl for discovery.

2013-02-14  Harald Oehlmann  <[email protected]>

	* library/msgcat/msgcat.tcl: [Bug 3604576]: Catch missing registry
	entry "HCU\Control Panel\International".
	Bumped msgcat version to 1.5.1

2013-02-11  Donal K. Fellows  <[email protected]>

	* generic/tclZlib.c (ZlibTransformOutput): [Bug 3603553]: Ensure that
	data gets written to the underlying stream by compressing transforms
	when the amount of data to be written is one buffer's-worth; problem
	was particularly likely to occur when compressing large quantities of
	not-very-compressible data. Many thanks to Piera Poggio (vampiera) for
	reporting.

2013-02-09  Donal K. Fellows  <[email protected]>

	* generic/tclOOBasic.c (TclOO_Object_VarName): [Bug 3603695]: Change
	the way that the 'varname' method is implemented so that there are no
	longer problems with interactions due to the resolver. Thanks to
	Taylor Venable <[email protected]> for identifying the problem.

2013-02-08  Donal K. Fellows  <[email protected]>

	* generic/regc_nfa.c (duptraverse): [Bug 3603557]: Increase the
	maximum depth of recursion used when duplicating an automaton in
	response to encountering a "wild" RE that hit the previous limit.
	Allow the limit (DUPTRAVERSE_MAX_DEPTH) to be set by defining its
	value in the Makefile. Problem reported by Jonathan Mills.

2013-02-05  Don Porter  <[email protected]>

	* win/tclWinFile.c:	[Bug 3603434]: Make sure TclpObjNormalizePath()
	properly declares "a:/" to be normalized, even when no "A:" drive is
	present on the system.

2013-02-05  Donal K. Fellows  <[email protected]>

	* generic/tclLoadNone.c (TclpLoadMemory): [Bug 3433012]: Added dummy
	version of this function to use in the event that a platform thinks it
	can load from memory but cannot actually do so due to it being
	disabled at configuration time.

2013-02-04  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmds.c (TclCompileArraySetCmd): [Bug 3603163]: Stop
	crash in weird case where [eval] is used to make [array set] get
	confused about whether there is a local variable table or not. Thanks
	to Poor Yorick for identifying a reproducible crashing case.

2013-01-30  Andreas Kupries  <[email protected]>

	* library/platform/platform.tcl (::platform::LibcVersion): See
	* library/platform/pkgIndex.tcl: [Bug 3599098]: Fixed the RE
	* unix/Makefile.in: extracting the version to avoid issues with
	* win/Makefile.in: recent changes to the glibc banner. Now targeting a
	less variable part of the string. Bumped package to version 1.0.11.

2013-01-28  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmds.c (TclCompileArraySetCmd)
	(TclCompileArrayUnsetCmd, TclCompileDictAppendCmd)
	(TclCompileDictCreateCmd, CompileDictEachCmd, TclCompileDictIncrCmd)
	(TclCompileDictLappendCmd, TclCompileDictMergeCmd)
	(TclCompileDictUnsetCmd, TclCompileDictUpdateCmd)
	(TclCompileDictWithCmd, TclCompileInfoCommandsCmd):
	* generic/tclCompCmdsSZ.c (TclCompileStringMatchCmd)
	(TclCompileStringMapCmd): Improve the code generation in cases where
	full compilation is impossible but a full ensemble invoke is provably
	not necessary.

2013-01-26  Jan Nijtmans  <[email protected]>

	* unix/tclUnixCompat.c: [Bug 3601804]: platformCPUID segmentation
	fault on Darwin.

2013-01-23  Donal K. Fellows  <[email protected]>

	* library/http/http.tcl (http::geturl): [Bug 2911139]: Do not do vwait
	for connect to avoid reentrancy problems (except when operating
	without a -command option). Internally, this means that all sockets
	created by the http package will always be operated in asynchronous
	mode.

2013-01-21  Jan Nijtmans  <[email protected]>

	* generic/tclInt.decls: Put back Tcl[GS]etStartupScript(Path|FileName)
	in private stub table, so extensions using this (like Tk 8.4) will
	continue to work in all Tcl 8.x versions. Extensions using this
	still cannot be compiled against Tcl 8.6 headers.

2013-01-18  Jan Nijtmans  <[email protected]>

	* generic/tclPort.h: [Bug 3598300]: unix: tcl.h does not include
	sys/stat.h

2013-01-17  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmds.c (PushVarName): [Bug 3600328]: Added mechanism
	for suppressing compilation of variables when we couldn't cope with
	the results. Useful for some [array] subcommands.
	* generic/tclEnsemble.c (CompileToCompiledCommand): Must restore the
	compilation environment when a command compiler fails.

2013-01-16  Donal K. Fellows  <[email protected]>

	* generic/tclZlib.c (TclZlibInit): [Bug 3601086]: Register the config
	info in the iso8859-1 encoding as that is guaranteed to be present.

2013-01-16  Jan Nijtmans  <[email protected]>

	* Makefile.in:   Allow win32 build with -DTCL_NO_DEPRECATED, just as
	* generic/tcl.h: in the UNIX build. Define Tcl_EvalObj and
	* generic/tclDecls.h: Tcl_GlobalEvalObj as macros, even when
	* generic/tclBasic.c: TCL_NO_DEPRECATED is defined, so Tk can benefit
	from it too.

2013-01-14  Jan Nijtmans  <[email protected]>

	* win/tcl.m4: More flexible search for win32 tclConfig.sh, backported
	from TEA (not actually used in Tcl, only for Tk)

2013-01-14  Jan Nijtmans  <[email protected]>

	* generic/tclInt.decls: Put back Tcl_[GS]etStartupScript in internal
	stub table, so extensions using this, compiled against 8.5 headers
	still run in Tcl 8.6.

2013-01-13  Alexandre Ferrieux  <[email protected]>

	* doc/fileevent.n: [Bug 3436609]: Clarify readable fileevent "false
	positives" in the case of multibyte encodings/transforms.

2013-01-13  Jan Nijtmans  <[email protected]>

	* generic/tclIntDecls.h: If TCL_NO_DEPRECATED is defined, make sure
	that TIP #139 functions all are taken from the public stub table, even
	if the inclusion is through tclInt.h.

2013-01-12  Jan Nijtmans  <[email protected]>

	* generic/tclInt.decls: Put back TclBackgroundException in internal
	stub table, so extensions using this, compiled against 8.5 headers
	still run in Tcl 8.6.

2013-01-09  Jan Nijtmans  <[email protected]>

	* library/http/http.tcl: [Bug 3599395]: http assumes status line is a
	proper Tcl list.

2013-01-08  Jan Nijtmans  <[email protected]>

	* win/tclWinFile.c: [Bug 3092089]: [file normalize] can remove path
	components.	[Bug 3587096]: win vista/7: "can't find init.tcl" when
	called via junction without folder list access.

2013-01-07  Jan Nijtmans  <[email protected]>

	* generic/tclOOStubLib.c: Restrict the stub library to only use
	* generic/tclTomMathStubLib.c: Tcl_PkgRequireEx, Tcl_ResetResult and
	Tcl_AppendResult, not any other function. This puts least restrictions
	on eventual Tcl 9 stubs re-organization, and it works on the widest
	range of Tcl versions.

2013-01-06  Jan Nijtmans  <[email protected]>

	* library/http/http.tcl: Don't depend on Spencer-specific regexp
	* tests/env.test: syntax (/u and /U) any more in unrelated places.
	* tests/exec.test:
	Bump http package to 2.8.6.

2013-01-04  Donal K. Fellows  <[email protected]>

	* generic/tclEnsemble.c (CompileBasicNArgCommand): Added very simple
	compiler (which just compiles to a normal invoke of the implementation
	command) for many ensemble subcommands where we can prove that there
	is no way for scripts to detect the difference even through error
	handling or [info level]/[info frame]. This improves the code produced
	from some ensembles (e.g., [info], [string]) to the point where the
	ensemble is now not normally seen at the bytecode level at all.

2013-01-04  Miguel Sofer  <[email protected]>

	* generic/tclInt.h:      Insure that PURIFY builds cannot exploit the
	* generic/tclExecute.c:  Tcl stack to hide mem defects.

2013-01-03  Donal K. Fellows  <[email protected]>

	* doc/fconfigure.n, doc/CrtChannel.3: Updated to reflect the fact that
	the minimum buffer size is one byte, not ten. Identified by Schelte
	Bron on the Tcler's Chat.

	* generic/tclExecute.c (TEBCresume:INST_INVOKE_REPLACE):
	* generic/tclEnsemble.c (TclCompileEnsemble): Added new mechanism to
	allow for more efficient dispatch of non-bytecode-compiled subcommands
	of bytecode-compiled ensembles. This can provide substantial speed
	benefits in some cases.

2013-01-02  Miguel Sofer  <[email protected]>

	* generic/tclEnsemble.c:  Remove stray calls to Tcl_Alloc and friends:
	* generic/tclExecute.c:   the core should only use ckalloc to allow
	* generic/tclIORTrans.c:  MEM_DEBUG to work properly.
	* generic/tclTomMathInterface.c:

2012-12-31  Donal K. Fellows  <[email protected]>

	* doc/string.n: Noted the obsolescence of the 'bytelength',
	'wordstart' and 'wordend' subcommands, and moved them to later in the
	file.

2012-12-27  Jan Nijtmans  <[email protected]>

	* generic/tclListObj.c: [Bug 3598580]: Tcl_ListObjReplace may release
	deleted elements too early.

2012-12-22  Alexandre Ferrieux  <[email protected]>

	* generic/tclUtil.c: [Bug 3598150]: Stop leaking allocated space when
	objifying a zero-length DString. Spotted by afredd.

2012-12-21  Jan Nijtmans  <[email protected]>

	* unix/dltest/pkgb.c:  Inline compat Tcl_GetDefaultEncodingDir.
	* generic/tclStubLib.c: Eliminate unnecessary static HasStubSupport()
	and isDigit() functions, just do the same inline.

2012-12-18  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmdsSZ.c (TclSubstCompile): Improved the sequence of
	instructions issued for [subst] when dealing with simple variable
	references.

2012-12-14  Don Porter  <[email protected]>

	*** 8.6.0 TAGGED FOR RELEASE ***

	* changes: updates for 8.6.0

2012-12-13  Don Porter  <[email protected]>

	* generic/tclZlib.c:	Repair same issue with misusing the
	* tests/zlib.test:	'fire and forget' nature of Tcl_ObjSetVar2
	in the new TIP 400 implementation.

2012-12-13  Miguel Sofer  <[email protected]>

	* generic/tclCmdAH.c:	(CatchObjCmdCallback): do not decrRefCount
	* tests/cmdAH.test:	the newValuePtr sent to Tcl_ObjSetVar2:
	TOSV2 is 'fire and forget', it decrs on its own.
	Fix for [Bug 3595576], found by andrewsh.

2012-12-13  Jan Nijtmans  <[email protected]>

	* generic/tcl.h: Fix Tcl_DecrRefCount macro such that it doesn't
	access its objPtr parameter twice any more.

2012-12-11  Don Porter  <[email protected]>

	* generic/tcl.h:	Bump version number to 8.6.0.
	* library/init.tcl:
	* unix/configure.in:
	* win/configure.in:
	* unix/tcl.spec:
	* README:

	* unix/configure:	autoconf-2.59
	* win/configure:

2012-12-10  Donal K. Fellows  <[email protected]>

	* tools/tcltk-man2html.tcl (plus-pkgs): Increased robustness of
	version number detection code to deal with packages whose names are
	prefixes of other packages.
	* unix/Makefile.in (dist): Added pkgs/package.list.txt to distribution
	builds to ensure that 'make html' will work better.

2012-12-09  Alexandre Ferrieux  <[email protected]>

	* tests/chan.test: Clean up unwanted eofchar side-effect of chan-4.6
	leading to a spurious "'" at end of chan.test under certain conditions
	(see [Bug 3389289] and [Bug 3389251]).

	* doc/expr.n: [Bug 3594188]: Clarifications about commas.

2012-12-08  Alexandre Ferrieux  <[email protected]>

	* generic/tclIO.c: Fix busyloop at exit under TCL_FINALIZE_ON_EXIT
	when there are unflushed nonblocking channels.  Thanks Miguel for
	spotting.

2012-12-07  Jan Nijtmans  <[email protected]>

	* unix/dltest/pkgb.c:  Turn pkgb.so into a Tcl9 interoperability test
        library: Whatever Tcl9 looks like, loading pkgb.so in Tcl 9 should
        either result in an error-message, either succeed, but never crash.

2012-11-28  Donal K. Fellows  <[email protected]>

	* generic/tclZlib.c (ZlibStreamSubcmd): [Bug 3590483]: Use a mechanism
	for complex option resolution that has fewer problems with more
	finicky compilers.

2012-11-26  Reinhard Max  <[email protected]>

	* unix/tclUnixSock.c: Factor out creation of the -sockname and
	-peername lists from TcpGetOptionProc() to TcpHostPortList().  Make it
	robust against implementations of getnameinfo() that error out if
	reverse mapping fails instead of falling back to the numeric
	representation.

2012-11-20  Donal K. Fellows  <[email protected]>

	* generic/tclBinary.c (BinaryDecode64): [Bug 3033307]: Corrected
	handling of trailing whitespace when decoding base64. Thanks to Anton
	Kovalenko for reporting, and Andy Goth for the fix and tests.

2012-11-19  Donal K. Fellows  <[email protected]>

	* generic/tclExecute.c (INST_STR_RANGE_IMM): [Bug 3588366]: Corrected
	implementation of bounds restriction for end-indexed compiled [string
	range]. Thanks to Emiliano Gavilan for diagnosis and fix.

2012-11-15  Jan Nijtmans  <[email protected]>

	IMPLEMENTATION OF TIP#416

	New Options for 'load': -global and -lazy

	* generic/tcl.h:
	* generic/tclLoad.c
	* unix/tclLoadDl.c
	* unix/tclLoadDyld.c
	* tests/load.test
	* doc/Load.3
	* doc/load.n

2012-11-14  Donal K. Fellows  <[email protected]>

	* unix/tclUnixFCmd.c (TclUnixOpenTemporaryFile): [Bug 2933003]: Factor
	out all the code to do temporary file creation so that it is possible
	to make it correct in one place. Allow overriding of the back-stop
	default temporary file location at compile time by setting the
	TCL_TEMPORARY_FILE_DIRECTORY #def to a string containing the directory
	name (defaults to "/tmp" as that is the most common default).

2012-11-13  Joe Mistachkin  <[email protected]>

	* win/tclWinInit.c: also search for the library directory (init.tcl,
	encodings, etc) relative to the build directory associated with the
	source checkout.

2012-11-10  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c:   re-enable bcc-tailcall, after fixing an
	* generic/tclExecute.c: infinite loop in the TCL_COMPILE_DEBUG mode


2012-11-07  Kevin B. Kenny  <[email protected]>

	* library/tzdata/Africa/Casablanca:
	* library/tzdata/America/Araguaina:
	* library/tzdata/America/Bahia:
	* library/tzdata/America/Havana:
	* library/tzdata/Asia/Amman:
	* library/tzdata/Asia/Gaza:
	* library/tzdata/Asia/Hebron:
	* library/tzdata/Asia/Jerusalem:
	* library/tzdata/Pacific/Apia:
	* library/tzdata/Pacific/Fakaofo:
	* library/tzdata/Pacific/Fiji:		Import tzdata2012i.

2012-11-06  Donal K. Fellows  <[email protected]>

	* library/http/http.tcl (http::Finish): [Bug 3581754]: Ensure that
	callbacks are done at most once to prevent problems with timeouts on a
	keep-alive connection (combined with reentrant http package use)
	causing excessive stack growth. Not a fix for the underlying problem,
	but ensures that pain will be mostly kept away from users.
	Bump http package to 2.8.5.

2012-11-05  Donal K. Fellows  <[email protected]>

	Added bytecode compilation of many Tcl commands. Some of these are
	total compilations and some are only partial (i.e., only compile in
	some cases). The (sub-)commands affected are:
	* array: exists, set, unset
	* dict: create, exists, merge
	* format: (simple cases only)
	* info: commands, coroutine, level, object
	* info object: class, isa object, namespace
	* namespace: current, code, qualifiers, tail, which
	* regsub: (only cases convertable to simple [string map])
	* self: (only no-argument and [self object] cases)
	* string: first, last, map, range
	* tailcall:
	* yield:

	[This was work originally done on the 'dkf-compile-misc-info' branch.]

2012-11-05  Jan Nijtmans  <[email protected]>

	IMPLEMENTATION OF TIP#413

	Align the [string trim] and [string is space] commands, such that
	[string trim] by default trims all characters for which [string is
	space] returns 1, augmented with the NUL character.

	* generic/tclUtf.c: Add NEL, BOM and two more characters to [string is
	space]
	* generic/tclCmdMZ.c: Modify [string trim] for Unicode modifications.
	* generic/regc_locale.c: Regexp engine must match [string is space]
	* doc/string.n
	* tests/string.test
	***POTENTIAL INCOMPATIBILITY***
	Code that relied on characters not previously trimmed being not
	removed will notice a difference; it is believed that this is rare,
	but a workaround to get the behavior in Tcl 8.5 is to use " \t\n\r" as
	an explicit trim set.

2012-10-31  Jan Nijtmans  <[email protected]>

	* win/Makefile.in:   Dde version number to 1.4.0, ready for Tcl 8.6.0rc1
	* win/makefile.vc
	* win/tclWinDde.c
	* library/dde/pkgIndex.tcl
	* tests/winDde.test

2012-10-24  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmds.c (TclCompileDictUnsetCmd): Added compilation of
	the [dict unset] command (for scalar var in LVT only).

2012-10-23  Jan Nijtmans  <[email protected]>

	* generic/tclInt.h:       Add "flags" parameter from Tcl_LoadFile to
	* generic/tclIOUtil.c:    to various internal functions, so these
	* generic/tclLoadNone.c:  flags are available through the whole
	* unix/tclLoad*.c:        filesystem for (future) internal use.
	* win/tclWinLoad.c:

2012-10-17  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c (TclNRCoroutineObjCmd): insure that numlevels
	are properly set, fix bug discovered by dkf and reported at
	http://code.activestate.com/lists/tcl-core/12213/

2012-10-16  Donal K. Fellows  <[email protected]>

	IMPLEMENTATION OF TIP#405

	New commands for applying a transformation to the elements of a list
	to produce another list (the [lmap] command) and to the mappings of a
	dictionary to produce another dictionary (the [dict map] command). In
	both cases, a [continue] will cause the skipping of an element/pair,
	and a [break] will terminate the construction early and successfully.

	* generic/tclCmdAH.c (Tcl_LmapObjCmd, TclNRLmapCmd): Implementation of
	the new [lmap] command, based on (and sharing much of) [foreach].
	* generic/tclDictObj.c (DictMapNRCmd): Implementation of the new [dict
	map] subcommand, based on (and sharing much of) [dict for].
	* generic/tclCompCmds.c (TclCompileLmapCmd, TclCompileDictMapCmd):
	Compilation engines for [lmap] and [dict map].

	IMPLEMENTATION OF TIP#400

	* generic/tclZlib.c: Allow the specification of a compression
	dictionary (a binary blob used to seed the compression engine) in both
	streams and channel transformations. Also some reorganization to allow
	for getting gzip header dictionaries and controlling buffering levels
	in channel transformations (allowing a trade-off between formal
	correctness and speed).
	(Tcl_ZlibStreamSetCompressionDictionary): New C API to allow setting
	the compression dictionary without using a Tcl script.

2012-10-14  Jan Nijtmans  <[email protected]>

	* generic/tclDictObj.c: [Bug 3576509]: ::tcl::Bgerror crashes with
	* generic/tclEvent.c:    invalid arguments. Better fix, which helps
	for all Tcl_DictObjGet() calls in Tcl's source code.

2012-10-13  Jan Nijtmans  <[email protected]>

	* generic/tclEvent.c: [Bug 3576509]: tcl::Bgerror crashes with invalid
	arguments

2012-10-06  Jan Nijtmans  <[email protected]>

	* win/Makefile.in: [Bug 2459774]: tcl/win/Makefile.in not compatible
	with msys 0.8.

2012-10-03  Don Porter  <[email protected]>

	* generic/tclIO.c:	When checking for std channels being closed,
	compare the channel state, not the channel itself so that stacked
	channels do not cause trouble.

2012-09-26  Reinhard Max  <[email protected]>

	* generic/tclIOSock.c (TclCreateSocketAddress): Work around a bug in
	getaddrinfo() on OSX that caused name resolution to fail for [socket
	-server foo -myaddr localhost 0].

2012-09-20  Jan Nijtmans  <[email protected]>

	* win/configure.in: New import libraries for zlib 1.2.7, usable for
	* win/configure:    all win32/win64 compilers
	* compat/zlib/win32/zdll.lib:
	* compat/zlib/win64/zdll.lib:

	* win/tclWinDde.c: [FRQ 3527238]: Full unicode support for dde. Dde
	version is now 1.4.0b2.
	***POTENTIAL INCOMPATIBILITY***

2012-09-19  Jan Nijtmans  <[email protected]>

	* generic/tcl.h:  Make Tcl_Interp a fully opaque structure if
	TCL_NO_DEPRECATED is set (TIP 330 and 336).
	* win/nmakehlp.c: Let "nmakehlp -V" start searching digits after the
	found match (suggested by Harald Oehlmann).

2012-09-19  Harald Oehlmann  <[email protected]>

	IMPLEMENTATION OF TIP#412.

	* library/msgcat/msgcat.tcl:	dynamic locale change with mc file
	* library/clock.tcl:            load on locale change.
	clock uses new msgcat features.

2012-09-07  Harald Oehlmann  <[email protected]>

	*** 8.6b3 TAGGED FOR RELEASE ***

	IMPLEMENTATION OF TIP#404.

	* library/msgcat/msgcat.tcl:	[FRQ 3544988]: New commands [mcflset]
	* library/msgcat/pkgIndex.tcl:	and [mcflmset] to set mc entries with
	* unix/Makefile.in:		implicit message file locale.
	* win/Makefile.in:		Bump to 1.5.0.

2012-08-25  Donal K. Fellows  <[email protected]>

	* library/msgs/uk.msg: [Bug 3561330]: Use the correct full name of
	March in Ukrainian. Thanks to Mikhail Teterin for reporting.

2012-08-23  Jan Nijtmans  <[email protected]>

	* generic/tclBinary.c: [Bug 3496014]: Unecessary memset() in
	Tcl_SetByteArrayObj().

2012-08-20  Don Porter  <[email protected]>

	* generic/tclPathObj.c:	[Bug 3559678]: Fix bad filename normalization
	when the last component is the empty string.

2012-08-20  Jan Nijtmans  <[email protected]>

	* win/tclWinPort.h:  Remove wrapper macro for ntohs(): unnecessary,
	because it doesn't require an initialized winsock_2 library. See:
	<http://msdn.microsoft.com/en-us/library/windows/desktop/ms740075%28v=vs.85%29.aspx>
	* win/tclWinSock.c:
	* generic/tclStubInit.c:

2012-08-17  Jan Nijtmans  <[email protected]>

	* win/nmakehlp.c: Add "-V<num>" option, in order to be able to detect
	partial version numbers.

2012-08-15  Jan Nijtmans  <[email protected]>

	* win/buildall.vc.bat: Only build the threaded builds by default
	* win/rules.vc:        Some code cleanup

2010-08-13  Stuart Cassoff  <[email protected]>

	* unix/tclUnixCompat.c: [Bug 3555454]: Rearrange a bit to quash
	'declared but never defined' compiler warnings.

2012-08-13  Jan Nijtmans  <[email protected]>

	* compat/zlib/win64/zlib1.dll:  Add 64-bit build of zlib1.dll, and use
	* compat/zlib/win64/zdll.lib:   it for the dynamic mingw-w64 build.
	* win/Makefile.in:
	* win/configure.in:
	* win/configure:

2012-08-09  Reinhard Max  <[email protected]>

	* tests/http.test: Fix http-3.29 for machines without IPv6 support.

2010-08-08  Stuart Cassoff  <[email protected]>

	* unix/tclUnixCompat.c: Change one '#ifdef' to '#if defined()' for
	improved consistency within the file.

2012-08-08  Jan Nijtmans  <[email protected]>

	* generic/tclfileName.c: [Bug #1536227]: Cygwin network pathname
	* tests/fileName.test:   support

2012-08-07  Don Porter  <[email protected]>

	* generic/tclIOUtil.c:	[Bug 3554250]: Overlooked one field of cleanup
	in the thread exit handler for the filesystem subsystem.

2012-07-31  Donal K. Fellows  <[email protected]>

	* generic/tclInterp.c (Tcl_GetInterpPath):
	* unix/tclUnixPipe.c (TclGetAndDetachPids, Tcl_PidObjCmd):
	* win/tclWinPipe.c (TclGetAndDetachPids, Tcl_PidObjCmd):
	Purge use of Tcl_AppendElement, and corrected conversion of PIDs to
	integer objects.

2012-07-31  Jan Nijtmans  <[email protected]>

	* win/nmakehlp.c:  Add -Q option from sampleextension.
	* win/Makefile.in: [FRQ 3544967]: Missing objectfiles in static lib
	* win/makefile.vc: (Thanks to Jos Decoster).

2012-07-29  Jan Nijtmans  <[email protected]>

	* win/Makefile.in:  No longer build tcltest.exe to run the tests,
	but use tclsh86.exe in combination with tcltest86.dll to do that.
	* tests/*.test:     load tcltest86.dll if necessary.

2012-07-28  Jan Nijtmans  <[email protected]>

	* tests/clock.test:    [Bug 3549770]: Multiple test failures running
	* tests/registry.test: tcltest outside build tree
	* tests/winDde.test:

2012-07-27  Jan Nijtmans  <[email protected]>

	* generic/tclUniData.c:   Support Unicode 6.2 (Add Turkish lira sign)
	* generic/regc_locale.c:

2012-07-25  Alexandre Ferrieux  <[email protected]>

	* win/tclWinPipe.c: [Bug 3547994]: Abandon the synchronous Windows
	pipe driver to its fate when needed to honour TIP#398.

2012-07-24  Trevor Davel  <[email protected]>

	* win/tclWinSock.c: [Bug: 3545363]: Loop over multiple underlying file
	descriptors for a socket where required (TcpCloseProc, SocketProc).
	Refactor socket/descriptor setup to manage linked list operations in
	one place. Fix memory leak in socket close (TcpCloseProc) and related
	dangling pointers in SocketEventProc.

2012-07-19  Reinhard Max  <[email protected]>

	* win/tclWinSock.c (TcpAccept): [Bug: 3545363]: Use a large enough
	buffer for accept()ing IPv6 connections. Fix conversion of host and
	port for passing to the accept proc to be independent of the IP
	version.

2012-07-23  Alexandre Ferrieux  <[email protected]>

	* generic/tclIO.c: [Bug 3545365]: Never try a bg-flush  on a dead
	channel, just like before 2011-08-17.

2012-07-19  Joe Mistachkin  <[email protected]>

	* generic/tclTest.c: Fix several more missing mutex-locks in
	TestasyncCmd.

2012-07-19  Alexandre Ferrieux  <[email protected]>

	* generic/tclTest.c: [Bug 3544685]: Missing mutex-lock in
	TestasyncCmd since 2011-08-19. Unbounded gratitude to Stuart
	Cassoff for spotting it.

2012-07-17  Jan Nijtmans  <[email protected]>

	* win/makefile.vc: [Bug 3544932]: Visual studio compiler check fails

2012-07-16  Donal K. Fellows  <[email protected]>

	* generic/tclUtil.c (UpdateStringOfEndOffset): [Bug 3544658]: Stop
	1-byte overrun in memcpy, that object placement rules made harmless
	but which still caused compiler complaints.

2012-07-16  Jan Nijtmans  <[email protected]>

	* library/reg/pkgIndex.tcl:  Make registry 1.3 package dynamically
	loadable when ::tcl::pkgconfig is available.

2012-07-11  Jan Nijtmans  <[email protected]>

	* win/tclWinReg.c: [Bug 3362446]: registry keys command fails
	with 8.5/8.6. Follow Microsofts example better in order to prevent
	problems when using HKEY_PERFORMANCE_DATA.

2012-07-10  Jan Nijtmans  <[email protected]>

	* unix/tclUnixNotfy.c: [Bug 3541646]: Don't panic on triggerPipe
	overrun.

2012-07-10  Donal K. Fellows  <[email protected]>

	* win/tclWinSock.c (InitializeHostName): Corrected logic that
	extracted the name of the computer from the gethostname call so that
	it would use the name on success, not failure. Also ensured that the
	buffer size is exactly that recommended by Microsoft.

2012-07-08  Reinhard Max  <[email protected]>

	* library/http/http.tcl: [Bug 3531209]: Add fix and test for URLs that
	* tests/http.test: 	 contain literal IPv6 addresses.

2012-07-05  Don Porter  <[email protected]>

	* unix/tclUnixPipe.c:	[Bug 1189293]: Make "<<" binary safe.
	* win/tclWinPipe.c:

2012-07-03  Donal K. Fellows  <[email protected]>

	* generic/tclUtil.c (TclDStringAppendObj, TclDStringAppendDString):
	* generic/tclInt.h (TclDStringAppendLiteral, TclDStringClear):
	* generic/tclCompile.h (TclDStringAppendToken): Added wrappers to make
	common cases of appending to Tcl_DStrings simpler to write. Prompted
	by looking at [FRQ 1357401] (these are an _internal_ implementation of
	that FRQ).

2012-06-29  Jan Nijtmans  <[email protected]>

	* library/msgcat/msgcat.tcl:   Add tn, ro_MO and ru_MO to msgcat.

2012-06-29  Harald Oehlmann <[email protected]>

	* library/msgcat/msgcat.tcl:	[Bug 3536888]: Locale guessing of
	* library/msgcat/pkgIndex.tcl:	msgcat fails on (some) Windows 7. Bump
	* unix/Makefile.in:		to 1.4.5
	* win/Makefile.in:

2012-06-29  Donal K. Fellows  <[email protected]>

	* doc/GetIndex.3: Reinforced the description of the requirement for
	the tables of names to index over to be static, following posting to
	tcl-core by Brian Griffin about a bug caused by Tktreectrl not obeying
	this rule correctly. This does not represent a functionality change,
	merely a clearer documentation of a long-standing constraint.

2012-06-26  Jan Nijtmans  <[email protected]>

	* unix/tcl.m4:       Let Cygwin shared build link with
	* unix/configure.in: zlib1.dll, not cygz.dll (two less
	* unix/configure:    dependencies on cygwin-specific dll's)
	* unix/Makefile.in:

2012-06-26  Reinhard Max  <[email protected]>

	* generic/tclIOSock.c: Use EAI_SYSTEM only if it exists.
	* unix/tclUnixSock.c:

2012-06-25  Don Porter  <[email protected]>

	* generic/tclFileSystem.h:	[Bug 3024359]: Make sure that the
	* generic/tclIOUtil.c:	per-thread cache of the list of file systems
	* generic/tclPathObj.c:	currently registered is only updated at times
	when no active loops are traversing it.  Also reduce the amount of
	epoch storing and checking to where it can make a difference.

2012-06-25  Donal K. Fellows  <[email protected]>

	* generic/tclCmdAH.c (EncodingDirsObjCmd): [Bug 3537605]: Do the right
	thing when reporting errors with the number of arguments.

2012-06-25  Jan Nijtmans  <[email protected]>

	* generic/tclfileName.c: [Patch 1536227]: Cygwin network pathname
	* tests/fileName.test:   support.

2012-06-23  Jan Nijtmans  <[email protected]>

	* unix/tclUnixNotfy.c: [Bug 3508771]: Cygwin notifier for handling
	win32 events.

2012-06-22  Reinhard Max  <[email protected]>

	* generic/tclIOSock.c: Rework the error message generation of [socket],
	* unix/tclUnixSock.c:  so that the error code of getaddrinfo is used
	* win/tclWinSock.c:    instead of errno unless it is EAI_SYSTEM.

2012-06-21  Jan Nijtmans  <[email protected]>

	* win/tclWinReg.c:	[Bug 3362446]: registry keys command fails
	* tests/registry.test:	with 8.5/8.6

2012-06-11  Don Porter  <[email protected]>

	* generic/tclBasic.c:	[Bug 3532959]: Make sure the lifetime
	* generic/tclProc.c:	management of entries in the linePBodyPtr
	* tests/proc.test:	hash table can tolerate either order of
	teardown, interp first, or Proc first.

2012-06-08  Don Porter  <[email protected]>

	* unix/configure.in:	Update autogoo for gettimeofday().
	* unix/tclUnixPort.h:	Thanks Joe English.
	* unix/configure:	autoconf 2.13

	* unix/tclUnixPort.h:	[Bug 3530533]: Centralize #include <pthread.h>
	* unix/tclUnixThrd.c:	in the tclUnixPort.h header so that old unix
	systems that need inclusion in all compilation units are supported.

2012-06-08  Jan Nijtmans  <[email protected]>

	* win/tclWinDde.c:    Revise the "null data" check: null strings are
	possible, but empty binary arrays are not.
	* tests/winDde.test:  Add test-case (winDde-9.4) for transferring
	null-strings with dde. Convert tests to tcltest-2 syntax.

2012-06-06  Donal K. Fellows  <[email protected]>

	* generic/tclZlib.c (TclZlibInit): Declare that Tcl is publishing the
	zlib package (version 2.0) as part of its bootstrap process. This will
	have an impact on tclkit (which includes zlib 1.1) but otherwise be
	very low impact.

2012-06-06  Jan Nijtmans  <[email protected]>

	* unix/tclUnixInit.c: On Cygwin, use win32 API in stead of uname()
	to determine the tcl_platform variables.

2012-05-31  Jan Nijtmans  <[email protected]>

	* generic/tclZlib.c:  [Bug 3530536]: zlib-7.4 fails on IRIX64
	* tests/zlib.test:
	* doc/zlib.n:         Document that [stream checksum] doesn't do
	what's expected for "inflate" and "deflate" formats

2012-05-31  Donal K. Fellows  <[email protected]>

	* library/safe.tcl (safe::AliasFileSubcommand): Don't assume that
	slaves have corresponding commands, as that is not true for
	sub-subinterpreters (used in Tk's test suite).

	* doc/safe.n: [Bug 1997845]: Corrected formatting so that generated
	HTML can link properly.

	* tests/socket.test (socket*-13.1): Prevented intermittent test
	failure due to race condition.

2012-05-29  Donal K. Fellows  <[email protected]>

	* doc/expr.n, doc/mathop.n: [Bug 2931407]: Clarified semantics of
	division and remainder operators.

2012-05-29  Jan Nijtmans  <[email protected]>

	* win/tclWinDde.c:    [Bug 3525762]: Encoding handling in dde.
	* win/Makefile.in:    Fix "make genstubs" when cross-compiling on UNIX

2012-05-28  Donal K. Fellows  <[email protected]>

	* library/safe.tcl (safe::AliasFileSubcommand): [Bug 3529949]: Made a
	more sophisticated method for preventing information leakage; it
	changes references to "~user" into "./~user", which is safe.

2012-05-25  Donal K. Fellows  <[email protected]>

	* doc/namespace.n, doc/Ensemble.3: [Bug 3528418]: Document what is
	going on with respect to qualification of command prefixes in ensemble
	subcommand maps.

	* generic/tclIO.h (SYNTHETIC_EVENT_TIME): Factored out the definition
	of the amount of time that should be waited before firing a synthetic
	event on a channel.

2012-05-25  Jan Nijtmans  <[email protected]>

	* win/tclWinDde.c: [Bug 473946]: Special characters were not correctly
	sent, now for XTYP_EXECUTE as well as XTYP_REQUEST.
	* win/Makefile.in: Fix "make genstubs" when cross-compiling on UNIX

2012-05-24  Jan Nijtmans  <[email protected]>

	* tools/genStubs.tcl:  Take cygwin handling of X11 into account.
	* generic/tcl*Decls.h: re-generated
	* generic/tclStubInit.c:  Implement TclpIsAtty, Cygwin only.
	* doc/dde.n: Doc fix: "dde execute iexplore" doesn't work
	without -async, because iexplore doesn't return a value

2012-05-24  Jan Nijtmans  <[email protected]>

	* tools/genStubs.tcl:   Let cygwin share stub table with win32
	* win/tclWinSock.c:     implement TclpInetNtoa for win32
	* generic/tclInt.decls: Revert most of [3caedf05df], since when
	  we let cygwin share the win32 stub table this is no longer necessary
	* generic/tcl*Decls.h:  re-generated
	* doc/dde.n:            1.3 -> 1.4

2012-05-23  Donal K. Fellows  <[email protected]>

	* generic/tclZlib.c (ZlibTransformInput): [Bug 3525907]: Ensure that
	decompressed input is flushed through the transform correctly when the
	input stream gets to the end. Thanks to Alexandre Ferrieux and Andreas
	Kupries for their work on this.

2012-05-21  Don Porter  <[email protected]>

	* generic/tclFileName.c:	When using Tcl_SetObjLength() calls to
	* generic/tclPathObj.c:		grow and shrink the objPtr->bytes
	buffer, care must be taken that the value cannot possibly become pure
	Unicode.  Calling Tcl_AppendToObj() has the possibility of making such
	a conversion.  Bug found while valgrinding the trunk.

2012-05-21  Jan Nijtmans  <[email protected]>

	IMPLEMENTATION OF TIP#106

	* win/tclWinDde.c:		Added encoding-related abilities to
	* library/dde/pkgIndex.tcl:	the [dde] command. The dde package's
	* tests/winDde.test:		version is now 1.4.0.
	* doc/dde.n:

2012-05-20  Donal K. Fellows  <[email protected]>

	* generic/tclOOBasic.c (TclOO_Class_Constructor): [Bug 2023112]: Cut
	the amount of hackiness in class constructors, and refactor some of
	the error message handling from [oo::define] to be saner in the face
	of odd happenings.

2012-05-17  Donal K. Fellows  <[email protected]>

	* generic/tclCmdMZ.c (Tcl_SwitchObjCmd): [Bug 3106532]: Corrected
	resulting indexes from -indexvar option to be usable with [string
	range]; this was always the intention (and is consistent with [regexp
	-indices] too).
	***POTENTIAL INCOMPATIBILITY***
	Uses of [switch -regexp -indexvar] that previously compensated for the
	wrong offsets (by subtracting 1 from the end indices) now do not need
	to do so as the value is correct.

	* library/safe.tcl (safe::InterpInit): Ensure that the module path is
	constructed in the correct order.
	(safe::AliasGlob): [Bug 2964715]: More extensive handling of what
	globbing is required to support package loading.

	* doc/expr.n: [Bug 3525462]: Corrected statement about what happens
	when comparing "0y" and "0x12"; the previously documented behavior was
	actually a subtle bug (now long-corrected).

2012-05-16  Donal K. Fellows  <[email protected]>

	* generic/tclCmdAH.c (TclMakeFileCommandSafe): [Bug 3445787]: Improve
	the compatibility of safe interpreters' version of 'file' with that of
	unsafe interpreters.
	* library/safe.tcl (::safe::InterpInit): Teach the safe-interp scripts
	about how to expose 'file' properly.

2012-05-13  Jan Nijtmans  <[email protected]>

	* win/tclWinDde.c:   Protect against receiving strings without ending
	\0, as external applications (or Tcl with TIP #106) could generate
	that.

2012-05-10  Jan Nijtmans  <[email protected]>

	* win/tclWinDde.c: [Bug 473946]: Special characters not correctly sent
	* library/dde/pkgIndex.tcl:  Increase version to 1.3.3

2012-05-10  Alexandre Ferrieux  <[email protected]>

	* {win,unix}/configure{,.in}: [Bug 2812981]: Clean up bundled
	packages' build directory from within Tcl's ./configure, to avoid
	stale configuration.

2012-05-09  Andreas Kupries  <[email protected]>

	* generic/tclIORChan.c: [Bug 3522560]: Fixed the crash, enabled the
	test case. Modified [chan postevent] to properly inject the event(s)
	into the owner thread's event queue for execution in the correct
	context. Renamed the ForwardOpTo...Thread() function to match with our
	terminology.

	* tests/ioCmd.test: [Bug 3522560]: Added a test which crashes the core
	if it were not disabled as knownBug. For a reflected channel
	transfered to a different thread the [chan postevent] run in the
	handler thread tries to execute the owner threads's fileevent scripts
	by itself, wrongly reaching across thread boundaries.

2012-04-28  Alexandre Ferrieux  <[email protected]>

	* generic/tclIO.c: Properly close nonblocking channels even when
	not flushing them.

2012-05-03  Jan Nijtmans  <[email protected]>

	* compat/zlib/*: Upgrade to zlib 1.2.7 (pre-built dll is still 1.2.5,
	will be upgraded as soon as the official build is available)

2012-05-03  Don Porter  <[email protected]>

	* tests/socket.test:	[Bug 3428754]: Test socket-14.2 tolerate
	[socket -async] connection that connects synchronously.

	* unix/tclUnixSock.c:	[Bug 3428753]: Fix [socket -async] connections
	that manage to connect synchronously.

2012-05-02  Jan Nijtmans  <[email protected]>

	* generic/configure.in:    Better detection and implementation for
	* generic/configure:       cpuid instruction on Intel-derived
	* generic/tclUnixCompat.c: processors, both 32-bit and 64-bit.
	* generic/tclTest.c:       Move cpuid testcase from win-specific to
	* win/tclWinTest.c:        generic tests, as it should work on all
	* tests/platform.test:     Intel-related platforms now.

2012-04-30  Alexandre Ferrieux  <[email protected]>

	* tests/ioCmd.test: [Bug 3522560]: Tame deadlocks in broken refchan
	tests.

2012-04-28  Alexandre Ferrieux  <[email protected]>

	IMPLEMENTATION OF TIP#398

	* generic/tclIO.c: Quickly Exit with Non-Blocking Blocked Channels
	* tests/io.test  : *** POTENTIAL INCOMPATIBILITY ***
	* doc/close.n    : (compat flag available)

2012-04-27  Jan Nijtmans  <[email protected]>

	* generic/tclPort.h:    Move CYGWIN-specific stuff from tclPort.h to
	* generic/tclEnv.c:     tclUnixPort.h, where it belongs.
	* unix/tclUnixPort.h:
	* unix/tclUnixFile.c:

2012-04-27  Donal K. Fellows  <[email protected]>

	* library/init.tcl (auto_execok): Allow shell builtins to be detected
	even if they are upper-cased.

2012-04-26  Jan Nijtmans  <[email protected]>

	* generic/tclStubInit.c:    Get rid of _ANSI_ARGS_ and CONST
	* generic/tclIO.c:
	* generic/tclIOCmd.c:
	* generic/tclTest.c:
	* unix/tclUnixChan.c:

2012-04-25  Donal K. Fellows  <[email protected]>

	* generic/tclUtil.c (TclDStringToObj): Added internal function to make
	the fairly-common operation of converting a DString into an Obj a more
	efficient one; for long strings, it can just transfer the ownership of
	the buffer directly. Replaces this:
	   obj=Tcl_NewStringObj(Tcl_DStringValue(&ds),Tcl_DStringLength(&ds));
	   Tcl_DStringFree(&ds);
	with this:
	   obj=TclDStringToObj(&ds);

2012-04-24  Jan Nijtmans  <[email protected]>

	* generic/tclInt.decls:      [Bug 3508771]: load tclreg.dll in cygwin
				     tclsh
	* generic/tclIntPlatDecls.h: Implement TclWinGetSockOpt,
	* generic/tclStubInit.c:     TclWinGetServByName and TclWinCPUID for
	* generic/tclUnixCompat.c:   Cygwin.
	* unix/configure.in:
	* unix/configure:
	* unix/tclUnixCompat.c:

2012-04-18  Kevin B. Kenny  <[email protected]>

	* library/tzdata/Africa/Casablanca:
	* library/tzdata/America/Port-au-Prince:
	* library/tzdata/Asia/Damascus:
	* library/tzdata/Asia/Gaza:
	* library/tzdata/Asia/Hebron: tzdata2012c

2012-04-16  Donal K. Fellows  <[email protected]>

	* doc/FileSystem.3 (Tcl_FSOpenFileChannelProc): [Bug 3518244]: Fixed
	documentation of this filesystem callback function; it must not
	register its created channel - that's the responsibility of the caller
	of Tcl_FSOpenFileChannel - as that leads to reference leaks.

2012-04-15  Donal K. Fellows  <[email protected]>

	* generic/tclEnsemble.c (NsEnsembleImplementationCmdNR):
	* generic/tclIOUtil.c (Tcl_FSEvalFileEx): Cut out levels of the C
	stack by going direct to the relevant internal evaluation function.

	* generic/tclZlib.c (ZlibTransformSetOption): [Bug 3517696]: Make
	flushing work correctly in a pushed compressing channel transform.

2012-04-12  Jan Nijtmans  <[email protected]>

	* generic/tclInt.decls:      [Bug 3514475]: Remove TclpGetTimeZone and
	* generic/tclIntDecls.h:     TclpGetTZName
	* generic/tclIntPlatDecls.h:
	* generic/tclStubInit.c:
	* unix/tclUnixTime.c:
	* unix/tclWinTilemc:

2012-04-11  Jan Nijtmans  <[email protected]>

	* win/tclWinInit.c:     [Bug 3448512]: clock scan "1958-01-01" fails
	* win/tcl.m4:           only in debug compilation.
	* win/configure:
	* unix/tcl.m4:          Use NDEBUG consistantly meaning: no debugging.
	* unix/configure:
	* generic/tclBasic.c:
	* library/dde/pkgIndex.tcl:  Use [::tcl::pkgconfig get debug] instead
	* library/reg/pkgIndex.tcl:  of [info exists ::tcl_platform(debug)]

2012-04-10  Donal K. Fellows  <[email protected]>

	* generic/tcl.h (TCL_DEPRECATED_API): [Bug 2458976]: Added macro that
	can be used to mark parts of Tcl's API as deprecated. Currently only
	used for fields of Tcl_Interp, which TIPs 330 and 336 have deprecated
	with a migration strategy; we want to encourage people to move away
	from those fields.

2012-04-09  Donal K. Fellows  <[email protected]>

	* generic/tclOODefineCmds.c (ClassVarsSet, ObjVarsSet): [Bug 3396896]:
	Ensure that the lists of variable names used to drive variable
	resolution will never have the same name twice.

	* generic/tclVar.c (AppendLocals): [Bug 2712377]: Fix problem with
	reporting of declared variables in methods. It's really a problem with
	how [info vars] interacts with variable resolvers; this is just a bit
	of a hack so it is no longer a big problem.

2012-04-04  Donal K. Fellows  <[email protected]>

	* generic/tclOO.c (Tcl_NewObjectInstance, TclNRNewObjectInstance):
	[Bug 3514761]: Fixed bogosity with automated argument description
	handling when constructing an instance of a class that is itself a
	member of an ensemble. Thanks to Andreas Kupries for identifying that
	this was a problem case at all!
	(Tcl_CopyObjectInstance): Fix potential bleed-over of ensemble
	information into [oo::copy].

2012-04-04  Jan Nijtmans  <[email protected]>

	* win/tclWinSock.c:	[Bug 510001]: TclSockMinimumBuffers needs
	* generic/tclIOSock.c:	platform implementation.
	* generic/tclInt.decls:
	* generic/tclIntDecls.h:
	* generic/tclStubInit.c:

2012-04-03  Jan Nijtmans  <[email protected]>

	* generic/tclStubInit.c: Remove the TclpGetTZName implementation for
	* generic/tclIntDecls.h: Cygwin (from 2012-04-02 commit), re-generated
	* generic/tclIntPlatDecls.h:

2012-04-02  Donal K. Fellows  <[email protected]>

	IMPLEMENTATION OF TIP#396.

	* generic/tclBasic.c (builtInCmds, TclNRYieldToObjCmd): Convert the
	formerly-unsupported yieldm and yieldTo commands into [yieldto].

2012-04-02  Jan Nijtmans  <[email protected]>

	* generic/tclInt.decls: [Bug 3508771]: load tclreg.dll in cygwin tclsh
	* generic/tclIntPlatDecls.h: Implement TclWinGetTclInstance,
	* generic/tclStubInit.c:     TclpGetTZName, and various more
	win32-specific internal functions for Cygwin, so win32 extensions
	using those can be loaded in the cygwin version of tclsh.

2012-03-30  Jan Nijtmans  <[email protected]>

	* unix/tcl.m4:        [Bug 3511806]: Compiler checks too early
	* unix/configure.in:  This change allows to build the cygwin and
	* unix/tclUnixPort.h: mingw32 ports of Tcl/Tk to build out-of-the-box
	* win/tcl.m4:         using a native or cross-compiler.
	* win/configure.in:
	* win/tclWinPort.h:
	* win/README          Document how to build win32 or win64 executables
	with Linux, Cygwin or Darwin.

2012-03-29  Jan Nijtmans  <[email protected]>

	* generic/tclCmdMZ.c (StringIsCmd): Faster mem-leak free
	implementation of [string is entier].

2012-03-27  Donal K. Fellows  <[email protected]>

	IMPLEMENTATION OF TIP#395.

	* generic/tclCmdMZ.c (StringIsCmd): Implementation of the [string is
	entier] check. Code by Jos Decoster.

2012-03-27  Jan Nijtmans  <[email protected]>

	* generic/tcl.h:      [Bug 3508771]: Wrong Tcl_StatBuf used on MinGW.
	* generic/tclFCmd.c:  [Bug 2015723]: Duplicate inodes from file stat
	* generic/tclCmdAH.c: on windows (but now for cygwin as well).
	* generic/tclOODefineCmds.c: minor gcc warning
	* win/tclWinPort.h:   Use lower numbers, preventing integer overflow.
	Remove the workaround for mingw-w64 [Bug 3407992]. It's long fixed.

2012-03-27  Donal K. Fellows  <[email protected]>

	IMPLEMENTATION OF TIP#397.

	* generic/tclOO.c (Tcl_CopyObjectInstance): [Bug 3474460]: Make the
	target object name optional when copying classes. [RFE 3485060]: Add
	callback method ("<cloned>") so that scripted control over copying is
	easier.
	***POTENTIAL INCOMPATIBILITY***
	If you'd previously been using the "<cloned>" method name, this now
	has a standard semantics and call interface. Only a problem if you are
	also using [oo::copy].

2012-03-26  Donal K. Fellows  <[email protected]>

	IMPLEMENTATION OF TIP#380.

	* doc/define.n, doc/object.n, generic/tclOO.c, generic/tclOOBasic.c:
	* generic/tclOOCall.c, generic/tclOODefineCmds.c, generic/tclOOInt.h:
	* tests/oo.test: Switch definitions of lists of things in objects and
	classes to a slot-based approach, which gives a lot more flexibility
	and programmability at the script-level. Introduce new [::oo::Slot]
	class which is the implementation of these things.

	***POTENTIAL INCOMPATIBILITY***
	The unknown method handler now may be asked to deal with the case
	where no method name is provided at all. The default implementation
	generates a compatible error message, and any override that forces the
	presence of a first argument (i.e., a method name) will continue to
	function as at present as well, so this is a pretty small change.

	* generic/tclOOBasic.c (TclOO_Object_Destroy): Made it easier to do a
	tailcall inside a normally-invoked destructor; prevented leakage out
	to calling command.

2012-03-25  Jan Nijtmans  <[email protected]>

	* generic/tclInt.decls:      [Bug 3508771]: load tclreg.dll in cygwin
	* generic/tclIntPlatDecls.h: tclsh. Implement TclWinConvertError,
	* generic/tclStubInit.c:     TclWinConvertWSAError, and various more
	* unix/Makefile.in:          win32-specific internal functions for
	* unix/tcl.m4:               Cygwin, so win32 extensions using those
	* unix/configure:            can be loaded in the cygwin version of
	* win/tclWinError.c:         tclsh.

2012-03-23  Jan Nijtmans  <[email protected]>

	* generic/tclInt.decls:       Revert some cygwin-related signature
	* generic/tclIntPlatDecls.h:  changes from [835f8e1e9d] (2010-01-22).
	* win/tclWinError.c:          They were an attempt to make the cygwin
	                              port compile again, but since cygwin is
	                              based on unix this serves no purpose any
	                              more.
	* win/tclWinSerial.c:         Use EAGAIN in stead of EWOULDBLOCK,
	* win/tclWinSock.c:           because in VS10+ the value of
	                              EWOULDBLOCK is no longer the same as
	                              EAGAIN.
	* unix/Makefile.in:           Add tclWinError.c to the CYGWIN build.
	* unix/tcl.m4:
	* unix/configure:

2012-03-20  Jan Nijtmans  <[email protected]>

	* generic/tcl.decls:         [Bug 3508771]: load tclreg.dll in cygwin
	* generic/tclInt.decls:      tclsh. Implement TclWinGetPlatformId,
	* generic/tclIntPlatDecls.h: Tcl_WinUtfToTChar, Tcl_WinTCharToUtf (and
	* generic/tclPlatDecls.h:    a dummy TclWinCPUID) for Cygwin, so win32
	* generic/tclStubInit.c:     extensions using those can be loaded in
	* unix/tclUnixCompat.c:      the cygwin version of tclsh.

2012-03-19  Venkat Iyer <[email protected]>

	* library/tzdata/America/Atikokan: Update to tzdata2012b.
	* library/tzdata/America/Blanc-Sablon:
	* library/tzdata/America/Dawson_Creek:
	* library/tzdata/America/Edmonton:
	* library/tzdata/America/Glace_Bay:
	* library/tzdata/America/Goose_Bay:
	* library/tzdata/America/Halifax:
	* library/tzdata/America/Havana:
	* library/tzdata/America/Moncton:
	* library/tzdata/America/Montreal:
	* library/tzdata/America/Nipigon:
	* library/tzdata/America/Rainy_River:
	* library/tzdata/America/Regina:
	* library/tzdata/America/Santiago:
	* library/tzdata/America/St_Johns:
	* library/tzdata/America/Swift_Current:
	* library/tzdata/America/Toronto:
	* library/tzdata/America/Vancouver:
	* library/tzdata/America/Winnipeg:
	* library/tzdata/Antarctica/Casey:
	* library/tzdata/Antarctica/Davis:
	* library/tzdata/Antarctica/Palmer:
	* library/tzdata/Asia/Yerevan:
	* library/tzdata/Atlantic/Stanley:
	* library/tzdata/Pacific/Easter:
	* library/tzdata/Pacific/Fakaofo:
	* library/tzdata/America/Creston: (new)

2012-03-19  Reinhard Max  <[email protected]>

	* unix/tclUnixSock.c (Tcl_OpenTcpServer): Use the values returned
	by getaddrinfo() for all three arguments to socket() instead of
	only using ai_family. Try to keep the most meaningful error while
	iterating over the result list, because using the last error can
	be misleading.

2012-03-15  Jan Nijtmans  <[email protected]>

	* generic/tcl.h: [Bug 3288345]: Wrong Tcl_StatBuf used on Cygwin
	* unix/tclUnixFile.c:
	* unix/tclUnixPort.h:
	* win/cat.c:           Remove cygwin stuff no longer needed
	* win/tclWinFile.c:
	* win/tclWinPort.h:

2012-03-12  Jan Nijtmans  <[email protected]>

	* win/tclWinFile.c: [Bug 3388350]: mingw64 compiler warnings

2012-03-11  Donal K. Fellows  <[email protected]>

	* doc/*.n, doc/*.3: A number of small spelling and wording fixes.

2012-03-08  Donal K. Fellows  <[email protected]>

	* doc/info.n:   Various minor fixes (prompted by Andreas Kupries
	* doc/socket.n: detecting a spelling mistake).

2012-03-07  Andreas Kupries  <[email protected]>

	* library/http/http.tcl: [Bug 3498327]: Generate upper-case
	* library/http/pkgIndex.tcl: hexadecimal output for compliance
	* tests/http.test: with RFC 3986. Bumped version to 2.8.4.
	* unix/Makefile.in:
	* win/Makefile.in:

2012-03-06  Jan Nijtmans  <[email protected]>

	* win/tclWinPort.h: Compatibility with older Visual Studio versions.

2012-03-04  Jan Nijtmans  <[email protected]>

	* generic/tclLoad.c: Patch from the cygwin folks
	* unix/tcl.m4:
	* unix/configure: (re-generated)

2012-03-02  Donal K. Fellows  <[email protected]>

	* generic/tclBinary.c (Tcl_SetByteArrayObj): [Bug 3496014]: Only zero
	out the memory block if it is not being immediately overwritten. (Our
	caller might still overwrite, but we should at least avoid
	known-useless work.)

2012-02-29  Jan Nijtmans  <[email protected]>

	* generic/tclIOUtil.c:	[Bug 3466099]: BOM in Unicode
	* generic/tclEncoding.c:
	* tests/source.test:

2012-02-23  Donal K. Fellows  <[email protected]>

	* tests/reg.test (14.21-23): Add tests relating to Bug 1115587. Actual
	bug is characterised by test marked with 'knownBug'.

2012-02-17  Jan Nijtmans  <[email protected]>

	* generic/tclIOUtil.c: [Bug 2233954]: AIX: compile error
	* unix/tclUnixPort.h:

2012-02-16  Donal K. Fellows  <[email protected]>

	* generic/tclExecute.c (INST_LIST_RANGE_IMM): Enhance implementation
	so that shortening a (not multiply-referenced) list by lopping the end
	off with [lrange] or [lreplace] is efficient.

2012-02-15  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmds.c (TclCompileLreplaceCmd): Added a compilation
	strategy for [lreplace] that tackles the cases which are equivalent to
	a static [lrange].
	(TclCompileLrangeCmd): Add compiler for [lrange] with constant indices
	so we can take advantage of existing TCL_LIST_RANGE_IMM opcode.
	(TclCompileLindexCmd): Improve coverage of constant-index-style
	compliation using technique developed for [lrange] above.

	(TclCompileDictForCmd): [Bug 3487626]: Fix crash in compilation of
	[dict for] when its implementation command is used directly rather
	than through the ensemble.

2012-02-09  Don Porter  <[email protected]>

	* generic/tclStringObj.c:	Converted the memcpy() calls in append
	operations to memmove() calls.  This adds safety in the case of
	overlapping copies, and improves performance on some benchmarks.

2012-02-06  Don Porter  <[email protected]>

	* generic/tclEnsemble.c: [Bug 3485022]: TclCompileEnsemble() avoid
	* tests/trace.test:	compile when exec traces set.

2012-02-06  Miguel Sofer  <[email protected]>

	* generic/tclTrace.c:  [Bug 3484621]: Ensure that execution traces on
	* tests/trace.test:    bytecoded commands bump the interp's compile
	epoch.

2012-02-02  Jan Nijtmans  <[email protected]>

	* generic/tclUniData.c: [FRQ 3464401]: Support Unicode 6.1
	* generic/regc_locale.c:

2012-02-02  Don Porter  <[email protected]>

	* win/tclWinFile.c:	[Bugs 2974459,2879351,1951574,1852572,
	1661378,1613456]: Revisions to the NativeAccess() routine that queries
	file permissions on Windows native filesystems.  Meant to fix numerous
	bugs where [file writable|readable|executable] "lies" about what
	operations are possible, especially when the file resides on a Samba
	share.

2012-02-01  Donal K. Fellows  <[email protected]>

	* doc/AddErrInfo.3: [Bug 3482614]: Documentation nit.

2012-01-30  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmds.c (TclCompileCatchCmd): Added a more efficient
	bytecode generator for the case where 'catch' is used without any
	variable arguments; don't capture the result just to discard it.

2012-01-26  Don Porter  <[email protected]>

	* generic/tclCmdAH.c:		[Bug 3479689]: New internal routine
	* generic/tclFCmd.c:		TclJoinPath(). Refactor all the
	* generic/tclFileName.c:	*Join*Path* routines to give them more
	* generic/tclInt.h:		useful interfaces that are easier to
	* generic/tclPathObj.c:		manage getting the refcounts right.

2012-01-26  Don Porter  <[email protected]>

	* generic/tclPathObj.c:	[Bug 3475569]: Add checks for unshared values
	before calls demanding them.  [Bug 3479689]: Stop memory corruption
	when shimmering 0-refCount value to "path" type.

2012-01-25  Donal K. Fellows  <[email protected]>

	* generic/tclOO.c (Tcl_CopyObjectInstance): [Bug 3474460]: When
	copying an object, make sure that the configuration of the variable
	resolver is also duplicated.

2012-01-22  Jan Nijtmans  <[email protected]>

	* tools/uniClass.tcl:    [FRQ 3473670]: Various Unicode-related
	* tools/uniParse.tcl:    speedups/robustness. Enhanced tools to be
	* generic/tclUniData.c:  able to handle characters > 0xFFFF. Done in
	* generic/tclUtf.c:      all branches in order to simplify merges for
	* generic/regc_locale.c: new Unicode versions (such as 6.1)

2012-01-22  Donal K. Fellows  <[email protected]>

	* generic/tclDictObj.c (DictExistsCmd): [Bug 3475264]: Ensure that
	errors only ever happen when insufficient arguments are supplied, and
	not when a path doesn't exist or a dictionary is poorly formatted (the
	two cases can't be easily distinguished).

2012-01-21  Jan Nijtmans  <[email protected]>

	* generic/tcl.h:        [Bug 3474726]: Eliminate detection of struct
	* generic/tclWinPort.h: _stat32i64, just use _stati64 in combination
	* generic/tclFCmd.c:    with _USE_32BIT_TIME_T, which is the same
	* generic/tclTest.c:    then. Only keep _stat32i64 usage for cygwin,
	* win/configure.in:     so it will not conflict with cygwin's own
	* win/configure:	struct stat.

2012-01-21  Don Porter  <[email protected]>

	* generic/tclCmdMZ.c:	[Bug 3475667]: Prevent buffer read overflow.
	Thanks to "sebres" for the report and fix.

2012-01-17  Donal K. Fellows  <[email protected]>

	* doc/dict.n (dict with): [Bug 3474512]: Explain better what is going
	on when a dictionary key and the dictionary variable collide.

2012-01-13  Donal K. Fellows  <[email protected]>

	* library/http/http.tcl (http::Connect): [Bug 3472316]: Ensure that we
	only try to read the socket error exactly once.

2012-01-12  Donal K. Fellows  <[email protected]>

	* doc/tclvars.n: [Bug 3466506]: Document more environment variables.

2012-01-09  Jan Nijtmans  <[email protected]>

	* generic/tclUtf.c:      [Bug 3464428]: [string is graph \u0120] was
	* generic/regc_locale.c: wrong. Add table for Unicode [:cntrl:] class.
	* tools/uniClass.tcl:    Generate Unicode [:cntrl:] class table.
	* tests/utf.test:

2012-01-08  Kevin B. Kenny  <[email protected]>

	* library/clock.tcl (ReadZoneinfoFile): [Bug 3470928]: Corrected a bug
	* tests/clock.test (clock-56.4):        where loading zoneinfo would
	fail if one timezone abbreviation was a proper tail of another, and
	zic used the same bytes of the file to represent both of them. Added a
	test case for the bug, using the same data that caused the observed
	failure "in the wild."

2011-12-30  Venkat Iyer <[email protected]>

	* library/tzdata/America/Bahia:		Update to Olson's tzdata2011n
	* library/tzdata/America/Havana:
	* library/tzdata/Europe/Kiev:
	* library/tzdata/Europe/Simferopol:
	* library/tzdata/Europe/Uzhgorod:
	* library/tzdata/Europe/Zaporozhye:
	* library/tzdata/Pacific/Fiji:

2011-12-23  Jan Nijtmans  <[email protected]>

	* generic/tclUtf.c: [Bug 3464428]: [string is graph \u0120] is wrong.
	* generic/tclUniData.c:
	* generic/regc_locale.c:
	* tests/utf.test:
	* tools/uniParse.tcl:   Clean up some unused stuff, and be more robust
	against changes in UnicodeData.txt syntax

2011-12-13  Andreas Kupries  <[email protected]>

	* generic/tclCompile.c (TclInitAuxDataTypeTable): Extended to register
	the DictUpdateInfo structure as an AuxData type. For use by tbcload,
	tclcompiler.

2011-12-11  Jan Nijtmans  <[email protected]>

	* generic/regc_locale.c: [Bug 3457031]: Some Unicode 6.0 chars not
	* tests/utf.test:        in [:print:] class

2011-12-07  Jan Nijtmans  <[email protected]>

	* tools/uniParse.tcl:    [Bug 3444754]: string tolower \u01c5 is wrong
	* generic/tclUniData.c:
	* tests/utf.test:

2011-11-30  Jan Nijtmans  <[email protected]>

	* library/tcltest/tcltest.tcl: [Bug 967195]: Make tcltest work
	when tclsh is compiled without using the setargv() function on mingw.

2011-11-29  Jan Nijtmans  <[email protected]>

	* win/Makefile.in: don't install tommath_(super)?class.h
	* unix/Makefile.in: don't install directories like 8.2 and 8.3
	* generic/tclTomMath.h: [Bug 2991415]: move include tclInt.h from
	* generic/tclTomMathInt.h: tclTomMath.h to tclTomMathInt.h

2011-11-25  Donal K. Fellows  <[email protected]>

	* library/history.tcl (history): Simplify the dance of variable
	management used when chaining to the implementation command.

2011-11-22  Donal K. Fellows  <[email protected]>

	* generic/tclExecute.c (TclCompileObj): Simplify and de-indent the
	logic so that it is easier to comprehend.

2011-11-22  Jan Nijtmans  <[email protected]>

	* win/tclWinPort.h: [Bug 3354324]: Windows: [file mtime] sets wrong
	* win/tclWinFile.c: time (VS2005+ only).
	* generic/tclTest.c:

2011-11-20  Joe Mistachkin  <[email protected]>

	* tests/thread.test: Remove unnecessary [after] calls from the thread
	tests.  Make error message matching more robust for tests that may
	have built-in race conditions.  Test thread-7.26 must first unset all
	thread testing related variables.  Revise results of the thread-7.28
	through thread-7.31 tests to account for the fact they are canceled
	via a script sent to the thread asynchronously, which then impacts the
	error message handling.  Attempt to manually drain the event queue for
	the main thread after joining the test thread to make sure no stray
	events are processed at the wrong time on the main thread.  Revise all
	the synchronization and comparison semantics related to the thread id
	and error message.

2011-11-18  Joe Mistachkin  <[email protected]>

	* tests/thread.test: Remove all use of thread::release from the thread
	7.x tests, replacing it with a script that can easily cause "stuck"
	threads to self-destruct for those test cases that require it.  Also,
	make the error message handling far more robust by keeping track of
	every asynchronous error.

2011-11-17  Joe Mistachkin  <[email protected]>

	* tests/thread.test: Refactor all the remaining thread-7.x tests that
	were using [testthread].  Note that this test file now requires the
	very latest version of the Thread package to pass all tests.  In
	addition, the thread-7.18 and thread-7.19 tests have been flagged as
	knownBug because they cannot pass without modifications to the [expr]
	command, persuant to TIP #392.

2011-11-17  Joe Mistachkin  <[email protected]>

	* generic/tclThreadTest.c: For [testthread cancel], avoid creating a
	new Tcl_Obj when the default script cancellation result is desired.

2011-11-11  Donal K. Fellows  <[email protected]>

	* win/tclWinConsole.c: Refactor common thread handling patterns.

2011-11-11  Alexandre Ferrieux  <[email protected]>

	* tests/zlib.test: [Bug 3428756]: Use nonblocking writes in
	single-threaded IO tests to avoid deadlocks when going beyond OS
	buffers.  Tidy up [chan configure] flags across zlib.test.

2011-11-03  Donal K. Fellows  <[email protected]>

	* unix/tclUnixCompat.c (TclpGetPwNam, TclpGetPwUid, TclpGetGrNam)
	(TclpGetGrGid): Use the elaborate memory management scheme outlined on
	http://www.opengroup.org/austin/docs/austin_328.txt to handle Tcl's
	use of standard reentrant versions of the passwd/group access
	functions so that everything can work on all BSDs. Problem identified
	by Stuart Cassoff.

2011-10-20  Don Porter  <[email protected]>

	* library/http/http.tcl:        Bump to version 2.8.3
	* library/http/pkgIndex.tcl:
	* unix/Makefile.in:
	* win/Makefile.in:

	* changes:	Updates toward 8.6b3 release.

2011-10-20  Donal K. Fellows  <[email protected]>

	* generic/tclLiteral.c (TclInvalidateCmdLiteral): [Bug 3418547]:
	Additional code for handling the invalidation of literals.
	* generic/tclBasic.c (Tcl_CreateObjCommand, Tcl_CreateCommand)
	(TclRenameCommand, Tcl_ExposeCommand): The four additional places that
	need extra care when dealing with literals.
	* generic/tclTest.c (TestInterpResolverCmd): Additional test machinery
	for interpreter resolvers.

2011-10-18  Reinhard Max  <[email protected]>

	* library/clock.tcl (::tcl::clock::GetSystemTimeZone): Cache the time
	zone only if it was detected by one of the expensive methods.
	Otherwise after unsetting TCL_TZ or TZ the previous value will still
	be used.

2011-10-15  Venkat Iyer <[email protected]>

	* library/tzdata/America/Sitka: Update to Olson's tzdata2011l
	* library/tzdata/Pacific/Fiji:
	* library/tzdata/Asia/Hebron: (New)

2011-10-11  Jan Nijtmans  <[email protected]>

	* win/tclWinFile.c:    [Bug 2935503]: Incorrect mode field returned by
	[file stat] command.

2011-10-09  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmds.c (TclCompileDictWithCmd): Corrected handling of
	qualified names, and added spacial cases for empty bodies (used when
	[dict with] is just used for extracting variables).

2011-10-07  Jan Nijtmans  <[email protected]>

	* generic/tcl.h:        Fix gcc warnings (discovered with latest
	* generic/tclIORChan.c: mingw, based on gcc 4.6.1)
	* tests/env.test:       Fix env.test, when running under wine 1.3.

2011-10-06  Donal K. Fellows  <[email protected]>

	* generic/tclDictObj.c (TclDictWithInit, TclDictWithFinish):
	* generic/tclCompCmds.c (TclCompileDictWithCmd): Experimental
	compilation for the [dict with] subcommand, using parts factored out
	from the interpreted version of the command.

2011-10-05  Jan Nijtmans  <[email protected]>

	* win/tclWinInt.h:   Remove tclWinProcs, as it is no longer
	* win/tclWin32Dll.c: being used.

2011-10-03  Venkat Iyer <[email protected]>

	* library/tzdata/Africa/Dar_es_Salaam: Update to Olson's tzdata2011k
	* library/tzdata/Africa/Kampala:
	* library/tzdata/Africa/Nairobi:
	* library/tzdata/Asia/Gaza:
	* library/tzdata/Europe/Kaliningrad:
	* library/tzdata/Europe/Kiev:
	* library/tzdata/Europe/Minsk:
	* library/tzdata/Europe/Simferopol:
	* library/tzdata/Europe/Uzhgorod:
	* library/tzdata/Europe/Zaporozhye:
	* library/tzdata/Pacific/Apia:

2011-09-29  Donal K. Fellows  <[email protected]>

	* tools/tcltk-man2html.tcl, tools/tcltk-man2html-utils.tcl: More
	refactoring so that more of the utility code is decently out of the
	way. Adjusted the header-material generator so that version numbers
	are only included in locations where there is room.

2011-09-28  Jan Nijtmans  <[email protected]>

	* generic/tclOO.h:      [RFE 3010352]: make all TclOO API functions
	* generic/tclOODecls.h: MODULE_SCOPE
	* generic/tclOOIntDecls.h:

2011-09-27  Donal K. Fellows  <[email protected]>

	* generic/tclIndexObj.c (Tcl_ParseArgsObjv): [Bug 3413857]: Corrected
	the memory management for the code parsing arguments when returning
	"large" numbers of arguments. Also unbroke the TCL_ARGV_AUTO_REST
	macro in passing.

2011-09-26  Donal K. Fellows  <[email protected]>

	* generic/tclCmdAH.c (TclMakeFileCommandSafe): [Bug 3211758]: Also
	make the main [file] command hidden by default in safe interpreters,
	because that's what existing code expects. This will reduce the amount
	which the code breaks, but not necessarily eliminate it...

2011-09-23  Don Porter  <[email protected]>

	* generic/tclIORTrans.c: More revisions to get finalization of
	ReflectedTransforms correct, including adopting a "dead" field as was
	done in tclIORChan.c.

	* tests/thread.test:	Stop using the deprecated thread management
	commands of the tcltest package.  The test suite ought to provide
	these tools for itself.  They do not belong in a testing harness.

2011-09-22  Don Porter  <[email protected]>

	* generic/tclCmdIL.c:	Revise [info frame] so that it stops creating
	cycles in the iPtr->cmdFramePtr stack.

2011-09-22  Donal K. Fellows  <[email protected]>

	* doc/re_syntax.n: [Bug 2903743]: Add more magic so that we can do at
	least something sane on Solaris.
	* tools/tcltk-man2html-utils.tcl (process-text): Teach the HTML
	generator how to handle this magic.

2011-09-21  Don Porter  <[email protected]>

	* generic/tclThreadTest.c: Revise the thread exit handling of the
	[testthread] command so that it properly maintains the per-process
	data structures even when the thread exits for reasons other than the
	[testthread exit] command.

2011-09-21  Alexandre Ferrieux  <[email protected]>

	* unix/tclIO.c: [Bug 3412487]: Now short reads are allowed in
	synchronous fcopy, avoid mistaking them as nonblocking ones.

2011-09-21  Andreas Kupries  <[email protected]>

	* generic/tclIORTrans.c (ForwardOpToOwnerThread): Fixed the missing
	initialization of the 'dsti' field. Reported by Don Porter, on chat.

2011-09-20  Don Porter  <[email protected]>

	* generic/tclIORChan.c: Re-using the "interp" field to signal a dead
	channel (via NULL value) interfered with conditional cleanup tasks
	testing for "the right interp". Added a new field "dead" to perform
	the dead channel signalling task so the corrupted logic is avoided.

	* generic/tclIORTrans.c: Revised ReflectClose() and
	FreeReflectedTransform() so that we stop leaking ReflectedTransforms,
	yet free all Tcl_Obj values in the same thread that alloced them.

2011-09-19  Don Porter  <[email protected]>

	* tests/ioTrans.test:	Conversion from [testthread] to Thread package
	stops most memory leaks.

	* tests/thread.test:	Plug most memory leaks in thread.test.
	Constrain the rest to be skipped during `make valgrind'.  Tests using
	the [testthread cancel] testing command are leaky.  Corrections wait
	for either addition of [thread::cancel] to the Thread package, or
	improvements to the [testthread] testing command to make leak-free
	versions of these tests possible.

	* generic/tclIORChan.c:	Plug all memory leaks in ioCmd.test exposed
	* tests/ioCmd.test:	by `make valgrind'.
	* unix/Makefile.in:

2011-09-16  Jan Nijtmans  <[email protected]>

	IMPLEMENTATION OF TIP #388

	* doc/Tcl.n:
	* doc/re_syntax.n:
	* generic/regc_lex.c:
	* generic/regcomp.c:
	* generic/regcustom.h:
	* generic/tcl.h:
	* generic/tclParse.c:
	* tests/reg.test:
	* tests/utf.test:

2011-09-16  Donal K. Fellows  <[email protected]>

	* generic/tclProc.c (ProcWrongNumArgs): [Bugs 3400658,3408830]:
	Corrected the handling of procedure error messages (found by TclOO).

2011-09-16  Jan Nijtmans  <[email protected]>

	* generic/tcl.h:        Don't change Tcl_UniChar type when
	* generic/regcustom.h:  TCL_UTF_MAX == 4 (not supported anyway)

2011-09-16  Donal K. Fellows  <[email protected]>

	* generic/tclProc.c (ProcWrongNumArgs): [Bugs 3400658,3408830]:
	Ensemble-like rewriting of error messages is complex, and TclOO (in
	combination with iTcl) hits the most tricky cases.

	* library/http/http.tcl (http::geturl): [Bug 3391977]: Ensure that the
	-headers option overrides the -type option (important because -type
	has a default that is not always appropriate, and the header must not
	be duplicated).

2011-09-15  Don Porter  <[email protected]>

	* generic/tclCompExpr.c: [Bug 3408408]: Partial improvement by sharing
	as literals the computed values of constant subexpressions when we can
	do so without incurring the cost of string rep generation.

2011-09-13  Don Porter  <[email protected]>

	* generic/tclUtil.c:	[Bug 3390638]: Workaround broken Solaris
	Studio cc optimizer.  Thanks to Wolfgang S. Kechel.

	* generic/tclDTrace.d:	[Bug 3405652]: Portability workaround for
	broken system DTrace support.  Thanks to Dagobert Michelson.

2011-09-12  Jan Nijtmans  <[email protected]>

	* win/tclWinPort.h: [Bug 3407070]: tclPosixStr.c won't build with
	EOVERFLOW==E2BIG

2011-09-11  Don Porter  <[email protected]>

	* tests/thread.test:	Convert [testthread] use to Thread package use
	in thread-6.1.  Eliminates a memory leak in `make valgrind`.

	* tests/socket.test:	[Bug 3390699]: Convert [testthread] use to
	Thread package use in socket_*-13.1.  Eliminates a memory leak in
	`make valgrind`.

2011-09-09  Don Porter  <[email protected]>

	* tests/chanio.test:	[Bug 3389733]: Convert [testthread] use to
	* tests/io.test:	Thread package use in *io-70.1.  Eliminates a
	memory leak in `make valgrind`.

2011-09-07  Don Porter  <[email protected]>

	* generic/tclCompExpr.c: [Bug 3401704]: Allow function names like
	* tests/parseExpr.test:	 influence(), nanobot(), and 99bottles() that
	have been parsed as missing operator syntax errors before with the
	form NUMBER + FUNCTION.
	***POTENTIAL INCOMPATIBILITY***

2011-09-06  Venkat Iyer <[email protected]>

	* library/tzdata/America/Goose_Bay: Update to Olson's tzdata2011i
	* library/tzdata/America/Metlakatla:
	* library/tzdata/America/Resolute:
	* library/tzdata/America/St_Johns:
	* library/tzdata/Europe/Kaliningrad:
	* library/tzdata/Pacific/Apia:
	* library/tzdata/Pacific/Honolulu:
	* library/tzdata/Africa/Juba: (new)

2011-09-06  Jan Nijtmans  <[email protected]>

	* generic/tcl.h:   [RFE 1711975]: Tcl_MainEx() (like Tk_MainEx())
	* generic/tclDecls.h:
	* generic/tclMain.c:

2011-09-02  Don Porter  <[email protected]>

	* tests/http.test:	Convert [testthread] use to Thread package use.
	Eliminates memory leak seen in `make valgrind`.

2011-09-01  Alexandre Ferrieux  <[email protected]>

	* unix/tclUnixSock.c: [Bug 3401422]: Cache script-level changes to the
	nonblocking flag of an async client socket in progress, and commit
	them on completion.

2011-09-01  Don Porter  <[email protected]>

	* generic/tclStrToD.c:	[Bug 3402540]: Corrections to TclParseNumber()
	* tests/binary.test:	to make it reject invalid Nan(Hex) strings.

	* tests/scan.test:	[scan Inf %g] is portable; remove constraint.

2011-08-30  Donal K. Fellows  <[email protected]>

	* generic/tclInterp.c (SlaveCommandLimitCmd, SlaveTimeLimitCmd):
	[Bug 3398794]: Ensure that low-level conditions in the limit API are
	enforced at the script level through errors, not a Tcl_Panic. This
	means that interpreters cannot read their own limits (writing already
	did not work).

2011-08-30  Reinhard Max  <[email protected]>

	* unix/tclUnixSock.c (TcpWatchProc): [Bug 3394732]: Put back the check
	for server sockets.

2011-08-29  Don Porter  <[email protected]>

	* generic/tclIORTrans.c: Leak of ReflectedTransformMap.

2011-08-27  Don Porter  <[email protected]>

	* generic/tclStringObj.c:  [RFE 3396731]: Revise the [string reverse]
	* tests/string.test:	implementation to operate on the representation
	that comes in, avoid conversion to other reps.

2011-08-23  Don Porter  <[email protected]>

	* generic/tclIORChan.c:	[Bug 3396948]: Leak of ReflectedChannelMap.

2011-08-19  Don Porter  <[email protected]>

	* generic/tclIORTrans.c: [Bugs 3393279, 3393280]: ReflectClose(.) is
	missing Tcl_EventuallyFree() calls at some of its exits.

	* generic/tclIO.c: [Bugs 3394654, 3393276]: Revise FlushChannel() to
	account for the possibility that the ChanWrite() call might recycle
	the buffer out from under us.

	* generic/tclIO.c: Preserve the chanPtr during FlushChannel so that
	channel drivers don't yank it away before we're done with it.

2011-08-19  Alexandre Ferrieux  <[email protected]>

	* generic/tclTest.c: [Bug 2981154]: async-4.3 segfault.
	* tests/async.test:  [Bug 1774689]: async-4.3 sometimes fails.

2011-08-18  Alexandre Ferrieux  <[email protected]>

	* generic/tclIO.c: [Bug 3096275]: Sync fcopy buffers input.

2011-08-18  Jan Nijtmans  <[email protected]>

	* generic/tclUniData.c: [Bug 3393714]: Overflow in toupper delta
	* tools/uniParse.tcl:
	* tests/utf.test:

2011-08-17  Alexandre Ferrieux  <[email protected]>

	* generic/tclIO.c:  [Bug 2946474]: Consistently resume backgrounded
	* tests/ioCmd.test: flushes+closes when exiting.

2011-08-17  Alexandre Ferrieux  <[email protected]>

	* doc/interp.n: Document TIP 378's one-way-ness.

2011-08-17  Don Porter  <[email protected]>

	* generic/tclGet.c: [Bug 3393150]: Overlooked free of intreps.
	(It matters for bignums!)

2011-08-16  Don Porter  <[email protected]>

	* generic/tclCompile.c: [Bug 3392070]: More complete prevention of
	Tcl_Obj reference cycles when producing an intrep of ByteCode.

2011-08-16  Donal K. Fellows  <[email protected]>

	* generic/tclListObj.c (TclLindexList, TclLsetFlat): Silence warnings
	about (unreachable) cases of uninitialized variables.
	* generic/tclCmdIL.c (SelectObjFromSublist): Improve the generation of
	* generic/tclIndexObj.c (Tcl_ParseArgsObjv): messages through the use
	* generic/tclVar.c (ArrayStartSearchCmd):    of Tcl_ObjPrintf.

2011-08-15  Don Porter  <[email protected]>

	* generic/tclBasic.c: [Bug 3390272]: Leak of [info script] value.

2011-08-15  Jan Nijtmans  <[email protected]>

	* generic/tclPosixStr.c:    [Bug 3388350]: mingw64 compiler warnings
	* win/tclWinPort.h:
	* win/configure.in:
	* win/configure:

2011-08-14  Jan Nijtmans  <[email protected]>

	* doc/FindExec.3: [Patch 3124554]: Move WishPanic from Tk to Tcl
	* doc/Panic.3     Added Documentation

2011-08-12  Don Porter  <[email protected]>

	* generic/tclPathObj.c:	[Bug 3389764]: Eliminate possibility that dup
	of a "path" value can create reference cycle.

2011-08-12  Donal K. Fellows  <[email protected]>

	* generic/tclZlib.c (ZlibTransformOutput): [Bug 3390073]: Return the
	correct length of written data for a compressing transform.

2011-08-10 Alexandre Ferrieux  <[email protected]>

	* generic/tclTestObj.c: [Bug 3386721]: Allow multiple [load]ing of the
	Tcltest package.

2011-08-09 Alexandre Ferrieux  <[email protected]>

	* generic/tclBasic.c: [Bug 2919042]: Restore "valgrindability" of Tcl
	* generic/tclEvent.c: that was lost by the streamlining of [exit], by
	* generic/tclExecute.c: conditionally forcing a full Finalize:
	* generic/tclInt.h:  use -DPURIFY or ::env(TCL_FINALIZE_ON_EXIT)

2011-08-09 Alexandre Ferrieux  <[email protected]>

	* generic/tclCompCmds.c: [Bug 3386417]: Avoid a reference loop between
	* generic/tclInt.h:      the bytecode and its companion errostack
	* generic/tclResult.c:   when compiling a syntax error.

2011-08-09  Jan Nijtmans  <[email protected]>

	* win/tclWinConsole.c: [Bug 3388350]: mingw64 compiler warnings
	* win/tclWinDde.c:
	* win/tclWinPipe.c:
	* win/tclWinSerial.c:

2011-08-09  Jan Nijtmans  <[email protected]>

	* generic/tclInt.h: Change the signature of TclParseHex(), such that
	* generic/tclParse.c: it can now parse up to 8 hex characters.

2011-08-08  Donal K. Fellows  <[email protected]>

	* generic/tclZlib.c (ZlibStreamCmd): Make the -buffersize option to
	'$zstream add' function correctly instead of having its value just be
	discarded unceremoniously. Also generate error codes from more of the
	code, not just the low-level code but also the Tcl infrastructure.

2011-08-07  Donal K. Fellows  <[email protected]>

	* generic/tclOOInfo.c (InfoClassCallCmd): [Bug 3387082]: Plug memory
	leak in call chain introspection.

2011-08-06  Kevin B, Kenny  <[email protected]>

	* generic/tclAssemnbly.c: [Bug 3384840]: Plug another memory leak.
	* generic/tclStrToD.c: [Bug 3386975]: Plug another memory leak.

2011-08-05  Kevin B. Kenny  <[email protected]>

	* generic/tclStrToD.c: [Bug 3386975]: Plugged a memory leak in
	double->string conversion.

2011-08-05  Don Porter  <[email protected]>

	*** 8.6b2 TAGGED FOR RELEASE ***

	* changes:	Updates for 8.6b2 release.

2011-08-05  Donal K. Fellows  <[email protected]>

	* generic/tclAssembly.c (AssembleOneLine): Ensure that memory isn't
	leaked when an unknown instruction is encountered. Also simplify code
	through use of Tcl_ObjPrintf in error message generation.

	* generic/tclZlib.c (ZlibTransformClose): [Bug 3386197]: Plug a memory
	leak found by Miguel with valgrind, and ensure that the correct
	direction's buffers are released.

2011-08-04  Miguel Sofer  <[email protected]>

	* generic/tclVar.c (TclPtrSetVar): Fix valgrind-detected error when
	newValuePtr is the interp's result obj.

2011-08-04  Donal K. Fellows  <[email protected]>

	* generic/tclAssembly.c (FreeAssemblyEnv): [Bug 3384840]: Plug another
	possible memory leak due to over-complex code for freeing the table of
	labels.

2011-08-04  Reinhard Max  <[email protected]>

	* generic/tclIOSock.c (TclCreateSocketAddress): Don't bother using
	AI_ADDRCONFIG for now, as it was causing problems in various
	situations.

2011-08-04  Donal K. Fellows  <[email protected]>

	* generic/tclAssembly.c (AssembleOneLine, GetBooleanOperand)
	(GetIntegerOperand, GetListIndexOperand, FindLocalVar): [Bug 3384840]:
	A Tcl_Obj is allocated by GetNextOperand, so callers of it must not
	hold a reference to one in the 'out' parameter when calling it. This
	was causing a great many memory leaks.
	* tests/assemble.test (assemble-51.*): Added group of memory leak
	tests.

2011-08-02  Don Porter  <[email protected]>

	* changes:	Updates for 8.6b2 release.
	* tools/tcltk-man2html.tcl: Variable substitution botch.

2011-08-02  Donal K. Fellows  <[email protected]>

	* generic/tclObj.c (Tcl_DbIncrRefCount, Tcl_DbDecrRefCount)
	(Tcl_DbIsShared): [Bug 3384007]: Fix the panic messages so they share
	what should be shared and have the right number of spaces.

2011-08-01  Miguel Sofer  <[email protected]>

	* generic/tclProc.c (TclProcCompileProc): [Bug 3383616]: Fix for leak
	of resolveInfo when recompiling procs. Thanks go to Gustaf Neumann for
	detecting the bug and providing the fix.

2011-08-01  Donal K. Fellows  <[email protected]>

	* doc/tclvars.n (EXAMPLES): Added some examples of how some of the
	standard global variables can be used, following prompting by a
	request by Robert Hicks.

	* tools/tcltk-man2html.tcl (plus-pkgs): [Bug 3382474]: Added code to
	determine the version number of contributed packages from their
	directory names so that HTML documentation builds are less confusing.

2011-07-29  Donal K. Fellows  <[email protected]>

	* tools/tcltk-man2html.tcl (ensemble_commands, remap_link_target):
	Small enhancements to improve cross-linking with contributed packages.
	* tools/tcltk-man2html-utils.tcl (insert-cross-references): Enhance to
	cope with contributed packages' C API.

2011-07-28  Reinhard Max  <[email protected]>

	* unix/tcl.m4 (SC_TCL_IPV6): Fix AC_DEFINE invocation for
	NEED_FAKE_RFC2553.
	* unix/configure:	autoconf-2.59

2011-07-28  Don Porter  <[email protected]>

	* changes:	Updates for 8.6b2 release.

	* library/tzdata/Asia/Anadyr: Update to Olson's tzdata2011h
	* library/tzdata/Asia/Irkutsk:
	* library/tzdata/Asia/Kamchatka:
	* library/tzdata/Asia/Krasnoyarsk:
	* library/tzdata/Asia/Magadan:
	* library/tzdata/Asia/Novokuznetsk:
	* library/tzdata/Asia/Novosibirsk:
	* library/tzdata/Asia/Omsk:
	* library/tzdata/Asia/Sakhalin:
	* library/tzdata/Asia/Vladivostok:
	* library/tzdata/Asia/Yakutsk:
	* library/tzdata/Asia/Yekaterinburg:
	* library/tzdata/Europe/Kaliningrad:
	* library/tzdata/Europe/Moscow:
	* library/tzdata/Europe/Samara:
	* library/tzdata/Europe/Volgograd:
	* library/tzdata/America/Kralendijk: (new)
	* library/tzdata/America/Lower_Princes: (new)

2011-07-26  Donal K. Fellows  <[email protected]>

	* generic/tclOO.c (initScript): Ensure that TclOO is properly found by
	all the various package mechanisms (by adding a dummy ifneeded script)
	and not just some of them.

2011-07-21  Jan Nijtmans  <[email protected]>

	* win/tclWinPort.h: [Bug 3372130]: Fix hypot math function with MSVC10

2011-07-19  Don Porter  <[email protected]>

	* generic/tclUtil.c:	[Bug 3371644]: Repair failure to properly handle
	* tests/util.test: (length == -1) scanning in TclConvertElement().
	Thanks to Thomas Sader and Alexandre Ferrieux.

2011-07-19  Donal K. Fellows  <[email protected]>

	* doc/*.3, doc/*.n: Many small fixes to documentation as part of
	project to improve quality of generated HTML docs.

	* tools/tcltk-man2html.tcl (remap_link_target): More complete set of
	definitions of link targets, especially for major C API types.
	* tools/tcltk-man2html-utils.tcl (output-IP-list, cross-reference):
	Update to generation to produce proper HTML bulleted and enumerated
	lists.

2011-07-19 Alexandre Ferrieux  <[email protected]>

	* doc/upvar.n: Undocument long gone limitation of [upvar].

2011-07-18  Don Porter  <[email protected]>

	* generic/tcl.h:	Bump version number to 8.6b2.
	* library/init.tcl:
	* unix/configure.in:
	* win/configure.in:
	* unix/tcl.spec:
	* tools/tcl.wse.in:
	* README:

	* unix/configure:	autoconf-2.59
	* win/configure:

2011-07-15  Don Porter  <[email protected]>

	* generic/tclCompile.c: Avoid segfaults when RecordByteCodeStats() is
	called in a deleted interp.

	* generic/tclCompile.c: [Bug 467523, 3357771]: Prevent circular
	references in values with ByteCode intreps.  They can lead to memory
	leaks.

2011-07-14  Donal K. Fellows  <[email protected]>

	* generic/tclOOCall.c (TclOORenderCallChain): [Bug 3365156]: Remove
	stray refcount bump that caused a memory leak.

2011-07-12  Don Porter  <[email protected]>

	* generic/tclUnixSock.c:  [Bug 3364777]: Stop segfault caused by
	reading from struct after it had been freed.

2011-07-11  Joe Mistachkin  <[email protected]>

	* generic/tclExecute.c: [Bug 3339502]: Correct cast for CURR_DEPTH to
	silence compiler warning.

2011-07-08  Donal K. Fellows  <[email protected]>

	* doc/http.n: [FRQ 3358415]: State what RFC defines HTTP/1.1.

2011-07-07  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c: Add missing INT2PTR

2011-07-03  Donal K. Fellows  <[email protected]>

	* doc/FileSystem.3: Corrected statements about ctime field of 'struct
	stat'; that was always the time of the last metadata change, not the
	time of creation.

2011-07-02  Kevin B. Kenny  <[email protected]>

	* generic/tclStrToD.c:
	* generic/tclTomMath.decls:
	* generic/tclTomMathDecls.h:
	* macosx/Tcl.xcode/project.pbxproj:
	* macosx/Tcl.xcodeproj/project.pbxproj:
	* tests/util.test:
	* unix/Makefile.in:
	* win/Makefile.in:
	* win/Makefile.vc:
	[Bug 3349507]: Fix a bug where bignum->double conversion is "round up"
	and not "round to nearest" (causing expr double(1[string repeat 0 23])
	not to be 1e+23).

2011-06-28  Reinhard Max  <[email protected]>

	* unix/tclUnixSock.c (CreateClientSocket): [Bug 3325339]: Fix and
	simplify posting of the writable fileevent at the end of an
	asynchronous connection attempt. Improve comments for some of the
	trickery around [socket -async].

	* tests/socket.test: Adjust tests to the async code changes. Add more
	tests for corner cases of async sockets.

2011-06-22  Andreas Kupries  <[email protected]>

	* library/platform/pkgIndex.tcl: Updated to platform 1.0.10. Added
	* library/platform/platform.tcl: handling of the DEB_HOST_MULTIARCH
	* unix/Makefile.in: location change for libc.
	* win/Makefile.in:

	* generic/tclInt.h: Fixed the inadvertently committed disabling of
	stack checks, see my 2010-11-15 commit.

2011-06-22  Reinhard Max  <[email protected]>

	Merge from rmax-ipv6-branch:
	* unix/tclUnixSock.c: Fix [socket -async], so that all addresses
	returned by getaddrinfo() are tried, not just the first one. This
	requires the event loop to be running while the async connection is in
	progress. ***POTENTIAL INCOMPATIBILITY***
	* tests/socket.test: Add a test for the above.
	* doc/socket: Document the fact that -async needs the event loop
	* generic/tclIOSock.c: AI_ADDRCONFIG is broken on HP-UX

2011-06-21  Don Porter  <[email protected]>

	* generic/tclLink.c:	[Bug 3317466]: Prevent multiple links to a
	single Tcl variable when calling Tcl_LinkVar().

2011-06-13  Don Porter  <[email protected]>

	* generic/tclStrToD.c:  [Bug 3315098]: Mem leak fix from Gustaf
	Neumann.

2011-06-08  Andreas Kupries  <[email protected]>

	* generic/tclExecute.c: Reverted the fix for [Bug 3274728] committed
	on 2011-04-06 and replaced with one which is 64bit-safe. The existing
	fix crashed tclsh on Windows 64bit.

2011-06-08  Donal K. Fellows  <[email protected]>

	* tests/fileSystem.test: Reduce the amount of use of duplication of
	complex code to perform common tests, and convert others to do the
	test result check directly using Tcltest's own primitives.

2011-06-06  Jan Nijtmans  <[email protected]>

	* tests/socket.test: Add test constraint, so 6.2 and 6.3 don't fail
	when the machine does not have support for ip6. Follow-up to checkin
	from 2011-05-11 by rmax.

2011-06-02  Don Porter  <[email protected]>

	* generic/tclBasic.c:	Removed TclCleanupLiteralTable(), and old
	* generic/tclInt.h:	band-aid routine put in place while a fix for
	* generic/tclLiteral.c:	[Bug 994838] took shape.  No longer needed.

2011-06-02  Donal K. Fellows  <[email protected]>

	* generic/tclInt.h (TclInvalidateNsCmdLookup): [Bug 3185407]: Extend
	the set of epochs that are potentially bumped when a command is
	created, for a slight performance drop (in some circumstances) and
	improved semantics.

2011-06-01  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c: Using the two free data elements in NRCommand to
	store objc and objv - useful for debugging.

2011-06-01  Jan Nijtmans  <[email protected]>

	* generic/tclUtil.c:   Fix for [Bug 3309871]: Valgrind finds: invalid
	read in TclMaxListLength().

2011-05-31  Don Porter  <[email protected]>

	* generic/tclInt.h:	  Use a complete growth algorithm for lists so
	* generic/tclListObj.c:	  that length limits do not overconstrain by a
	* generic/tclStringObj.c: factor of 2.  [Bug 3293874]: Fix includes
	* generic/tclUtil.c:	  rooting all growth routines by default on a
	common tunable parameter TCL_MIN_GROWTH.

2011-05-25  Don Porter  <[email protected]>

	* library/msgcat/msgcat.tcl:	Bump to msgcat 1.4.4.
	* library/msgcat/pkgIndex.tcl:
	* unix/Makefile.in:
	* win/Makefile.in:

2011-05-25  Donal K. Fellows  <[email protected]>

	* generic/tclOO.h (TCLOO_VERSION): Bump version.

	IMPLEMENTATION OF TIP#381.

	* doc/next.n, doc/ooInfo.n, doc/self.n, generic/tclOO.c,
	* generic/tclOOBasic.c, generic/tclOOCall.c, generic/tclOOInfo.c,
	* generic/tclOOInt.h, tests/oo.test, tests/ooNext2.test: Added
	introspection of call chains ([self call], [info object call], [info
	class call]) and ability to skip ahead in chain ([nextto]).

2011-05-24  Venkat Iyer <[email protected]>

	* library/tzdata/Africa/Cairo: Update to Olson tzdata2011g

2011-05-24  Donal K. Fellows  <[email protected]>

	* library/msgcat/msgcat.tcl (msgcat::mcset, msgcat::mcmset): Remove
	some useless code; [dict set] builds dictionary levels for us.

2011-05-17  Andreas Kupries  <[email protected]>

	* generic/tclCompile.c (TclFixupForwardJump): Tracked down and fixed
	* generic/tclBasic.c (TclArgumentBCEnter): the cause of a violation of
	my assertion that 'ePtr->nline == objc' in TclArgumentBCEnter.  When a
	bytecode was grown during jump fixup the pc -> command line mapping
	was not updated. When things aligned just wrong the mapping would
	direct command A to the data for command B, with a different number of
	arguments.

2011-05-11  Reinhard Max  <[email protected]>

	* unix/tclUnixSock.c (TcpWatchProc): No need to check for server
	sockets here, as the generic server code already takes care of that.
	* tests/socket.test (accept): Add tests to make sure that this remains
	so.

2011-05-10  Don Porter  <[email protected]>

	* generic/tclInt.h:     New internal routines TclScanElement() and
	* generic/tclUtil.c:    TclConvertElement() are rewritten guts of
	machinery to produce string rep of lists.  The new routines avoid and
	correct [Bug 3173086].  See comments for much more detail.

	* generic/tclDictObj.c:         Update all callers.
	* generic/tclIndexObj.c:
	* generic/tclListObj.c:
	* generic/tclUtil.c:
	* tests/list.test:

2011-05-09  Donal K. Fellows  <[email protected]>

	* generic/tclNamesp.c (NamespacePathCmd): Convert to use Tcl_Obj API
	* generic/tclPkg.c (Tcl_PackageObjCmd):   for result generation in
	* generic/tclTimer.c (Tcl_AfterObjCmd):   [after info], [namespace
	path] and [package versions].

2011-05-09  Don Porter  <[email protected]>

	* generic/tclListObj.c:	Revise empty string tests so that we avoid
	potentially expensive string rep generations, especially for dicts.

2011-05-07  Donal K. Fellows  <[email protected]>

	* generic/tclLoad.c (TclGetLoadedPackages): Convert to use Tcl_Obj API
	for result generation.

2011-05-07  Miguel Sofer  <[email protected]>

	* generic/tclInt.h: Fix USE_TCLALLOC so that it can be enabled without
	* unix/Makefile.in: editing the Makefile.

2011-05-05  Don Porter  <[email protected]>

	* generic/tclListObj.c:	Stop generating string rep of dict when
	converting to list.  Tolerate NULL interps more completely.

2011-05-03  Don Porter  <[email protected]>

	* generic/tclUtil.c:	Tighten Tcl_SplitList().
	* generic/tclListObj.c:	Tighten SetListFromAny().
	* generic/tclDictObj.c:	Tighten SetDictFromAny().
	* tests/join.test:
	* tests/mathop.test:

2011-05-02  Don Porter  <[email protected]>

	* generic/tclCmdMZ.c:	Revised TclFindElement() interface. The final
	* generic/tclDictObj.c:	argument had been bracePtr, the address of a
	* generic/tclListObj.c:	boolean var, where the caller can be told
	* generic/tclParse.c:	whether or not the parsed list element was
	* generic/tclUtil.c:	enclosed in braces.  In practice, no callers
	really care about that.  What the callers really want to know is
	whether the list element value exists as a literal substring of the
	string being parsed, or whether a call to TclCopyAndCollpase() is
	needed to produce the list element value.  Now the final argument is
	changed to do what callers actually need. This is a better fit for the
	calls in tclParse.c, where now a good deal of post-processing checking
	for "naked backslashes" is no longer necessary.
	***POTENTIAL INCOMPATIBILITY***
	For any callers calling in via the internal stubs table who really do
	use the final argument explicitly to check for the enclosing brace
	scenario.  Simply looking for the braces where they must be is the
	revision available to those callers, and it will backport cleanly.

	* tests/parse.test:	Tests for expanded literals quoting detection.

	* generic/tclCompCmdsSZ.c:	New TclFindElement() is also a better
	fit for the [switch] compiler.

	* generic/tclInt.h:	Replace TclCountSpaceRuns() with
	* generic/tclListObj.c:	TclMaxListLength() which is the function we
	* generic/tclUtil.c:	actually want.
	* generic/tclCompCmdsSZ.c:

	* generic/tclCompCmdsSZ.c: Rewrite of parts of the switch compiler to
	better use the powers of TclFindElement() and do less parsing on its
	own.

2011-04-28  Don Porter  <[email protected]>

	* generic/tclInt.h:	New utility routines:
	* generic/tclParse.c:	TclIsSpaceProc() and TclCountSpaceRuns()
	* generic/tclUtil.c:

	* generic/tclCmdMZ.c:	Use new routines to replace calls to isspace()
	* generic/tclListObj.c:	and their /* INTL */ risk.
	* generic/tclStrToD.c:
	* generic/tclUtf.c:
	* unix/tclUnixFile.c:

	* generic/tclStringObj.c:	Improved reaction to out of memory.

2011-04-27  Don Porter  <[email protected]>

	* generic/tclCmdMZ.c:	TclFreeIntRep() correction & cleanup.
	* generic/tclExecute.c:
	* generic/tclIndexObj.c:
	* generic/tclInt.h:
	* generic/tclListObj.c:
	* generic/tclNamesp.c:
	* generic/tclResult.c:
	* generic/tclStringObj.c:
	* generic/tclVar.c:

	* generic/tclListObj.c:	FreeListInternalRep() cleanup.

2011-04-21  Don Porter  <[email protected]>

	* generic/tclInt.h:	Use macro to set List intreps.
	* generic/tclListObj.c:

	* generic/tclCmdIL.c:	Limits on list length were too strict.
	* generic/tclInt.h:	Revised panics to errors where possible.
	* generic/tclListObj.c:
	* tests/lrepeat.test:

	* generic/tclCompile.c:	Make sure SetFooFromAny routines react
	* generic/tclIO.c:	reasonably when passed a NULL interp.
	* generic/tclIndexObj.c:
	* generic/tclListObj.c:
	* generic/tclNamesp.c:
	* generic/tclObj.c:
	* generic/tclProc.c:
	* macosx/tclMacOSXFCmd.c:

2011-04-21  Jan Nijtmans  <[email protected]>

	* generic/tcl.h:       fix for [Bug 3288345]: Wrong Tcl_StatBuf
	* generic/tclInt.h:    used on MinGW. Make sure that all _WIN32
	* win/tclWinFile.c:    compilers use exactly the same layout
	* win/configure.in:    for Tcl_StatBuf - the one used by MSVC6 -
	* win/configure:       in all situations.

2011-04-19  Don Porter  <[email protected]>

	* generic/tclConfig.c:	Reduce internals access in the implementation
	of [<foo>::pkgconfig list].

2011-04-18  Don Porter  <[email protected]>

	* generic/tclCmdIL.c:	Use ListRepPtr(.) and other cleanup.
	* generic/tclConfig.c:
	* generic/tclListObj.c:

	* generic/tclInt.h:	Define and use macros that test whether a Tcl
	* generic/tclBasic.c:	list value is canonical.
	* generic/tclUtil.c:

2011-04-18  Donal K. Fellows  <[email protected]>

	* doc/dict.n: [Bug 3288696]: Command summary was confusingly wrong
	when it came to [dict filter] with a 'value' filter.

2011-04-16  Donal K. Fellows  <[email protected]>

	* generic/tclFCmd.c (TclFileAttrsCmd): Add comments to make this code
	easier to understand. Added a panic to handle the case where the VFS
	layer does something odd.

2011-04-13  Don Porter  <[email protected]>

	* generic/tclUtil.c:	[Bug 3285375]: Rewrite of Tcl_Concat*()
	routines to prevent segfaults on buffer overflow.  Build them out of
	existing primitives already coded to handle overflow properly.  Uses
	the new TclTrim*() routines.

	* generic/tclCmdMZ.c:	New internal utility routines TclTrimLeft()
	* generic/tclInt.h:	and TclTrimRight().  Refactor the
	* generic/tclUtil.c:	[string trim*] implementations to use them.

2011-04-13  Miguel Sofer  <[email protected]>

	* generic/tclVar.c: [Bug 2662380]: Fix crash caused by appending to a
	variable with a write trace that unsets it.

2011-04-13  Donal K. Fellows  <[email protected]>

	* generic/tclUtil.c (Tcl_ConcatObj): [Bug 3285375]: Make the crash
	less mysterious through the judicious use of a panic. Not yet properly
	fixed, but at least now clearer what the failure mode is.

2011-04-12  Don Porter  <[email protected]>

	* tests/string.test:	Test for [Bug 3285472]. Not buggy in trunk.

2011-04-12  Venkat Iyer <[email protected]>

	* library/tzdata/Atlantic/Stanley: Update to Olson tzdata2011f

2011-04-12  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c: Fix for [Bug 2440625], kbk's patch

2011-04-11  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c:
	* tests/coroutine.test: [Bug 3282869]: Ensure that 'coroutine eval'
	runs the initial command in the proper context.

2011-04-11  Jan Nijtmans  <[email protected]>

	* generic/tcl.h:    Fix for [Bug 3281728]: Tcl sources from 2011-04-06
	* unix/tcl.m4:      do not build on GCC9 (RH9)
	* unix/configure:

2011-04-08  Jan Nijtmans  <[email protected]>

	* win/tclWinPort.h: Fix for [Bug 3280043]: win2k: unresolved DLL
	* win/configure.in: imports.
	* win/configure

2011-04-06  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c (TclCompileObj): Earlier return if Tip280
	gymnastics not needed.

	* generic/tclExecute.c: Fix for [Bug 3274728]: making *catchTop an
	unsigned long.

2011-04-06  Jan Nijtmans  <[email protected]>

	* unix/tclAppInit.c:  Make symbols "main" and "Tcl_AppInit"
	MODULE_SCOPE: there is absolutely no reason for exporting them.
	* unix/tcl.m4:        Don't use -fvisibility=hidden with static
	* unix/configure      libraries (--disable-shared)

2011-04-06  Donal K. Fellows  <[email protected]>

	* generic/tclFCmd.c, macosx/tclMacOSXFCmd.c, unix/tclUnixChan.c,
	* unix/tclUnixFCmd.c, win/tclWinChan.c, win/tclWinDde.c,
	* win/tclWinFCmd.c, win/tclWinLoad.c, win/tclWinPipe.c,
	* win/tclWinReg.c, win/tclWinSerial.c, win/tclWinSock.c: More
	generation of error codes (most platform-specific parts not already
	using Tcl_PosixError).

2011-04-05  Venkat Iyer <[email protected]>

	* library/tzdata/Africa/Casablanca: Update to Olson's tzdata2011e
	* library/tzdata/America/Santiago:
	* library/tzdata/Pacific/Easter:
	* library/tzdata/America/Metlakatla: (new)
	* library/tzdata/America/North_Dakota/Beulah: (new)
	* library/tzdata/America/Sitka: (new)

2011-04-04  Donal K. Fellows  <[email protected]>

	* generic/tclOO.c, generic/tclOOBasic.c, generic/tclOODefineCmds.c
	* generic/tclOOInfo.c, generic/tclOOMethod.c: More generation of
	error codes (TclOO miscellany).

	* generic/tclCmdAH.c, generic/tclCmdIL.c: More generation of error
	codes (miscellaneous commands mostly already handled).

2011-04-04  Don Porter  <[email protected]>

	* README:	[Bug 3202030]: Updated README files, repairing broken
	* macosx/README:URLs and removing other bits that were clearly wrong.
	* unix/README:	Still could use more eyeballs on the detailed build
	* win/README:	advice on various plaforms.

2011-04-04  Donal K. Fellows  <[email protected]>

	* library/init.tcl (tcl::mathfunc::rmmadwiw): Disable by default to
	make test suite work.

	* generic/tclBasic.c, generic/tclStringObj.c, generic/tclTimer.c,
	* generic/tclTrace.c, generic/tclUtil.c: More generation of error
	codes ([format], [after], [trace], RE optimizer).

2011-04-04  Jan Nijtmans  <[email protected]>

	* generic/tclCmdAH.c:  Better error-message in case of errors
	* generic/tclCmdIL.c:  related to setting a variable. This fixes
	* generic/tclDictObj.c: a warning: "Why make your own error
	* generic/tclScan.c:   message? Why?"
	* generic/tclTest.c:
	* test/error.test:
	* test/info.test:
	* test/scan.test:
	* unix/tclUnixThrd.h:  Remove this unused header file.

2011-04-03  Donal K. Fellows  <[email protected]>

	* generic/tclNamesp.c, generic/tclObj.c, generic/tclPathObj.c:
	* generic/tclPipe.c, generic/tclPkg.c, generic/tclProc.c:
	* generic/tclScan.c: More generation of error codes (namespace
	creation, path normalization, pipeline creation, package handling,
	procedures, [scan] formats)

2011-04-02  Kevin B. Kenny  <[email protected]>

	* generic/tclStrToD.c (QuickConversion): Replaced another couple
	of 'double' declarations with 'volatile double' to work around
	misrounding issues in mingw-gcc 3.4.5.

2011-04-02  Donal K. Fellows  <[email protected]>

	* generic/tclInterp.c, generic/tclListObj.c, generic/tclLoad.c:
	More generation of errorCodes ([interp], [lset], [load], [unload]).

	* generic/tclEvent.c, generic/tclFileName.c: More generation of
	errorCode information (default [bgerror] and [glob]).

2011-04-01  Reinhard Max  <[email protected]>

	* library/init.tcl: TIP#131 implementation.

2011-03-31  Donal K. Fellows  <[email protected]>

	* generic/tclGetDate.y, generic/tclDate.c (TclClockOldscanObjCmd):
	More generation of errorCode information.

2011-03-28  Donal K. Fellows  <[email protected]>

	* generic/tclCmdMZ.c, generic/tclConfig.c, generic/tclUtil.c: More
	generation of errorCode information, notably when lists are mis-parsed

	* generic/tclCmdMZ.c (Tcl_RegexpObjCmd, Tcl_RegsubObjCmd): Use the
	error messages generated by the variable management code rather than
	creating our own.

2011-03-27  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c (TclNREvalObjEx): fix performance issue, notably
	apparent in tclbench's "LIST lset foreach". Many thanks to Twylite for
	patiently researching the issue and explaining it to me: a missing
	Tcl_ResetObjResult that causes unwanted sharing of the current result
	Tcl_Obj.

2011-03-26  Donal K. Fellows  <[email protected]>

	* generic/tclNamesp.c (Tcl_Export, Tcl_Import, DoImport): More
	generation of errorCode information.

	* generic/tclCompExpr.c, generic/tclCompile.c, generic/tclExecute.c:
	* generic/tclListObj.c, generic/tclNamesp.c, generic/tclObj.c:
	* generic/tclStringObj.c, generic/tclUtil.c: Reduce the number of
	casts used to manage Tcl_Obj internal representations.

2011-03-24  Don Porter  <[email protected]>

	* generic/tcl.h (ckfree,etc.): Restored C++ usability to the memory
	allocation and free macros.

2011-03-24  Donal K. Fellows  <[email protected]>

	* generic/tclFCmd.c (TclFileAttrsCmd): Ensure that any reference to
	temporary index tables is squelched immediately rather than hanging
	around to trip us up in the future.

2011-03-23  Miguel Sofer  <[email protected]>

	* generic/tclObj.c: Exploit HAVE_FAST_TSD for the deletion context in
	TclFreeObj()

2011-03-22  Miguel Sofer  <[email protected]>

	* generic/tclThreadAlloc.c: Simpler initialization of Cache under
	HAVE_FAST_TSD, from mig-alloc-reform.

2011-03-21  Jan Nijtmans  <[email protected]>

	* unix/tclLoadDl.c:    [Bug 3216070]: Loading extension libraries
	* unix/tclLoadDyld.c:  from embedded Tcl applications.
	***POTENTIAL INCOMPATIBILITY***
	For extensions which rely on symbols from other extensions being
	present in the global symbol table. For an example and some discussion
	of workarounds, see http://stackoverflow.com/q/8330614/301832

2011-03-21  Miguel Sofer  <[email protected]>

	* generic/tclCkAlloc.c:
	* generic/tclInt.h: Remove one level of allocator indirection in
	non-memdebug builds, imported from mig-alloc-reform.

2011-03-20  Miguel Sofer  <[email protected]>

	* generic/tclThreadAlloc.c: Imported HAVE_FAST_TSD support from
	mig-alloc-reform. The feature has to be enabled by hand: no autoconf
	support has been added. It is not clear how universal a build using
	this will be: it also requires some loader support.

2011-03-17  Donal K. Fellows  <[email protected]>

	* generic/tclCompExpr.c (ParseExpr): Generate errorCode information on
	failure to parse expressions.

2011-03-17  Jan Nijtmans  <[email protected]>

	* generic/tclMain.c: [Patch 3124683]: Reorganize the platform-specific
	stuff in (tcl|tk)Main.c.

2011-03-16  Jan Nijtmans  <[email protected]>

	* generic/tclCkalloc.c: [Bug 3197864]: Pointer truncation on Win64
	TCL_MEM_DEBUG builds.

2011-03-16  Don Porter  <[email protected]>

	* generic/tclBasic.c:	Some rewrites to eliminate calls to isspace()
	* generic/tclParse.c:	and their /* INTL */ risk.
	* generic/tclProc.c:

2011-03-16  Jan Nijtmans  <[email protected]>

	* unix/tcl.m4:    Make SHLIB_LD_LIBS='${LIBS}' the default and
	* unix/configure: set to "" on per-platform necessary basis.
	Backported from TEA, but kept all original platform code which was
	removed from TEA.

2011-03-14  Kevin B. Kenny  <[email protected]>

	* tools/tclZIC.tcl (onDayOfMonth): Allow for leading zeroes in month
	and day so that tzdata2011d parses correctly.
	* library/tzdata/America/Havana:
	* library/tzdata/America/Juneau:
	* library/tzdata/America/Santiago:
	* library/tzdata/Europe/Istanbul:
	* library/tzdata/Pacific/Apia:
	* library/tzdata/Pacific/Easter:
	* library/tzdata/Pacific/Honolulu:  tzdata2011d

	* generic/tclAssembly.c (BBEmitInstInt1): Changed parameter data types
	in an effort to silence a MSVC warning reported by Ashok P. Nadkarni.
	Unable to test, since both forms work on my machine in VC2005, 2008,
	2010, in both release and debug builds.
	* tests/tclTest.c (TestdstringCmd): Restored MSVC buildability broken
	by [5574bdd262], which changed the effective return type of 'ckalloc'
	from 'char*' to 'void*'.

2011-03-13  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c: remove TEBCreturn()

2011-03-12  Donal K. Fellows  <[email protected]>

	* generic/tcl.h (ckalloc,ckfree,ckrealloc): Moved casts into these
	macro so that they work with VOID* (which is a void* on all platforms
	which Tcl actually builds on) and unsigned int for the length
	parameters, removing the need for MANY casts across the rest of Tcl.
	Note that this is a strict source-level-only change, so size_t cannot
	be used (would break binary compatibility on 64-bit platforms).

2011-03-12  Jan Nijtmans  <[email protected]>

	* win/tclWinFile.c: [Bug 3185609]: File normalization corner case
	of ... broken with -DUNICODE

2011-03-11  Donal K. Fellows  <[email protected]>

	* tests/unixInit.test: Make better use of tcltest2.

2011-03-10  Donal K. Fellows  <[email protected]>

	* generic/tclBasic.c, generic/tclCompCmds.c, generic/tclEnsemble.c:
	* generic/tclInt.h, generic/tclNamesp.c, library/auto.tcl:
	* tests/interp.test, tests/namespace.test, tests/nre.test:
	Converted the [namespace] command into an ensemble. This has the
	consequence of making it vital for Tcl code that wishes to work with
	namespaces to _not_ delete the ::tcl namespace.
	***POTENTIAL INCOMPATIBILITY***

	* library/tcltest/tcltest.tcl (loadIntoSlaveInterpreter): Added this
	command to handle connecting tcltest to a slave interpreter. This adds
	in the hook (inside the tcltest namespace) that allows the tests run
	in the child interpreter to be reported as part of the main sequence
	of test results. Bumped version of tcltest to 2.3.3.
	* tests/init.test, tests/package.test: Adapted these test files to use
	the new feature.

	* generic/tclAlloc.c, generic/tclCmdMZ.c, generic/tclCompExpr.c:
	* generic/tclCompile.c, generic/tclEnv.c, generic/tclEvent.c:
	* generic/tclIO.c, generic/tclIOCmd.c, generic/tclIORChan.c:
	* generic/tclIORTrans.c, generic/tclLiteral.c, generic/tclNotify.c:
	* generic/tclParse.c, generic/tclStringObj.c, generic/tclUtil.c:
	* generic/tclZlib.c, unix/tclUnixFCmd.c, unix/tclUnixNotfy.c:
	* unix/tclUnixPort.h, unix/tclXtNotify.c: Formatting fixes, mainly to
	comments, so code better fits the style in the Engineering Manual.

2011-03-09  Donal K. Fellows  <[email protected]>

	* tests/incr.test: Update more of the test suite to use Tcltest 2.

2011-03-09  Don Porter  <[email protected]>

	* generic/tclNamesp.c:	[Bug 3202171]: Tighten the detector of nested
	* tests/namespace.test:	[namespace code] quoting that the quoted
	scripts function properly even in a namespace that contains a custom
	"namespace" command.

	* doc/tclvars.n:	Formatting fix.  Thanks to Pat Thotys.

2011-03-09  Donal K. Fellows  <[email protected]>

	* tests/dstring.test, tests/init.test, tests/link.test: Update more of
	the test suite to use Tcltest 2.

2011-03-08  Jan Nijtmans  <[email protected]>

	* generic/tclBasic.c: Fix gcc warnings: variable set but not used
	* generic/tclProc.c:
	* generic/tclIORChan.c:
	* generic/tclIORTrans.c:
	* generic/tclAssembly.c:  Fix gcc warning: comparison between signed
	and unsigned integer expressions

2011-03-08  Don Porter  <[email protected]>

	* generic/tclInt.h:	Remove TclMarkList() routine, an experimental
	* generic/tclUtil.c:	dead-end from the 8.5 alpha days.

	* generic/tclResult.c (ResetObjResult): [Bug 3202905]: Correct failure
	to clear invalid intrep.  Thanks to Colin McDonald.

2011-03-08  Donal K. Fellows  <[email protected]>

	* generic/tclAssembly.c, tests/assemble.test: Migrate to use a style
	more consistent with the rest of Tcl.

2011-03-06  Don Porter  <[email protected]>

	* generic/tclBasic.c:	More replacements of Tcl_UtfBackslash() calls
	* generic/tclCompile.c:	with TclParseBackslash() where possible.
	* generic/tclCompCmdsSZ.c:
	* generic/tclParse.c:
	* generic/tclUtil.c:

	* generic/tclUtil.c (TclFindElement):	[Bug 3192636]: Guard escape
	sequence scans to not overrun the string end.

2011-03-05  Don Porter  <[email protected]>

	* generic/tclParse.c (TclParseBackslash): [Bug 3200987]: Correct
	* tests/parse.test:	trunction checks in \x and \u substitutions.

2011-03-05  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c (TclStackFree): insure that the execStack
	satisfies "at most one free stack after the current one" when
	consecutive reallocs caused the creation of intervening stacks.

2011-03-05  Kevin B. Kenny  <[email protected]>

	* generic/tclAssembly.c (new file):
	* generic/tclBasic.c (Tcl_CreateInterp):
	* generic/tclInt.h:
	* tests/assemble.test (new file):
	* unix/Makefile.in:
	* win/Makefile.in:
	* win/makefile.vc:  Merged dogeen-assembler-branch into HEAD. Since
	all functional changes are in the tcl::unsupported namespace, there's
	no reason to sequester this code on a separate branch.

2011-03-05  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c: Cleaner mem management for TEBCdata

	* generic/tclExecute.c:
	* tests/nre.test: Renamed BottomData to TEBCdata, so that the name
	refers to what it is rather than to its storage location.

	* generic/tclBasic.c:     Renamed struct TEOV_callback to the more
	* generic/tclCompExpr.c:  descriptive NRE_callback.
	* generic/tclCompile.c:
	* generic/tclExecute.c:
	* generic/tclInt.decls:
	* generic/tclInt.h:
	* generic/tclIntDecls.h:
	* generic/tclTest.c:

2011-03-04  Donal K. Fellows  <[email protected]>

	* generic/tclOOMethod.c (ProcedureMethodCompiledVarConnect)
	(ProcedureMethodCompiledVarDelete): [Bug 3185009]: Keep references to
	resolved object variables so that an unset doesn't leave any dangling
	pointers for code to trip over.

2011-03-01  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c (TclNREvalObjv): Missing a variable declaration
	in commented out non-optimised code, left for ref in checkin
	[b97b771b6d]

2011-03-03  Don Porter  <[email protected]>

	* generic/tclResult.c (Tcl_AppendResultVA):	Use the directive
	USE_INTERP_RESULT [TIP 330] to force compat with interp->result
	access, instead of the improvised hack USE_DIRECT_INTERP_RESULT_ACCESS
	from releases past.

2011-03-01  Miguel Sofer  <[email protected]>

	* generic/tclCompCmdsSZ.c (TclCompileThrowCmd, TclCompileUnsetCmd):
	fix leaks

	* generic/tclBasic.c:       This is [Patch 3168398],
	* generic/tclCompCmdsSZ.c:  Joe Mistachkin's optimisation
	* generic/tclExecute.c:     of Tip #285
	* generic/tclInt.decls:
	* generic/tclInt.h:
	* generic/tclIntDecls.h:
	* generic/tclInterp.c:
	* generic/tclOODecls.h:
	* generic/tclStubInit.c:
	* win/makefile.vc:

	* generic/tclExecute.c (ExprObjCallback): Fix object leak

	* generic/tclExecute.c (TEBCresume): Store local var array and
	constants in automatic vars to reduce indirection, slight perf
	increase

	* generic/tclOOCall.c (TclOODeleteContext): Added missing '*' so that
	trunk compiles.

	* generic/tclBasic.c (TclNRRunCallbacks): [Patch 3168229]: Don't do
	the trampoline dance for commands that do not have an nreProc.

2011-03-01  Donal K. Fellows  <[email protected]>

	* generic/tclOO.c (Tcl_NewObjectInstance, TclNRNewObjectInstance)
	(TclOOObjectCmdCore, FinalizeObjectCall):
	* generic/tclOOBasic.c (TclOO_Object_Destroy, AfterNRDestructor):
	* generic/tclOOCall.c (TclOODeleteContext, TclOOGetCallContext):
	Reorganization of call context reference count management so that code
	is (mostly) simpler.

2011-01-26  Donal K. Fellows  <[email protected]>

	* doc/RegExp.3: [Bug 3165108]: Corrected documentation of description
	of subexpression info in Tcl_RegExpInfo structure.

2011-01-25  Jan Nijtmans  <[email protected]>

	* generic/tclPreserve.c:  Don't miss 64-bit address bits in panic
				  message.
	* win/tclWinChan.c:       Fix various gcc-4.5.2 64-bit warning
	* win/tclWinConsole.c:    messages, e.g. by using full 64-bits for
	* win/tclWinDde.c:	  socket fd's
	* win/tclWinPipe.c:
	* win/tclWinReg.c:
	* win/tclWinSerial.c:
	* win/tclWinSock.c:
	* win/tclWinThrd.c:

2011-01-19  Jan Nijtmans  <[email protected]>

	* tools/genStubs.tcl: [FRQ 3159920]: Tcl_ObjPrintf() crashes with
	* generic/tcl.decls   bad format specifier.
	* generic/tcl.h:
	* generic/tclDecls.h:

2011-01-18  Donal K. Fellows  <[email protected]>

	* generic/tclOOMethod.c (PushMethodCallFrame): [Bug 3001438]: Make
	sure that the cmdPtr field of the procPtr is correct and relevant at
	all times so that [info frame] can report sensible information about a
	frame after a return to it from a recursive call, instead of probably
	crashing (depending on what else has overwritten the Tcl stack!)

2011-01-18  Jan Nijtmans  <[email protected]>

	* generic/tclBasic.c:      Various mismatches between Tcl_Panic
	* generic/tclCompCmds.c:   format string and its arguments,
	* generic/tclCompCmdsSZ.c: discovered thanks to [Bug 3159920]
	* generic/tclCompExpr.c:
	* generic/tclEnsemble.c:
	* generic/tclPreserve.c:
	* generic/tclTest.c:

2011-01-17  Jan Nijtmans  <[email protected]>

	* generic/tclIOCmd.c: [Bug 3148192]: Commands "read/puts" incorrectly
	* tests/chanio.test:  interpret parameters. Improved error-message
	* tests/io.test       regarding legacy form.
	* tests/ioCmd.test

2011-01-15  Kevin B. Kenny  <[email protected]>

	* doc/tclvars.n:
	* generic/tclStrToD.c:
	* generic/tclUtil.c (Tcl_PrintDouble):
	* tests/util.test (util-16.*): [Bug 3157475]: Restored full Tcl 8.4
	compatibility for the formatting of floating point numbers when
	$::tcl_precision is not zero. Added compatibility tests to make sure
	that excess trailing zeroes are suppressed for all eight major code
	paths.

2011-01-12  Jan Nijtmans  <[email protected]>

	* win/tclWinFile.c:   Use _vsnprintf in stead of vsnprintf, because
	MSVC 6 doesn't have it. Reported by andreask.
	* win/tcl.m4:         handle --enable-64bit=ia64 for gcc
	* win/configure.in:   more accurate test for correct <intrin.h>
	* win/configure:      (autoconf-2.59)
	* win/tclWin32Dll.c:  VS 2005 64-bit does not have intrin.h, and
	* generic/tclPanic.c: does not need it.

2011-01-07  Kevin B. Kenny  <[email protected]>

	* tests/util.test (util-15.*): Added test cases for floating point
	conversion of the largest denormal and the smallest normal number, to
	avoid any possibility of the failure suffered by PHP in the last
	couple of days. (They didn't fail, so no actual functional change.)

2011-01-05  Donal K. Fellows  <[email protected]>

	* tests/package.test, tests/pkg.test: Coalesce these tests into one
	file that is concerned with the package system. Convert to use
	tcltest2 properly.
	* tests/autoMkindex.test, tests/pkgMkIndex.test: Convert to use
	tcltest2 properly.

2011-01-01  Donal K. Fellows  <[email protected]>

	* tests/cmdAH.test, tests/cmdMZ.test, tests/compExpr.test,
	* tests/compile.test, tests/concat.test, tests/eval.test,
	* tests/fileName.test, tests/fileSystem.test, tests/interp.test,
	* tests/lsearch.test, tests/namespace-old.test, tests/namespace.test,
	* tests/oo.test, tests/proc.test, tests/security.test,
	* tests/switch.test, tests/unixInit.test, tests/var.test,
	* tests/winDde.test, tests/winPipe.test: Clean up of tests and
	conversion to tcltest 2. Target has been to get init and cleanup code
	out of the test body and into the -setup/-cleanup stanzas.

	* tests/execute.test (execute-11.1): [Bug 3142026]: Added test that
	fails (with a crash) in an unfixed memdebug build on 64-bit systems.

2010-12-31  Donal K. Fellows  <[email protected]>

	* generic/tclCmdIL.c (SortElement): Use unions properly in the
	definition of this structure so that there is no need to use nasty
	int/pointer type punning. Made it clearer what the purposes of the
	various parts of the structure are.

2010-12-31  Jan Nijtmans  <[email protected]>

	* unix/dltest/*.c: [Bug 3148192]: Fix broken [load] tests by ensuring
	that the affected files are never compiled with -DSTATIC_BUILD.

2010-12-30  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c (GrowEvaluationStack): Off-by-one error in
	sizing the new allocation - was ok in comment but wrong in the code.
	Triggered by [Bug 3142026] which happened to require exactly one more
	than what was in existence.

2010-12-26  Donal K. Fellows  <[email protected]>

	* generic/tclCmdIL.c (Tcl_LsortObjCmd): Fix crash when multiple -index
	options are used. Simplified memory handling logic.

2010-12-20  Jan Nijtmans  <[email protected]>

	* win/tclWin32Dll.c:    [Patch 3059922]: fixes for mingw64 - gcc4.5.1
	tdm64-1: completed for all environments.

2010-12-20  Jan Nijtmans  <[email protected]>

	* win/configure.in:   Explicitely test for intrinsics support in
	compiler, before assuming only MSVC has it.
	* win/configure:      (autoconf-2.59)
	* generic/tclPanic.c:

2010-12-19  Jan Nijtmans  <[email protected]>

	* win/tclWin32Dll.c:    [Patch 3059922]: fixes for mingw64 - gcc4.5.1
	tdm64-1: Fixed for gcc, not yet for MSVC 64-bit.

2010-12-17  Stuart Cassoff  <[email protected]>

	* unix/Makefile.in:  Remove unwanted/obsolete 'ddd' target.

2010-12-17  Stuart Cassoff  <[email protected]>

	* unix/Makefile.in:	Clean up '.PHONY:' targets: Arrange those
				common to Tcl and Tk as in Tk's Makefile.in,
				add any missing ones and remove duplicates.

2010-12-17  Stuart Cassoff  <[email protected]>

	* unix/Makefile.in:  [Bug 2446711]: Remove 'allpatch' target.

2010-12-17  Stuart Cassoff  <[email protected]>

	* unix/Makefile.in:  [Bug 2537626]: Use 'rpmbuild', not 'rpm'.

2010-12-16  Jan Nijtmans  <[email protected]>

	* generic/tclPanic.c:  [Patch 3124554]: Move WishPanic from Tk to Tcl
	* win/tclWinFile.c:    Better communication with debugger, if present.

2010-12-15  Kevin B. Kenny  <[email protected]>

	[dogeen-assembler-branch]

	* tclAssembly.c:
	* assemble.test: 	Reworked beginCatch/endCatch handling to
	enforce the more severe (but more correct) restrictions on catch
	handling that appeared in the discussion of [Bug 3098302] and in
	tcl-core traffic beginning about 2010-10-29.

2010-12-15  Jan Nijtmans  <[email protected]>

	* generic/tclPanic.c:    Restore abort() as it was before.
	* win/tclWinFile.c:      [Patch 3124554]: Use ExitProcess() here, like
	in wish.

2010-12-14  Jan Nijtmans  <[email protected]>

	* generic/tcl.h: [Bug 3137454]: Tcl CVS HEAD does not build on GCC 3.

2010-12-14  Reinhard Max  <[email protected]>

	* win/tclWinSock.c (CreateSocket):         Swap the loops over
	* unix/tclUnixSock.c (CreateClientSocket): local and remote addresses,
	so that the system's address preference for the remote side decides
	which family gets tried first. Cleanup and clarify some of the
	comments.

2010-12-13  Jan Nijtmans  <[email protected]>

	* generic/tcl.h:    [Bug 3135271]: Link error due to hidden
	* unix/tcl.m4:      symbols (CentOS 4.2)
	* unix/configure:   (autoconf-2.59)
	* win/tclWinFile.c:  Undocumented feature, only meant to be used by
	Tk_Main. See [Patch 3124554]: Move WishPanic from Tk to Tcl

2010-12-12  Stuart Cassoff  <[email protected]>

	* unix/tcl.m4: Better building on OpenBSD.
	* unix/configure: (autoconf-2.59)

2010-12-10  Jan Nijtmans  <[email protected]>

	* generic/tcl.h:       [Bug 3129448]: Possible over-allocation on
	* generic/tclCkalloc.c: 64-bit platforms, part 2
	* generic/tclCompile.c:
	* generic/tclHash.c:
	* generic/tclInt.h:
	* generic/tclIO.h:
	* generic/tclProc.c:

2010-12-10 Alexandre Ferrieux  <[email protected]>

	* generic/tclIO.c: Make sure [fcopy -size ... -command ...] always
	* tests/io.test:   calls the callback asynchronously, even for size
			   zero.

2010-12-10  Jan Nijtmans  <[email protected]>

	* generic/tclBinary.c:  Fix gcc -Wextra warning: missing initializer
	* generic/tclCmdAH.c:
	* generic/tclCmdIL.c:
	* generic/tclCmdMZ.c:
	* generic/tclDictObj.c:
	* generic/tclIndexObj.c:
	* generic/tclIOCmd.c:
	* generic/tclVar.c:
	* win/tcl.m4:               Fix manifest-generation for 64-bit gcc
				    (mingw-w64)
	* win/configure.in:         Check for availability of intptr_t and
				    uintptr_t
	* win/configure:            (autoconf-2.59)
	* generic/tclInt.decls:     Change 1st param of TclSockMinimumBuffers
	* generic/tclIntDecls.h:    to ClientData, and TclWin(Get|Set)SockOpt
	* generic/tclIntPlatDecls.h:to SOCKET, because on Win64 those are
	* generic/tclIOSock.c:	    64-bit, which does not fit.
	* win/tclWinSock.c:
	* unix/tclUnixSock.c:

2010-12-09  Donal K. Fellows  <[email protected]>

	* tests/fCmd.test: Improve sanity of constraints now that we don't
	support anything before Windows 2000.

	* generic/tclCmdAH.c (TclInitFileCmd, TclMakeFileCommandSafe, ...):
	Break up [file] into an ensemble. Note that the ensemble is safe in
	itself, but the majority of its subcommands are not.
	* generic/tclFCmd.c (FileCopyRename,TclFileDeleteCmd,TclFileAttrsCmd)
	(TclFileMakeDirsCmd): Adjust these subcommand implementations to work
	inside an ensemble.
	(TclFileLinkCmd, TclFileReadLinkCmd, TclFileTemporaryCmd): Move these
	subcommand implementations from tclCmdAH.c, where they didn't really
	belong.
	* generic/tclIOCmd.c (TclChannelNamesCmd): Move to more appropriate
	source file.
	* generic/tclEnsemble.c (TclMakeEnsemble): Start of code to make
	partially-safe ensembles. Currently does not function as expected due
	to various shortcomings in how safe interpreters are constructed.
	* tests/cmdAH.test, tests/fCmd.test, tests/interp.test: Test updates
	to take into account systematization of error messages.

	* tests/append.test, tests/appendComp.test: Clean up tests so that
	they don't leave things in the global environment (detected when doing
	-singleproc testing).

2010-12-07  Donal K. Fellows  <[email protected]>

	* tests/fCmd.test, tests/safe.test, tests/uplevel.test,
	* tests/upvar.test, tests/var.test: Convert more tests to tcltest2 and
	factor them to be easier to understand.

	* generic/tclStrToD.c: Tidy up code so that more #ifdef-fery is
	quarantined at the front of the file and function headers follow the
	modern Tcl style.

2010-12-06  Jan Nijtmans  <[email protected]>

	* generic/tclBinary.c:  [Bug 3129448]: Possible over-allocation on
	* generic/tclCkalloc.c: 64-bit platforms.
	* generic/tclTrace.c:

2010-12-05  Jan Nijtmans  <[email protected]>

	* unix/tcl.m4: [Patch 3116490]: Cross-compile support for unix
	* unix/configure: (autoconf-2.59)

2010-12-03  Jeff Hobbs  <[email protected]>

	* generic/tclUtil.c (TclReToGlob): Add extra check for multiple inner
	*s that leads to poor recursive glob matching, defer to original RE
	instead.  tclbench RE var backtrack.

2010-12-03  Jan Nijtmans  <[email protected]>

	* generic/tclUtil.c:   Silence gcc warning when using -Wwrite-strings
	* generic/tclStrToD.c: Silence gcc warning for non-IEEE platforms
	* win/Makefile.in:  [Patch 3116490]: Cross-compile Tcl mingw32 on unix
	* win/tcl.m4:       This makes it possible to cross-compile Tcl/Tk for
	* win/configure.in: Windows (either 32-bit or 64-bit) out-of-the-box
	* win/configure:    on UNIX, using mingw-w64 build tools (If Itcl,
	tdbc and Thread take over the latest tcl.m4, they can do that too).

2010-12-01  Kevin B. Kenny  <[email protected]>

	* generic/tclStrToD.c (SetPrecisionLimits, TclDoubleDigits):
	[Bug 3124675]: Added meaningless initialization of 'i', 'ilim' and
	'ilim1' to silence warnings from the C compiler about possible use of
	uninitialized variables, Added a panic to the 'switch' that assigns
	them, to assert that the 'default' case is impossible.

2010-12-01  Jan Nijtmans  <[email protected]>

	* generic/tclBasic.c: Fix gcc 64-bit warnings: cast from pointer to
	* generic/tclHash.c:  integer of different size.
	* generic/tclTest.c:
	* generic/tclThreadTest.c:
	* generic/tclStrToD.c: Fix gcc(-4.5.2) warning: 'static' is not at
	beginning of declaration.
	* generic/tclPanic.c: Allow Tcl_Panic() to enter the debugger on win32
	* generic/tclCkalloc.c: Use Tcl_Panic() in stead of duplicating the
	code.

2010-11-30  Jeff Hobbs  <[email protected]>

	* generic/tclInt.decls, generic/tclInt.h, generic/tclIntDecls.h:
	* generic/tclStubInit.c: TclFormatInt restored at slot 24
	* generic/tclUtil.c (TclFormatInt): restore TclFormatInt func from
	2005-07-05 macro-ization. Benchmarks indicate it is faster, as a key
	int->string routine (e.g. int-indexed arrays).

2010-11-29 Alexandre Ferrieux  <[email protected]>

	* generic/tclBasic.c: Patch by Miguel, providing a
	[::tcl::unsupported::inject coroname command args], which prepends
	("injects") arbitrary code to a suspended coro's future resumption.
	Neat for debugging complex coros without heavy instrumentation.

2010-11-29  Kevin B. Kenny  <[email protected]>

	* generic/tclInt.decls:
	* generic/tclInt.h:
	* generic/tclStrToD.c:
	* generic/tclTest.c:
	* generic/tclTomMath.decls:
	* generic/tclUtil.c:
	* tests/util.test:
	* unix/Makefile.in:
	* win/Makefile.in:
	* win/makefile.vc: Rewrite of Tcl_PrintDouble and TclDoubleDigits that
	(a) fixes a severe performance problem with floating point shimmering
	reported by Karl Lehenbauer, (b) allows TclDoubleDigits to generate
	the digit strings for 'e' and 'f' format, so that it can be used for
	tcl_precision != 0 (and possibly later for [format]), (c) fixes [Bug
	3120139] by making TclPrintDouble inherently locale-independent, (d)
	adds test cases to util.test for correct rounding in difficult cases
	of TclDoubleDigits where fixed- precision results are requested. (e)
	adds test cases to util.test for the controversial aspects of [Bug
	3105247]. As a side effect, two more modules from libtommath
	(bn_mp_set_int.c and bn_mp_init_set_int.c) are brought into the build,
	since the new code uses them.

	* generic/tclIntDecls.h:
	* generic/tclStubInit.c:
	* generic/tclTomMathDecls.h:	Regenerated.

2010-11-24  Donal K. Fellows  <[email protected]>

	* tests/chanio.test, tests/iogt.test, tests/ioTrans.test: Convert more
	tests to tcltest2 and factor them to be easier to understand.

2010-11-20  Donal K. Fellows  <[email protected]>

	* tests/chanio.test: Converted many tests to tcltest2 by marking the
	setup and cleanup parts as such.

2010-11-19  Jan Nijtmans  <[email protected]>

	* win/tclWin32Dll.c: Fix gcc warnings: unused variable 'registration'
	* win/tclWinChan.c:
	* win/tclWinFCmd.c:

2010-11-18  Jan Nijtmans  <[email protected]>

	* win/tclAppInit.c: [FRQ 491789]: "setargv() doesn't support a unicode
	cmdline" now implemented for cygwin and mingw32 too.
	* tests/main.test: No longer disable tests Tcl_Main-1.4 and 1.6 on
	Windows, because those now work on all supported platforms.
	* win/configure.in:  Set NO_VIZ=1 when zlib is compiled in libtcl,
	this resolves compiler warnings in 64-bit and static builds.
	* win/configure (regenerated)

2010-11-18  Donal K. Fellows  <[email protected]>

	* doc/file.n: [Bug 3111298]: Typofix.

	* tests/oo.test: [Bug 3111059]: Added testing that neatly trapped this
	issue.

2010-11-18  Miguel Sofer  <[email protected]>

	* generic/tclNamesp.c: [Bug 3111059]: Fix leak due to bad looping
	construct.

2010-11-17  Jan Nijtmans  <[email protected]>

	* win/tcl.m4: [FRQ 491789]: "setargv() doesn't support a unicode
	cmdline" now implemented for mingw-w64
	* win/configure    (re-generated)

2010-11-16  Jan Nijtmans  <[email protected]>

	* win/tclAppInit.c:Bring compilation under mingw-w64 a bit closer
	* win/cat.c:       to reality. See for what's missing:
	* win/tcl.m4:      <https://sourceforge.net/apps/trac/mingw-w64/wiki/Unicode%20apps>
	* win/configure:   (re-generated)
	* win/tclWinPort.h: [Bug 3110161]: Extensions using TCHAR don't
	compile on VS2005 SP1

2010-11-15  Andreas Kupries  <[email protected]>

	* doc/interp.n: [Bug 3081184]: TIP #378.
	* doc/tclvars.n: Performance fix for TIP #280.
	* generic/tclBasic.c:
	* generic/tclExecute.c:
	* generic/tclInt.h:
	* generic/tclInterp.c:
	* tests/info.test:
	* tests/interp.test:

2010-11-10  Andreas Kupries  <[email protected]>

	* changes:	Updates for 8.6b2 release.

2010-11-09  Donal K. Fellows  <[email protected]>

	* generic/tclOOMethod.c (ProcedureMethodVarResolver): [Bug 3105999]:
	* tests/oo.test:	Make sure that resolver structures that are
				only temporarily needed get squelched.

2010-11-05  Jan Nijtmans  <[email protected]>

	* generic/tclMain.c: Thanks, Kevin, for the fix, but this how it was
	supposed to be (TCL_ASCII_MAIN is only supposed to be defined on
	WIN32).

2010-11-05  Kevin B. Kenny  <[email protected]>

	* generic/tclMain.c: Added missing conditional on _WIN32 around code
	that messes around with the definition of _UNICODE, to correct a badly
	broken Unix build from Jan's last commit.

2010-11-04  Jan Nijtmans  <[email protected]>

	* generic/tclDecls.h:	[FRQ 491789]: "setargv() doesn't support a
	* generic/tclMain.c:	unicode cmdline" implemented for Tcl on MSVC++
	* doc/Tcl_Main.3:
	* win/tclAppInit.c:
	* win/makefile.vc:
	* win/Makefile.in:
	* win/tclWin32Dll.c:	Eliminate minor MSVC warning TCHAR -> char
				conversion

2010-11-04  Reinhard Max  <[email protected]>

	* tests/socket.test: Run the socket tests three times with the address
	family set to any, inet, and inet6 respectively. Use constraints to
	skip the tests if a family is found to be unsupported or not
	configured on the local machine. Adjust the tests to dynamically adapt
	to the address family that is being tested.

	Rework some of the tests to speed them up by avoiding (supposedly)
	unneeded [after]s.

2010-11-04  Stuart Cassoff  <[email protected]>

	* unix/Makefile.in:	[Patch 3101127]: Installer Improvements.
	* unix/install-sh:

2010-11-04  Donal K. Fellows  <[email protected]>

	* tests/error.test (error-19.13): Another variation on testing for
	issues in [try] compilation.

	* doc/Tcl.n (Variable substitution): [Bug 3099086]: Increase clarity
	of explanation of what characters are actually permitted in variable
	substitutions. Note that this does not constitute a change of
	behavior; it is just an improvement of explanation.

2010-11-04  Don Porter  <[email protected]>

	* changes:	Updates for 8.6b2 release.  (Thanks Andreas Kupries)

2010-11-03  Jan Nijtmans  <[email protected]>

	* win/tclWinFcmd.c:    [FRQ 2965056]: Windows build with -DUNICODE
	* win/tclWinFile.c:    (more clean-ups for pre-win2000 stuff)
	* win/tclWinReg.c:

2010-11-03  Donal K. Fellows  <[email protected]>

	* generic/tclCmdMZ.c (TryPostBody):  Ensure that errors when setting
	* tests/error.test (error-19.1[12]): message/opt capture variables get
					     reflected properly to the caller.

2010-11-03  Kevin B. Kenny  <[email protected]>

	* generic/tclCompCmds.c (TclCompileCatchCmd): [Bug 3098302]:
	* tests/compile.test (compile-3.6): Reworked the compilation of the
	[catch] command so as to avoid placing any code that might throw an
	exception (specifically, any initial substitutions or any stores to
	result or options variables) between the BEGIN_CATCH and END_CATCH but
	outside the exception range.  Added a test case that panics on a stack
	smash if the change is not made.

2010-11-01  Stuart Cassoff  <[email protected]>

	* library/safe.tcl:	Improved handling of non-standard module path
	* tests/safe.test:	lists, empty path lists in particular.

2010-11-01  Kevin B. Kenny  <[email protected]>

	* library/tzdata/Asia/Hong_Kong:
	* library/tzdata/Pacific/Apia:
	* library/tzdata/Pacific/Fiji:   Olson's tzdata2010o.

2010-10-29  Alexandre Ferrieux  <[email protected]>

	* generic/tclTimer.c:	[Bug 2905784]: Stop small [after]s from
				wasting CPU while keeping accuracy.

2010-10-28  Kevin B. Kenny  <[email protected]>

	[dogeen-assembler-branch]
	* generic/tclAssembly.c:
	* tests/assembly.test (assemble-31.*): Added jump tables.

2010-10-28  Don Porter  <[email protected]>

	* tests/http.test:	[Bug 3097490]: Make http-4.15 pass in
				isolation.

	* unix/tclUnixSock.c:	[Bug 3093120]: Prevent calls of
				freeaddrinfo(NULL) which can crash some
				systems.  Thanks Larry Virden.

2010-10-26  Reinhard Max  <[email protected]>

	* Changelog.2008: Split off from Changelog.
	* generic/tclIOSock.c (TclCreateSocketAddress): The interp != NULL
	check is needed for ::tcl::unsupported::socketAF as well.

2010-10-26  Donal K. Fellows  <[email protected]>

	* unix/tclUnixSock.c (TcpGetOptionProc): Prevent crash if interp is
	* win/tclWinSock.c (TcpGetOptionProc):   NULL (a legal situation).

2010-10-26  Reinhard Max  <[email protected]>

	* unix/tclUnixSock.c (TcpGetOptionProc): Added support for
	::tcl::unsupported::noReverseDNS, which if set to any value, prevents
	[fconfigure -sockname] and [fconfigure -peername] from doing
	reverse DNS queries.

2010-10-24  Kevin B. Kenny  <[email protected]>

	[dogeen-assembler-branch]
	* generic/tclAssembly.c:
	* tests/assembly.test (assemble-17.15): Reworked branch handling so
	that forward branches can use jump1 (jumpTrue1, jumpFalse1). Added
	test cases that the forward branches will expand to jump4, jumpTrue4,
	jumpFalse4 when needed.

2010-10-23  Kevin B. Kenny  <[email protected]>

	[dogeen-assembler-branch]
	* generic/tclAssembly.h (removed):
				Removed file that was included in only one
				source file.
	* generictclAssembly.c:	Inlined tclAssembly.h.

2010-10-17  Alexandre Ferrieux  <[email protected]>

	* doc/info.n:            [Patch 2995655]:
	* generic/tclBasic.c:    Report inner contexts in [info errorstack]
	* generic/tclCompCmds.c:
	* generic/tclCompile.c:
	* generic/tclCompile.h:
	* generic/tclExecute.c:
	* generic/tclInt.h:
	* generic/tclNamesp.c:
	* tests/error.test:
	* tests/result.test:

2010-10-20  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmds.c (TclCompileDictForCmd): Update the compilation
	* generic/tclCompile.c (tclInstructionTable):	of [dict for] so that
	* generic/tclExecute.c (TEBCresume):		it no longer makes any
	use of INST_DICT_DONE now that's not needed, and make it clearer in
	the implementation of the instruction that it's just a deprecated form
	of unset operation. Followup to my commit of 2010-10-16.

2010-10-19  Donal K. Fellows  <[email protected]>

	* generic/tclZlib.c (Tcl_ZlibStreamGet): [Bug 3081008]: Ensure that
	when a bytearray gets its internals entangled with zlib for more than
	a passing moment, that bytearray will never be shimmered away. This
	increases the amount of copying but is simple to get right, which is a
	reasonable trade-off.

	* generic/tclStringObj.c (Tcl_AppendObjToObj): Added some special
	cases so that most of the time when you build up a bytearray by
	appending, it actually ends up being a bytearray rather than
	shimmering back and forth to string.

	* tests/http11.test (check_crc): Use a simpler way to express the
	functionality of this procedure.

	* generic/tclZlib.c: Purge code that wrote to the object returned by
	Tcl_GetObjResult, as we don't want to do that anti-pattern no more.

2010-10-18  Jan Nijtmans  <[email protected]>

	* tools/uniParse.tcl:   [Bug 3085863]: tclUniData was 9 years old;
	Ignore non-BMP characters and fix comment about UnicodeData.txt file.
	* generic/regcomp.c:    Fix comment
	* tests/utf.test:       Add some Unicode 6 testcases

2010-10-17  Alexandre Ferrieux  <[email protected]>

	* doc/info.n:           Document [info errorstack] faithfully.

2010-10-16  Donal K. Fellows  <[email protected]>

	* generic/tclExecute.c (ReleaseDictIterator): Factored out the release
	of the bytecode-level dictionary iterator information so that the
	side-conditions on instruction issuing are simpler.

2010-10-15  Jan Nijtmans  <[email protected]>

	* generic/reg_locale.c: [Bug 3085863]: tclUniData 9 years old: Updated
	* generic/tclUniData.c: Unicode tables to latest UnicodeData.txt,
	* tools/uniParse.tcl:   corresponding with Unicode 6.0 (except for
				out-of-range chars > 0xFFFF)

2010-10-13  Don Porter  <[email protected]>

	* generic/tclCompile.c:	Alternative fix for [Bugs 467523,983660] where
	* generic/tclExecute.c:	sharing of empty scripts is allowed again.

2010-10-13  Jan Nijtmans  <[email protected]>

	* win/tclWinThrd.h: (removed) because it is just empty en used nowhere
	* win/tcl.dsp

2010-10-12  Jan Nijtmans  <[email protected]>

	* tools/uniClass.tcl:    Spacing and comments: let uniClass.tcl
	* generic/regc_locale.c: generation match better the current
				 (hand-modified) regc_locale.c
	* tools/uniParse.tcl:    Generate proper const qualifiers for
	* generic/tclUniData.c:  tclUniData.c

2010-10-12  Reinhard Max  <[email protected]>

	* unix/tclUnixSock.c (CreateClientSocket): [Bug 3084338]: Fix a
	memleak and refactor the calls to freeaddrinfo().

2010-10-11  Jan Nijtmans  <[email protected]>

	* win/tclWinDde.c:    [FRQ 2965056]: Windows build with -DUNICODE
	* win/tclWinReg.c:
	* win/tclWinTest.c:   More cleanups
	* win/tclWinFile.c:   Add netapi32 to the link line, so we no longer
	* win/tcl.m4:         have to use LoadLibrary to access those
			      functions.
	* win/makefile.vc:
	* win/configure:      (Re-generate with autoconf-2.59)
	* win/rules.vc        Update for VS10

2010-10-09  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c: Fix overallocation of exec stack in TEBC (due
	to mixing numwords and numbytes)

2010-10-08  Jan Nijtmans  <[email protected]>

	* generic/tclIOSock.c: On Windows, use gai_strerrorA

2010-10-06  Don Porter  <[email protected]>

	* tests/winPipe.test:	Test hygiene with makeFile and removeFile.

	* generic/tclCompile.c:	[Bug 3081065]: Prevent writing to the intrep
	* tests/subst.test:	fields of a freed Tcl_Obj.

2010-10-06  Kevin B. Kenny  <[email protected]>

	[dogeen-assembler-branch]

	* generic/tclAssembly.c:
	* generic/tclAssembly.h:
	* tests/assemble.test: Added catches. Still needs a lot of testing.

2010-10-02  Kevin B. Kenny  <[email protected]>

	[dogeen-assembler-branch]

	* generic/tclAssembly.c:
	* generic/tclAssembly.h:
	* tests/assemble.test: Added dictAppend, dictIncrImm, dictLappend,
	dictSet, dictUnset, nop, regexp, nsupvar, upvar, and variable.

2010-10-02  Donal K. Fellows  <[email protected]>

	* generic/tclExecute.c (TEBCresume): [Bug 3079830]: Added invalidation
	of string representations of dictionaries in some cases.

2010-10-01  Jeff Hobbs  <[email protected]>

	* generic/tclExecute.c (EvalStatsCmd): change 'evalstats' to return
	data to interp by default, or if given an arg, use that as filename to
	output to (accepts 'stdout' and 'stderr').  Fix output to print used
	inst count data.
	* generic/tclCkalloc.c: Change TclDumpMemoryInfo sig to allow objPtr
	* generic/tclInt.decls: as well as FILE* as output.
	* generic/tclIntDecls.h:

2010-10-01  Donal K. Fellows  <[email protected]>

	* generic/tclBasic.c, generic/tclClock.c, generic/tclEncoding.c,
	* generic/tclEnv.c, generic/tclLoad.c, generic/tclNamesp.c,
	* generic/tclObj.c, generic/tclRegexp.c, generic/tclResolve.c,
	* generic/tclResult.c, generic/tclUtil.c, macosx/tclMacOSXFCmd.c:
	More purging of strcpy() from locations where we already know the
	length of the data being copied.

2010-10-01  Kevin B. Kenny  <[email protected]>

	[dogeen-assembler-branch]

	* tests/assemble.test:
	* generic/tclAssemble.h:
	* generic/tclAssemble.c:  Added listIn, listNotIn, and dictGet.

2010-09-30  Kevin B. Kenny  <[email protected]>

	[dogeen-assembler-branch]

	* tests/assemble.test:   Added tryCvtToNumeric and several more list
	* generic/tclAssemble.c: operations.
	* generic/tclAssemble.h:

2010-09-29  Kevin B. Kenny  <[email protected]>

	[dogeen-assembler-branch]

	* tests/assemble.test:   Completed conversion of tests to a
	* generic/tclAssemble.c: "white box" structure that follows the
	C code. Added missing safety checks on the operands of 'over' and
	'reverse' so that negative operand counts don't smash the stack.

2010-09-29  Jan Nijtmans  <[email protected]>

	* unix/configure:	Re-generate with autoconf-2.59
	* win/configure:
	* generic/tclMain.c:	Make compilable with -DUNICODE as well

2010-09-28  Reinhard Max  <[email protected]>

	TIP #162 IMPLEMENTATION

	* doc/socket.n:		Document the changes to the [socket] and
				[fconfigure] commands.

	* generic/tclInt.h:	Introduce TclCreateSocketAddress() as a
	* generic/tclIOSock.c:	replacement for the platform-dependent
	* unix/tclUnixSock.c:	TclpCreateSocketAddress() functions. Extend
	* unix/tclUnixChan.c:	the [socket] and [fconfigure] commands to
	* unix/tclUnixPort.h:	behave as proposed in TIP #162. This is the
	* win/tclWinSock.c:	core of what is required to support the use of
	* win/tclWinPort.h:	IPv6 sockets in Tcl.

	* compat/fake-rfc2553.c: A compat implementation of the APIs defined
	* compat/fake-rfc2553.h: in RFC-2553 (getaddrinfo() and friends) on
				 top of the existing gethostbyname() etc.
	* unix/configure.in:	 Test whether the fake-implementation is
	* unix/tcl.m4:		 needed.
	* unix/Makefile.in:	 Add a compile target for fake-rfc2553.

	* win/configure.in:	Allow cross-compilation by default.

	* tests/socket.test:	Improve the test suite to make more use of
	* tests/remote.tcl:	randomized ports to reduce interference with
				tests running in parallel or other services on
				the machine.

2010-09-28  Kevin B. Kenny  <[email protected]>

	[dogeen-assembler-branch]

	* tests/assemble.test: Added more "white box" tests.
	* generic/tclAssembly.c: Added the error checking and reporting
	for undefined labels. Revised code so that no pointers into the
	bytecode sequence are held (because the sequence can move!),
	that no Tcl_HashEntry pointers are held (because the hash table
	doesn't guarantee their stability!) and to eliminate the BBHash
	table, which is merely additional information indexed by jump
	labels and can just as easily be held in the 'label' structure.
	Renamed shared structures to CamelCase, and renamed 'label' to
	JumpLabel because other types of labels may eventually be possible.

2010-09-27  Kevin B. Kenny  <[email protected]>

	[dogeen-assembler-branch]

	* tests/assemble.test: Added more "white box" tests.
	* generic/tclAssembly.c: Fixed bugs exposed by the new tests.
	(a) [eval] and [expr] had incorrect stack balance computed if
	the arg was not a simple word. (b) [concat] accepted a negative
	operand count. (c) [invoke] accepted a zero or negative operand
	count. (d) more misspelt error messages.
	Also replaced a funky NRCallTEBC with the new call
	TclNRExecuteByteCode, necessitated by a merge with changes on the
	HEAD.

2010-09-26  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c:    [Patch 3072080] (minus the itcl
	* generic/tclCmdIL.c:    update): a saner NRE.
	* generic/tclCompExpr.c:
	* generic/tclCompile.c:  This makes TclNRExecuteByteCode (ex TEBC)
	* generic/tclCompile.h:  to be a normal NRE citizen: it loses its
	* generic/tclExecute.c:  special status.
	* generic/tclInt.decls:  The logic flow within the BC engine is
	* generic/tclInt.h:      simplified considerably.
	* generic/tclIntDecls.h:
	* generic/tclObj.c:
	* generic/tclProc.c:
	* generic/tclTest.c:

	* generic/tclVar.c: Use the macro HasLocalVars everywhere

2010-09-26  Miguel Sofer  <[email protected]>

	* generic/tclOOMethod.c (ProcedureMethodVarResolver): avoid code
	duplication, let the runtime var resolver call the compiled var
	resolver.

2010-09-26  Kevin B. Kenny  <[email protected]>

	[dogeen-assembler-branch]

	* tests/assemble.test:	Added many new tests moving toward a more
	comprehensive test suite for the assembler.
	* generic/tclAssembly.c:	Fixed bugs exposed by the new tests:
	(a) [bitnot] and [not] had incorrect operand counts. (b)
	INST_CONCAT cannot concatenate zero objects. (c) misspelt error
	messages. (d) the "assembly code" internal representation lacked
	a duplicator, which caused double-frees of the Bytecode object
	if assembly code ever was duplicated.

2010-09-25  Kevin B. Kenny   <[email protected]>

	[dogeen-assembler-branch]

	* generic/tclAssembly.c:	Massive refactoring of the assembler
	* generic/tclAssembly.h:	to use a Tcl-like syntax (and use
	* tests/assemble.test:		Tcl_ParseCommand to parse it). The
	* tests/assemble1.bench:	refactoring also ensures that
	Tcl_Tokens in the assembler have string ranges inside the source
	code, which allows for [eval] and [expr] assembler directives
	that simply call TclCompileScript and TclCompileExpr recursively.

2010-09-24  Jeff Hobbs  <[email protected]>

	* tests/stringComp.test: improved string eq/cmp test coverage
	* generic/tclExecute.c (TclExecuteByteCode): merge INST_STR_CMP and
	INST_STR_EQ/INST_STR_NEQ paths.  Speeds up eq/ne/[string eq] with
	obj-aware comparisons and eq/==/ne/!= with length equality check.

2010-09-24  Andreas Kupries  <[email protected]>

	* tclWinsock.c: [Bug 3056775]: Fixed race condition between thread and
	internal co-thread access of a socket's structure because of the
	thread not using the socketListLock in TcpAccept(). Added
	documentation on how the module works to the top.

2010-09-23  Jan Nijtmans  <[email protected]>

	* generic/tclDecls.h: Make Tcl_SetPanicProc and Tcl_GetStringResult
	* unix/tclAppInit.c:  callable without stubs, just as Tcl_SetVar.
	* win/tclAppInit.c:

2010-09-23  Don Porter  <[email protected]>

	* generic/tclCmdAH.c:   Fix cases where value returned by
	* generic/tclEvent.c:   Tcl_GetReturnOptions() was leaked.
	* generic/tclMain.c:    Thanks to Jeff Hobbs for discovery of the
	anti-pattern to seek and destroy.

2010-09-23  Jan Nijtmans  <[email protected]>

	* unix/tclAppInit.c:  Make compilable with -DUNICODE (not activated
	* win/tclAppInit.c:   yet), many clean-ups in comments.

2010-09-22  Miguel Sofer  <[email protected]>

	* generic/tclExecute: [Bug 3072640]: One more DECACHE_STACK_INFO() was
	missing.

	* tests/execute.test: Added execute-10.3 for [Bug 3072640]. The test
	causes a mem failure.

	* generic/tclExecute: Protect all possible writes to ::errorInfo or
	::errorCode with DECACHE_STACK_INFO(), as they could run traces. The
	new calls to be protected are Tcl_ResetResult(), Tcl_SetErrorCode(),
	IllegalExprOperandType(), TclExprFloatError(). The error was triggered
	by [Patch 3072080].

2010-09-22  Jan Nijtmans  <[email protected]>

	* win/tcl.m4:		Add kernel32 to LIBS, so the link line for
	* win/configure:	mingw is exactly the same as for MSVC++.

2010-09-21  Jeff Hobbs  <[email protected]>

	* generic/tclExecute.c (TclExecuteByteCode):
	* generic/tclOOMethod.c (ProcedureMethodCompiledVarConnect):
	* generic/tclVar.c (TclLookupSimpleVar, CompareVarKeys):
	* generic/tclPathObj.c (Tcl_FSGetNormalizedPath, Tcl_FSEqualPaths):
	* generic/tclIOUtil.c (TclFSCwdPointerEquals): peephole opt
	* generic/tclResult.c (TclMergeReturnOptions): Use memcmp where
	applicable as possible speedup on some libc variants.

2010-09-21  Kevin B. Kenny  <[email protected]>

	[BRANCH: dogeen-assembler-branch]

	* generic/tclAssembly.c (new file):
	* generic/tclAssembly.h:
	* generic/tclBasic.c (builtInCmds, Tcl_CreateInterp):
	* generic/tclInt.h:
	* tests/assemble.test (new file):
	* tests/assemble1.bench (new file):
	* unix/Makefile.in:
	* win/Makefile.in:
	* win/Makefile.vc:
		Initial commit of Ozgur Dogan Ugurlu's (SF user: dogeen)
		assembler for the Tcl bytecode language.

2010-09-21  Jan Nijtmans  <[email protected]>

	* win/tclWinFile.c:   Fix declaration after statement.
	* win/tcl.m4:         Add -Wdeclaration-after-statement, so this
	* win/configure:      mistake cannot happen again.
	* win/tclWinFCmd.c:   [Bug 3069278]: Breakage on head Windows
	* win/tclWinPipe.c:   triggered by install-tzdata, final fix

2010-09-20  Jan Nijtmans  <[email protected]>

	* win/tclWinFCmd.c: Eliminate tclWinProcs->useWide everywhere, since
	* win/tclWinFile.c: the value is always "1" on platforms >win95
	* win/tclWinPipe.c:

2010-09-19  Donal K. Fellows  <[email protected]>

	* doc/file.n (file readlink): [Bug 3070580]: Typofix.

2010-09-18  Jan Nijtmans  <[email protected]>

	* win/tclWinFCmd.c [Bug 3069278]: Breakage on head Windows triggered
	by install-tzdata. Temporary don't compile this with -DUNICODE, while
	investigating this bug.

2010-09-16  Jeff Hobbs  <[email protected]>

	* win/tclWinFile.c: Remove define of FINDEX_INFO_LEVELS as all
	supported versions of compilers should now have it.

	* unix/Makefile.in: Do not pass current build env vars when using
	NATIVE_TCLSH in targets.

2010-09-16  Jan Nijtmans  <[email protected]>

	* generic/tclDecls.h:    Make Tcl_FindExecutable() work in UNICODE
	* generic/tclEncoding.c: compiles (windows-only) as well as ASCII.
	* generic/tclStubInit.c: Needed for [FRQ 491789]: setargv() doesn't
	support a unicode cmdline.

2010-09-15  Donal K. Fellows  <[email protected]>

	* generic/tclBinary.c (TclAppendBytesToByteArray): [Bug 3067036]: Make
	sure we never try to double zero repeatedly to get a buffer size. Also
	added a check for sanity on the size of buffer being appended.

2010-09-15  Don Porter  <[email protected]>

	* unix/Makefile.in:	Revise `make dist` target to tolerate the
	case of zero bundled packages.

2010-09-15  Jan Nijtmans  <[email protected]>

	* tools/genStubs.tcl:   [Patch 3034251]: Backport ttkGenStubs.tcl
	* generic/tcl.decls:    features to genStubs.tcl. Make the "generic"
	* generic/tclInt.decls: argument in the *.decls files optional
	* generic/tclOO.decls:  (no change to any tcl*Decls.h files)
	* generic/tclTomMath.decls:
	This allows genStubs.tcl to generate the ttk stub files as well, while
	keeping full compatibility with existing *.decls files.

2010-09-14  Jan Nijtmans  <[email protected]>

	* win/tclWinPort.h:  Allow all Win2000+ API entries in Tcl
	* win/tclWin32Dll.c: Eliminate dynamical loading of advapi23 and
	kernel32 symbols.

2010-09-13  Jan Nijtmans  <[email protected]>

	* win/tclWinChan.c:      Various clean-ups, converting from
	* win/tclWinConsole.c:   tclWinProc->xxxProc directly to Xxx
	* win/tclWinInit.c:      (no change in functionality)
	* win/tclWinLoad.c:
	* win/tclWinSerial.c:
	* win/tclWinSock.c:
	* tools/genStubs.tcl:    Add scspec feature from ttkGenStubs.tcl
	  (no change in output for *Decls.h files)

2010-09-10  Jan Nijtmans  <[email protected]>

	* win/tclWin32Dll.c: Partly revert yesterday's change, to make it work
	on VC++ 6.0 again.

2010-09-10  Donal K. Fellows  <[email protected]>

	* doc/regsub.n: [Bug 3063568]: Fix for gotcha in example due to Tcl's
	special handling of backslash-newline. Makes example slightly less
	pure, but more useful.

2010-09-09  Jan Nijtmans  <[email protected]>

	* win/makefile.vc:   Mingw should always link with -ladvapi32.
	* win/tcl.m4:
	* win/configure:     (regenerated)
	* win/tclWinInt.h:   Remove ascii variant of tkWinPocs table, it is
	* win/tclWin32Dll.c: no longer necessary. Fix CreateProcess signature
	* win/tclWinPipe.c:  and remove unused GetModuleFileName and lstrcpy.
	* win/tclWinPort.h:  Mingw/cygwin fixes: <tchar.h> should always be
	included, and fix conflict in various macro values: Always force the
	same values as in VC++.

2010-09-08  Don Porter  <[email protected]>

	* win/tclWinChan.c:	[Bug 3059922]: #ifdef protections to permit
	* win/tclWinFCmd.c:     builds with mingw on amd64 systems. Thanks to
				"mescalinum" for reporting and testing.

2010-09-08  Andreas Kupries  <[email protected]>

	* doc/tm.n: Added underscore to the set of characters accepted in
	module names. This is true for quite some time in the code, this
	change catches up the documentation.

2010-09-03  Donal K. Fellows  <[email protected]>

	* tools/tcltk-man2html.tcl (plus-pkgs): Improve the package
	documentation search pattern to support the doctoos-generated
	directory structure.
	* tools/tcltk-man2html-utils.tcl (output-name): Made this more
	resilient against misformatted NAME sections, induced by import of
	Thread package documentation into Tcl doc tree.

2010-09-02  Andreas Kupries  <[email protected]>

	* doc/glob.n: Fixed documentation ambiguity regarding the handling
	of -join.

	* library/safe.tcl (safe::AliasGlob): Fixed another problem, the
	option -join does not stop option processing in the core builtin, so
	the emulation must not do that either.

2010-09-01  Andreas Kupries  <[email protected]>

	* library/safe.tcl (safe::AliasGlob): Moved the command extending the
	actual glob command with a -directory flag to when we actually have a
	proper untranslated path,

2010-09-01  Andreas Kupries  <[email protected]>

	* generic/tclExecute.c: [Bug 3057639]: Applied patch by Jeff to make
	* generic/tclVar.c:	the behaviour of lappend in bytecompiled mode
	* tests/append.test:	consistent with direct-eval and 'append'
	* tests/appendComp.test: generally. Added tests (append*-9.*)
	showing the difference.

2010-08-31  Jan Nijtmans  <[email protected]>

	* win/rules.vc:               Typo (thanks to Twylite discovering
				      this)
	* generic/tclStubLib.c:       Revert to previous version: MSVC++ 6.0
	* generic/tclTomMathStubLib.c:cannot handle the new construct.
	* generic/tcl.decls           [Patch 2997642]: Many type casts needed
	* generic/tclDecls.h:         when using Tcl_Pkg* API. Remaining part.
	* generic/tclPkg.c:
	* generic/tclBasic.c:
	* generic/tclTomMathInterface.c:
	* doc/PkgRequire.3

2010-08-31  Andreas Kupries  <[email protected]>

	* win/tcl.m4: Applied patch by Jeff fixing issues with the manifest
	handling on Win64.
	* win/configure: Regenerated.

2010-08-30  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c:    [Bugs 3046594,3047235,3048771]: New
	* generic/tclCmdAH.c:    implementation for [tailcall] command: it now
	* generic/tclCmdMZ.c:    schedules the command and returns TCL_RETURN.
	* generic/tclExecute.c:  This fixes all issues with [catch] and [try].
	* generic/tclInt.h:      Thanks dgp for exploring the dark corners.
	* generic/tclNamesp.c:   More thorough testing is required.
	* tests/tailcall.test:

2010-08-30  Jan Nijtmans  <[email protected]>

	* win/Makefile.in:   [FRQ 2965056]: Windows build with -DUNICODE
	* win/rules.vc:
	* win/tclWinFCmd.c:  Make sure that allocated TCHAR arrays are
	* win/tclWinFile.c:  always properly aligned as wchar_t, and
	* win/tclWinPipe.c:  not bigger than necessary.
	* win/tclWinSock.c:
	* win/tclWinDde.c:   Those 3 files are not converted yet to be
	* win/tclWinReg.c:   built with -DUNICODE, so add a TODO.
	* win/tclWinTest.c:
	* generic/tcl.decls:  [Patch 2997642]: Many type casts needed when
	* generic/tclDecls.h: using Tcl_Pkg* API. Partly.
	* generic/tclPkg.c:
	* generic/tclStubLib.c: Demonstration how this change can benefit
				code.
	* generic/tclTomMathStubLib.c:
	* doc/PkgRequire.3:

2010-08-29  Donal K. Fellows  <[email protected]>

	* doc/dict.n: [Bug 3046999]: Corrected cross reference to array
	manpage to refer to (correct) existing subcommand.

2010-08-26  Jeff Hobbs  <[email protected]>

	* unix/configure, unix/tcl.m4: SHLIB_LD_LIBS='${LIBS}' for OSF1-V*.
	Add /usr/lib64 to set of auto-search dirs. [Bug 1230554]
	(SC_PATH_X): Correct syntax error when xincludes not found.

	* win/Makefile.in (VC_MANIFEST_EMBED_DLL VC_MANIFEST_EMBED_EXE):
	* win/configure, win/configure.in, win/tcl.m4: SC_EMBED_MANIFEST
	macro and --enable-embedded-manifest configure arg added to support
	manifest embedding where we know the magic.  Help prevents DLL hell
	with MSVC8+.

2010-08-24  Jan Nijtmans  <[email protected]>

	* generic/tcl.decls: [Bug 3007895]: Tcl_(Find|Create)HashEntry
	* generic/tclHash.c: stub entries can never be called.
	* generic/tclDecls.h:
	* generic/tclStubInit.c: [Patch 2994165]: Change signature of
	Tcl_FSGetNativePath and TclpDeleteFile follow-up: move stub entry back
	to original location.

2010-08-23  Kevin B. Kenny  <[email protected]>

	* library/tzdata/Africa/Cairo:
	* library/tzdata/Asia/Gaza: Olson's tzdata2010l.

2010-08-22  Jan Nijtmans  <[email protected]>

	* generic/tclBasic.c:  [Patch 3009403]: Signature of Tcl_GetHashKey,
	* generic/tclBinary.c: Tcl_(Create|Find)HashEntry follow-up:
	* generic/tclCmdIL.c:  Remove many type casts which are no longer
	* generic/tclCompile.c:necessary as a result of this signature change.
	* generic/tclDictObj.c:
	* generic/tclEncoding.c:
	* generic/tclExecute.c:
	* generic/tclInterp.c:
	* generic/tclIOCmd.c:
	* generic/tclObj.c:
	* generic/tclProc.c:
	* generic/tclTest.c:
	* generic/tclTrace.c:
	* generic/tclUtil.c:
	* generic/tclVar.c:

2010-08-21  Donal K. Fellows  <[email protected]>

	* doc/linsert.n: [Bug 3045123]: Make description of what is actually
	happening more accurate.

2010-08-21  Jan Nijtmans  <[email protected]>

	* tools/genStubs.tcl: [Patch 3034251]: Backport ttkGenStubs.tcl
	features to genStubs.tcl, partly: Use void (*reserved$i)(void) = 0
	instead of void *reserved$i = NULL for unused stub entries, in case
	pointer-to-function and pointer-to-object are different sizes.
	* generic/tcl*Decls.h:   (regenerated)
	* generic/tcl*StubInit.c:(regenerated)

2010-08-20  Jan Nijtmans  <[email protected]>

	* doc/Method.3:   Fix definition of Tcl_MethodType.

2010-08-19  Donal K. Fellows  <[email protected]>

	* generic/tclTrace.c (TraceExecutionObjCmd, TraceCommandObjCmd)
	(TraceVariableObjCmd): [Patch 3048354]: Use memcpy() instead of
	strcpy() to avoid buffer overflow; we have the correct length of data
	to copy anyway since we've just allocated the target buffer.

2010-08-18  Jan Nijtmans  <[email protected]>

	* tools/genStubs.tcl: [Patch 3034251]: Backport ttkGenStubs.tcl
	features to genStubs.tcl, partly: remove unneeded ifdeffery and put
	C++ guard around stubs pointer definition.
	* generic/*Decls.h:   (regenerated)

2010-08-18  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c:   New redesign of [tailcall]: find
	* generic/tclExecute.c: errors early on, so that errorInfo
	* generic/tclInt.h:     contains the proper info [Bug 3047235]
	* generic/tclNamesp.c:

	* generic/tclCmdAH.c (TclNRTryObjCmd): [Bug 3046594]: Block
	tailcalling out of the body of a non-bc'ed [try].

	* generic/tclBasic.c:    Redesign of [tailcall] to
	* generic/tclCmdAH.c:    (a) fix [Bug 3047235]
	* generic/tclCompile.h:  (b) enable fix for [Bug 3046594]
	* generic/tclExecute.c:  (c) enable recursive tailcalls
	* generic/tclInt.h:
	* generic/tclNamesp.c:
	* tests/tailcall.test:

2010-08-18  Donal K. Fellows  <[email protected]>

	* library/safe.tcl (AliasGlob): [Bug 3004191]: Restore safe [glob] to
	working condition.

2010-08-15  Donal K. Fellows  <[email protected]>

	* generic/tclProc.c (ProcWrongNumArgs): [Bug 3045010]: Make the
	handling of passing the wrong number of arguments to [apply] somewhat
	less verbose when a lambda term is present.

2010-08-14  Jan Nijtmans  <[email protected]>

	* compat/unicows:    Remove completely, see [FRQ 2819611].
	* doc/FileSystem.3: [Patch 2994165]: Change signature of
	* generic/tcl.decls  Tcl_FSGetNativePath and TclpDeleteFile
	* generic/tclDecls.h:
	* generic/tclIOUtil.c:
	* generic/tclStubInit.c:
	* generic/tclInt.h:
	* unix/tclUnixFCmd.c:
	* win/tclWinFCmd.c:
	* doc/Hash.3: [Patch 3009403]: Signature of Tcl_GetHashKey,
	* generic/tcl.h:     Tcl_(Create|Find)HashEntry

2010-08-11  Jeff Hobbs  <[email protected]>

	* unix/ldAix: Remove ancient (pre-4.2) AIX support
	* unix/configure: Regen with ac-2.59
	* unix/configure.in, unix/tclConfig.sh.in, unix/Makefile.in:
	* unix/tcl.m4 (AIX): Remove the need for ldAIX, replace with
	-bexpall/-brtl.  Remove TCL_EXP_FILE (export file) and other baggage
	that went with it.  Remove pre-4 AIX build support.

2010-08-11  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c (TclNRYieldToObjCmd):
	* tests/coroutine.test: Fixed bad copypasta snafu. Thanks to Andy Goth
	for finding the bug.

2010-08-10  Jeff Hobbs  <[email protected]>

	* generic/tclUtil.c (TclByteArrayMatch): Patterns may not be
	null-terminated, so account for that.

2010-08-09  Don Porter  <[email protected]>

	* changes:	Updates for 8.6b2 release.

2010-08-04  Jeff Hobbs  <[email protected]>

	* win/Makefile.in, win/makefile.bc, win/makefile.vc, win/tcl.dsp:
	* win/tclWinPipe.c (TclpCreateProcess):
	* win/stub16.c (removed): Removed Win9x tclpip8x.dll build and 16-bit
	application loader stub support.  Win9x is no longer supported.

	* win/tclWin32Dll.c (TclWinInit): Hard-enforce Windows 9x as an
	unsupported platform with a panic.  Code to support it still exists in
	other files (to go away in time), but new APIs are being used that
	don't exist on Win9x.

	* unix/tclUnixFCmd.c: Adjust license header as per
	ftp://ftp.cs.berkeley.edu/pub/4bsd/README.Impt.License.Change

	* license.terms: Fix DFARs note for number-adjusted rights clause

	* win/tclWin32Dll.c (asciiProcs, unicodeProcs):
	* win/tclWinLoad.c (TclpDlopen): 'load' use LoadLibraryEx with
	* win/tclWinInt.h (TclWinProcs): LOAD_WITH_ALTERED_SEARCH_PATH to
	prefer dependent DLLs in same dir as loaded DLL.

	* win/Makefile.in (%.${OBJEXT}): better implicit rules support

2010-08-04  Andreas Kupries  <[email protected]>

	* generic/tclIORChan.c: [Bug 3034840]: Fixed reference counting in
	* generic/tclIORTrans.c: InvokeTclMethod and callers.
	* tests/ioTrans.test:

2010-08-03  Andreas Kupries  <[email protected]>

	* tests/var.test (var-19.1): [Bug 3037525]: Added test demonstrating
	the local hashtable deletion crash and fix.

	* tests/info.test (info-39.1): Added forward copy of test in 8.5
	branch about [Bug 2933089]. Should not fail, and doesn't, after
	updating the line numbers to the changed position.

2010-08-02  Kevin B. Kenny  <[email protected]>

	* library/tzdata/America/Bahia_Banderas:
	* library/tzdata/Pacific/Chuuk:
	* library/tzdata/Pacific/Pohnpei:
	* library/tzdata/Africa/Cairo:
	* library/tzdata/Europe/Helsinki:
	* library/tzdata/Pacific/Ponape:
	* library/tzdata/Pacific/Truk:
	* library/tzdata/Pacific/Yap:			Olson's tzdata2010k.

2010-08-02  Miguel Sofer  <[email protected]>

	* generic/tclVar.c: Correcting bad port of [Bug 3037525] fix

2010-07-28  Miguel Sofer  <[email protected]>

	* generic/tclVar.c: [Bug 3037525]: Lose fickle optimisation in
	TclDeleteVars (used for runtime-created locals) that caused crash.

2010-07-29  Jan Nijtmans  <[email protected]>

	* compat/zlib/win32/README.txt: Official build of zlib1.dll 1.2.5 is
	* compat/zlib/win32/USAGE.txt:  finally available, so put it in.
	* compat/zlib/win32/zlib1.dll:

2010-07-25  Donal K. Fellows  <[email protected]>

	* doc/http.n: Corrected description of location of one of the entries
	in the state array.

2010-07-24  Jan Nijtmans  <[email protected]>

	* generic/tclDecls.h: [Bug 3029891]: Functions that don't belong in
	* generic/tclTest.c:  the stub table.
	* generic/tclBasic.c: From [Bug 3030870] make itcl 3.x built with
	pre-8.6 work in 8.6: Relax the relation between Tcl_CallFrame and
	CallFrame.

2010-07-16  Donal K. Fellows  <[email protected]>

	* generic/tclBasic.c: Added more errorCode setting.

2010-07-15  Donal K. Fellows  <[email protected]>

	* generic/tclExecute.c (TclExecuteByteCode): Ensure that [dict get]
	* generic/tclDictObj.c (DictGetCmd): always generates an errorCode on
	a failure to look up an entry.

2010-07-11  Pat Thoyts  <[email protected]>

	* unix/configure: (regenerated)
	* unix/configure.in: For the NATIVE_TCLSH variable use the autoconf
	* unix/Makefile.in:  SC_PROG_TCLSH to try and find a locally installed
	native binary. This avoids manually fixing up when cross compiling. If
	there is not one, revert to using the build product.

2010-07-02  Don Porter  <[email protected]>

	* generic/tclInt.decs:	Reverted to the original TIP 337
	implementation on what to do with the obsolete internal stub for
	TclBackgroundException() (eliminate it!)
	* generic/tclIntDecls.h:	make genstubs
	* generic/tclStubInit.c:

2010-07-02  Jan Nijtmans  <[email protected]>

	* generic/tclInt.decls:  [Bug 803489]: Tcl_FindNamespace problem in
	* generic/tclIntDecls.h: the Stubs table
	* generic/tclStubInit.c:

2010-07-02  Donal K. Fellows  <[email protected]>

	* generic/tclExecute.c (IllegalExprOperandType): [Bug 3024379]: Made
	sure that errors caused by an argument to an operator being outside
	the domain of the operator all result in ::errorCode being ARITH
	DOMAIN and not NONE.

2010-07-01  Jan Nijtmans  <[email protected]>

	* win/rules.vc:              [Bug 3020677]: wish can't link reg1.2
	* tools/checkLibraryDoc.tcl: formatting, spacing, cleanup unused
	* tools/eolFix.tcl:          variables; no change in generated output
	* tools/fix_tommath_h.tcl:
	* tools/genStubs.tcl:
	* tools/index.tcl:
	* tools/man2help2.tcl:
	* tools/regexpTestLib.tcl:
	* tools/tsdPerf.tcl:
	* tools/uniClass.tcl:
	* tools/uniParse.tcl:

2010-07-01  Donal K. Fellows  <[email protected]>

	* doc/mathop.n: [Bug 3023165]: Fix typo that was preventing proper
	rendering of the exclusive-or operator.

2010-06-28  Jan Nijtmans  <[email protected]>

	* generic/tclPosixStr.c: [Bug 3019634]: errno.h and tclWinPort.h have
	conflicting definitions. Added messages for ENOTRECOVERABLE, EOTHER,
	ECANCELED and EOWNERDEAD, and fixed various typing mistakes in other
	messages.

2010-06-25  Reinhard Max  <[email protected]>

	* tests/socket.test: Prevent a race condition during shutdown of the
	remote test server that can cause a hang when the server is being run
	in verbose mode.

2010-06-24  Jan Nijtmans  <[email protected]>

	* win/tclWinPort.h: [Bug 3019634]: errno.h and tclWinPort.h have
	conflicting definitions.

		***POTENTIAL INCOMPATIBILITY***
	On win32, the correspondence between errno and the related error
	message, as handled by Tcl_ErrnoMsg() changes. The error message is
	kept the same, but the corresponding errno value might change.

2010-06-22  Donal K. Fellows  <[email protected]>

	* generic/tclCmdIL.c (Tcl_LsetObjCmd): [Bug 3019351]: Corrected wrong
	args message.

2010-06-21  Jan Nijtmans  <[email protected]>

	* unix/tclLoadDl.c:    Eliminate various unnecessary type casts, use
	* unix/tclLoadNext.c:  function typedefs whenever possible
	* unix/tclUnixChan.c:
	* unix/tclUnixFile.c:
	* unix/tclUnixNotfy.c:
	* unix/tclUnixSock.c:
	* unix/tclUnixTest.c:
	* unix/tclXtTest.c:
	* generic/tclZlib.c:   Remove hack needed for zlib 1.2.3 on win32

2010-06-18  Donal K. Fellows  <[email protected]>

	* library/init.tcl (auto_execok): [Bug 3017997]: Add .cmd to the
	default list of extensions that we can execute interactively.

2010-06-16  Jan Nijtmans  <[email protected]>

	* tools/loadICU.tcl:   [Bug 3016135]: Traceback using clock format
	* library/msgs/he.msg: with locale of he_IL.

	* generic/tcl.h:       Simplify Tcl_AppInit and *_Init definitions,
	* generic/tclInt.h:    spacing. Change TclpThreadCreate and
	* generic/tcl.decls:   Tcl_CreateThread signature, making clear that
	* generic/tclDecls.h:  "proc" is a function pointer, as in all other
	* generic/tclEvent.c:  "proc" function parameters.
	* generic/tclTestProcBodyObj.c:
	* win/tclWinThrd.c:
	* unix/tclUnixThrd.c:
	* doc/Thread.3:
	* doc/Class.3:         Fix Tcl_ObjectMetadataType definition.

2010-06-14  Jan Nijtmans  <[email protected]>

	* unix/Makefile.in:    Fix compilation of xttest with 8.6 changes
	* unix/tclXtNotify.c:
	* unix/tclXtTest.c:
	* generic/tclPipe.c:   Fix gcc warning (with -fstrict-aliasing=2)
	* library/auto.tcl:    Spacing and style fixes.
	* library/history.tcl:
	* library/init.tcl:
	* library/package.tcl:
	* library/safe.tcl:
	* library/tm.tcl:

2010-06-13  Donal K. Fellows  <[email protected]>

	* tools/tcltk-man2html.tcl (make-man-pages): [Bug 3015327]: Make the
	title of a manual page be stored relative to its resulting directory
	name as well as its source filename. This was caused by both Tcl and a
	contributed package ([incr Tcl]) defining an Object.3. Also corrected
	the joining of strings in titles to avoid extra braces.

2010-06-09  Andreas Kupries  <[email protected]>

	* library/platform/platform.tcl: Added OSX Intel 64bit
	* library/platform/pkgIndex.tcl: Package updated to version 1.0.9.
	* unix/Makefile.in:
	* win/Makefile.in:

2010-06-09  Jan Nijtmans  <[email protected]>

	* tools/tsdPerf.c:    Fix export of symbol Tsdperf_Init, when using
	-fvisibility=hidden. Make two functions static, eliminate some
	unnecessary type casts.
	* tools/configure.in: Update to Tcl 8.6
	* tools/configure:    (regenerated)
	* tools/.cvsignore    new file

2010-06-07  Alexandre Ferrieux  <[email protected]>

	* generic/tclExecute.c: Ensure proper reset of [info errorstack] even
	* generic/tclNamesp.c:  when compiling constant expr's with errors.

2010-06-05  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c:   [Bug 3008307]: make callerPtr chains be
	* generic/tclExecute.c: traversable accross coro boundaries. Add the
	special coroutine CallFrame (partially reverting commit of
	2009-12-10), as it is needed for coroutines that do not push a CF, eg,
	those with [eval] as command. Thanks to Colin McCormack (coldstore)
	and Alexandre Ferrieux for the hard work on this.

2010-06-03  Alexandre Ferrieux  <[email protected]>

	* generic/tclNamesp.c: Safer (and faster) computation of [uplevel]
	* tests/error.test:    offsets in TIP 348. Toplevel offsets no longer
	* tests/result.test:   overestimated.

2010-06-02  Jan Nijtmans  <[email protected]>

	* generic/tclOO.h:  BUILD_tcloo is never defined (leftover)
	* win/makefile.bc:  Don't set BUILD_tcloo (leftover)
	See also entry below: 2008-06-01  Joe Mistachkin

2010-06-01  Alexandre Ferrieux  <[email protected]>

	* generic/tclNamesp.c: Fix computation of [uplevel] offsets in TIP 348
	* tests/error.test:    Only depend on callerPtr chaining now.
	* tests/result.test:   Needed for upcoming coro patch.

2010-05-31  Jan Nijtmans  <[email protected]>

	* generic/tclVar.c:        Eliminate some casts to (Tcl_HashTable *)
	* generic/tclExecute.c:
	* tests/fileSystem.test:   Fix filesystem-5.1 test failure on CYGWIN

2010-05-28  Jan Nijtmans  <[email protected]>

	* generic/tclInt.h: [Patch 3008541]: Order of TIP #348 fields in
	Interp structure

2010-05-28  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmdsSZ.c (IssueTryFinallyInstructions): [3007374]:
	Corrected error in handling of catch contexts to prevent crash with
	chained handlers.

	* generic/tclExecute.c (TclExecuteByteCode): Restore correct operation
	of instruction-level execution tracing (had been broken by NRE).

2010-05-27  Jan Nijtmans  <[email protected]>

	* library/opt/optParse.tcl: Don't generate spaces at the end of a
	* library/opt/pkgIndex.tcl: line, eliminate ';' at line end, bump to
	* tools/uniParse.tcl:       v0.4.6
	* generic/tclUniData.c:
	* tests/opt.test:
	* tests/safe.test:

2010-05-21  Jan Nijtmans  <[email protected]>

	* tools/installData.tcl: Make sure that copyDir only receives
	normalized paths, otherwise it might result in a crash on CYGWIN.
	Restyle according to the Tcl style guide.
	* generic/tclStrToD.c: [Bug 3005233]: Fix for build on OpenBSD vax

2010-05-19  Alexandre Ferrieux  <[email protected]>

	* tests/dict.test: Add missing tests for [Bug 3004007], fixed under
	the radar on 2010-02-24 (dkf): EIAS violation in list-dict conversions

2010-05-19  Jan Nijtmans  <[email protected]>

	* generic/regcomp.c:     Don't use arrays of length 1, just use a
	* generic/tclFileName.c: single element then, it makes code more
	* generic/tclLoad.c:     readable. (Here it even prevents a type cast)

2010-05-17  Jan Nijtmans  <[email protected]>

	* generic/tclStrToD.c: [Bug 2996549]: Failure in expr.test on Win32

2010-05-17  Donal K. Fellows  <[email protected]>

	* generic/tclCmdIL.c (TclInfoFrame): Change this code to use
	Tcl_GetCommandFullName rather than rolling its own. Discovered during
	the hunting of [Bug 3001438] but unlikely to be a fix.

2010-05-11  Jan Nijtmans  <[email protected]>

	* win/tclWinConsole.c: [Patch 2997087]: Unnecessary type casts.
	* win/tclWinDde.c:
	* win/tclWinLoad.c:
	* win/tclWinNotify.c:
	* win/tclWinSerial.c:
	* win/tclWinSock.c:
	* win/tclWinTime.c:
	* win/tclWinPort.h: Don't duplicate CYGWIN timezone #define from
			    tclPort.h

2010-05-07  Andreas Kupries  <[email protected]>

	* library/platform/platform.tcl: Fix cpu name for Solaris/Intel 64bit.
	* library/platform/pkgIndex.tcl: Package updated to version 1.0.8.
	* unix/Makefile.in:
	* win/Makefile.in:

2010-05-06  Jan Nijtmans  <[email protected]>

	* generic/tclPkg.c:   Unnecessary type casts, see [Patch 2997087]

2010-05-04  Jan Nijtmans  <[email protected]>

	* win/tclWinNotify.c:	TCHAR-related fixes, making those two files
	* win/tclWinSock.c:	compile fine when TCHAR != char. Please see
	comments in [FRQ 2965056] (2965056-1.patch).

2010-05-03  Jan Nijtmans  <[email protected]>

	* generic/tclIORChan.c:   Use "tclIO.h" and "tclTomMathDecls.h"
	* generic/tclIORTrans.c:  everywhere
	* generic/tclTomMath.h:
	* tools/fix_tommath_h.tcl:
	* libtommath/tommath.h:   Formatting (# should always be first char on
				  line)
	* win/tclAppInit.c:       For MINGW/CYGWIN, use GetCommandLineA
				  explicitly.
	* unix/.cvsignore:        Add pkg, *.dll

	* libtommath/tommath.h:       CONSTify various useful internal
	* libtommath/bn_mp_cmp_d.c:   functions (TclBignumToDouble, TclCeil,
	* libtommath/bn_mp_cmp_mag.c: TclFloor), and related tommath functions
	* libtommath/bn_mp_cmp.c:
	* libtommath/bn_mp_copy.c:
	* libtommath/bn_mp_count_bits.c:
	* libtommath/bn_mp_div_2d.c:
	* libtommath/bn_mp_mod_2d.c:
	* libtommath/bn_mp_mul_2d.c:
	* libtommath/bn_mp_neg.c:
	* generic/tclBasic.c:        Handle TODO: const correctness ?
	* generic/tclInt.h:
	* generic/tclStrToD.c:
	* generic/tclTomMath.decls:
	* generic/tclTomMath.h:
	* generic/tclTomMathDecls.h:

2010-04-30  Don Porter  <[email protected]>

	* generic/tcl.h:	Bump patchlevel to 8.6b1.2 to distinguish
	* library/init.tcl:	CVS snapshots from earlier snapshots as well
	* unix/configure.in:	as the 8.6b1 and 8.6b2 releases.
	* win/configure.in:

	* unix/configure:	autoconf-2.59
	* win/configure:

	* generic/tclBinary.c (TclAppendBytesToByteArray):	Add comments
	* generic/tclInt.h (TclAppendBytesToByteArray):	placing overflow
	protection responsibility on caller.  Convert "len" argument to signed
	int which any value already vetted for overflow issues will fit into.
	* generic/tclStringObj.c:	Update caller; standardize panic msg.

	* generic/tclBinary.c (UpdateStringOfByteArray): [Bug 2994924]:	Add
	panic when the generated string representation would grow beyond Tcl's
	size limits.

2010-04-30  Donal K. Fellows  <[email protected]>

	* generic/tclBinary.c (TclAppendBytesToByteArray): Add extra armour
	against buffer overflows.

	* generic/tclBasic.c (NRInterpCoroutine): Corrected handling of
	* tests/coroutine.test (coroutine-6.4):   arguments to deal with
						  trickier cases.

2010-04-30  Miguel Sofer  <[email protected]>

	* tests/coroutine.test: testing coroutine arguments after [yield]:
	check that only 0/1 allowed

2010-04-30  Donal K. Fellows  <[email protected]>

	* generic/tclBasic.c (NRInterpCoroutine): Corrected handling of
	arguments to deal with trickier cases.

	* generic/tclCompCmds.c (TclCompileVariableCmd): Slightly tighter
	issuing of instructions.

	* generic/tclExecute.c (TclExecuteByteCode): Add peephole optimization
	of the fact that INST_DICT_FIRST and INST_DICT_NEXT always have a
	conditional jump afterwards.

	* generic/tclBasic.c (TclNRYieldObjCmd, TclNRYieldmObjCmd)
	(NRInterpCoroutine): Replace magic values for formal argument counts
	for coroutine command implementations with #defines, for an increase
	in readability.

2010-04-30  Jan Nijtmans  <[email protected]>

	* generic/tclMain.c: Unnecessary TCL_STORAGE_CLASS re-definition. It
	was used for an ancient dummy reference to Tcl_LinkVar(), but that's
	already gone since 2002-05-29.

2010-04-29  Miguel Sofer  <[email protected]>

	* generic/tclCompExpr.c: Slight change in the literal sharing
	* generic/tclCompile.c:  mechanism to avoid shimmering of
	* generic/tclCompile.h:  command names.
	* generic/tclLiteral.c:

2010-04-29  Andreas Kupries  <[email protected]>

	* library/platform/platform.tcl: Another stab at getting the /lib,
	* library/platform/pkgIndex.tcl: /lib64 difference right for linux.
	* unix/Makefile.in:		 Package updated to version 1.0.7.
	* win/Makefile.in:

2010-04-29  Kevin B. Kenny  <[email protected]>

	* library/tzdata/Antarctica/Macquarie:
	* library/tzdata/Africa/Casablanca:
	* library/tzdata/Africa/Tunis:
	* library/tzdata/America/Santiago:
	* library/tzdata/America/Argentina/San_Luis:
	* library/tzdata/Antarctica/Casey:
	* library/tzdata/Antarctica/Davis:
	* library/tzdata/Asia/Anadyr:
	* library/tzdata/Asia/Damascus:
	* library/tzdata/Asia/Dhaka:
	* library/tzdata/Asia/Gaza:
	* library/tzdata/Asia/Kamchatka:
	* library/tzdata/Asia/Karachi:
	* library/tzdata/Asia/Taipei:
	* library/tzdata/Europe/Samara:
	* library/tzdata/Pacific/Apia:
	* library/tzdata/Pacific/Easter:
	* library/tzdata/Pacific/Fiji:   Olson's tzdata2010i.

2010-04-29  Donal K. Fellows  <[email protected]>

	* generic/tclBinary.c (TclAppendBytesToByteArray): [Bug 2992970]: Make
	* generic/tclStringObj.c (Tcl_AppendObjToObj): an append of a byte
	array to another into an efficent operation. The problem was the (lack
	of) a proper growth management strategy for the byte array.

2010-04-29  Jan Nijtmans  <[email protected]>

	* compat/dirent2.h:	Include "tcl.h", not <tcl.h>, like everywhere
	* compat/dlfcn.h:	else, to ensure that the version in the Tcl
	* compat/stdlib.h:	distribution is used, not some version from
	* compat/string.h:	somewhere else.
	* compat/unistd.h:

2010-04-28  Jan Nijtmans  <[email protected]>

	* win/Makefile.in:	Remove unused @MAN2TCLFLAGS@
	* win/tclWinPort.h:	Move <limits.h> include from tclInt.h to
	* generic/tclInt.h:	tclWinPort.h, and eliminate unneeded
	* generic/tclEnv.c:	<stdlib.h>, <stdio.h> and <string.h>, which
				are already in tclInt.h
	* generic/regcustom.h:	Move "tclInt.h" from regcustom.h up to
	* generic/regex.h:	regex.h.
	* generic/tclAlloc.c:	Unneeded <stdio.h> include.
	* generic/tclExecute.c:	Fix gcc warning: comparison between signed and
				unsigned.

2010-04-28  Donal K. Fellows  <[email protected]>

	* generic/tclInt.h (TclIsVarDirectUnsettable): Corrected flags so that
	deletion of traces is not optimized out...

	* generic/tclExecute.c (ExecuteExtendedBinaryMathOp)
	(TclCompareTwoNumbers,ExecuteExtendedUnaryMathOp,TclExecuteByteCode):
	[Patch 2981677]: Move the less common arithmetic operations (i.e.,
	exponentiation and operations on non-longs) out of TEBC for a big drop
	in the overall size of the stack frame for most code. Net effect on
	speed is minimal (slightly faster overall in tclbench). Also extended
	the number of places where TRESULT handling is replaced with a jump to
	dedicated code.

2010-04-27  Donal K. Fellows  <[email protected]>

	* generic/tclExecute.c (TclExecuteByteCode): Rearrange location of an
	assignment to shorten the object code.

2010-04-27  Jan Nijtmans  <[email protected]>

	* generic/tclIOUtil.c (Tcl_FSGetNativePath): [Bug 2992292]:
	tclIOUtil.c assignment type mismatch compiler warning
	* generic/regguts.h:     If tclInt.h or tclPort.h is already
	* generic/tclBasic.c:    included, don't include <limits.h>
	* generic/tclExecute.c:  again. Follow-up to [Bug 2991415]:
	* generic/tclIORChan.c:  tclport.h #included before limits.h
	* generic/tclIORTrans.c: See comments in [Bug 2991415]
	* generic/tclObj.c:
	* generic/tclOOInt.h:
	* generic/tclStrToD.c:
	* generic/tclTomMath.h:
	* generic/tclTomMathInterface.c:
	* generic/tclUtil.c:
	* compat/strtod.c:
	* compat/strtol.c:

2010-04-27  Kevin B. Kenny  <[email protected]>

	* unix/tclLoadDl.c (FindSymbol): [Bug 2992295]: Simplified the logic
	so that the casts added in Donal Fellows's change for the same bug are
	no longer necessary.

2010-04-26  Donal K. Fellows  <[email protected]>

	* unix/tclLoadDl.c (FindSymbol): [Bug 2992295]: Added an explicit cast
	because auto-casting between function and non-function types is never
	naturally warning-free.

	* generic/tclStubInit.c:   Add a small amount of gcc-isms (with #ifdef
	* generic/tclOOStubInit.c: guards) to ensure that warnings are issued
	when these files are older than the various *.decls files.

2010-04-25  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c:    Add unsupported [yieldm] command. Credit
	* generic/tclInt.h:      Lars Hellstrom for the basic idea.

2010-04-24  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c:    Modify api of TclSpliceTailcall() to fix
	* generic/tclExecute.c:  [yieldTo], which had not survived the latest
	* generic/tclInt.h:      mods to tailcall. Thanks kbk for detecting
	the problem.

2010-04-23  Jan Nijtmans  <[email protected]>

	* unix/tclUnixPort.h: [Bug 2991415]: tclport.h #included before
	limits.h

2010-04-22  Jan Nijtmans  <[email protected]>

	* generic/tclPlatDecls.h:  Move TCHAR fallback typedef from tcl.h to
	* generic/tcl.h:           tclPlatDecls.h (as suggested by dgp)
	* generic/tclInt.h:        fix typo
	* generic/tclIOUtil.c:     Eliminate various unnecessary
	* unix/tclUnixFile.c:      type casts.
	* unix/tclUnixPipe.c:
	* win/tclWinChan.c:
	* win/tclWinFCmd.c:
	* win/tclWinFile.c:
	* win/tclWinLoad.c:
	* win/tclWinPipe.c:

2010-04-20  Jan Nijtmans  <[email protected]>

	* generic/tclTest.c:  Use function prototypes from the FS API.
	* compat/zlib/*:      Upgrade to zlib 1.2.5

2010-04-19  Donal K. Fellows  <[email protected]>

	* generic/tclExecute.c (TclExecuteByteCode): Improve commenting and
	reduce indentation for the Invocation Block.

2010-04-18  Donal K. Fellows  <[email protected]>

	* doc/unset.n: [Bug 2988940]: Fix typo.

2010-04-15  Jan Nijtmans  <[email protected]>

	* win/tclWinPort.h:       Move inclusion of <tchar.h> from
	* generic/tcl.h:          tclPlatDecls.h to tclWinPort.h, where it
	* generic/tclPlatDecls.h: belongs. Add fallback in tcl.h, so TCHAR is
				  available in win32 always.

2010-04-15  Donal K. Fellows  <[email protected]>

	* doc/try.n: [Bug 2987551]: Fix typo.

2010-04-14  Andreas Kupries  <[email protected]>

	* library/platform/platform.tcl: Linux platform identification:
	* library/platform/pkgIndex.tcl: Check /lib64 for existence of files
	* unix/Makefile.in: matching libc* before accepting it as base
	* win/Makefile.in:  directory. This can happen on weirdly installed
	32bit systems which have an empty or partially filled /lib64 without
	an actual libc. Bumped to version 1.0.6.

2010-04-13  Jan Nijtmans  <[email protected]>

	* win/tclWinPort.h: Fix [Patch 2986105]: conditionally defining
	* win/tclWinFile.c: strcasecmp/strncasecmp
	* win/tclWinLoad.c: Fix gcc warning: comparison of unsigned expression
	>= 0 is always true

2010-04-08  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmdsSZ.c (TclSubstCompile): If the first token does
	not result in a *guaranteed* push of a Tcl_Obj on the stack, we must
	push an empty object. Otherwise it is possible to get to a 'concat1'
	or 'done' without enough values on the stack, resulting in a crash.
	Thanks to Joe Mistachkin for identifying a script that could trigger
	this case.

2010-04-07  Donal K. Fellows  <[email protected]>

	* doc/catch.n, doc/info.n, doc/return.n: Formatting.

2010-04-06  Donal K. Fellows  <[email protected]>

	* doc/Load.3: Minor corrections of formatting and cross links.

2010-04-06  Jan Nijtmans  <[email protected]>

	* win/configure:       (regenerate with autoconf-2.59)
	* unix/configure:
	* unix/installManPage: [Bug 2982540]: configure and install* script
	* unix/install-sh:     files should always have LF line ending.
	* doc/Load.3:          Fix signature of Tcl_LoadFile in documentation.

2010-04-05  Alexandre Ferrieux  <[email protected]>

	TIP #348 IMPLEMENTATION

	* generic/tclBasic.c: [Patch 2868499]: Substituted error stack
	* generic/tclCmdIL.c:
	* generic/tclInt.h:
	* generic/tclNamesp.c:
	* generic/tclResult.c:
	* doc/catch.n:
	* doc/info.n:
	* doc/return.n:
	* tests/cmdMZ.test:
	* tests/error.test:
	* tests/execute.test:
	* tests/info.test:
	* tests/init.test:
	* tests/result.test:

2010-04-05  Donal K. Fellows  <[email protected]>

	* unix/tcl.m4 (SC_ENABLE_THREADS): Flip the default for whether to
	* win/tcl.m4 (SC_ENABLE_THREADS):  build in threaded mode. Part of
	* win/rules.vc:			   TIP #364.

	* unix/tclLoadDyld.c (FindSymbol): Better human-readable error message
	generation to match code in tclLoadDl.c.

2010-04-04  Donal K. Fellows  <[email protected]>

	* generic/tclIOUtil.c, unix/tclLoadDl.c: Minor changes to enforce
	Engineering Manual style rules.

	* doc/FileSystem.3, doc/Load.3: Documentation for TIP#357.

	* macosx/tclMacOSXBundle.c (OpenResourceMap): [Bug 2981528]: Only
	define this function when HAVE_COREFOUNDATION is defined.

2010-04-02  Jan Nijtmans  <[email protected]>

	* generic/tcl.decls (Tcl_LoadFile): Add missing "const" in signature,
	* generic/tclIOUtil.c (Tcl_LoadFile): and some formatting fixes
	* generic/tclDecls.h:  (regenerated)

2010-04-02  Donal K. Fellows  <[email protected]>

	* generic/tclIOUtil.c (Tcl_LoadFile): Corrections to previous commit
	* unix/tclLoadDyld.c (TclpDlopen):    to make it build on OSX.

2010-04-02  Kevin B. Kenny  <[email protected]>

	TIP #357 IMPLEMENTATION
	TIP #362 IMPLEMENTATION

	* generic/tclStrToD.c: [Bug 2952904]: Defer creation of the smallest
	floating point number until it is actually used. (This change avoids a
	bogus syslog message regarding a 'floating point software assist
	fault' on SGI systems.)

	* library/reg/pkgIndex.tcl:	[TIP #362]: Fixed first round of bugs
	* tests/registry.test:		resulting from the recent commits of
	* win/tclWinReg.c:		changes in support of the referenced
					TIP.

	* generic/tcl.decls:		[TIP #357]: First round of changes
	* generic/tclDecls.h:		to export Tcl_LoadFile,
	* generic/tclIOUtil.c:		Tcl_FindSymbol, and Tcl_FSUnloadFile
	* generic/tclInt.h:		to the public API.
	* generic/tclLoad.c:
	* generic/tclLoadNone.c:
	* generic/tclStubInit.c:
	* tests/fileSystem.test:
	* tests/load.test:
	* tests/unload.test:
	* unix/tclLoadDl.c:
	* unix/tclLoadDyld.c:
	* unix/tclLoadNext.c:
	* unix/tclLoadOSF.c:
	* unix/tclLoadShl.c:
	* unix/tclUnixPipe.c:
	* win/Makefile.in:
	* win/tclWinLoad.c:

2010-03-31  Donal K. Fellows  <[email protected]>

	* doc/registry.n: Added missing documentation of TIP#362 flags.

	* doc/package.n: [Bug 2980210]: Document the arguments taken by
	the [package present] command correctly.

	* doc/Thread.3: Added some better documentation of how to create and
	use a thread using the C-level thread API, based on realization that
	no such tutorial appeared to exist.

2010-03-31  Jan Nijtmans  <[email protected]>

	* test/cmdMZ.test:    [FRQ 2974744]: share exception codes (ObjType?):
	* test/error.test:    Revised test cases, making sure that abbreviated
	* test/proc-old.test: codes are checked resulting in an error, and
	                      checking for the exact error message.

2010-03-30  Andreas Kupries  <[email protected]>

	* generic/tclIORChan.c (ReflectClose, ReflectInput, ReflectOutput,
	(ReflectSeekWide, ReflectWatch, ReflectBlock, ReflectSetOption,
	(ReflectGetOption, ForwardProc): [Bug 2978773]: Preserve
	ReflectedChannel* structures across handler invokations, to avoid
	crashes when the handler implementation induces nested callbacks and
	destruction of the channel deep inside such a nesting.

2010-03-30  Don Porter  <[email protected]>

	* generic/tclObj.c (Tcl_GetCommandFromObj):     [Bug 2979402]: Reorder
	the validity tests on internal rep of a "cmdName" value to avoid
	invalid reads reported by valgrind.

2010-03-30  Jan Nijtmans  <[email protected]>

	* generic/tclIndexObj:	[FRQ 2974744]: share exception codes
	* generic/tclResult.c:	further optimization, making use of indexType.
	* generic/tclZlib.c:    [Bug 2979399]: uninitialized value troubles

2010-03-30  Donal K. Fellows  <[email protected]>

	TIP #362 IMPLEMENTATION

	* win/tclWinReg.c: [Patch 2960976]: Apply patch from Damon Courtney to
	* tests/registry.test:	allow the registry command to be told to work
	* win/Makefile.in:	with both 32-bit and 64-bit registries. Bump
	* win/configure.in:	version of registry package to 1.3.
	* win/makefile.bc:
	* win/makefile.vc:
	* win/configure:	autoconf-2.59

2010-03-29  Jan Nijtmans  <[email protected]>

	* unix/tcl.m4:            Only test for -visibility=hidden with gcc
	                          (Second remark in [Bug 2976508])
	* unix/configure:         regen

2010-03-29  Don Porter  <[email protected]>

	* generic/tclStringObj.c:       Fix array overrun in test format-1.12
	caught by valgrind testing.

2010-03-27  Jan Nijtmans  <[email protected]>

	* generic/tclInt.h:	[FRQ 2974744]: share exception codes
	* generic/tclResult.c:	(ObjType?)
	* generic/tclCmdMZ.c:
	* generic/tclCompCmdsSZ.c:

2010-03-26  Jan Nijtmans  <[email protected]>

	* generic/tclExecute.c: [Bug 2976508]: Tcl HEAD fails on HP-UX

2010-03-25  Donal K. Fellows  <[email protected]>

	* unix/tclUnixFCmd.c (TclUnixCopyFile): [Bug 2976504]: Corrected
	number of arguments to fstatfs() call.

	* macosx/tclMacOSXBundle.c, macosx/tclMacOSXFCmd.c:
	* macosx/tclMacOSXNotify.c: Reduce the level of ifdeffery in the
	functions of these files to improve readability. They need to be
	audited for whether complexity can be removed based on the minimum
	supported version of OSX, but that requires a real expert.

2010-03-24  Don Porter  <[email protected]>

	* generic/tclResult.c:  [Bug 2383005]: Revise [return -errorcode] so
	* tests/result.test:    that it rejects illegal non-list values.

2010-03-24  Donal K. Fellows  <[email protected]>

	* generic/tclOOInfo.c (InfoObjectMethodTypeCmd)
	(InfoClassMethodTypeCmd): Added introspection of method types so that
	it is possible to find this info out without using errors.
	* generic/tclOOMethod.c (procMethodType): Now that introspection can
	reveal the name of method types, regularize the name of normal methods
	to be the name of the definition type used to create them.

	* tests/async.test (async-4.*): Reduce obscurity of these tests by
	putting the bulk of the code for them inside the test body with the
	help of [apply].

	* generic/tclCmdMZ.c (TryPostBody, TryPostHandler): Make sure that the
	[try] command does not trap unwinding due to limits.

2010-03-23  Don Porter  <[email protected]>

	* generic/tclCmdMZ.c:	[Bug 2973361]: Revised fix for computing
	indices of script arguments to [try].

2010-03-23  Jan Nijtmans  <[email protected]>

	* generic/tclCmdMZ.c:      Make error message in "try" implementation
	* generic/tclCompCmdsSZ.c: exactly the same as the one in "return"
	* tests/error.test:
	* libtommath/mtests/mpi.c: Single "const" addition

2010-03-22  Don Porter  <[email protected]>

	* generic/tclCmdMZ.c:	[Bug 2973361]: Compute the correct integer
	values to identify the argument indices of the various script
	arguments to [try]. Passing in -1 led to invalid memory reads.

2010-03-20  Donal K. Fellows  <[email protected]>

	* doc/exec.n: Make it a bit clearer that there is an option to run a
	pipeline in the background.

	* generic/tclIOCmd.c (Tcl_FcopyObjCmd):		Lift the restriction
	* generic/tclIO.c (TclCopyChannel, CopyData):	on the [fcopy] command
	* generic/tclIO.h (CopyState):			that forced it to only
	copy up to 2GB per script-level callback. Now it is anything that can
	fit in a (signed) 64-bit integer. Problem identified by Frederic
	Bonnet on comp.lang.tcl. Note that individual low-level reads and
	writes are still smaller as the optimal buffer size is smaller.

2010-03-20  Jan Nijtmans  <[email protected]>

	* win/stub16.c:         Don't hide that we use the ASCII API here.
	                        (does someone still use that?)
	* win/tclWinPipe.c:     2 unnecessary type casts.

2010-03-19  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmdsSZ.c (TclCompileThrowCmd): Added compilation for
	the [throw] command.

2010-03-18  Don Porter  <[email protected]>

	* generic/tclListObj.c:	[Bug 2971669]: Prevent in overflow trouble in
	* generic/tclTestObj.c:	ListObjReplace operations. Thanks to kbk for
	* tests/listObj.test:	fix and test.

2010-03-18  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmdsSZ.c (IssueTryFinallyInstructions):
	[Bug 2971921]: Corrected jump so that it doesn't skip into the middle
	of an instruction! Tightened the instruction issuing. Moved endCatch
	calls closer to their point that they guard, ensuring correct ordering
	of result values.

2010-03-17  Andreas Kupries  <[email protected]>

	* generic/tclIORTrans.c (ReflectInput, ReflectOutput)
	(ReflectSeekWide): [Bug 2921116]: Added missing TclEventuallyFree
	calls for preserved ReflectedTransform* structures. Reworked
	ReflectInput to preserve the structure for its whole life, not only in
	InvokeTclMethod.

	* generic/tclIO.c (Tcl_GetsObj): [Bug 2921116]: Regenerate topChan,
	may have been changed by a self-modifying transformation.

	* tests/ioTrans/test (iortrans-4.8, iortrans-4.9, iortrans-5.11)
	(iortrans-7.4, iortrans-8.3): New test cases.

2010-03-16  Jan Nijtmans  <[email protected]>

	* compat/zlib/*:	Upgrade zlib to version 1.2.4.
	* win/makefile.vc:
	* unix/Makefile.in:
	* win/tclWinChan.c:	Don't cast away "const" without reason.

2010-03-12  Jan Nijtmans  <[email protected]>

	* win/makefile.vc: [Bug 2967340]: Static build was failing.
	* win/.cvsignore:

2010-03-10  Jan Nijtmans  <[email protected]>

	* generic/tclTest.c:	Remove unnecessary '&' decoration for
	* generic/tclIOUtil.c:	function pointers
	* win/tclWin32Dll.c:	Double declaration of TclNativeDupInternalRep
	* unix/tclIOUtil.c:
	* unix/dltest/.cvsignore: Ignore *.so here

2010-03-09  Andreas Kupries  <[email protected]>

	* generic/tclIORChan.c: [Bug 2936225]: Thanks to Alexandre Ferrieux
	* doc/refchan.n:    <[email protected]> for debugging and
	* tests/ioCmd.test: fixing the problem. It is the write-side
	equivalent to the bug fixed 2009-08-06.

2010-03-09  Don Porter  <[email protected]>

	* library/tzdata/America/Matamoros: New locale
	* library/tzdata/America/Ojinaga: New locale
	* library/tzdata/America/Santa_Isabel: New locale
	* library/tzdata/America/Asuncion:
	* library/tzdata/America/Tijuana:
	* library/tzdata/Antarctica/Casey:
	* library/tzdata/Antarctica/Davis:
	* library/tzdata/Antarctica/Mawson:
	* library/tzdata/Asia/Dhaka:
	* library/tzdata/Pacific/Fiji:
	Olson tzdata2010c.

2010-03-07  Jan Nijtmans  <[email protected]>

	* generic/tclTest.c:	  Test that tclOO stubs are present in stub
				  library
	* generic/tclOOMethod.c:  Applied missing part of [Patch 2961556]
	* win/tclWinInt.h:	  Change all tclWinProcs signatures to use
	* win/tclWin32Dll.c:	  TCHAR* in stead of WCHAR*. This is meant
	* win/tclWinDde.c:	  as preparation to make [Enh 2965056]
	* win/tclWinFCmd.c:	  possible at all.
	* win/tclWinFile.c:
	* win/tclWinPipe.c:
	* win/tclWinSock.c:

2010-03-06  Jan Nijtmans  <[email protected]>

	* generic/tclStubLib.c:	Remove presence of tclTomMathStubsPtr here.
	* generic/tclTest.c:	Test that tommath stubs are present in stub
				library.

2010-03-05  Donal K. Fellows  <[email protected]>

	* generic/tclIORTrans.c (ForwardProc): [Bug 2964425]: When cleaning
	the stables, it is sometimes necessary to do more than the minimum. In
	this case, rationalizing the variables for a forwarded limit? method
	required removing an extra Tcl_DecrRefCount too.

	* generic/tclOO.h, generic/tclOOInt.h: [Patch 2961556]: Change TclOO
	to use the same style of function typedefs as Tcl, as this is about
	the last chance to get this right.

	***POTENTIAL INCOMPATIBILITY***
	Source code that uses function typedefs from TclOO will need to update
	variables and argument definitions so that pointers to the function
	values are used instead. Binary compatibility is not affected.

	* generic/*.c, generic/tclInt.h, unix/*.c, macosx/*.c: Applied results
	of doing a Code Audit. Principal changes:
	  * Use do { ... } while (0) in macros
	  * Avoid shadowing one local variable with another
	  * Use clearer 'foo.bar++;' instead of '++foo.bar;' where result not
	    required (i.e., semantically equivalent); clarity is increased
	    because it is bar that is incremented, not foo.
	  * Follow Engineering Manual rules on spacing and declarations

2010-03-04  Donal K. Fellows  <[email protected]>

	* generic/tclOO.c (ObjectRenamedTrace): [Bug 2962664]: Add special
	handling so that when the class of classes is deleted, so is the class
	of objects. Immediately.

	* generic/tclOOInt.h (ROOT_CLASS): Add new flag for specially marking
	the root class. Simpler and more robust than the previous technique.

2010-03-04  Jan Nijtmans  <[email protected]>

	* generic/tclGetDate.y:    3 unnecessary MODULE_SCOPE
	* generic/tclDate.c:       symbols
	* generic/tclStubLib.c:    Split tommath stub lib
	* generic/tclTomMathStubLib.c:  in separate file.
	* win/makefile.bc:
	* win/Makefile.in:
	* win/makefile.vc:
	* win/tcl.dsp:
	* unix/Makefile.in:
	* unix/tcl.m4:          Cygwin only gives warning
	* unix/configure:       using -fvisibility=hidden
	* compat/strncasecmp.c: A few more const's
	* compat/strtod.c:
	* compat/strtoul.c:

2010-03-03  Andreas Kupries <[email protected]>

	* doc/refchan.n: Followup to ChangeLog entry 2009-10-07
	(generic/tclIORChan.c). Fixed the documentation to explain that errno
	numbers are operating system dependent, and reworked the associated
	example.

2010-03-02  Jan Nijtmans  <[email protected]>

	* unix/tcl.m4:     [FRQ 2959069]: Support for -fvisibility=hidden
	* unix/configure   (regenerated with autoconf-2.59)

2010-03-01  Alexandre Ferrieux  <[email protected]>

	* unix/tclUnixSock.c: Refrain from a possibly lengthy reverse-DNS
	lookup on 0.0.0.0 when calling [fconfigure -sockname] on an
	universally-bound (default) server socket.

	* generic/tclIndexObj.c: fix [AT 86258]: special-casing of empty
	tables when generating error messages for [::tcl::prefix match].

2010-02-28  Donal K. Fellows  <[email protected]>

	* generic/tclCmdIL.c: More additions of {TCL LOOKUP} error-code
	generation to various subcommands of [info] as part of long-term
	project to classify all Tcl's generated errors.

2010-02-28  Jan Nijtmans  <[email protected]>

	* generic/tclStubInit.c: [Bug 2959713]: Link error with gcc 4.1

2010-02-27  Donal K. Fellows  <[email protected]>

	* generic/tclCmdMZ.c (StringFirstCmd, StringLastCmd): [Bug 2960021]:
	Only search for the needle in the haystack when the needle isn't
	larger than the haystack. Prevents an odd crash from sometimes
	happening when things get mixed up (a common programming error).

	* generic/tclMain.c (Tcl_Main): [Bug 801429]: Factor out the holding
	of the client-installed main loop function into thread-specific data.

	***POTENTIAL INCOMPATIBILITY***
	Code that previously tried to set the main loop from another thread
	will now fail. On the other hand, there is a fairly high probability
	that such programs would have been failing before due to the lack of
	any kind of inter-thread memory barriers guarding accesses to this
	part of Tcl's state.

2010-02-26  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmds.c:   Split this file into two pieces to make it
	* generic/tclCompCmdsSZ.c: easier to work with. It's still two very
				   long files even after the split.

2010-02-26  Reinhard Max  <[email protected]>

	* doc/safe.n: Name the installed file after the command it documents.
	Use "Safe Tcl" instead of the "Safe Base", "Safe Tcl" mixture.

2010-02-26  Donal K. Fellows  <[email protected]>

	* unix/Makefile.in (NATIVE_TCLSH): Added this variable to allow for
	better control of what tclsh to use for various scripts when doing
	cross compiling. An imperfect solution, but works.

	* unix/installManPage: Remap non-alphanumeric sequences in filenames
	to single underscores (especially colons).

2010-02-26  Pat Thoyts  <[email protected]>

	* tests/zlib.test: Add tests for [Bug 2818131] which was crashing with
	mismatched zlib algorithms used in combination with gets. This issue
	has been fixed by Andreas's last commit.

2010-02-25  Jan Nijtmans  <[email protected]>

	* generic/tclHash.c:	[FRQ 2958832]: Further speed-up of the
	* generic/tclLiteral.c:	ouster-hash function.
	* generic/tclObj.c:
	* generic/tclCkalloc.c:	Eliminate various unnecessary (ClientData)
	* generic/tclTest.c:	type casts.
	* generic/tclTestObj.c:
	* generic/tclTestProcBodyObj.c:
	* unix/tclUnixTest.c:
	* unix/tclUnixTime.c:
	* unix/tclXtTest.c:

2010-02-24  Donal K. Fellows  <[email protected]>

	* generic/tclDictObj.c (SetDictFromAny): Prevent the list<->dict
	* generic/tclListObj.c (SetListFromAny): conversion code from taking
	too many liberties. Stops loss of duplicate keys in some scenarios.
	Many thanks to Jean-Claude Wippler for finding this.

	* generic/tclExecute.c (TclExecuteByteCode): Reduce ifdef-fery and
	size of activation record. More variables shared across instructions
	than before.

	* doc/socket.n: [Bug 2957688]: Clarified that [socket -server] works
	with a command prefix. Extended example to show this in action.

2010-02-22  Andreas Kupries  <[email protected]>

	* generic/tclZlib.c (ZlibTransformInput): [Bug 2762041]: Added a hack
	to work around the general problem, early EOF recognition based on the
	base-channel, instead of the data we have ready for reading in the
	transform. Long-term we need a proper general fix (likely tracking EOF
	on each level of the channel stack), with attendant complexity.
	Furthermore, Z_BUF_ERROR can be ignored, and must be when feeding the
	zlib code with single characters.

2010-02-22  Jan Nijtmans  <[email protected]>

	* unix/tclUnixPort.h:   Remove unnecessary EXTERN's, which already are
	                        in the global stub table.
	* unix/configure.in:    Use @EXEEXT@ in stead of @EXT_SUFFIX@
	* unix/tcl.m4:
	* unix/Makefile.in:     Use -DBUILD_tcl for CYGWIN
	* unix/configure:       (regenerated)
	* unix/dltest/pkg*.c:   Use EXTERN to control CYGWIN exported symbols
	* generic/tclCmdMZ.c:   Remove some unnecessary type casts.
	* generic/tclCompCmds.c:
	* generic/tclTest.c:
	* generic/tclUtil.c:

2010-02-21  Mo DeJong  <[email protected]>

	* tests/regexp.test: Add test cases back ported from Jacl regexp work.

2010-02-21  Jan Nijtmans  <[email protected]>

	* generic/tclDate.c:    Some more const tables.
	* generic/tclGetDate.y:
	* generic/regc_lex.c:
	* generic/regerror.c:
	* generic/tclStubLib.c:
	* generic/tclBasic.c:   Fix [Bug 2954959] expr abs(0.0) is -0.0
	* tests/expr.test:

2010-02-20  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmds.c (TclCompileStringLenCmd): Make [string length]
	of a constant string be handled better (i.e., handle backslashes too).

2010-02-19  Stuart Cassoff  <[email protected]>

	* tcl.m4: Correct compiler/linker flags for threaded builds on
	OpenBSD.
	* configure: (regenerated).

2010-02-19  Donal K. Fellows  <[email protected]>

	* unix/installManPage: [Bug 2954638]: Correct behaviour of manual page
	installer. Also added armouring to check that assumptions about the
	initial state are actually valid (e.g., look for existing input file).

2010-02-17  Donal K. Fellows  <[email protected]>

	* generic/tclHash.c (HashStringKey):	Restore these hash functions
	* generic/tclLiteral.c (HashString):	to use the classic algorithm.
	* generic/tclObj.c (TclHashObjKey):	Community felt normal case
	speed to be more important than resistance to malicious cases. For
	now, hashes that need to deal with the malicious case can use a custom
	hash table and install their own hash function, though that is not
	functionality exposed to the script level.

	* generic/tclCompCmds.c (TclCompileDictUpdateCmd): Stack depth must be
	correctly described when compiling a body to prevent crashes in some
	debugging modes.

2010-02-16  Jan Nijtmans  <[email protected]>

	* generic/tclInt.h: Change order of various struct members,
	fixing potential binary incompatibility with Tcl 8.5

2010-02-16  Donal K. Fellows  <[email protected]>

	* unix/configure.in, generic/tclIOUtil.c (Tcl_Stat): Updated so that
	we do not assume that all unix systems have the POSIX blkcnt_t type,
	since OpenBSD apparently does not.

	* generic/tclLiteral.c (HashString): Missed updating to FNV in one
	place; the literal table (a copy of the hash table code...)

2010-02-15  Jan Nijtmans  <[email protected]>

	* tools/genStubs.tcl:   Reverted earlier rename from tcl*Stubs to
	* generic/tclBasic.c:   tcl*ConstStubs, it's not necessary at all.
	* generic/tclOO.c:
	* generic/tclTomMathInterface.c:
	* generic/tclStubInit.c: (regenerated)
	* generic/tclOOStubInit.c: (regenerated)
	* generic/tclEnsemble.c:Fix signed-unsigned mismatch
	* win/tclWinInt.h:      make tclWinProcs "const"
	* win/tclWin32Dll.c:
	* win/tclWinFCmd.c:     Eliminate all internal Tcl_WinUtfToTChar
	* win/tclWinFile.c:     and Tcl_WinTCharToUtf calls, needed
	* win/tclWinInit.c:     for mslu support.
	* win/tclWinLoad.c:
	* win/tclWinPipe.c:
	* win/tclWinSerial.c:
	* win/.cvsignore:
	* compat/unicows/readme.txt:  [FRQ 2819611]: Add first part of MSLU
	* compat/unicows/license.txt: support.
	* compat/unicows/unicows.lib:

2010-02-15  Donal K. Fellows  <[email protected]>

	* generic/tclOO.c (AllocObject, SquelchedNsFirst, ObjectRenamedTrace):
	* generic/tclNamesp.c (Tcl_DeleteNamespace): [Bug 2950259]: Revised
	the namespace deletion code to provide an additional internal callback
	that gets triggered early enough in namespace deletion to allow TclOO
	destructors to run sanely. Adjusted TclOO to take advantage of this,
	so making tearing down an object by killing its namespace appear to
	work seamlessly, which is needed for Itcl. (Note that this is not a
	feature that will ever be backported to 8.5, and it remains not a
	recommended way of deleting an object.)

2010-02-13  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmds.c (TclCompileSwitchCmd): Divided the [switch]
	compiler into three pieces (after the model of [try]): a parser, an
	instruction-issuer for chained tests, and an instruction-issuer for
	jump tables.

	* generic/tclEnsemble.c: Split the ensemble engine out into its own
	file rather than keeping it mashed together with the namespace code.

2010-02-12  Jan Nijtmans  <[email protected]>

	* win/tcl.m4:		Use -pipe for gcc on win32
	* win/configure:	(mingw/cygwin) (regenerated)
	* win/.cvsignore:	Add .lib, .exp and .res here

2010-02-11  Mo DeJong  <[email protected]>

	* tests/list.test: Add tests for explicit \0 in a string argument to
	the list command.

2010-02-11  Donal K. Fellows  <[email protected]>

	* generic/tclIOCmd.c (Tcl_OpenObjCmd): [Bug 2949740]: Make sure that
	we do not try to put a NULL pipeline channel into binary mode.

2010-02-11  Mo DeJong  <[email protected]>

	[Bug 2826551, Patch 2948425]: Assorted regexp bugs related to -all,
	-line and -start options and newlines.
	* generic/tclCmdMZ.c (Tcl_RegexpObjCmd): If -offset is given, treat it
	as the start of the line if the previous character was a newline. Fix
	nasty edge case where a zero length match would not advance the index.
	* tests/regexp.test: Add regression tests back ported from Jacl.
	Checks for a number of issues related to -line and newline handling. A
	few of tests were broken before the patch and continue to be broken,
	marked as knownBug.

2010-02-11  Donal K. Fellows  <[email protected]>

	* generic/tclOO.c (ObjectRenamedTrace): [Bug 2949397]: Prevent
	destructors from running on the two core class objects when the whole
	interpreter is being destroyed.

2010-02-09  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmds.c (TclCompileTryCmd, IssueTryInstructions)
	(IssueTryFinallyInstructions): Added compiler for the [try] command.
	It is split into three pieces that handle the parsing of the tokens,
	the issuing of instructions for finally-free [try], and the issuing of
	instructions for [try] with finally; there are enough differences
	between the all cases that it was easier to split the code rather than
	have a single function do the whole thing.

2010-02-09  Alexandre Ferrieux  <[email protected]>

	* tools/genStubs.tcl: Remove dependency on 8.5+ idiom "in" in
	expressions.

2010-02-08  Donal K. Fellows  <[email protected]>

	* generic/tclZlib.c (Tcl_ZlibDeflate, Tcl_ZlibInflate): [Bug 2947783]:
	Make sure that the result is an unshared object before appending to it
	so that nothing crashes if it is shared (use in Tcl code was not
	affected by this, but use from C was an issue).

2010-02-06  Donal K. Fellows  <[email protected]>

	* generic/tclHash.c (HashStringKey):	Replace Tcl's crusty old hash
	* generic/tclObj.c (TclHashObjKey):	function with the algorithm
	due to Fowler, Noll and Vo. This is slightly faster (assuming the
	presence of hardware multiply) and has somewhat better distribution
	properties of the resulting hash values. Note that we only ever used
	the 32-bit version of the FNV algorithm; Tcl's core hash engine
	assumes that hash values are simple unsigned ints.

	***POTENTIAL INCOMPATIBILITY***
	Code that depends on hash iteration order (especially tests) may well
	be disrupted by this. Where a definite order is required, the fix is
	usually to just sort the results after extracting them from the hash.
	Where this is insufficient, the code that has ceased working was
	always wrong and was only working by chance.

2010-02-05  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmds.c (TclCompileErrorCmd): Added compilation of the
	[error] command. No new bytecodes.

2010-02-05  Jan Nijtmans  <[email protected]>

	* tools/genStubs.tcl:	Follow-up to earlier commit today:
	          Eliminate the need for an extra Stubs Pointer for adressing
	          a static stub table: Just change the exported table from
	          static to MODULE_SCOPE.
	* generic/tclBasic.c
	* generic/tclOO.c
	* generic/tclTomMathInterface.c
	* generic/tcl*Decls.h (regenerated)
	* generic/tclStubInit.c (regenerated)
	* generic/tclOOStubInit.c (regenerated)
	* generic/tclTest.c (minor formatting)

2010-02-05  Donal K. Fellows  <[email protected]>

	* generic/tclVar.c: More consistency in errorcode generation.

	* generic/tclOOBasic.c (TclOO_Object_Destroy): Rewrote to be NRE-aware
	when calling destructors. Note that there is no guarantee that
	destructors will always be called in an NRE context; that's a feature
	of the 'destroy' method only.

	* generic/tclEncoding.c: Add 'const' to many function-internal vars
	that are never pointing to things that are written to.

2010-02-05  Jan Nijtmans  <[email protected]>

	* tools/genStubs.tcl:	Follow-up to [2010-01-29] commit:
		prevent space within stub table function parameters if the
		parameter type is a pointer.
	* win/tclWinInt.h:	Minor Formatting
	* generic/tcl.h:	VOID -> void and other formatting
	* generic/tclInt.h:	Minor formatting
	* generic/tclInt.decls: Change signature of TclNRInterpProcCore,
	* generic/tclOO.decls:	and TclOONewProc(Instance|)MethodEx,
	* generic/tclProc.c:	indicating that errorProc is a function,
	* generic/tclOOMethod.c:pointer, and other formatting
	* generic/tcl*Decls.h:	(regenerated)
	* generic/tclVar.c:	gcc warning(line 3703): 'pattern' may be used
				uninitialized in this function
				gcc warning(line 3788): 'matched' may be used
				uninitialized in this function

2010-02-04  Donal K. Fellows  <[email protected]>

	* generic/tclVar.c: Added more use of error-codes and reduced the
	stack overhead of older interfaces.
	(ArrayGetCmd): Stop silly crash when using a trivial pattern due to
	error in conversion to ensemble.
	(ArrayNamesCmd): Use the object RE interface for faster matching.

2010-02-03  Donal K. Fellows  <[email protected]>

	* generic/tclVar.c (ArrayUnsetCmd): More corrections.

2010-02-02  Donal K. Fellows  <[email protected]>

	* generic/tclVar.c: Turned the [array] command into a true ensemble.

	* generic/tclOO.c (AllocObject, MyDeleted): A slightly faster way to
	handle the deletion of [my] is with a standard delete callback. This
	is because it doesn't require an additional memory allocation during
	object creation. Also reduced the amount of string manipulation
	performed during object creation to further streamline memory
	handling; this is not backported to the 8.5 package as it breaks a
	number of abstractions.

	* generic/tclOOBasic.c (TclOO_Object_Destroy): [Bug 2944404]: Do not
	crash when a destructor deletes the object that is executing that
	destructor.

2010-02-01  Donal K. Fellows  <[email protected]>

	* generic/tclVar.c (Tcl_ArrayObjCmd): [Bug 2939073]: Stop the [array
	unset] command from having dangling pointer problems when an unset
	trace deletes the element that is going to be processed next. Many
	thanks to Alexandre Ferrieux for the bulk of this fix.

	* generic/regexec.c (ccondissect, crevdissect): [Bug 2942697]: Rework
	these functions so that certain pathological patterns are matched much
	more rapidly. Many thanks to Tom Lane for dianosing this issue and
	providing an initial patch.

2010-01-30  Donal K. Fellows  <[email protected]>

	* generic/tclCompile.c (tclInstructionTable):	Bytecode instructions
	* generic/tclCompCmds.c (TclCompileUnsetCmd):	to allow the [unset]
	* generic/tclExecute.c (TclExecuteByteCode):	command to be compiled
	with the compiler being a complete compilation for all compile-time
	decidable uses.

	* generic/tclVar.c (TclPtrUnsetVar): Var reference version of the code
	to unset a variable. Required for INST_UNSET bytecodes.

2010-01-29  Jan Nijtmans  <[email protected]>

	* generic/tcl.h: [Bug 2942081]: Reverted Tcl_ThreadDataKey type change
				Changed some Tcl_CallFrame fields from "char *"
				to "void *". This saves unnecessary space on
				Cray's (and it's simply more correct).

	* tools/genStubs.tcl:	No longer generate a space after "*" and
				immediately after a function name, so the
				format of function definitions in tcl*Decls.h
				match all other tcl*.h header files.
	* doc/ParseArgs.3:	Change Tcl_ArgvFuncProc, Tcl_ArgvGenFuncProc
	* generic/tcl.h:	and GetFrameInfoValueProc to be function
	* generic/tclInt.h:	definitions, not pointers, for consistency
	* generic/tclOOInt.h:	with all other Tcl function definitions.
	* generic/tclIndexObj.c:
	* generic/regguts.h:	CONST -> const
	* generic/tcl.decls:	Formatting
	* generic/tclTomMath.decls: Formatting
	* generic/tclDecls.h:	(regenerated)
	* generic/tclIntDecls.h:
	* generic/tclIntPlatDecls.h:
	* generic/tclOODecls.h:
	* generic/tclOOIntDecls.h:
	* generic/tclPlatDecls.h:
	* generic/tclTomMathDecls.h:

2010-01-28  Donal K. Fellows  <[email protected]>

	* generic/tclOOBasic.c (TclOO_Object_Destroy): Move the execution of
	destructors to a point where they can produce an error. This will not
	work for all destructors, but it does mean that more failing calls of
	them will be caught.
	* generic/tclOO.c (AllocObject, MyDeletedTrace, ObjectRenamedTrace):
	(ObjectNamespaceDeleted): Stop various ways of getting at commands
	with dangling pointers to the object. Also increases the reliability
	of calling of destructors (though most destructors won't benefit; when
	an object is deleted namespace-first, its destructors are not run in a
	nice state as the namespace is partially gone).

2010-01-25  Jan Nijtmans  <[email protected]>

	* generic/tclOOStubInit.c:   Remove double includes (which causes a
	* generic/tclOOStubLib.c:    warning in CYGWIN compiles)
	* unix/.cvsignore:	     add confdefs.h

2010-01-22  Donal K. Fellows  <[email protected]>

	* doc/proc.n: [Bug 1970629]: Define a bit better what the current
	namespace of a procedure is.

2010-01-22  Jan Nijtmans  <[email protected]>

	* generic/tclInt.decls:	     Don't use DWORD and HANDLE here.
	* generic/tclIntPlatDecls.h:
	* generic/tcl.h:	     Revert [2009-12-21] change, instead
	* generic/tclPort.h:	     resolve the CYGWIN inclusion problems by
	* win/tclWinPort.h:	     re-arranging the inclusions at other
				     places.
	* win/tclWinError.c
	* win/tclWinPipe.c
	* win/tcl.m4:		     Make cygwin configuration error into
	* win/configure.in:	     a warning: CYGWIN compilation works
	* win/configure:	     although there still are test failures.

2010-01-22  Donal K. Fellows  <[email protected]>

	* generic/tclExecute.c (TclExecuteByteCode): Improve error code
	generation from some of the tailcall-related bits of TEBC.

2010-01-21  Miguel Sofer  <[email protected]>

	* generic/tclCompile.h: [Bug 2910748]: NRE-enable direct eval on BC
	* generic/tclExecute.c: spoilage.
	* tests/nre.test:

2010-01-19  Donal K. Fellows  <[email protected]>

	* doc/dict.n: [Bug 2929546]: Clarify just what [dict with] and [dict
	update] are doing with variables.

2010-01-18  Andreas Kupries  <[email protected]>

	* generic/tclIO.c (CreateScriptRecord): [Bug 2918110]: Initialize
	the EventScriptRecord (esPtr) fully before handing it to
	Tcl_CreateChannelHandler for registration. Otherwise a reflected
	channel calling 'chan postevent' (== Tcl_NotifyChannel) in its
	'watchProc' will cause the function 'TclChannelEventScriptInvoker'
	to be run on an uninitialized structure.

2010-01-18  Donal K. Fellows  <[email protected]>

	* generic/tclStringObj.c (Tcl_AppendFormatToObj): [Bug 2932421]: Stop
	the [format] command from causing argument objects to change their
	internal representation when not needed. Thanks to Alexandre Ferrieux
	for this fix.

2010-01-13  Donal K. Fellows  <[email protected]>

	* tools/tcltk-man2html.tcl:	  More factoring out of special cases
	* tools/tcltk-man2html-utils.tcl: so that they are described outside
	the engine file. Now there is only one real set of special cases in
	there, to handle the .SO/.OP/.SE directives.

2010-01-13  Jan Nijtmans  <[email protected]>

	* generic/tcl.h:      Fix TCL_LL_MODIFIER for Cygwin
	* generic/tclEnv.c:   Fix CYGWIN compilation problems,
	* generic/tclInt.h:   and remove some unnecessary
	* generic/tclPort.h:  double includes.
	* generic/tclPlatDecls.h:
	* win/cat.c:
	* win/tclWinConsole.c:
	* win/tclWinFCmd.c:
	* win/tclWinFile.c:
	* win/tclWinPipe.c:
	* win/tclWinSerial.c:
	* win/tclWinThrd.c:
	* win/tclWinPort.h:   Put win32 includes first
	* unix/tclUnixChan.c: Forgot one CONST change

2010-01-12  Donal K. Fellows  <[email protected]>

	* tools/tcltk-man2html.tcl: Make the generation of the list of things
	to process the docs from simpler and more flexible. Also factored out
	the lists of special cases.

2010-01-10  Jan Nijtmans  <[email protected]>

	* win/tclWinDde.c:      VC++ 6.0 doesn't have
	* win/tclWinReg.c:      PDWORD_PTR
	* win/tclWinThrd.c:     Fix various minor gcc warnings.
	* win/tclWinTime.c:
	* win/tclWinConsole.c:  Put channel type definitions
	* win/tclWinChan.c:     in static const memory
	* win/tclWinPipe.c:
	* win/tclWinSerial.c:
	* win/tclWinSock.c:
	* generic/tclIOGT.c:
	* generic/tclIORChan.c:
	* generic/tclIORTrans.c:
	* unix/tclUnixChan.c:
	* unix/tclUnixPipe.c:
	* unix/tclUnixSock.c:
	* unix/configure:       (regenerated with autoconf 2.59)
	* tests/info.test:      Make test independant from
	                        tcltest implementation.

2010-01-10  Donal K. Fellows  <[email protected]>

	* tests/namespace.test (namespace-51.17): [Bug 2898722]: Demonstrate
	that there are still bugs in the handling of resolution epochs. This
	bug is not yet fixed.

	* tools/tcltk-man2html.tcl:	  Split the man->html converter into
	* tools/tcltk-man2html-utils.tcl: two pieces for easier maintenance.
	Also made it much less verbose in its printed messages by default.

2010-01-09  Donal K. Fellows  <[email protected]>

	* tools/tcltk-man2html.tcl: Added basic support for building the docs
	for contributed packages into the HTML versions. Prompted by question
	on Tcler's Chat by Tom Krehbiel. Note that there remain problems in
	the documentation generated due to errors in the contributed docs.

2010-01-05  Don Porter  <[email protected]>

	* generic/tclPathObj.c (TclPathPart):   [Bug 2918610]: Correct
	* tests/fileName.test (filename-14.31): inconsistency between the
	string rep and the intrep of a path value created by [file rootname].
	Thanks to Vitaly Magerya for reporting.

2010-01-03  Donal K. Fellows  <[email protected]>

	* unix/tcl.m4 (SC_CONFIG_CFLAGS): [Bug 1636685]: Use the configuration
	for modern FreeBSD suggested by the FreeBSD porter.

2010-01-03  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c:	[Bug 2724403]: Fix leak of coroutines on
	* generic/tclCompile.h: namespace deletion. Added a test for this
	* generic/tclNamesp.c:	leak, and also a test for leaks on namespace
	* tests/coroutine.test: deletion.
	* tests/namespace.test:

2009-12-30  Donal K. Fellows  <[email protected]>

	* library/safe.tcl (AliasSource): [Bug 2923613]: Make the safer
	* tests/safe.test (safe-8.9):	  [source] handle a [return] at the
					  end of the file correctly.

2009-12-30  Miguel Sofer  <[email protected]>

	* library/init.tcl (unknown): [Bug 2824981]: Fix infinite recursion of
	::unknown when [set] is undefined.

2009-12-29  Donal K. Fellows  <[email protected]>

	* generic/tclHistory.c (Tcl_RecordAndEvalObj): Reduce the amount of
	allocation and deallocation of memory by caching objects in the
	interpreter assocData table.

	* generic/tclObj.c (Tcl_GetCommandFromObj): Rewrite the logic so that
	it does not require making assignments part way through an 'if'
	condition, which was deeply unclear.

	* generic/tclInterp.c (Tcl_MakeSafe): [Bug 2895741]: Make sure that
	the min() and max() functions are supported in safe interpreters.

2009-12-29  Pat Thoyts  <[email protected]>

	* generic/tclBinary.c:	[Bug 2922555]: Handle completely invalid input
	* tests/binary.test:	to the decode methods.

2009-12-28  Donal K. Fellows  <[email protected]>

	* unix/Makefile.in (trace-shell, trace-test): [FRQ 1083288]: Added
	targets to allow easier tracing of shell and test invokations.

	* unix/configure.in: [Bug 942170]:	Detect the st_blocks field of
	* generic/tclCmdAH.c (StoreStatData):	'struct stat' correctly.
	* generic/tclFileName.c (Tcl_GetBlocksFromStat):
	* generic/tclIOUtil.c (Tcl_Stat):

	* generic/tclInterp.c (TimeLimitCallback): [Bug 2891362]: Ensure that
	* tests/interp.test (interp-34.13):	   the granularity ticker is
	reset when we check limits because of the time limit event firing.

2009-12-27  Donal K. Fellows  <[email protected]>

	* doc/namespace.n (SCOPED SCRIPTS): [Bug 2921538]: Updated example to
	not be quite so ancient.

2009-12-25  Jan Nijtmans  <[email protected]>

	* generic/tclCmdMZ.c:      CONST -> const
	* generic/tclParse.c

2009-12-23  Donal K. Fellows  <[email protected]>

	* library/safe.tcl (AliasSource, AliasExeName): [Bug 2913625]: Stop
	information about paths from leaking through [info script] and [info
	nameofexecutable].

2009-12-23  Jan Nijtmans  <[email protected]>

	* unix/tcl.m4:		Install libtcl8.6.dll in bin directory
	* unix/Makefile.in:
	* unix/configure:	(regenerated)

2009-12-22  Donal K. Fellows  <[email protected]>

	* generic/tclCmdIL.c (Tcl_LsortObjCmd): [Bug 2918962]: Stop crash when
	-index and -stride are used together.

2009-12-21  Jan Nijtmans  <[email protected]>

	* generic/tclThreadStorage.c: Fix gcc warning, using gcc-4.3.4 on
				      cygwin: missing initializer
	* generic/tclOOInt.h:	      Prevent conflict with DUPLICATE
				      definition in WINAPI's nb30.h
	* generic/rege_dfa.c:	      Fix macro conflict on CYGWIN: don't use
				      "small".
	* generic/tcl.h:	      Include <winsock2.h> before <stdio.h> on
				      CYGWIN
	* generic/tclPathObj.c
	* generic/tclPort.h
	* tests/env.test:	      Don't unset WINDIR and TERM, it has a
				      special meaning on CYGWIN (both in UNIX
				      and WIN32 mode!)
	* generic/tclPlatDecls.h:     Include <tchar.h> through tclPlatDecls.h
	* win/tclWinPort.h:	      stricmp -> strcasecmp
	* win/tclWinDde.c:	      _wcsicmp -> wcscasecmp
	* win/tclWinFile.c
	* win/tclWinPipe.c
	* win/tclWinSock.c
	* unix/tcl.m4:		      Add dynamic loading support to CYGWIN
	* unix/configure (regenerated)
	* unix/Makefile.in

2009-12-19  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c:	[Bug 2917627]: Fix for bad cmd resolution by
	* tests/coroutine.test:	coroutines. Thanks to schelte for finding it.

2009-12-16  Donal K. Fellows  <[email protected]>

	* library/safe.tcl (::safe::AliasGlob): Upgrade to correctly support a
	larger fraction of [glob] functionality, while being stricter about
	directory management.

2009-12-11  Jan Nijtmans  <[email protected]>

	* generic/tclTest.c:	Fix gcc warning: ignoring return value of
	* unix/tclUnixNotify.c:	"write", declared with attribute
	* unix/tclUnixPipe.c:	warn_unused_result.
	* generic/tclInt.decls:	CONSTify functions TclpGetUserHome and
	* generic/tclIntDecls.h:TclSetPreInitScript (TIP #27)
	* generic/tclInterp.c:
	* win/tclWinFile.c:
	* unix/tclUnixFile.c:

2009-12-16  Donal K. Fellows  <[email protected]>

	* doc/tm.n: [Bug 1911342]: Formatting rewrite to avoid bogus crosslink
	to the list manpage when generating HTML.

	* library/msgcat/msgcat.tcl (Init): [Bug 2913616]: Do not use platform
	tests that are not needed and which don't work in safe interpreters.

2009-12-14  Donal K. Fellows  <[email protected]>

	* doc/file.n (file tempfile): [Bug 2388866]: Note that this only ever
	creates files on the native filesystem. This is a design feature.

2009-12-13  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c:	Release TclPopCallFrame() from its
	* generic/tclExecute.c:	tailcall-management duties
	* generic/tclNamesp.c:

	* generic/tclBasic.c:	Moving TclBCArgumentRelease call from
	* generic/tclExecute.c:	TclNRTailcallObjCmd to TEBC, so that the
	pairing of the Enter and Release calls is clearer.

2009-12-12  Donal K. Fellows  <[email protected]>

	* generic/tclTest.c (TestconcatobjCmd): [Bug 2895367]: Stop memory
	leak when testing. We don't need extra noise of this sort when
	tracking down real problems!

2009-12-11  Jan Nijtmans  <[email protected]>

	* generic/tclBinary.c:	Fix gcc warning, using gcc-4.3.4 on cygwin
	* generic/tclCompExpr.c:warning: array subscript has type 'char'
	* generic/tclPkg.c:
	* libtommath/bn_mp_read_radix.c:
	* win/makefile.vc:	[Bug 2912773]: Revert to version 1.203
	* unix/tclUnixCompat.c:	Fix gcc warning: signed and unsigned type
				in conditional expression.

2009-12-11  Donal K. Fellows  <[email protected]>

	* tools/tcltk-man2html.tcl (long-toc, cross-reference): [FRQ 2897296]:
	Added cross links to sections within manual pages.

2009-12-11  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c:   [Bug 2806407]: Full nre-enabling of coroutines
	* generic/tclExecute.c:

	* generic/tclBasic.c: Small cleanup

	* generic/tclExecute.c: Fix panic in http11.test caused by buggy
	earlier commits in coroutine management.

2009-12-10  Andreas Kupries  <[email protected]>

	* generic/tclObj.c (TclContinuationsEnter): [Bug 2895323]: Updated
	comments to describe when the function can be entered for the same
	Tcl_Obj* multiple times. This is a continuation of the 2009-11-10
	entry where a memory leak was plugged, but where not sure if that was
	just a band-aid to paper over some other error. It isn't, this is a
	legal situation.

2009-12-10  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c:   Reducing the # of moving parts for coroutines
	* generic/tclExecute.c: by delegating more to tebc; eliminate the
	special coroutine CallFrame.

2009-12-09  Andreas Kupries  <[email protected]>

	* generic/tclIO.c: [Bug 2901998]: Applied Alexandre Ferrieux's patch
	fixing the inconsistent buffered I/O. Tcl's I/O now flushes buffered
	output before reading, discards buffered input before writing, etc.

2009-12-09  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c: Ensure right lifetime of varFrame's (objc,objv)
	for coroutines.

	* generic/tclExecute.c: Code regrouping

2009-12-09  Donal K. Fellows  <[email protected]>

	* generic/tclBasic.c: Added some of the missing setting of errorcode
	values.

2009-12-08  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c (TclStackFree): Improved panic msg.

2009-12-08  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c:   Partial nre-enabling of coroutines. The
	* generic/tclExecute.c: initial call still requires its own
	* generic/tclInt.h:     instance of tebc, but on resume coros can
	execute in the caller's tebc.

	* generic/tclExecute.c (TEBC): Silence warning about pcAdjustment.

2009-12-08  Donal K. Fellows  <[email protected]>

	* generic/tclExecute.c (TclExecuteByteCode): Make the dict opcodes
	more sparing in their use of C variables, to reduce size of TEBC
	activiation record a little bit.

2009-12-07  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c (TEBC): Grouping "slow" variables into structs,
	to reduce register pressure and help the compiler with variable
	allocation.

2009-12-07  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c: Start cleaning the TEBC stables
	* generic/tclInt.h:

	* generic/tclCmdIL.c:   [Bug 2910094]: Fix by aku
	* tests/coroutine.test:

	* generic/tclBasic.c: Arrange for [tailcall] to be created with the
	other builtins: was being created in a separate call, leftover from
	pre-tip days.

2009-12-07  Don Porter  <[email protected]>

	* generic/tclStrToD.c: [Bug 2902010]: Correct conditional compile
	directives to better detect the toolchain that needs extra work for
	proper underflow treatment instead of merely detecting the MIPS
	platform.

2009-12-07  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c: [Patch 2910056]: Add ::tcl::unsupported::yieldTo
	* generic/tclInt.h:

2009-12-07  Donal K. Fellows  <[email protected]>

	* generic/tclCmdMZ.c (TryPostBody): [Bug 2910044]: Close off memory
	leak in [try] when a variable-free handler clause is present.

2009-12-05  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c:   Small changes for clarity in tailcall
	* generic/tclExecute.c: and coroutine code.
	* tests/coroutine.test:

	* tests/tailcall.test: Remove some old unused crud; improved the
	stack depth tests.

	* generic/tclBasic.c:  Fixed things so that you can tailcall
	* generic/tclNamesp.c: properly out of a coroutine.
	* tests/tailcall.test:

	* generic/tclInterp.c: Fixed tailcalls for same-interp aliases (no
	test)

2009-12-03  Donal K. Fellows  <[email protected]>

	* library/safe.tcl (::safe::AliasEncoding): Make the safe encoding
	command behave more closely like the unsafe one (for safe ops).
	(::safe::AliasGlob): [Bug 2906841]: Clamp down on evil use of [glob]
	in safe interpreters.
	* tests/safe.test: Rewrite to use tcltest2 better.

2009-12-02  Jan Nijtmans  <[email protected]>

	* tools/genStubs.tcl:	Add support for win32 CALLBACK functions and
	remove obsolete "emitStubs" and "genStubs" functions.
	* win/Makefile.in:	Use tcltest86.dll for all tests, and add
	.PHONY rules to preemptively stop trouble that plagued Tk from hitting
	Tcl too.

2009-11-30  Jan Nijtmans  <[email protected]>

	* generic/tcl.h:	Don't use EXPORT for Tcl_InitStubs
	* win/Makefile.in:	Better dependancies in case of static build.

2009-11-30  Donal K. Fellows  <[email protected]>

	* doc/Tcl.n: [Bug 2901433]: Improved description of expansion to
	mention that it is using list syntax.

2009-11-27  Kevin B. Kenny  <[email protected]>

	* win/tclAppInit.c (Tcl_AppInit): [Bug 2902965]: Reverted Jan's change
	that added a call to Tcl_InitStubs. The 'tclsh' and 'tcltest' programs
	are providers, not consumers of the Stubs table, and should not link
	with the Stubs library, but only with the main Tcl library. (In any
	case, the presence of Tcl_InitStubs broke the build.)

2009-11-27  Donal K. Fellows  <[email protected]>

	* doc/BoolObj.3, doc/Class.3, doc/CrtChannel.3, doc/DictObj.3:
	* doc/DoubleObj.3, doc/Ensemble.3, doc/Environment.3:
	* doc/FileSystem.3, doc/Hash.3, doc/IntObj.3, doc/Limit.3:
	* doc/Method.3, doc/NRE.3, doc/ObjectType.3, doc/PkgRequire.3:
	* doc/SetChanErr.3, doc/SetResult.3: [Patch 2903921]: Many small
	spelling fixes from Larry Virden.

	BUMP VERSION OF TCLOO TO 0.6.2. Too many people need accumulated small
	versions and bugfixes, so the version-bump removes confusion.

	* generic/tclOOBasic.c (TclOO_Object_LinkVar): [Bug 2903811]: Remove
	unneeded restrictions on who can usefully call this method.

2009-11-26  Donal K. Fellows  <[email protected]>

	* unix/Makefile.in: Add .PHONY rules and documentation to preemptively
	stop trouble that plagued Tk from hitting Tcl too, and to make the
	overall makefile easier to understand. Some reorganization too to move
	related rules closer together.

2009-11-26  Jan Nijtmans  <[email protected]>

	* win/Makefile.in:	[Bug 2902965]: Fix stub related changes that
	* win/makefile.vc:	caused tclkit build to break.
	* win/tclAppInit.c
	* unix/tcl.m4
	* unix/Makefile.in
	* unix/tclAppInit.c
	* unix/configure:	(regenerated)

2009-11-25  Kevin B. Kenny  <[email protected]>

	* win/Makefile.in:	Added a 'test-tcl' rule that is identical to
	'test' except that it does not go spelunking in 'pkgs/'. (This rule
	has existed in unix/Makefile.in for some time.)

2009-11-25  Stuart Cassoff  <[email protected]>

	* unix/configure.in:	[Patch 2892871]: Remove unneeded
	* unix/tcl.m4:		AC_STRUCT_TIMEZONE and use
	* unix/tclConfig.h.in:	AC_CHECK_MEMBERS([struct stat.st_blksize])
	* unix/tclUnixFCmd.c:	instead of AC_STRUCT_ST_BLKSIZE.
	* unix/configure:	Regenerated with autoconf-2.59.

2009-11-24  Andreas Kupries  <[email protected]>

	* library/tclIndex: Manually redone the part of tclIndex dealing with
	safe.tcl and tm.tcl. This part passes the testsuite. Note that
	automatic regeneration of this part is not possible because it wrongly
	puts 'safe::Setup' on the list, and wrongly leaves out 'safe::Log'
	which is more dynamically created than the generator expects.

	Further note that the file "clock.tcl" is explicitly loaded by
	"init.tcl", the first time the clock command is invoked. The relevant
	code can be found at line 172ff, roughly, the definition of the
	procedure 'clock'. This means none of the procedures of this file
	belong in the tclIndex. Another indicator that automatic regeneration
	of tclIndex is ill-advised.

2009-11-24  Donal K. Fellows  <[email protected]>

	* generic/tclOO.c (FinalizeAlloc, Tcl_NewObjectInstance):
	[Bug 2903011]: Make it an error to destroy an object in a constructor,
	and also make sure that an object is not deleted twice in the error
	case.

2009-11-24  Pat Thoyts  <[email protected]>

	* tests/fCmd.test: [Bug 2893771]: Teach [file stat] to handle locked
	* win/tclWinFile.c: files so that [file exists] no longer lies.

2009-11-23  Kevin Kenny  <[email protected]>

	* tests/fCmd.test (fCmd-30.1): Changed registry location of the 'My
	Documents' folder to the one that's correct for Windows 2000, XP,
	Server 2003, Vista, Server 2008, and Windows 7. (See
	http://support.microsoft.com/kb/310746)

2009-11-23  Jan Nijtmans  <[email protected]>

	* win/tclWinDde.c:	#undef STATIC_BUILD, in order to make sure
	* win/tclWinReg.c:	that Xxxxx_Init is always exported even when
	* generic/tclTest.c:	Tcl is built static (otherwise we cannot
				create a DLL).
	* generic/tclThreadTest.c: Make all functions static, except
				TclThread_Init.
	* tests/fCmd.test:	Enable fCmd-30.1 when registry is available.
	* win/tcl.m4:		Fix ${SHLIB_LD_LIBS} definition, fix conflicts
	* win/Makefile.in:	Simplifications related to tcl.m4 changes.
	* win/configure.in:	Between static libraries and import library on
				windows.
	* win/configure:	(regenerated)
	* win/makefile.vc:	Add stub library to necessary link lines.

2009-11-23  Kevin B. Kenny  <[email protected]>

	* generic/tclThreadTest.c (NewTestThread): [Bug 2901803]: Further
	machinations to get NewTestThread actually to launch the thread, not
	just compile.

2009-11-22  Donal K. Fellows  <[email protected]>

	* generic/tclThreadTest.c (NewTestThread): [Bug 2901803]: Fix small
	error in function naming which blocked a threaded test build.

2009-11-19  Jan Nijtmans  <[email protected]>

	* win/Makefile.in:	Create tcltest86.dll as dynamic Tcltest
				package.
	* generic/tclTest.c:	Remove extraneous prototypes, follow-up to
	* generic/tclTestObj.c:	[Bug 2883850]
	* tests/chanio.test:	Test-cases for fixed [Bug 2849797]
	* tests/io.test:
	* tests/safe.test:	Fix safe-10.1 and safe-10.4 test cases, making
				the wrong assumption that Tcltest is a static
				package.
	* generic/tclEncoding.c:[Bug 2857044]: Updated freeIntRepProc routines
	* generic/tclVar.c:	so that they set the typePtr field to NULL so
				that the Tcl_Obj is not left in an
				inconsistent state.
	* unix/tcl.m4:		[Patch 2883533]: tcl.m4 support for Haiku OS
	* unix/configure:	autoconf-2.59

2009-11-19  Don Porter  <[email protected]>

	* unix/tclAppInit.c:	[Bug 2883850, 2900542]: Repair broken build of
	* win/tclAppInit.c:	the tcltest executable.

2009-11-19  Donal K. Fellows  <[email protected]>

	* library/auto.tcl (tcl_findLibrary):
	* library/clock.tcl (MakeUniquePrefixRegexp, MakeParseCodeFromFields)
	(SetupTimeZone, ProcessPosixTimeZone):	Restored the use of a literal
	* library/history.tcl (HistAdd):	'then' when following a multi-
	* library/safe.tcl (interpConfigure):	line test expresssion. It's an
	* library/tm.tcl (UnknownHandler):	aid to readability then.

2009-11-19  Jan Nijtmans  <[email protected]>

	* generic/tclInt.h:      Make all internal initialization
	* generic/tclTest.c:     routines MODULE_SCOPE
	* generic/tclTestObj.c:
	* generic/tclTestProcBodyObj.c:
	* generic/tclThreadTest.c:
	* unix/Makefile.in:      Fix [Bug 2883850]: pkgIndex.tcl doesn't
	* unix/tclAppInit.c:     get created with static Tcl build
	* unix/tclXtTest.c:
	* unix/tclXtNotify.c:
	* unix/tclUnixTest.c:
	* win/Makefile.in:
	* win/tcl.m4:
	* win/configure:         (regenerated)
	* win/tclAppInit.c:
	* win/tclWinDde.c:       Always compile with Stubs.
	* win/tclWinReg.c:
	* win/tclWinTest.c:

2009-11-18  Jan Nijtmans  <[email protected]>

	* doc/CrtChannel.3:	[Bug 2849797]: Fix channel name inconsistences
	* generic/tclIORChan.c:	as suggested by DKF.
	* generic/tclIO.c:	Minor *** POTENTIAL INCOMPATIBILITY ***
				because Tcl_CreateChannel() and derivatives
				now sometimes ignore their "chanName"
				argument.

	* generic/tclAsync.c:	Eliminate various gcc warnings (with -Wextra)
	* generic/tclBasic.c
	* generic/tclBinary.c
	* generic/tclCmdAH.c
	* generic/tclCmdIL.c
	* generic/tclCmdMZ.c
	* generic/tclCompile.c
	* generic/tclDate.c
	* generic/tclExecute.c
	* generic/tclDictObj.c
	* generic/tclIndexObj.c
	* generic/tclIOCmd.c
	* generic/tclIOUtil.c
	* generic/tclIORTrans.c
	* generic/tclOO.c
	* generic/tclZlib.c
	* generic/tclGetDate.y
	* win/tclWinInit.c
	* win/tclWinChan.c
	* win/tclWinConsole.c
	* win/tclWinNotify.c
	* win/tclWinReg.c
	* library/auto.tcl:		Eliminate "then" keyword
	* library/clock.tcl
	* library/history.tcl
	* library/safe.tcl
	* library/tm.tcl
	* library/http/http.tcl:	Eliminate unnecessary spaces
	* library/http1.0/http.tcl
	* library/msgcat/msgcat.tcl
	* library/opt/optparse.tcl
	* library/platform/platform.tcl
	* tools/tcltk-man2html.tcl
	* tools/tclZIC.tcl
	* tools/tsdPerf.c

2009-11-17  Andreas Kupries  <[email protected]>

	* unix/tclUnixChan.c (TtyParseMode): Partial undo of Donal's tidy-up
	from a few days ago (2009-11-9, not in ChangeLog). It seems that
	strchr is apparently a macro on AIX and reacts badly to pre-processor
	directives in its arguments.

2009-11-16  Alexandre Ferrieux  <[email protected]>

	* generic/tclEncoding.c:  [Bug 2891556]: Fix and improve test to
	* generic/tclTest.c:	  detect similar manifestations in the future.
	* tests/encoding.test:    Add tcltest support for finalization.

2009-11-15  Mo DeJong  <[email protected]>

	* win/tclWinDde.c: Avoid gcc compiler warning by explicitly casting
	DdeCreateStringHandle argument.

2009-11-12  Andreas Kupries  <[email protected]>

	* generic/tclIO.c (CopyData): [Bug 2895565]: Dropped bogosity which
	* tests/io.test: used the number of _written_ bytes or character to
	update the counters for the read bytes/characters. New test io-53.11.
	This is a forward port from the 8.5 branch.

2009-11-11  Don Porter  <[email protected]>

	* generic/tclClock.c (TclClockInit):    Do not create [clock] support
	commands in safe interps.

2009-11-11  Jan Nijtmans  <[email protected]>

	* library/http/http.tcl (http::geturl): [Bug 2891171]: URL checking
	too strict when using multiple question marks.
	* tests/http.test
	* library/http/pkgIndex.tcl:  Bump to http 2.8.2
	* unix/Makefile.in:
	* win/Makefile.in:

2009-11-11  Alexandre Ferrieux  <[email protected]>

	* generic/tclIO.c: Fix [Bug 2888099] (close discards ENOSPC error) by
	saving the errno from the first of two FlushChannel()s. Uneasy to
	test; might need specific channel drivers. Four-hands with aku.

2009-11-10  Pat Thoyts  <[email protected]>

	* tests/winFCmd.test: Cleanup directories that have been set chmod
	000. On Windows7 and Vista we really have no access and these were
	getting left behind.
	A few tests were changed to reflect the intent of the test where
	setting a directory chmod 000 should prevent any modification. This
	restriction was ignored on XP but is honoured on Vista

2009-11-10  Andreas Kupries  <[email protected]>

	* generic/tclBasic.c: Plug another leak in TCL_EVAL_DIRECT evaluation.
	Forward port from Tcl 8.5 branch, change by Don Porter.

	* generic/tclObj.c: [Bug 2895323]: Plug memory leak in
	TclContinuationsEnter(). Forward port from Tcl 8.5 branch, change by
	Don Porter.

2009-11-09  Stuart Cassoff  <[email protected]>

	* win/README: [bug 2459744]: Removed outdated Msys + Mingw info.

2009-11-09  Andreas Kupries  <[email protected]>

	* generic/tclBasic.c (TclEvalObjEx): Moved the #280 decrement of
	refCount for the file path out of the branch after the whole
	conditional, closing a memory leak. Added clause on structure type to
	prevent seg.faulting. Forward port from valgrinding the Tcl 8.5
	branch.

	* tests/info.test: Resolve ambiguous resolution of variable "res".
	Forward port from 8.5

2009-11-08  Donal K. Fellows  <[email protected]>

	* doc/string.n (bytelength): Noted that this command is not a good
	thing to use, and suggested a better alternatve. Also factored out the
	description of the indices into its own section.

2009-11-07  Pat Thoyts  <[email protected]>

	* tests/fCmd.test: [Bug 2891026]: Exclude tests using chmod 555
	directories on vista and win7. The current user has access denied and
	so cannot rename the directory without admin privileges.

2009-11-06  Andreas Kupries  <[email protected]>

	* library/safe.tcl (::safe::Setup): Added documentation of the
	contents of the state array. Also killed the 'InterpState' procedure
	with its upleveled variable/upvar combination, and replaced all uses
	with 'namespace upvar'.

2009-11-05  Andreas Kupries  <[email protected]>

	* library/safe.tcl: A series of patches which bring the SafeBase up to
	date with code guidelines, Tcl's features, also eliminating a number
	of inefficiencies along the way.
	(1) Changed all procedure names to be fully qualified.
	(2) Moved the procedures out of the namespace eval. Kept their
	locations. IOW, broke the namespace eval apart into small sections not
	covering the procedure definitions.
	(3) Reindented the code. Just lots of whitespace changes.
	Functionality unchanged.
	(4) Moved the multiple namespace eval's around. Command export at the
	top, everything else (var decls, argument parsing setup) at the
	bottom.
	(5) Moved the argument parsing setup into a procedure called when the
	code is loaded. Easier management of temporary data.
	(6) Replaced several uses of 'Set' with calls to the new procedure
	'InterpState' and direct access to the per-slave state array.
	(7) Replaced the remaining uses of 'Set' and others outside of the
	path/token handling, and deleted a number of procedures related to
	state array access which are not used any longer.
	(8) Converted the path token system to cache normalized paths and path
	<-> token conversions. Removed more procedures not used any longer.
	Removed the test cases 4.3 and 4.4 from safe.test. They were testing
	the now deleted command "InterpStateName".
	(9) Changed the log command setup so that logging is compiled out
	completely when disabled (default).
	(10) Misc. cleanup. Inlined IsInterp into CheckInterp, its only user.
	Consistent 'return -code error' for error reporting. Updated to use
	modern features (lassign, in/ni, dicts). The latter are used to keep a
	reverse path -> token map and quicker check of existence.
	(11) Fixed [Bug 2854929]: Recurse into all subdirs under all TM root
	dirs and put them on the access path.

2009-11-02  Kevin B. Kenny  <[email protected]>

	* library/tzdata/Asia/Novokuznetsk: New tzdata locale for Kemerovo
	oblast', which now keeps Novosibirsk time and not Kranoyarsk time.
	* library/tzdata/Asia/Damascus: Syrian DST changes.
	* library/tzdata/Asia/Hong_Kong: Hong Kong historic DST corrections.
	Olson tzdata2009q.

2009-11-02  Donal K. Fellows  <[email protected]>

	* doc/object.n (DESCRIPTION): Substantive revision to make it clearer
	what the fundamental semantics of an object actually are.

2009-11-01  Joe Mistachkin  <[email protected]>

	* doc/Cancel.3: Minor cosmetic fixes.
	* win/makefile.vc: Make htmlhelp target work again.  An extra set of
	double quotes around the definition of the HTML help compiler tool
	appears to be required.  Previously, there was one set of double
	quotes around the definition of the tool and one around the actual
	invocation.  This led to confusion because it was the only such tool
	path to include double quotes around its invocation.  Also, it was
	somewhat inflexible in the event that somebody needed to override the
	tool command to include arguments.  Therefore, even though it may look
	"wrong", there are now two double quotes on either side of the tool
	path definition.  This fixes the problem that currently prevents the
	htmlhelp target from building and maintains flexibility in case
	somebody needs to override it via the command line or an environment
	variable.

2009-11-01  Joe English  <[email protected]>

	* doc/Eval.3, doc/Cancel.3: Move TIP#285 routines out of Eval.3 into
	their own manpage.

2009-10-31  Donal K. Fellows  <[email protected]>

	* generic/tclBasic.c (ExprRoundFunc): [Bug 2889593]: Correctly report
	the expected number of arguments when generating an error for round().

2009-10-30  Pat Thoyts  <[email protected]>

	* tests/tcltest.test: When creating the notwritabledir we deny the
	current user access to delete the file. We must grant this right when
	we cleanup. Required on Windows 7 when the user does not automatically
	have administrator rights.

2009-10-29  Don Porter  <[email protected]>

	* generic/tcl.h:        Changed the typedef for the mp_digit type
	from:
		typedef unsigned long mp_digit;
	to:
		typedef unsigned int mp_digit;
	For 32-bit builds where "long" and "int" are two names for the same
	thing, this is no change at all.  For 64-bit builds, though, this
	causes the dp[] array of an mp_int to be made up of 32-bit elements
	instead of 64-bit elements.  This is a huge improvement because
	details elsewhere in the mp_int implementation cause only 28 bits of
	each element to be actually used storing number data.  Without this
	change bignums are over 50% wasted space on 64-bit systems.  [Bug
	2800740].

	***POTENTIAL INCOMPATIBILITY***
	For 64-bit builds, callers of routines with (mp_digit) or (mp_digit *)
	arguments *will*, and callers of routines with (mp_int *) arguments
	*may* suffer both binary and stubs incompatibilities with Tcl releases
	8.5.0 - 8.5.7.  Such possibilities should be checked, and if such
	incompatibilities are present, suitable [package require] requirements
	on the Tcl release should be put in place to keep such built code
	[load]-ing only in Tcl interps that are compatible.

2009-10-29  Donal K. Fellows  <[email protected]>

	* tests/dict.test: Make variable-clean and simplify tests by utilizing
	the fact that dictionaries have defined orders.

	* generic/tclZlib.c (TclZlibCmd): Remove accidental C99-ism which
	reportedly makes the AIX native compiler choke.

2009-10-29  Kevin B. Kenny  <[email protected]>

	* library/clock.tcl (LocalizeFormat):
	* tests/clock.test (clock-67.1):
	[Bug 2819334]: Corrected a problem where '%%' followed by a letter in
	a format group could expand recursively: %%R would turn into %%H:%M:%S

2009-10-28  Don Porter  <[email protected]>

	* generic/tclLiteral.c:	[Bug 2888044]: Fixed 2 bugs.
	* tests/info.test:	First, as noted in the comments of the
	TclCleanupLiteralTable routine, since the teardown of the intrep of
	one Tcl_Obj can cause the teardown of others in the same table, the
	full table cleanup must be done with care, but the code did not
	contain the same care demanded in the comment.  Second, recent
	additions to the info.test file had poor hygiene, leaving an array
	variable ::a lying around, which breaks later interp.test tests during
	a -singleproc 1 run of the test suite.

2009-10-28  Kevin B. Kenny  <[email protected]>

	* tests/fileName.test (fileName-20.[78]): Corrected poor test
	hygiene (failure to save and restore the working directory) that
	caused these two tests to fail on Windows (and [Bug 2806250] to be
	reopened).

2009-10-27  Don Porter  <[email protected]>

	* generic/tclPathObj.c: [Bug 2884203]: Missing refcount on cached
	normalized path caused crashes.

2009-10-27  Kevin B. Kenny  <[email protected]>

	* library/clock.tcl (ParseClockScanFormat): [Bug 2886852]: Corrected a
	problem where [clock scan] didn't load the timezone soon enough when
	processing a time format that lacked a complete date.
	* tests/clock.test (clock-66.1):
	Added a test case for the above bug.
	* library/tzdata/America/Argentina/Buenos_Aires:
	* library/tzdata/America/Argentina/Cordoba:
	* library/tzdata/America/Argentina/San_Luis:
	* library/tzdata/America/Argentina/Tucuman:
	New DST rules for Argentina. (Olson's tzdata2009p.)

2009-10-26  Don Porter  <[email protected]>

	* unix/Makefile.in:	Remove $(PACKAGE).* and prototype from the
	`make distclean` target.  Completes 2009-10-20 commit.

2009-10-24  Kevin B. Kenny  <[email protected]>

	* library/clock.tcl (ProcessPosixTimeZone):
	Corrected a regression in the fix to [Bug 2207436] that caused
	[clock] to apply EU daylight saving time rules in the US.
	Thanks to Karl Lehenbauer for reporting this regression.
	* tests/clock.test (clock-52.4):
	Added a regression test for the above bug.
	* library/tzdata/Asia/Dhaka:
	* library/tzdata/Asia/Karachi:
	New DST rules for Bangladesh and Pakistan. (Olson's tzdata2009o.)

2009-10-23  Andreas Kupries  <[email protected]>

	* generic/tclIO.c (FlushChannel): Skip OutputProc for low-level
	0-length writes. When closing pipes which have already been closed
	not skipping leads to spurious SIG_PIPE signals. Reported by
	Mikhail Teterin <[email protected]>.

2009-10-22  Donal K. Fellows  <[email protected]>

	* generic/tclOOBasic.c (TclOO_Object_VarName): [Bug 2883857]: Allow
	the passing of array element names through this method.

2009-10-21  Donal K. Fellows  <[email protected]>

	* generic/tclPosixStr.c: [Bug 2882561]: Work around oddity on Haiku OS
	where SIGSEGV and SIGBUS are the same value.

	* generic/tclTrace.c (StringTraceProc): [Bug 2881259]: Added back cast
	to work around silly bug in MSVC's handling of auto-casting.

2009-10-20  Don Porter  <[email protected]>

	* unix/Makefile.in:	Removed the long outdated and broken targets
	package-* that were for building Solaris packages.  Appears that the
	pieces needed for these targets to function have never been present in
	the current era of Tcl development and belong completely to Tcl
	pre-history.

2009-10-19  Don Porter  <[email protected]>

	* generic/tclIO.c:      [Patch 2107634]: Revised ReadChars and
	FilterInputBytes routines to permit reads to continue up to the string
	limits of Tcl values.  Before revisions, large read attempts could
	panic when as little as half the limiting value length was reached.
	Thanks to Sean Morrison and Bob Parker for their roles in the fix.

2009-10-18  Joe Mistachkin  <[email protected]>

	* generic/tclObj.c (TclDbDumpActiveObjects, TclDbInitNewObj)
	(Tcl_DbIncrRefCount, Tcl_DbDecrRefCount, Tcl_DbIsShared):
	[Bug 2871908]: Enforce separation of concerns between the lineCLPtr
	and objThreadMap thread specific data members.

2009-10-18  Joe Mistachkin  <[email protected]>

	* tests/thread.test (thread-4.[345]): [Bug 1565466]: Correct tests to
	save their error state before the final call to threadReap just in
	case it triggers an "invalid thread id" error.  This error can occur
	if one or more of the target threads has exited prior to the attempt
	to send it an asynchronous exit command.

2009-10-17  Donal K. Fellows  <[email protected]>

	* generic/tclVar.c (UnsetVarStruct, TclDeleteNamespaceVars)
	(TclDeleteCompiledLocalVars, DeleteArray):
	* generic/tclTrace.c (Tcl_UntraceVar2): [Bug 2629338]: Stop traces
	that are deleted part way through (a feature used by tdom) from
	causing freed memory to be accessed.

2009-10-08  Donal K. Fellows  <[email protected]>

	* generic/tclDictObj.c (DictIncrCmd): [Bug 2874678]: Don't leak any
	bignums when doing [dict incr] with a value.
	* tests/dict.test (dict-19.3): Memory leak detection code.

2009-10-07  Andreas Kupries  <[email protected]>

	* generic/tclObj.c: [Bug 2871908]: Plug memory leaks of objThreadMap
	and lineCLPtr hashtables.  Also make the names of the continuation
	line information initialization and finalization functions more
	consistent. Patch supplied by Joe Mistachkin <[email protected]>.

	* generic/tclIORChan.c (ErrnoReturn): Replace hardwired constant 11
	with proper errno #define, EAGAIN. What was I thinking? The BSD's have
	a different errno assignment and break with the hardwired number.
	Reported by emiliano on the chat.

2009-10-06  Don Porter  <[email protected]>

	* generic/tclInterp.c (SlaveEval): Agressive stomping of internal reps
	was added as part of the NRE patch of 2008-07-13.  This doesn't appear
	to actually be needed, and it hurts quite a bit when large lists lose
	their intreps and require reparsing.  Thanks to Ashok Nadkarni for
	reporting the problem.

	* generic/tclTomMathInt.h (new): Public header tclTomMath.h had
	* generic/tclTomMath.h:	dependence on private headers, breaking use
	* generic/tommath.h:	by extensions [Bug 1941434].

2009-10-05  Andreas Kupries  <[email protected]>

	* library/safe.tcl (AliasGlob): Fixed conversion of catch to
	try/finally, it had an 'on ok msg' branch missing, causing a silent
	error immediately, and bogus glob results, breaking search for Tcl
	modules.

2009-10-04  Daniel Steffen  <[email protected]>

	* macosx/tclMacOSXBundle.c:	[Bug 2569449]: Workaround CF memory
	* unix/tclUnixInit.c:		managment bug in Mac OS X 10.4 &
					earlier.

2009-10-02  Kevin B. Kenny  <[email protected]>

	* library/tzdata/Africa/Cairo:
	* library/tzdata/Asia/Gaza:
	* library/tzdata/Asia/Karachi:
	* library/tzdata/Pacific/Apia:	Olson's tzdata2009n.

2009-09-29  Don Porter  <[email protected]>

	* generic/tclDictObj.c:		[Bug 2857044]: Updated freeIntRepProc
	* generic/tclExecute.c:		routines so that they set the typePtr
	* generic/tclIO.c:		field to NULL so that the Tcl_Obj is
	* generic/tclIndexObj.c:	not left in an inconsistent state.
	* generic/tclInt.h:
	* generic/tclListObj.c:
	* generic/tclNamesp.c:
	* generic/tclOOCall.c:
	* generic/tclObj.c:
	* generic/tclPathObj.c:
	* generic/tclProc.c:
	* generic/tclRegexp.c:
	* generic/tclStringObj.c:

	* generic/tclAlloc.c:           Cleaned up various routines in the
	* generic/tclCkalloc.c:         call stacks for memory allocation to
	* generic/tclInt.h:             guarantee that any size values computed
	* generic/tclThreadAlloc.c:     are within the domains of the routines
	they get passed to.  [Bugs 2557696 and 2557796].

2009-09-28  Don Porter  <[email protected]>

	* generic/tclCmdMZ.c:	Replaced TclProcessReturn() calls with
	* tests/error.test:	Tcl_SetReturnOptions() calls as a simple fix
	for [Bug 2855247].  Thanks to Anton Kovalenko for the report and fix.
	Additional fixes for other failures demonstrated by new tests.

2009-09-27  Don Porter  <[email protected]>

	* tests/error.test (error-15.8.*):	Coverage tests illustrating
	flaws in the propagation of return options by [try].

2009-09-26  Donal K. Fellows  <[email protected]>

	* unix/tclooConfig.sh, win/tclooConfig.sh: [Bug 2026844]: Added dummy
	versions of tclooConfig.sh that make it easier to build extensions
	against both Tcl8.5+TclOO-standalone and Tcl8.6.

2009-09-24  Don Porter  <[email protected]>

	TIP #356 IMPLEMENTATION

	* generic/tcl.decls:	Promote internal routine TclNRSubstObj()
	* generic/tclCmdMZ.c:	to public Tcl_NRSubstObj().  Still needs docs.
	* generic/tclCompile.c:
	* generic/tclInt.h:

	* generic/tclDecls.h:	make genstubs
	* generic/tclStubInit.c:

2009-09-23  Miguel Sofer  <[email protected]>

	* doc/namespace.n: the description of [namespace unknown] failed
	to mention [namespace path]: fixed. Thx emiliano.

2009-09-21  Mo DeJong  <[email protected]>

	* tests/regexp.test: Added check for error message from
	unbalanced [] in regexp. Added additional simple test cases
	of basic regsub command.

2009-09-21  Don Porter  <[email protected]>

	* generic/tclCompile.c:	Correct botch in the conversion of
	Tcl_SubstObj().  Thanks to Kevin Kenny for detection and report.

2009-09-17  Don Porter  <[email protected]>

	* generic/tclCompile.c:	Re-implement Tcl_SubstObj() as a simple
	* generic/tclParse.c:	wrapper around TclNRSubstObj().  This has
	* tests/basic.test:	the effect of caching compiled bytecode in
	* tests/parse.test:	the value to be substituted.  Note that
	Tcl_SubstObj() now exists only for extensions.  Tcl itself no longer
	makes any use of it.  Note also that TclSubstTokens() is now reachable
	only by Tcl_EvalEx() and Tcl_ParseVar() so tests aiming to test its
	functioning needed adjustment to still have the intended effect.

2009-09-16  Alexandre Ferrieux  <[email protected]>

	* generic/tclObj.c:   Extended ::tcl::unsupported::representation.

2009-09-11  Don Porter  <[email protected]>

	* generic/tclBasic.c:	Completed the NR-enabling of [subst].
	* generic/tclCmdMZ.c:	[Bug 2314561].
	* generic/tclCompCmds.c:
	* generic/tclCompile.c:
	* generic/tclInt.h:
	* tests/coroutine.test:
	* tests/parse.test:

2009-09-11  Donal K. Fellows  <[email protected]>

	* tests/http.test: Added in cleaning up of http tokens for each test
	to reduce amount of global-variable pollution.

2009-09-10  Donal K. Fellows  <[email protected]>

	* library/http/http.tcl (http::Event): [Bug 2849860]: Handle charset
	names in double quotes; some servers like generating them like that.

2009-09-07  Don Porter  <[email protected]>

	* generic/tclParse.c:	[Bug 2850901]: Corrected line counting error
	* tests/into.test:	in multi-command script substitutions.

2009-09-07  Daniel Steffen  <[email protected]>

	* generic/tclExecute.c:	Fix potential uninitialized variable use and
	* generic/tclFCmd.c:	null dereference flagged by clang static
	* generic/tclProc.c:	analyzer.
	* generic/tclTimer.c:
	* generic/tclUtf.c:

	* generic/tclExecute.c:	Silence false positives from clang static
	* generic/tclIO.c:	analyzer about potential null dereference.
	* generic/tclScan.c:
	* generic/tclCompExpr.c:

2009-09-04  Don Porter  <[email protected]>

	* generic/tclCompCmds.c (TclCompileSubstCmd): [Bug 2314561]:
	* generic/tclBasic.c:	Added a bytecode compiler routine for the
	* generic/tclCmdMZ.c:	[subst] command. This is a partial solution to
	* generic/tclCompile.c:	the need to NR-enable [subst] since bytecode
	* generic/tclCompile.h:	execution is already NR-enabled. Two new
	* generic/tclExecute.c:	bytecode instructions, INST_NOP and
	* generic/tclInt.h:	INST_RETURN_CODE_BRANCH were added to support
	* generic/tclParse.c:	the new routine.  INST_RETURN_CODE_BRANCH is
	* tests/basic.test:	likely to be useful in any future effort to
	* tests/info.test:	add a bytecode compiler routine for [try].
	* tests/parse.test:

2009-09-03  Donal K. Fellows  <[email protected]>

	* doc/LinkVar.3: [Bug 2844962]: Added documentation of issues relating
	to use of this API in a multi-threaded environment.

2009-09-01  Andreas Kupries  <[email protected]>

	* generic/tclIORTrans.c (ReflectInput): Remove error response to
	0-result from method 'limit?' of transformations. Return the number of
	copied bytes instead, which is possibly nothing. The latter then
	triggers EOF handling in the higher layers, making the 0-result of
	limit? the way to inject artificial EOF's into the data stream.

2009-09-01  Don Porter  <[email protected]>

	* library/tcltest/tcltest.tcl:  Bump to tcltest 2.3.2 after revision
	* library/tcltest/pkgIndex.tcl: to verbose error message.
	* unix/Makefile.in:
	* win/Makefile.in:

2009-08-27  Don Porter  <[email protected]>

	* generic/tclStringObj.c:       [Bug 2845535]: A few more string
	overflow cases in [format].

2009-08-25  Andreas Kupries  <[email protected]>

	* generic/tclBasic.c (Tcl_CreateInterp, Tcl_EvalTokensStandard)
	(Tcl_EvalEx, TclEvalEx, TclAdvanceContinuations, TclNREvalObjEx):
	* generic/tclCmdMZ.c (Tcl_SwitchObjCmd, TclListLines):
	* generic/tclCompCmds.c (*):
	* generic/tclCompile.c (TclSetByteCodeFromAny, TclInitCompileEnv)
	(TclFreeCompileEnv, TclCompileScript, TclCompileTokens):
	* generic/tclCompile.h (CompileEnv):
	* generic/tclInt.h (ContLineLoc, Interp):
	* generic/tclObj.c (ThreadSpecificData, ContLineLocFree)
	(TclThreadFinalizeObjects, TclInitObjSubsystem, TclContinuationsEnter,
	(TclContinuationsEnterDerived, TclContinuationsCopy, TclFreeObj)
	(TclContinuationsGet):
	* generic/tclParse.c (TclSubstTokens, Tcl_SubstObj):
	* generic/tclProc.c (TclCreateProc):
	* generic/tclVar.c (TclPtrSetVar):
	* tests/info.test (info-30.0-24):

	Extended the parser, compiler, and execution engine with code and
	attendant data structures tracking the position of continuation lines
	which are not visible in the resulting script Tcl_Obj*'s, to properly
	account for them while counting lines for #280.

2009-08-24  Daniel Steffen  <[email protected]>

	* generic/tclInt.h: Annotate Tcl_Panic as noreturn for clang static
	analyzer in PURIFY builds, replacing preprocessor/assert technique.

	* macosx/tclMacOSXNotify.c: Fix multiple issues with nested event loops
	when CoreFoundation notifier is running in embedded mode. (Fixes
	problems in TkAqua Cocoa reported by Youness Alaoui on tcl-mac)

2009-08-21  Don Porter  <[email protected]>

	* generic/tclFileName.c: Correct regression in [Bug 2837800] fix.
	* tests/fileName.test:

2009-08-20  Don Porter  <[email protected]>

	* generic/tclFileName.c: [Bug 2837800]: Correct the result produced by
	[glob */test] when * matches something like ~foo.

	* generic/tclPathObj.c: [Bug 2806250]: Prevent the storage of strings
	starting with ~ in the "tail" part (normPathPtr field) of the path
	intrep when PATHFLAGS != 0.  This establishes the assumptions relied
	on elsewhere that the name stored there is a relative path.  Also
	refactored to make an AppendPath() routine instead of the cut/paste
	stanzas that were littered throughout.

2009-08-20  Donal K. Fellows  <[email protected]>

	* generic/tclCmdIL.c (TclNRIfObjCmd): [Bug 2823276]: Make [if]
	NRE-safe on all arguments when interpreted.
	(Tcl_LsortObjCmd): Close off memory leak.

2009-08-19  Donal K. Fellows  <[email protected]>

	* generic/tclCmdAH.c (TclNRForObjCmd, etc.): [Bug 2823276]: Make [for]
	and [while] into NRE-safe commands, even when interpreted.

2009-08-18  Don Porter  <[email protected]>

	* generic/tclPathObj.c: [Bug 2837800]: Added NULL check to prevent
	* tests/fileName.test:  crashes during [glob].

2009-08-16  Jan Nijtmans  <[email protected]>

	* unix/dltest/pkge.c:  const addition
	* unix/tclUnixThrd.c:  Use <pthread.h> in stead of "pthread.h"
	* win/tclWinDde.c:     Eliminate some more gcc warnings
	* win/tclWinReg.c:
	* generic/tclInt.h:    Change ForIterData, make it const-safe.
	* generic/tclCmdAH.c:

2009-08-12  Don Porter  <[email protected]>

	TIP #353 IMPLEMENTATION

	* doc/NRE.3:		New public routine Tcl_NRExprObj() permits
	* generic/tcl.decls:	extension commands to evaluate Tcl expressions
	* generic/tclBasic.c:	in NR-enabled command procedures.
	* generic/tclCmdAH.c:
	* generic/tclExecute.c:
	* generic/tclInt.h:
	* generic/tclObj.c:
	* tests/expr.test:

	* generic/tclDecls.h:		make genstubs
	* generic/tclStubInit.c:

2009-08-06  Andreas Kupries  <[email protected]>

	* doc/refchan.n [Bug 2827000]: Extended the implementation of
	* generic/tclIORChan.c: reflective channels (TIP 219, method
	* tests/ioCmd.test: 'read'), enabling handlers to signal EAGAIN to
	indicate 'no data, but not at EOF either', and other system
	errors. Updated documentation, extended testsuite (New test cases
	iocmd*-23.{9,10}).

2009-08-02  Miguel Sofer  <[email protected]>

	* tests/coroutine.test: fix testfile cleanup

2009-08-02  Donal K. Fellows  <[email protected]>

	* generic/tclObj.c (Tcl_RepresentationCmd): Added an unsupported
	command for reporting the representation of an object. Result string
	is deliberately a bit obstructive so that people are not encouraged to
	make code that depends on it; it's a debugging tool only!

	* unix/tclUnixFCmd.c (GetOwnerAttribute, SetOwnerAttribute)
	(GetGroupAttribute, SetGroupAttribute): [Bug 1942222]: Stop calling
	* unix/tclUnixFile.c (TclpGetUserHome): endpwent() and endgrent();
	they've been unnecessary for ages.

2009-08-02  Jan Nijtmans  <[email protected]>

	* win/tclWin32Dll.c: Eliminate TclWinResetInterfaceEncodings, since it
	* win/tclWinInit.c:  does exactly the same as TclWinEncodingsCleanup,
	* win/tclWinInt.h:   make sure that tclWinProcs and
			     tclWinTCharEncoding are always set and reset
			     concurrently.
	* win/tclWinFCmd.c:  Correct check for win95

2009-07-31  Don Porter  <[email protected]>

	* generic/tclStringObj.c: [Bug 2830354]:	Corrected failure to
	* tests/format.test:		grow buffer when format spec request
	large width floating point values.  Thanks to Clemens Misch.

2009-07-26  Donal K. Fellows  <[email protected]>

	* library/auto.tcl (tcl_findLibrary, auto_mkindex):
	* library/package.tcl (pkg_mkIndex, tclPkgUnknown, MacOSXPkgUnknown):
	* library/safe.tcl (interpAddToAccessPath, interpDelete, AliasGlob):
	(AliasSource, AliasLoad, AliasEncoding):
	* library/tm.tcl (UnknownHandler): Simplify by swapping some [catch]
	gymnastics for use of [try].

2009-07-26 Alexandre Ferrieux  <[email protected]>

	* tools/genStubs.tcl: Forced LF translation when generating .h's to
	avoid spurious diffs when regenerating on a Windows box.

2009-07-26  Jan Nijtmans  <[email protected]>

	* win/Makefile.in: [Bug 2827066]: msys build --enable-symbols broken
	* win/tcl.m4:	   And modified the same for unicows.dll, as a
	* win/configure:   preparation for [Enh 2819611].

2009-07-25  Donal K. Fellows  <[email protected]>

	* library/history.tcl (history): Reworked the history mechanism in
	terms of ensembles, rather than the ad hoc ensemble-lite mechanism
	used previously.

2009-07-24  Donal K. Fellows  <[email protected]>

	* doc/self.n (self class): [Bug 2704302]: Add some text to make it
	clearer how to get the name of the current object's class.

2009-07-23  Andreas Kupries  <[email protected]>

	* generic/tclIO.c (Tcl_GetChannelHandle): [Bug 2826248]: Do not crash
	* generic/tclPipe.c (FileForRedirect): for getHandleProc == NULL, this
	is allowed. Provide a nice error message in the bypass area. Updated
	caller to check the bypass for a mesage. Bug reported by Andy
	Sonnenburg <[email protected]>

2009-07-23  Joe Mistachkin  <[email protected]>

	* generic/tclNotify.c: [Bug 2820349]: Ensure that queued events are
	freed once processed.

2009-07-22  Jan Nijtmans  <[email protected]>

	* macosx/tclMacOSXFCmd.c: CONST -> const
	* generic/tclGetDate.y:
	* generic/tclDate.c:
	* generic/tclLiteral.c: (char *) cast in ckfree call
	* generic/tclPanic.c: [Feature Request 2814786]: remove TclpPanic
	* generic/tclInt.h
	* unix/tclUnixPort.h
	* win/tclWinPort.h

2009-07-22 Alexandre Ferrieux  <[email protected]>

	* generic/tclEvent.c: [Bug 2001201 again]: Refined the 20090617 patch
	on [exit] streamlining, so that it now correctly calls thread exit
	handlers for the calling thread, including <Destroy> bindings in Tk.

2009-07-21  Kevin B. Kenny  <[email protected]>

	* library/tzdata/Asia/Dhaka:
	* library/tzdata/Indian/Mauritius: Olson's tzdata2009k.

2009-07-20  Donal K. Fellows  <[email protected]>

	* generic/tclCmdMZ.c (StringIsCmd): Reorganize so that [string is] is
	more efficient when parsing things that are correct, at a cost of
	making the empty string test slightly more costly. With this, the cost
	of doing [string is integer -strict $x] matches [catch {expr {$x+0}}]
	in the successful case, and greatly outstrips it in the failing case.

2009-07-19  Donal K. Fellows  <[email protected]>

	* generic/tclOO.decls, generic/tclOO.c (Tcl_GetObjectName): Expose a
	function for efficiently returning the current name of an object.

2009-07-18  Daniel Steffen  <[email protected]>

	* unix/Makefile.in: Define NDEBUG in optimized (non-symbols) build to
	disable NRE assert()s and threaded allocator range checks.

2009-07-16  Don Porter  <[email protected]>

	* generic/tclBinary.c:	Removed unused variables.
	* generic/tclCmdIL.c:
	* generic/tclCompile.c:
	* generic/tclExecute.c:
	* generic/tclHash.c:
	* generic/tclIOUtil.c:
	* generic/tclVar.c:

	* generic/tclBasic.c:	Silence compiler warnings about ClientData.
	* generic/tclProc.c:

	* generic/tclScan.c:    Typo in ACCEPT_NAN configuration.

	* generic/tclStrToD.c:  [Bug 2819200]: Set floating point control
	register on MIPS systems so that the gradual underflow expected by Tcl
	is in effect.

2009-07-15  Donal K. Fellows  <[email protected]>

	* generic/tclInt.h (Namespace):		   Added machinery to allow
	* generic/tclNamesp.c (many functions):	   reduction of memory used
	* generic/tclResolve.c (BumpCmdRefEpochs): by namespaces. Currently
	#ifdef'ed out because of compatibility concerns.

	* generic/tclInt.decls: Added four functions for better integration
	with itcl-ng.

2009-07-14  Kevin B. Kenny  <[email protected]>

	* generic/tclInt.h (TclNRSwitchObjCmd):
	* generic/tclBasic.c (builtInCmds):
	* generic/tclCmdMZ.c (Tcl_SwitchObjCmd):
	* tests/switch.test (switch-15.1):
	[Bug 2821401]: Make non-bytecoded [switch] command aware of NRE.

2009-07-13  Andreas Kupries  <[email protected]>

	* generic/tclCompile.c (TclInitCompileEnv, EnterCmdWordIndex)
	(TclCleanupByteCode, TclCompileScript):
	* generic/tclExecute.c (TclCompileObj, TclExecuteByteCode):
	* tclCompile.h (ExtCmdLoc):
	* tclInt.h (ExtIndex, CFWordBC, CmdFrame):
	* tclBasic.c (DeleteInterpProc, TclArgumentBCEnter)
	(TclArgumentBCRelease, TclArgumentGet, SAVE_CONTEXT)
	(RESTORE_CONTEXT, NRCoroutineExitCallback, TclNRCoroutineObjCmd):
	* generic/tclCmdAH.c (TclNRForObjCmd, TclNRForIterCallback,
	(ForNextCallback):
	* generic/tclCmdMZ.c (TclNRWhileObjCmd):

	Extended the bytecode compiler initialization to recognize the
	compilation of whole files (NRE enabled 'source' command) and switch
	to the counting of absolute lines in that case.

	Further extended the bytecode compiler to track the start line in the
	generated information, and modified the bytecode execution to
	recompile an object if the location as per the calling context doesn't
	match the location saved in the bytecode. This part could be optimized
	more by using more memory to keep all possibilities which occur
	around, or by just adjusting the location information instead of a
	total recompile.

	Reworked the handling of literal command arguments in bytecode to be
	saved (compiler) and used (execution) per command (See the
	TCL_INVOKE_STK* instructions), and not per the whole bytecode. This,
	and the previous change remove the problems with location data caused
	by literal sharing (across whole files, but also proc bodies).
	Simplified the associated datastructures (ExtIndex is gone, as is the
	function EnterCmdWordIndex).

	The last change causes the hashtable 'lineLABCPtr' to be state which
	has to be kept per coroutine, like the CmdFrame stack. Reworked the
	coroutine support code to create, delete and switch the information as
	needed. Further reworked the tailcall command as well, it has to pop
	its own arguments when run in a bytecode context to keep a proper
	stack in 'lineLABCPtr'.

	Fixed the mishandling of line information in the NRE-enabled 'for' and
	'while' commands introduced when both were made to share their
	iteration callbacks without taking into account that the loop body is
	found in different words of the command. Introduced a separate data
	structure to hold all the callback information, as we went over the
	limit of 4 direct client-data values for NRE callbacks.

	The above fixes [Bug 1605269].

2009-07-12  Donal K. Fellows  <[email protected]>

	* generic/tclCmdMZ.c (StringIndexCmd, StringEqualCmd, StringCmpCmd):
	* generic/tclExecute.c (TclExecuteByteCode): [Bug 2637173]: Factor out
	* generic/tclInt.h (TclIsPureByteArray):     the code to determine if
	* generic/tclUtil.c (TclStringMatchObj):     it is safe to work with
	byte arrays directly, so that we get the check correct _once_.

	* generic/tclOOCall.c (TclOOGetCallContext): [Bug 1895546]: Changed
	* generic/tclOO.c (TclOOObjectCmdCore):	     the way that the cache is
	managed so that when itcl does cunning things, those cunning things
	can be cached properly.

2009-07-11  Donal K. Fellows  <[email protected]>

	* doc/vwait.n: Substantially increased the discussion of issues and
	work-arounds relating to nested vwaits, following discussion on the
	tcl-core mailing list on the topic.

2009-07-10  Pat Thoyts  <[email protected]>

	* tests/zlib.test:   ZlibTransformClose may be called with a NULL
	* generic/tclZlib.c: interpreter during finalization and
	Tcl_SetChannelError requires a list. Added some tests to ensure error
	propagation from the zlib library to the interp.

2009-07-09  Pat Thoyts  <[email protected]>

	* tests/zlib.test: [Bug 2818131]: Added tests and fixed a typo that
	broke [zlib push] for deflate format.

2009-07-09  Donal K. Fellows  <[email protected]>

	* compat/mkstemp.c (mkstemp): [Bug 2819227]: Use rand() for random
	numbers as it is more portable.

2009-07-05  Donal K. Fellows  <[email protected]>

	* generic/tclZlib.c (ZlibTransformWatch): Correct the handling of
	events so that channel transforms work with things like an asynch
	[chan copy]. Problem reported by Pat Thoyts.

2009-07-01  Pat Thoyts  <[email protected]>

	* win/tclWinInt.h:   [Bug 2806622]: Handle the GetUserName API call
	* win/tclWin32Dll.c: via the tclWinProcs indirection structure. This
	* win/tclWinInit.c:  fixes a problem obtaining the username when the
	USERNAME environment variable is unset.

2009-06-30  Daniel Steffen  <[email protected]>

	* generic/tclInt.h:		Add assert macros for clang static
	* generic/tclPanic.c:		analyzer and redefine Tcl_Panic to
	* generic/tclStubInit.c:	assert after panic in clang PURIFY
					builds.

	* generic/tclCmdIL.c:		Add clang assert for false positive
					from static analyzer.

2009-06-26  Daniel Steffen  <[email protected]>

	* macosx/Tcl-Common.xcconfig:	 Update projects for Xcode 3.1 and
	* macosx/Tcl.xcode/*:		 3.2, standardize on gcc 4.2, remove
	* macosx/Tcl.xcodeproj/*:	 obsolete configurations and pre-Xcode
	* macosx/Tcl.pbproj/* (removed): project.

	* macosx/README:		 Update project docs, cleanup.

	* unix/Makefile.in:		 Update dist target for project
					 changes.

2009-06-24  Donal K. Fellows  <[email protected]>

	* tests/oo.test (oo-19.1): [Bug 2811598]: Make more resilient.

2009-06-24  Pat Thoyts  <[email protected]>

	* tests/http11.test: [Bug 2811492]: Clean up procs after testing.

2009-06-18  Donal K. Fellows  <[email protected]>

	* generic/tclCkalloc.c (MemoryCmd): [Bug 988703]:
	* generic/tclObj.c (ObjData, TclFinalizeThreadObjects): Add mechanism
	for discovering what Tcl_Objs are allocated when built for memory
	debugging. Developed by Joe Mistachkin.

2009-06-17 Alexandre Ferrieux  <[email protected]>

	* generic/tclEvent.c: Applied a patch by George Peter Staplin
	drastically reducing the ambition of [exit] wrt finalization, and
	thus solving many multi-thread teardown issues. [Bugs 2001201,
	486399, and possibly 597575, 990457, 1437595, 2750491]

2009-06-15  Don Porter  <[email protected]>

	* generic/tclStringObj.c: sprintf() -> Tcl_ObjPrintf() conversion.

2009-06-15  Reinhard Max  <[email protected]>

	* unix/tclUnixPort.h: Move all socket-related code from tclUnixChan.c
	* unix/tclUnixChan.c: to tclUnixSock.c.
	* unix/tclUnixSock.c:

2009-06-15  Donal K. Fellows  <[email protected]>

	* tools/tcltk-man2html.tcl (make-man-pages): [Patch 557486]: Apply
	last remaining meaningful part of this patch, a clean up of some
	closing tags.

2009-06-13  Don Porter  <[email protected]>

	* generic/tclCompile.c: [Bug 2802881]: The value stashed in
	* generic/tclProc.c:    iPtr->compiledProcPtr when compiling a proc
	* tests/execute.test:   survives too long. We only need it there long
	enough for the right TclInitCompileEnv() call to re-stash it into
	envPtr->procPtr.  Once that is done, the CompileEnv controls.  If we
	let the value of iPtr->compiledProcPtr linger, though, then any other
	bytecode compile operation that takes place will also have its
	CompileEnv initialized with it, and that's not correct.  The value is
	meant to control the compile of the proc body only, not other compile
	tasks that happen along.  Thanks to Carlos Tasada for discovering and
	reporting the problem.

2009-06-10  Don Porter  <[email protected]>

	* generic/tclStringObj.c:       [Bug 2801413]: Revised [format] to not
	overflow the integer calculations computing the length of the %ll
	formats of really big integers.  Also added protections so that
	[format]s that would produce results overflowing the maximum string
	length of Tcl values throw a normal Tcl error instead of a panic.

	* generic/tclStringObj.c:	[Bug 2803109]: Corrected failures to
	deal with the "pure unicode" representation of an empty string.
	Thanks to Julian Noble for reporting the problem.

2006-06-09  Kevin B. Kenny  <[email protected]>

	* generic/tclGetDate.y: Fixed a thread safety bug in the generated
	* library/clock.tcl:    Bison parser (needed a %pure-parser
	* tests/clock.test:     declaration to avoid static variables).
				Discovered that the %pure-parser declaration
	                        allowed for returning the Bison error message
	                        to the Tcl caller in the event of a syntax
	                        error, so did so.
	* generic/tclDate.c: bison 2.3

2006-06-08  Kevin B. Kenny  <[email protected]>

	* library/tzdata/Asia/Dhaka: New DST rule for Bangladesh. (Olson's
	tzdata2009i.)

2009-06-08  Donal K. Fellows  <[email protected]>

	* doc/copy.n: Fix error in example spotted by Venkat Iyer.

2009-06-02  Don Porter  <[email protected]>

	* generic/tclExecute.c: Replace dynamically-initialized table with a
	table of static constants in the lookup table for exponent operator
	computations that fit in a 64 bit integer result.

	* generic/tclExecute.c: [Bug 2798543]: Corrected implementations and
	selection logic of the INST_EXPON instruction.

2009-06-01  Don Porter  <[email protected]>

	* tests/expr.test:      [Bug 2798543]: Added many tests demonstrating
	the broken cases.

009-05-30  Kevin B. Kenny  <[email protected]>

	* library/tzdata/Africa/Cairo:
	* library/tzdata/Asia/Amman: Olson's tzdata2009h.

2009-05-29  Andreas Kupries  <[email protected]>

	* library/platform/platform.tcl: Fixed handling of cpu ia64,
	* library/platform/pkgIndex.tcl: taking ia64_32 into account
	* unix/Makefile.in: now. Bumped version to 1.0.5. Updated the
	* win/Makefile.in: installation commands.

2009-05-26 Alexandre Ferrieux  <[email protected]>

	* doc/expr.n: Fixed documentation of the right-associativity of
	the ** operator. (spotted by kbk)

2009-05-14  Donal K. Fellows  <[email protected]>

	* generic/tclOOInfo.c (InfoObjectNsCmd): Added introspection mechanism
	for finding out what an object's namespace is. Experience suggests
	that it is just too useful to be able to do without it.

2009-05-12  Donal K. Fellows  <[email protected]>

	* doc/vwait.n: Added more words to make it clear just how bad it is to
	nest [vwait]s.

	* compat/mkstemp.c: Add more headers to make this file build on IRIX
	6.5. Thanks to Larry McVoy for this.

2009-05-08  Donal K. Fellows  <[email protected]>

	* generic/tclOO.c (TclNRNewObjectInstance):  [Bug 2414858]: Add a
	* generic/tclBasic.c (TclPushTailcallPoint): marker to the stack of
	NRE callbacks at the right point so that tailcall works correctly in a
	constructor.

	* tests/exec.test (cat): [Bug 2788468]: Adjust the scripted version of
	cat so that it does not perform transformations on the data it is
	working with, making it more like the standard Unix 'cat' program.

2009-05-07  Miguel Sofer  <[email protected]>

	* generic/tclObj.c (Tcl_GetCommandFromObj): [Bug 2785893]: Ensure that
	a command in a deleted namespace can't be found through a cached name.

	* generic/tclBasic.c:    Let coroutines start with a much smaller
	* generic/tclCompile.h:  stack: 200 words (previously was 2000, the
	* generic/tclExecute.c:  same as interps).

2009-05-07  Donal K. Fellows  <[email protected]>

	* tests/env.test (printenvScript, env-4.3, env-4.5): [Bug 1513659]:
	* tests/exec.test (exec-2.6): These tests had subtle dependencies on
	being on platforms that were either ISO 8859-1 or UTF-8. Stabilized
	the results by forcing the encoding.

2009-05-06  Don Porter  <[email protected]>

	* generic/tclCmdMZ.c:	[Bug 2582327]: Improve overflow error message
	from [string repeat].

	* tests/interp.test: interp-20.50 test for Bug 2486550.

2009-05-04  Donal K. Fellows  <[email protected]>

	* generic/tclOO.c (InitFoundation, AllocObject, AllocClass):
	* generic/tclOODefineCmds.c (InitDefineContext): Make sure that when
	support namespaces are deleted, nothing bad can subsequently happen.
	Issue spotted by Don Porter.

2009-05-03  Donal K. Fellows  <[email protected]>

	* doc/Tcl.n: [Bug 2538432]: Clarified exact treatment of ${arr(idx)}
	form of variable substitution. This is not a change of behavior, just
	an improved description of the current situation.

2009-04-30  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c (TclObjInvoke): [Bug 2486550]: Make sure that a
	null objProc is not used, use Tcl_NRCallObjProc instead.

2009-05-01  Jan Nijtmans  <[email protected]>

	* win/configure.in   Fix 64-bit detection for zlib on Win64
	* win/configure      (regenerated)

2009-04-28  Jeff Hobbs  <[email protected]>

	* unix/tcl.m4, unix/configure (SC_CONFIG_CFLAGS): harden the check to
	add _r to CC on AIX with threads.

2009-04-27  Donal K. Fellows  <[email protected]>

	* doc/concat.n (EXAMPLES): [Bug 2780680]: Rewrote so that the spacing
	of result messages is correct. (The exact way they were wrong was
	different when rendered through groff or as HTML, but it was still
	wrong both ways.)

2009-04-27  Jan Nijtmans  <[email protected]>

	* generic/tclIndexObj.c:  Reset internal INTERP_ALTERNATE_WRONG_ARGS
	* generic/tclIOCmd.c:     flag inside the Tcl_WrongNumArgs function,
	                          so the caller no longer has to do the reset.

2009-04-24  Stuart Cassoff  <[email protected]>

	* unix/Makefile.in: [Patch 2769530]: Don't chmod/exec installManPage.

2009-04-19  Pat Thoyts  <[email protected]>

	* library/http/http.tcl: [Bug 2715421]: Removed spurious newline added
	* tests/http11.test:     after POST and added tests to detect excess
	* tests/httpd11.tcl:     bytes being POSTed.
	* library/http/pkgIndex.tcl:
	* makefiles:             package version now 2.8.1

2009-04-15  Donal K. Fellows  <[email protected]>

	* doc/chan.n, doc/close.n: Tidy up documentation of TIP #332.

2009-04-14  Kevin B. Kenny  <[email protected]>

	* library/tzdata/Asia/Karachi: Updated rules for Pakistan Summer
				       Time (Olson's tzdata2009f)

2009-04-11  Donal K. Fellows  <[email protected]>

	* generic/tclOOMethod.c (InvokeForwardMethod): Clarify the resolution
	behaviour of the name of the command that is forwarded to: it's now
	resolved using the object's namespace as context, which is much more
	useful than the previous (somewhat random) behaviour of using the
	caller's current namespace.

2009-04-10  Pat Thoyts  <[email protected]>

	* library/http/http.tcl:     Improved HTTP/1.1 support and added
	* library/http/pkgIndex.tcl: specific HTTP/1.1 testing to ensure
	* tests/http11.test:         we handle chunked+gzip for the various
	* tests/httpd11.test:        modes (normal, -channel and -handler)
	* makefiles:                 package version set to 2.8.0

2009-04-10  Daniel Steffen  <[email protected]>

	* unix/tclUnixChan.c:		TclUnixWaitForFile(): use FD_* macros
	* macosx/tclMacOSXNotify.c:	to manipulate select masks (Cassoff).
					[FRQ 1960647] [Bug 3486554]

	* unix/tclLoadDyld.c:		Use RTLD_GLOBAL instead of RTLD_LOCAL.
					[Bug 1961211]

	* macosx/tclMacOSXNotify.c:	revise CoreFoundation notifier to allow
					embedding into applications that
					already have a CFRunLoop running and
					want to run the tcl event loop via
					Tcl_ServiceModeHook(TCL_SERVICE_ALL).

	* macosx/tclMacOSXNotify.c:	add CFRunLoop based Tcl_Sleep() and
	* unix/tclUnixChan.c:		TclUnixWaitForFile() implementations
	* unix/tclUnixEvent.c:		and disable select() based ones in
					CoreFoundation builds.

	* unix/tclUnixNotify.c:		simplify, sync with tclMacOSXNotify.c.

	* generic/tclInt.decls: 	add TclMacOSXNotifierAddRunLoopMode()
	* generic/tclIntPlatDecls.h:	internal API, regen.
	* generic/tclStubInit.c:

	* unix/configure.in (Darwin):	use Darwin SUSv3 extensions if
					available; remove /Network locations
					from default tcl package search path
					(NFS mounted locations and thus slow).
	* unix/configure:		autoconf-2.59
	* unix/tclConfig.h.in:		autoheader-2.59

	* macosx/tclMacOSXBundle.c:	on Mac OS X 10.4 and later, replace
					deprecated NSModule API by dlfcn API.

2009-04-10  Donal K. Fellows  <[email protected]>

	* doc/StringObj.3: [Bug 2089279]: Corrected example so that it works
	on 64-bit machines as well.

2009-04-10  Pat Thoyts  <[email protected]>

	* tests/http.test: [Bug 26245326]: Added specific check for problem
	* tests/httpd: (return incomplete HTTP response header).

2009-04-08  Kevin B. Kenny  <[email protected]>

	* tools/tclZIC.tcl: Always emit files with Unix line termination.
	* library/tzdata: Olson's tzdata2009e

2009-04-09  Don Porter  <[email protected]>

	* library/http/http.tcl:	[Bug 26245326]: Handle incomplete
	lines in the "connecting" state. Thanks to Sergei Golovan.

2009-04-08  Andreas Kupries  <[email protected]>

	* library/platform/platform.tcl: Extended the darwin sections to add
	* library/platform/pkgIndex.tcl: a kernel version number to the
	* unix/Makefile.in: identifier for anything from Leopard (10.5) on up.
	* win/Makefile.in: Extended patterns for same. Extended cpu
	* doc/platform.n: recognition for 64bit Tcl running on a 32bit kernel
	on a 64bit processor (By Daniel Steffen). Bumped version to 1.0.4.
	Updated Makefiles.

2009-04-08  Don Porter  <[email protected]>

	* library/tcltest/tcltest.tcl:  [Bug 2570363]: Converted [eval]s (some
	* library/tcltest/pkgIndex.tcl: unsafe!) to {*} in tcltest package.
	* unix/Makefile.in:     => tcltest 2.3.1
	* win/Makefile.in:

2009-04-07  Don Porter  <[email protected]>

	* generic/tclStringObj.c:	Correction so that value of
	TCL_GROWTH_MIN_ALLOC is everywhere expressed in bytes as comment
	claims.

2009-04-04  Donal K. Fellows  <[email protected]>

	* doc/vwait.n: [Bug 1910136]: Extend description and examples to make
	it clearer just how this command interprets variable names.

2009-03-30  Don Porter  <[email protected]>

	* doc/Alloc.3: [Bug 2556263]:	Size argument is "unsigned int".

2009-03-27  Don Porter  <[email protected]>

	* generic/tclPathObj.c (TclPathPart): [Bug 2710920]: TclPathPart()
	* tests/fileName.test:	was computing the wrong results for both [file
	dirname] and [file tail] on "path" arguments with the PATHFLAGS != 0
	intrep and with an empty string for the "joined-on" part.

2009-03-25  Jan Nijtmans  <[email protected]>

	* doc/tclsh.1:		 Bring doc and tools in line with
	* tools/installData.tcl: https://wiki.tcl-lang.org/page/exec+magic
	* tools/str2c
	* tools/tcltk-man2html.tcl

2009-03-25  Donal K. Fellows  <[email protected]>

	* doc/coroutine.n: [Bug 2152285]: Added basic documentation for the
	coroutine and yield commands.

2009-03-24  Donal K. Fellows  <[email protected]>

	* generic/tclOOBasic.c (TclOOSelfObjCmd): [Bug 2704302]: Make 'self
	class' better defined in the context of objects that change class.

	* generic/tclVar.c (Tcl_UpvarObjCmd): [Bug 2673163] (ferrieux)
	* generic/tclProc.c (TclObjGetFrame): Make the upvar command more able
	to handle its officially documented syntax.

2009-03-22  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c: [Bug 2502037]: NR-enable the handling of unknown
	commands.

2009-03-21  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c:   Fixed "leaks" in aliases, imports and
	* generic/tclInt.h:     ensembles. Only remaining known leak is in
	* generic/tclInterp.c:  ensemble unknown dispatch (as it not
	* generic/tclNamesp.c:  NR-enabled)
	* tests/tailcall.test:

	* tclInt.h: comments

	* tests/tailcall.test: Added tests to show that [tailcall] does not
	currently always execute in constant space: interp-alias, ns-imports
	and ensembles "leak" as of this commit.

	* tests/nre.test: [foreach] has been NR-enabled for a while, the test
	was marked 'knownBug': unmark it.

	* generic/tclBasic.c:   Fix for (among others) [Bug 2699087]
	* generic/tclCmdAH.c:   Tailcalls now perform properly even from
	* generic/tclExecute.c: within [eval]ed scripts.
	* generic/tclInt.h:     More tests missing, as well as proper
	exploration and testing of the interaction with "redirectors" like
	interp-alias (suspect that it does not happen in constant space)
	and pure-eval commands.

	* generic/tclExecute.c: Proper fix for [Bug 2415422]. Reenabled
	* tests/nre.test:       the failing assertion that was disabled on
	2008-12-18: the assertion is correct, the fault was in the
	management of expansions.

	* generic/tclExecute.c:  Fix both test and code for tailcall
	* tests/tailcall.test:   from within a compiled [eval] body.

	* tests/tailcall.test: Slightly improved tests

2009-03-20  Don Porter  <[email protected]>

	* tests/stringObj.test:         [Bug 2597185]: Test stringObj-6.9
	checks that Tcl_AppendStringsToObj() no longer crashes when operating
	on a pure unicode value.

	* generic/tclExecute.c (INST_CONCAT1):  [Bug 2669109]: Panic when
	appends overflow the max length of a Tcl value.

2009-03-19  Miguel Sofer  <[email protected]>

	* generic/tcl.h:
	* generic/tclInt.h:
	* generic/tclBasic.c:
	* generic/tclExecute.c:
	* generic/tclNamesp.c (Tcl_PopCallFrame): Rewritten tailcall
	implementation, ::unsupported::atProcExit is (temporarily?) gone. The
	new approach is much simpler, and also closer to being correct. This
	commit fixes [Bug 2649975] and [Bug 2695587].

	* tests/coroutine.test:    Moved the tests to their own files,
	* tests/tailcall.test:     removed the unsupported.test. Added
	* tests/unsupported.test:  tests for the fixed bugs.

2009-03-19  Donal K. Fellows  <[email protected]>

	* doc/tailcall.n: Added documentation for tailcall command.

2009-03-18  Don Porter  <[email protected]>

	* win/tclWinFile.c (TclpObjNormalizePath):	[Bug 2688184]:
	Corrected Tcl_Obj leak. Thanks to Joe Mistachkin for detection and
	patch.

	* generic/tclVar.c (TclLookupSimpleVar):	[Bug 2689307]: Shift
	all calls to Tcl_SetErrorCode() out of TclLookupSimpleVar and onto its
	callers, where control with TCL_LEAVE_ERR_MSG flag is more easily
	handled.

2009-03-16  Donal K. Fellows  <[email protected]>

	* generic/tclCmdMZ.c (TryPostBody): [Bug 2688063]: Extract information
	from list before getting rid of last reference to it.

2009-03-15  Joe Mistachkin  <[email protected]>

	* generic/tclThread.c: [Bug 2687952]: Modify fix for TSD leak to match
	* generic/tclThreadStorage.c: Tcl 8.5 (and prior) allocation semantics

2009-03-15  Donal K. Fellows  <[email protected]>

	* generic/tclThreadStorage.c (TSDTableDelete):	[Bug 2687952]: Ensure
	* generic/tclThread.c (Tcl_GetThreadData):	that structures in
	Tcl's TSD system are all freed. Use the correct matching allocator.

	* generic/tclPosixStr.c (Tcl_SignalId,Tcl_SignalMsg): [Patch 1513655]:
	Added support for SIGINFO, which is present on BSD platforms.

2009-03-14  Donal K. Fellows  <[email protected]>

	* unix/tcl.pc.in (new file):		[Patch 2243948] (hat0)
	* unix/configure.in, unix/Makefile.in: Added support for reporting
	Tcl's public build configuration via the pkg-config system. TEA is
	still the official mechanism though, in part because pkg-config is not
	universally supported across all Tcl's supported platforms.

2009-03-11  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c (TclNRCoroutineObjCmd): fix Tcl_Obj leak.
	Diagnosis and fix thanks to GPS.

2009-03-09  Donal K. Fellows  <[email protected]>

	* generic/tclCmdMZ.c (Tcl_TryObjCmd, TclNRTryObjCmd): Moved the
	implementation of [try] from Tcl code into C. Still lacks a bytecode
	version, but should be better than what was before.

2009-03-04  Donal K. Fellows  <[email protected]>

	* generic/tclZlib.c (TclZlibCmd): Checksums are defined to be unsigned
	32-bit integers, use Tcl_WideInt to pass to scripts. [Bug 2662434]
	(ZlibStreamCmd, ChanGetOption): A few other related corrections.

2009-02-27  Jan Nijtmans  <[email protected]>

	* generic/tcl.decls:    [Bug 218977]: Tcl_DbCkfree needs return value
	* generic/tclCkalloc.c
	* generic/tclDecls.h:   (regenerated)
	* generic/tclInt.decls: don't use CONST84/CONST86 here
	* generic/tclCompile.h: don't use CONST86 here, comment fixing.
	* generic/tclIO.h:      don't use CONST86 here, comment fixing.
	* generic/tclIntDecls.h (regenerated)

2009-02-25  Don Porter  <[email protected]>

	* generic/tclUtil.c (TclStringMatchObj):	[Bug 2637173]: Revised
	the branching on the strObj->typePtr so that untyped values get
	converted to the "string" type and pass through the Unicode matcher.
	[Bug 2613766]: Also added checks to only perform "bytearray"
	optimization on pure bytearray values.

	* generic/tclCmdMZ.c:	Since Tcl_GetCharLength() has its own
	* generic/tclExecute.c:	optimizations for the tclByteArrayType, stop
	having the callers do them.

2009-02-24  Donal K. Fellows  <[email protected]>

	* doc/clock.n, doc/fblocked.n, doc/format.n, doc/lsort.n,
	* doc/pkgMkIndex.n, doc/regsub.n, doc/scan.n, doc/tclvars.n:
	General minor documentation improvements.

	* library/http/http.tcl (geturl, Eof): Added support for 8.6's built
	in zlib routines.

2009-02-22  Alexandre Ferrieux  <[email protected]>

	* tests/lrange.test:	Revert commits of 2008-07-23. Those were speed
	* tests/binary.test:	tests, that are inherently brittle.

2009-02-21  Don Porter  <[email protected]>

	* generic/tclStringObj.c:	Several revisions to the shimmering
	patterns between Unicode and UTF string reps.  Most notably the
	call: objPtr = Tcl_NewUnicodeObj(...,0); followed by a loop of calls:
	Tcl_AppendUnicodeToObj(objPtr, u, n); will now grow and append to
	the Unicode representation.  Before this commit, the sequence would
	convert each append to UTF and perform the append to the UTF rep.
	This is puzzling and likely a bug.  The performance of [string map]
	is significantly improved by this change (according to the MAP
	collection of benchmarks in tclbench).  Just in case there was some
	wisdom in the old ways that I missed, I left in the ability to restore
	the old patterns with a #define COMPAT 1 at the top of the file.

2009-02-20  Don Porter  <[email protected]>

	* generic/tclPathObj.c:	[Bug 2571597]: Fixed mistaken logic in
	* tests/fileName.test:	TclFSGetPathType() that assumed (not
	"absolute") => "relative". This is a false assumption on Windows,
	where "volumerelative" is another possibility.

2009-02-18  Don Porter  <[email protected]>

	* generic/tclStringObj.c:	Simplify the logic of the
	Tcl_*SetObjLength() routines.

	* generic/tclStringObj.c:	Rewrite GrowStringBuffer() so that it
	has parallel structure with GrowUnicodeBuffer().  The revision permits
	allocation attempts to continue all the way up to failure, with no
	gap. It also directly manipulates the String and Tcl_Obj internals
	instead of inefficiently operating via Tcl_*SetObjLength() with all of
	its extra protections and underdocumented special cases.

	* generic/tclStringObj.c:	Another round of simplification on
	the allocation macros.

2009-02-17  Jeff Hobbs  <[email protected]>

	* win/tcl.m4, win/configure: Check if cl groks _WIN64 already to
	avoid CC manipulation that can screw up later configure checks.
	Use 'd'ebug runtime in 64-bit builds.

2009-02-17  Don Porter  <[email protected]>

	* generic/tclStringObj.c:	Pare back the length of the unicode
	array in a non-extended String struct to one Tcl_UniChar, meant to
	hold the terminating NUL character.  Non-empty unicode strings are
	then stored by extending the String struct by stringPtr->maxChars
	additional slots in that array with sizeof(Tcl_UniChar) bytes per
	slot. This revision makes the allocation macros much simpler.

	* generic/tclStringObj.c:	Factor out common GrowUnicodeBuffer()
	and solve overflow and growth algorithm fallbacks in it.

	* generic/tclStringObj.c:	Factor out common GrowStringBuffer().

	* generic/tclStringObj.c:	Convert Tcl_AppendStringsToObj into
	* tests/stringObj.test:		a radically simpler implementation
	where we just loop over calls to Tcl_AppendToObj.  This fixes [Bug
	2597185].  It also creates a *** POTENTIAL INCOMPATIBILITY *** in
	that T_ASTO can now allocate more space than is strictly required,
	like all the other Tcl_Append* routines.  The incompatibility was
	detected by test stringObj-6.5, which I've updated to reflect the
	new behavior.

	* generic/tclStringObj.c:	Revise buffer growth implementation
	in ExtendStringRepWithUnicode.  Use cheap checks to determine that
	no reallocation is necessary without cost of computing the precise
	number of bytes needed.  Also make use of the string growth algortihm
	in the case of repeated appends.

2009-02-16  Jan Nijtmans  <[email protected]>

	* generic/tclZlib.c:	Hack needed for official zlib1.dll build.
	* win/configure.in:	fix [Feature Request 2605263] use official
	* win/Makefile.in:	zlib build.
	* win/configure:	(regenerated)
	* compat/zlib/zdll.lib:	new files
	* compat/zlib/zlib1.dll:

	* win/Makefile.in:  [Bug 2605232]: tdbc doesn't build when Tcl is
	compiled with --disable-shared.

2009-02-15  Don Porter  <[email protected]>

	* generic/tclStringObj.c:	[Bug 2603158]: Added protections from
	* generic/tclTestObj.c:		invalid memory accesses when we append
	* tests/stringObj.test:		(some part of) a Tcl_Obj to itself.
	Added the appendself and appendself2 subcommands to the
	[teststringobj] testing command and added tests to the test suite.

	* generic/tclStringObj.c:	Factor out duplicate code from
	Tcl_AppendObjToObj.

	* generic/tclStringObj.c:	Replace the 'size_t uallocated' field
	of the String struct, storing the number of bytes allocated to store
	the Tcl_UniChar array, with an 'int maxChars' field, storing the
	number of Tcl_UniChars that may be stored in the allocated space.
	This reduces memory requirement a small bit, and makes some range
	checks simpler to code.
	* generic/tclTestObj.c:	Replace the [teststringobj ualloc] testing
	* tests/stringObj.test:	command with [teststringobj maxchars] and
	update the tests.

	* generic/tclStringObj.c:	Removed limitation in
	Tcl_AppendObjToObj where the char length of the result was only
	computed if the appended string was all single byte characters.
	This limitation was in place to dodge a bug in Tcl_GetUniChar.
	With that bug gone, we can take advantage of always recording the
	length of append results when we know it.

2009-02-14  Don Porter  <[email protected]>

	* generic/tclStringObj.c:	Revisions so that we avoid creating
	the strange representation of an empty string with
	objPtr->bytes == NULL and stringPtr->hasUnicode == 0.  Instead in
	the situations where that was being created, create a traditional
	two-legged stork representation (objPtr->bytes = tclEmptyStringRep
	and stringPtr->hasUnicode = 1).  In the situations where the strange
	rep was treated differently, continue to do so by testing
	stringPtr->numChars == 0 to detect it.  These changes make the code
	more conventional so easier for new maintainers to pick up.  Also
	sets up further simplifications.

	* generic/tclTestObj.c:	Revise updates to [teststringobj] so we don't
	get blocked by MODULE_SCOPE limits.

2009-02-12  Don Porter  <[email protected]>

	* generic/tclStringObj.c:	Rewrites of the routines
	Tcl_GetCharLength, Tcl_GetUniChar, Tcl_GetUnicodeFromObj,
	Tcl_GetRange, and TclStringObjReverse to use the new macro, and
	to more simply and clearly split the cases depending on whether
	a valid unicode rep is present or needs to be created.
	New utility routine UnicodeLength(), to compute the length of unicode
	buffer arguments when no length is passed in, with built-in
	overflow protection included.  Update three callers to use it.

	* generic/tclInt.h:	New macro TclNumUtfChars meant to be a faster
	replacement for a full Tcl_NumUtfChars() call when the string has all
	single-byte characters.

	* generic/tclStringObj.c:	Simplified Tcl_GetCharLength by
	* generic/tclTestObj.c:		removing code that did nothing.
	Added early returns from Tcl_*SetObjLength when the desired length
	is already present; adapted test command to the change.

	* generic/tclStringObj.c:	Re-implemented AppendUtfToUnicodeRep
	so that we no longer pass through Tcl_DStrings which have their own
	sets of problems when lengths overflow the int range.  Now AUTUR and
	FillUnicodeRep share a common core routine.

2009-02-12  Donal K. Fellows  <[email protected]>

	* generic/tclOODefineCmds.c (TclOOGetDefineCmdContext): Use the
	correct field in the Interp structure for retrieving the frame to get
	the context object so that people can extend [oo::define] without deep
	shenanigans. Bug found by Federico Ferri.

2009-02-11  Don Porter  <[email protected]>

	* generic/tclStringObj.c:	Re-implemented AppendUnicodeToUtfRep
	so that we no longer pass through Tcl_DStrings which have their own
	sets of problems when lengths overflow the int range.  Now AUTUR and
	UpdateStringOfString share a common core routine.

	* generic/tclStringObj.c:	Changed type of the 'allocated' field
	* generic/tclTestObj.c:		of the String struct (and the
	TestString counterpart) from size_t to int since only int values are
	ever stored in it.

2009-02-10  Jan Nijtmans  <[email protected]>

	* generic/tclEncoding.c: Eliminate some unnessary type casts
	* generic/tclEvent.c:    some internal const decorations
	* generic/tclExecute.c:  spacing
	* generic/tclIndexObj.c:
	* generic/tclInterp.c:
	* generic/tclIO.c:
	* generic/tclIOCmd.c:
	* generic/tclIORChan.c:
	* generic/tclIOUtil.c:
	* generic/tclListObj.c:
	* generic/tclLiteral.c:
	* generic/tclNamesp.c:
	* generic/tclObj.c:
	* generic/tclOOBasic.c:
	* generic/tclPathObj.c:
	* generic/tclPkg.c:
	* generic/tclProc.c:
	* generic/tclRegexp.c:
	* generic/tclScan.c:
	* generic/tclStringObj.c:
	* generic/tclTest.c:
	* generic/tclTestProcBodyObj.c:
	* generic/tclThread.c:
	* generic/tclThreadTest.c:
	* generic/tclTimer.c:
	* generic/tclTrace.c:
	* generic/tclUtil.c:
	* generic/tclVar.c:
	* generic/tclStubInit.c: (regenerated)

2009-02-10  Jan Nijtmans  <[email protected]>

	* unix/tcl.m4: [Bug 2502365]: Building of head on HPUX is broken when
	using the native CC.
	* unix/configure: (autoconf-2.59)

2009-02-10  Don Porter  <[email protected]>

	* generic/tclObj.c (Tcl_GetString):	Added comments and validity
	checks following the call to an UpdateStringProc.

	* generic/tclStringObj.c: Reduce code duplication in Tcl_GetUnicode*.
	Restrict AppendUtfToUtfRep to non-negative length appends.
	Convert all Tcl_InvalidateStringRep() calls into macros.
	Simplify Tcl_AttemptSetObjLength by removing unreachable code.
	Simplify SetStringFromAny() by removing unreachable and duplicate code.
	Simplify Tcl_SetObjLength by removing unreachable code.
	Removed handling of (objPtr->bytes != NULL) from UpdateStringOfString,
	which is only called when objPtr->bytes is NULL.

2009-02-09  Jan Nijtmans  <[email protected]>

	* generic/tclCompile.c: [Bug 2555129]: const compiler warning (as
	error) in tclCompile.c

2009-02-07  Donal K. Fellows  <[email protected]>

	* generic/tclZlib.c (TclZlibCmd): [Bug 2573172]: Ensure that when
	invalid subcommand name is given, the list of valid subcommands is
	produced. This gives a better experience when using the command
	interactively.

2009-02-05  Joe Mistachkin  <[email protected]>

	* generic/tclInterp.c: [Bug 2544618]: Fix argument checking for
	[interp cancel].
	* unix/Makefile.in: Fix build issue with zlib on FreeBSD (and possibly
	other platforms).

2009-02-05  Donal K. Fellows  <[email protected]>

	* generic/tclCmdMZ.c (StringIndexCmd, StringRangeCmd, StringLenCmd):
	Simplify the implementation of some commands now that the underlying
	string API knows more about bytearrays.

	* generic/tclExecute.c (TclExecuteByteCode): [Bug 2568434]: Make sure
	that INST_CONCAT1 will not lose string reps wrongly.

	* generic/tclStringObj.c (Tcl_AppendObjToObj): Special-case the
	appending of one bytearray to another, which can be extremely rapid.
	Part of scheme to address [Bug 1665628] by making the basic string
	operations more efficient on byte arrays.
	(Tcl_GetCharLength, Tcl_GetUniChar, Tcl_GetRange): More special casing
	work for bytearrays.

2009-02-04  Don Porter  <[email protected]>

	* generic/tclStringObj.c: [Bug 2561794]: Added overflow protections to
	the AppendUtfToUtfRep routine to either avoid invalid arguments and
	crashes, or to replace them with controlled panics.

	* generic/tclCmdMZ.c:	[Bug 2561746]: Prevent crashes due to int
	overflow of the length of the result of [string repeat].

2009-02-03  Jan Nijtmans  <[email protected]>

	* macosx/tclMacOSXFCmd.c: Eliminate some unnessary type casts
	* unix/tclLoadDyld.c:	  some internal const decorations
	* unix/tclUnixCompat.c:	  spacing
	* unix/tclUnixFCmd.c
	* unix/tclUnixFile.c
	* win/tclWinDde.c
	* win/tclWinFCmd.c
	* win/tclWinInit.c
	* win/tclWinLoad.c
	* win/tclWinPipe.c
	* win/tclWinReg.c
	* win/tclWinTest.c
	* generic/tclBasic.c
	* generic/tclBinary.c
	* generic/tclCmdAH.c
	* generic/tclCmdIL.c
	* generic/tclCmdMZ.c
	* generic/tclCompCmds.c
	* generic/tclDictObj.c

2009-02-03  Donal K. Fellows  <[email protected]>

	* generic/tclObj.c (tclCmdNameType): [Bug 2558422]: Corrected the type
	of this structure so that extensions that write it (yuk!) will still
	be able to function correctly.

2009-02-03  Don Porter  <[email protected]>

	* generic/tclStringObj.c (SetUnicodeObj):	[Bug 2561488]:
	Corrected failure of Tcl_SetUnicodeObj() to panic on a shared object.
	Also factored out common code to reduce duplication.

	* generic/tclObj.c (Tcl_GetStringFromObj): Reduce code duplication.

2009-02-02  Don Porter  <[email protected]>

	* generic/tclInterp.c:	Reverted the conversion of [interp] into an
	* tests/interp.test:	ensemble.  Such conversion is not necessary
	* tests/nre.test:	(or even all that helpful) in the NRE-enabling
	of [interp invokehidden], and it has other implications -- including
	significant forkage of the 8.5 and 8.6 implementations -- that are
	better off avoided if there's no gain.

	* generic/tclStringObj.c (STRING_NOMEM):  [Bug 2494093]: Add missing
	cast of NULL to (char *) that upsets some compilers.

	* generic/tclStringObj.c (Tcl_(Attempt)SetObjLength):	[Bug 2553906]:
	Added protections against callers asking for negative lengths.  It is
	likely when this happens that an integer overflow is to blame.

2009-02-01  David Gravereaux  <[email protected]>

	* win/makefile.vc: Allow nmake flags such as -a (rebuild all) to pass
	down to the pkgs targets, too.

2009-01-30  Donal K. Fellows  <[email protected]>

	* doc/chan.n: [Bug 1216074]: Added another extended example.

	* doc/refchan.n: Added an example of how to build a scripted channel.

2009-01-29  Donal K. Fellows  <[email protected]>

	* tests/stringObj.test: [Bug 2006888]: Remove non-ASCII chars from
	non-comment locations in the file, making it work more reliably in
	locales with a non-Latin-1 default encoding.

	* generic/tclNamesp.c (Tcl_FindCommand): [Bug 2519474]: Ensure that
	the path is not searched when the TCL_NAMESPACE_ONLY flag is given.

	* generic/tclOODecls.h (Tcl_OOInitStubs): [Bug 2537839]: Make the
	declaration of this macro work correctly in the non-stub case.

2009-01-29  Don Porter  <[email protected]>

	* generic/tclInterp.c:	Convert the [interp] command into a
	* tests/interp.test:	[namespace ensemble].  Work in progress
	* tests/nre.test:	to NRE-enable the [interp invokehidden]
	subcommand.

2009-01-29  Donal K. Fellows  <[email protected]>

	* generic/tclNamesp.c (TclMakeEnsemble): [Bug 2529117]: Make this
	function behave more sensibly when presented with a fully-qualified
	name, rather than doing strange stuff.

2009-01-28  Donal K. Fellows  <[email protected]>

	* generic/tclBasic.c (TclInvokeObjectCommand): Made this understand
	what to do if it ends up being used on a command with no objProc; that
	shouldn't happen, but...

	* generic/tclNamesp.c (TclMakeEnsemble): [Bug 2529157]: Made this
	understand NRE command implementations better.
	* generic/tclDictObj.c (DictForCmd): Eliminate unnecessary command
	implementation.

2009-01-27  Donal K. Fellows  <[email protected]>

	* generic/tclOODefineCmds.c (Tcl_ClassSetConstructor):
	[Bug 2531577]: Ensure that caches of constructor chains are cleared
	when the constructor is changed.

2009-01-26  Alexandre Ferrieux  <[email protected]>

	* generic/tclInt.h:   [Bug 1028264]: WSACleanup() too early.
	* generic/tclEvent.c: The fix introduces "late exit handlers" for
	* win/tclWinSock.c:   similar late process-wide cleanups.

2009-01-26  Alexandre Ferrieux  <[email protected]>

	* win/tclWinSock.c: [Bug 2446662]: Resync Win behavior on RST with
	that of unix (EOF).

2009-01-26  Donal K. Fellows  <[email protected]>

	* generic/tclZlib.c (ChanClose): [Bug 2536400]: Only generate error
	messages in the interpreter when the thread is not being closed down.

2009-01-23  Donal K. Fellows  <[email protected]>

	* doc/zlib.n: Added a note that 'zlib push' is reversed by 'chan pop'.

2009-01-22  Jan Nijtmans  <[email protected]>

	* generic/tclCompile.h:	CONSTify TclPrintInstruction (TIP #27)
	* generic/tclCompile.c
	* generic/tclInt.h:	CONSTify TclpNativeJoinPath (TIP #27)
	* generic/tclFileName.c
	* generic/tcl.decls:	{unix win} is equivalent to {generic}
	* generic/tclInt.decls
	* generic/tclDecls.h:	(regenerated)
	* generic/tclIntDecls.h
	* generic/tclGetDate.y:	Single internal const decoration.
	* generic/tclDate.c:

2009-01-22  Kevin B. Kenny  <[email protected]>

	* unix/tcl.m4: Corrected a typo ($(SHLIB_VERSION) should be
	${SHLIB_VERSION}).
	* unix/configure: Autoconf 2.59

2009-01-21  Andreas Kupries  <[email protected]>

	* generic/tclIORChan.c (ReflectClose): [Bug 2458202]:
	* generic/tclIORTrans.c (ReflectClose): Closing a channel may supply
	NULL for the 'interp'. Test for finalization needs to be different,
	and one place has to pull the interp out of the channel instead.

2009-01-21  Don Porter  <[email protected]>

	* generic/tclStringObj.c: New fix for [Bug 2494093] replaces the
	flawed attempt committed 2009-01-09.

2009-01-19  Kevin B. Kenny  <[email protected]>

	* unix/Makefile.in: [Patch 907924]:Added a CONFIG_INSTALL_DIR
	* unix/tcl.m4:      parameter so that distributors can control where
	tclConfig.sh goes. Made the installation of 'ldAix' conditional upon
	actually being on an AIX system. Allowed for downstream packagers to
	customize SHLIB_VERSION on BSD-derived systems. Thanks to Stuart
	Cassoff for his help.
	* unix/configure: Autoconf 2.59

2009-01-19  David Gravereaux  <[email protected]>

	* win/build.vc.bat: Improved tools detection and error message
	* win/makefile.vc: Reorganized the $(TCLOBJ) file list into seperate
	parts for easier maintenance. Matched all sources built using -GL to
	both $(lib) and $(link) to use -LTCG and avoid a warning message.
	Addressed the over-building nature of the htmlhelp target by moving
	from a pseudo target to a real target dependent on the entire docs/
	directory contents.
	* win/nmakehlp.c: Removed -g option and GrepForDefine() func as it
	isn't being used anymore. The -V option method is much better.

2009-01-16  Don Porter  <[email protected]>

	* generic/tcl.h:	Bump patchlevel to 8.6b1.1 to distinguish
	* library/init.tcl:	CVS snapshots from the 8.6b1 and 8.6b2 releases
	* unix/configure.in:	and to deal with the fact that the 8.6b1
	* win/configure.in:	version of init.tcl will not [source] in the
	HEAD version of Tcl.

	* unix/configure:	autoconf-2.59
	* win/configure:

2009-01-14  Don Porter  <[email protected]>

	* generic/tclBasic.c (Tcl_DeleteCommandFromToken):	Reverted most
	of the substance of my 2009-01-12 commit. NULLing the objProc field of
	a Command when deleting it is important so that tests for certain
	classes of commands don't return false positives when applied to
	deleted command tokens. Overall change is now just replacement of a
	false comment with a true one.

2009-01-13  Jan Nijtmans  <[email protected]>

	* unix/tcl.m4: [Bug 2502365]: Building of head on HPUX is broken when
	using the native CC.
	* unix/configure (autoconf-2.59)

2009-01-13  Donal K. Fellows  <[email protected]>

	* generic/tclCmdMZ.c (Tcl_ThrowObjCmd):	Move implementation of [throw]
	* library/init.tcl (throw):		to C from Tcl.

2009-01-12  Don Porter  <[email protected]>

	* generic/tclBasic.c (Tcl_DeleteCommandFromToken): One consequence of
	the NRE rewrite is that there are now situations where a NULL objProc
	field in a Command struct is perfectly normal. Removed an outdated
	comment in Tcl_DeleteCommandFromToken that claimed we use
	cmdPtr->objPtr==NULL as a test of command validity. In fact we use
	cmdPtr->flags&CMD_IS_DELETED to perform that test. Also removed the
	setting to NULL, since any extension following the advice of the old
	comment is going to be broken by NRE anyway, and needs to shift to
	flag-based testing (or stop intruding into such internal matters).
	Part of [Bug 2486550].

2009-01-09  Don Porter  <[email protected]>

	* generic/tclStringObj.c (STRING_SIZE): [Bug 2494093]: Corrected
	failure to limit memory allocation requests to the sizes that can be
	supported by Tcl's memory allocation routines.

2009-01-09  Donal K. Fellows  <[email protected]>

	* generic/tclNamesp.c (NamespaceEnsembleCmd): [Bug 1558654]: Error out
	when someone gives wrong # of args to [namespace ensemble create].

2009-01-08  Don Porter  <[email protected]>

	* generic/tclStringObj.c (STRING_UALLOC): [Bug 2494093]: Added missing
	parens required to get correct results out of things like
	STRING_UALLOC(num + append).

2009-01-08  Donal K. Fellows  <[email protected]>

	* generic/tclDictObj.c, generic/tclIndexObj.c, generic/tclListObj.c,
	* generic/tclObj.c, generic/tclStrToD.c, generic/tclUtil.c,
	* generic/tclVar.c: Generate errorcodes for the error cases which
	approximate to "I can't interpret that string as one of those" and
	"You gave me the wrong number of arguments".

2009-01-07  Donal K. Fellows  <[email protected]>

	* doc/dict.n: [Tk Bug 2491235]: Added more examples.

	* tests/oo.test (oo-22.1): Adjusted test to be less dependent on the
	specifics of how [info frame] reports general frame information, and
	instead to focus on what methods add to it; that's really what the
	test is about anyway.

2009-01-06  Don Porter  <[email protected]>

	* tests/stringObj.test:	Revise tests that demand a NULL Tcl_ObjType
	in certain values to construct those values with [testdstring] so
	there's no lack of robustness depending on the shimmer history of
	shared literals.

2009-01-06  Donal K. Fellows  <[email protected]>

	* generic/tclDictObj.c (DictIncrCmd): Corrected twiddling in internals
	of dictionaries so that literals can't get destroyed.

	* tests/expr.test: [Bug 2006879]: Eliminate non-ASCII char.

	* generic/tclOOInfo.c (InfoObjectMethodsCmd,InfoClassMethodsCmd):
	[Bug 2489836]: Only delete pointers that were actually allocated!

	* generic/tclOO.c (TclNRNewObjectInstance, Tcl_NewObjectInstance):
	[Bug 2481109]: Perform search for existing commands in right context.

2009-01-05  Donal K. Fellows  <[email protected]>

	* generic/tclCmdMZ.c (TclNRSourceObjCmd): [Bug 2412068]: Make
	* generic/tclIOUtil.c (TclNREvalFile):    implementation of the
	[source] command be NRE enabled so that [yield] inside a script
	sourced in a coroutine can work.

2009-01-04  Donal K. Fellows  <[email protected]>

	* generic/tclCmdAH.c: Tidy up spacing and code style.

2009-01-03  Kevin B. Kenny  <[email protected]>

	* library/clock.tcl (tcl::clock::add): Fixed error message formatting
	in the case where [clock add] is presented with a bad switch.
	* tests/clock.test (clock-65.1) Added a test case for the above
	problem [Bug 2481670].

2009-01-02  Donal K. Fellows  <[email protected]>

	* unix/tcl.m4 (SC_CONFIG_CFLAGS): [Bug 878333]: Force the use of the
	compatibility version of mkstemp() on IRIX.
	* unix/configure.in, unix/Makefile.in (mkstemp.o):
	* compat/mkstemp.c (new file): [Bug 741967]: Added a compatibility
	implementation of the mkstemp() function, which is apparently needed
	on some platforms.

	******************************************************************
	*** CHANGELOG ENTRIES FOR 2008 IN "ChangeLog.2008"             ***
	*** CHANGELOG ENTRIES FOR 2006-2007 IN "ChangeLog.2007"        ***
	*** CHANGELOG ENTRIES FOR 2005 IN "ChangeLog.2005"             ***
	*** CHANGELOG ENTRIES FOR 2004 IN "ChangeLog.2004"             ***
	*** CHANGELOG ENTRIES FOR 2003 IN "ChangeLog.2003"             ***
	*** CHANGELOG ENTRIES FOR 2002 IN "ChangeLog.2002"             ***
	*** CHANGELOG ENTRIES FOR 2001 IN "ChangeLog.2001"             ***
	*** CHANGELOG ENTRIES FOR 2000 IN "ChangeLog.2000"             ***
	*** CHANGELOG ENTRIES FOR 1999 AND EARLIER IN "ChangeLog.1999" ***
	******************************************************************
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































Deleted ChangeLog.1999.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
1999-12-22  Jeff Hobbs  <[email protected]>

	* changes: updated changes file
	* tools/tclSplash.bmp: updated to show 8.3

1999-12-21  Jeff Hobbs  <[email protected]>

	* README:
	* generic/tcl.h:
	* mac/README:
	* unix/configure.in:
	* tools/tcl.wse.in:
	* win/README.binary:
	* win/configure.in: updated to patch level 8.3b1

	* unix/Makefile.in: added -srcdir=... for 'make html'

	* doc/Hash.3: fixed reference to ckfree [Bug 3912]
	* doc/RegExp.3: fixed calling params for Tcl_RegExecFromObj
	* doc/open.n: fixed minor formatting errors
	* doc/string.n: fixed minor formatting errors

	* doc/lsort.n: added -unique docs
	* tests/cmdIL.test:
	* generic/tclCmdIL.c: added -unique option to lsort

	* generic/tclThreadTest.c: changed thread ids to longs [Bug 3902]

	* mac/tclMacOSA.c: fixed applescript for I18N [Bug 3644]

	* win/mkd.bat:
	* win/rmd.bat: removed necessity of tag.txt [Bug 3874]

	* win/tclWinThrd.c: changed CreateThread to _beginthreadex and
	ExitThread to _endthreadex

1999-12-12  Jeff Hobbs  <[email protected]>

	* doc/glob.n:
	* tests/fileName.test:
	* generic/tclInt.decls:
	* generic/tclInt.h:
	* generic/tclIntDecls.h:
	* generic/tclStubInit.c:
	* generic/tclEncoding.c:
	* generic/tclFileName.c:
	* mac/tclMacFile.c:
	* unix/tclUnixFile.c:
	* win/tclWinFile.c: enhanced the glob command with the new options
	-types -path -directory and -join. Deprecated TclpMatchFiles with
	TclpMatchFilesTypes, extended TclGlob and TclDoGlob and added
	GlobTypeData structure. [Bug 2363]

1999-12-10  Jeff Hobbs  <[email protected]>

	* tests/var.test:
	* generic/tclCompile.c: fixed problem where setting to {} array would
	intermittently not work. [Bug 3339] (Fontaine)

	* generic/tclCmdMZ.c:
	* generic/tclExecute.c: optimized INST_TRY_CVT_TO_NUMERIC to recognize
	boolean objects. [Bug 2815] (Spjuth)

	* tests/info.test:
	* tests/parseOld.test:
	* generic/tclCmdAH.c:
	* generic/tclProc.c: changed Tcl_UplevelObjCmd (uplevel) and
	Tcl_EvalObjCmd (eval) to use TCL_EVAL_DIRECT in the single arg case as
	well, to take advantage of potential pure list input optimization.
	This means that it won't get byte compiled though, which should be
	acceptable.
	* generic/tclBasic.c: made Tcl_EvalObjEx pure list object aware in the
	TCL_EVAL_DIRECT case for efficiency.
	* generic/tclUtil.c: made Tcl_ConcatObj pure list object aware, and
	return a list object in that case [Bug 2098 2257]

	* generic/tclMain.c: changed Tcl_Main to not constantly reuse the
	commandPtr object (interactive case) as it could be shared. (Fellows)

	* unix/configure.in:
	* unix/tcl.m4:
	* unix/tclUnixPipe.c: removed checking for compatible vfork function
	and use of the vfork function. Modern VM systems rarely suffer any
	performance degradation when fork is used, and it solves multiple
	problems with vfork. Users that still want vfork can add -Dfork=vfork
	to the compile flags. [Bug 942 2228 1312]

1999-12-09  Jeff Hobbs  <[email protected]>

	* win/aclocal.m4: made it just include tcl.m4

	* doc/exec.n:
	* doc/open.n:
	* win/tclWin32Dll.c:
	* win/tclWinChan.c:
	* win/tclWinFCmd.c:
	* win/tclWinInit.c:
	* win/tclWinPipe.c:
	* win/tclWinSock.c: removed all code that supported Win32s. It was no
	longer officially supported, and likely didn't work anyway.
	* win/makefile.vc: removed 16 bit stuff, cleaned up.

	* win/tcl16.rc:
	* win/tclWin16.c:
	* win/winDumpExts.c: these files have been removed from the source
	tree (no longer necessary to build)

1999-12-07  Jeff Hobbs  <[email protected]>

	* tests/io.test: removed 'knownBug' tests that were for unsupported0,
	which is now fcopy (that already has tests)

	* mac/tclMacPort.h: added utime.h include

	* generic/tclDate.c:
	* unix/Makefile.in: fixed make gendate to swap const with CONST so it
	uses the Tcl defined CONST type [Bug 3521]

	* generic/tclIO.c: removed panic that could occur in FlushChannel when
	a "blocking" channel would receive EAGAIN, instead treating it the
	same as non-blocking. [Bug 3773]

	* generic/tclUtil.c: fixed Tcl_ScanCountedElement to not step beyond
	the end of the counted string. [Bug 3336]

1999-12-03  Jeff Hobbs  <[email protected]>

	* doc/load.n: added note about NT's buggy handling of './' with
	LoadLibrary

	* library/http2.1/http.tcl: fixed error handling in http::Event. [Bug
	3752]

	* tests/env.test: removed knownBug limitation from working test
	* tests/all.tcl: ensured that ::tcltest::testsDirectory would be set
	to an absolute path

	* tests/expr-old.test:
	* tests/parseExpr.test:
	* tests/string.test:
	* generic/tclGet.c:
	* generic/tclInt.h:
	* generic/tclObj.c:
	* generic/tclParseExpr.c:
	* generic/tclUtil.c:
	* generic/tclExecute.c: added TclCheckBadOctal routine to enhance
	error message checking for when users use invalid octal numbers (like
	08), as well as replumbed the Expr*Funcs with a new VerifyExprObjType
	to simplify type handling. [Bug 2467]

	* tests/expr.test:
	* generic/tclCompile.c: fixed 'bad code length' error for 'expr +
	{[incr]}' case, with new test case [Bug 3736] and seg fault on 'expr
	+ {[error]}' (different cause) that was caused by a correct
	optimization that didn't correctly track how it was modifying the
	source string in the opt. The optimization was removed, which means
	that:
		expr 1 + {[string length abc]}
	will be not be compiled inline as before, but this should be written:
		expr {1 + [string length abc]}
	which will be compiled inline for speed. This prevents:
		expr 1 + {[mindless error]}
	from seg faulting, and only affects optimizations for degenerate cases
	[Bug 3737]

1999-12-01  Scott Redman <[email protected]>

	* generic/tcl.decls:
	* generic/tclMain.c:
	* unix/tclAppInit.c:
	* win/tclAppInit.c: Added two new internal functions,
	TclSetStartupScriptFileName() and TclGetStartupScriptFileName() and
	added hooks into the main() code for supporting TclPro and other "big"
	shells more easily without requiring a copy of the main() code.

	* generic/tclEncoding.c:
	* generic/tclEvent.c: Moved encoding-related startup code from
	tclEvent.c into the more appropriate tclEncoding.c.

1999-11-30  Jeff Hobbs  <[email protected]>

	* generic/tclIO.c: fix from Kupries for	Tcl_UnstackChannel that
	correctly handles resetting translation and encoding.

	* generic/tclLoad.c: #def'd out the unloading of DLLs at finalize time
	for Unix in TclFinalizeLoad. [Bug 2560 3373] Should be parametrized
	to allow for user to specify unload or not.

	* win/tclWinTime.c: fixed handling of %Z on NT for time zones that
	don't have DST.

1999-11-29  Jeff Hobbs  <[email protected]>

	* library/dde1.1/pkgIndex.tcl:
	* library/reg1.0/pkgIndex.tcl: added supported for debugged versions
	of the libraries

	* unix/tclUnixPipe.c: fixed PipeBlockModeProc to properly set
	isNonBlocking flag on pipe. [Bug 1356 710]
	removed spurious fcntl call from PipeBlockModeProc

	* tests/scan.test:
	* generic/tclScan.c: fixed scan where %[..] didn't match anything and
	added test case. [Bug 3700]

1999-11-24  Jeff Hobbs  <[email protected]>

	* doc/open.n:
	* win/tclWinSerial.c: adopted patch from Schroedter to handle
	fconfigure $sock -lasterror on Windows. [RFE 3368]

	* generic/tclCmdIL.c: made SORTMODE_INTEGER work with Longs [Bug 3652]

1999-11-23  Scott Stanton  <[email protected]>

	* library/tcltest1.0/tcltest.tcl: Fixed bug where tcltest output went
	to stdout instead of the specified output file in some cases.

1999-11-19  Jeff Hobbs  <[email protected]>

	* generic/tclProc.c: backed out change from 1999-11-18 as it could
	affect return string from upvar as well.

	* tools/tcl.wse.in: added tcltest1.0 library to distribution list

	* doc/http.n:
	* library/http2.1/http.tcl:
	* library/http2.1/pkgIndex.tcl: updated http package to 2.2

1999-11-18  Jeff Hobbs  <[email protected]>

	* unix/tcl.m4: added defined for _THREAD_SAFE in --enable-threads
	case; added check for pthread_mutex_init in libc; in AIX case, with
	--enable-threads ${CC}_r is used; fixed flags when using gcc on SCO

	* generic/tclProc.c: corrected error reporting for default case at the
	global level for uplevel command.

	* generic/tclIOSock.c: changed int to size_t type for len in
	TclSockMinimumBuffers.

	* generic/tclCkalloc.c: fixed Tcl_DbCkfree to return a value on NULL
	input. [Bug 3400]

	* generic/tclStringObj.c: fixed support for passing in negative length
	to Tcl_SetUnicodeObj, et al handling routines. [Bug 3380]

	* doc/scan.n:
	* tests/scan.test:
	* generic/tclScan.c: finished support for inline scan by supporting
	XPG identifiers.

	* doc/http.n:
	* library/http2.1/http.tcl: added register and unregister commands to
	http:: package (better support for tls/SSL), as well as -type argument
	to http::geturl. [RFE 2617]

	* generic/tclBasic.c: removed extra decr of numLevels in Tcl_EvalObjEx
	that could cause seg fault. ([email protected])

	* generic/tclEvent.c: fixed possible lack of MutexUnlock in
	Tcl_DeleteExitHandler. [Bug 3545]

	* unix/tcl.m4: Added better pthreads library check and inclusion of
	_THREAD_SAFE in --enable-threads case
	Added support for gcc config on SCO

	* doc/glob.n: added note about ..../ glob behavior on Win9*
	* doc/tcltest.n: fixed minor example errors. [Bug 3551]

1999-11-17 Brent Welch <[email protected]>

	* library/http2.1/http.tcl: Correctly fixed the -timeout problem
	mentioned in the 10-29 change. Also added error handling for failed
	writes on the socket during the protocol.

1999-11-09  Jeff Hobbs  <[email protected]>

	* doc/open.n: corrected docs for 'a' open mode.

	* generic/tclIOUtil.c: changed Tcl_Alloc to ckalloc

	* generic/tclInt.h:
	* generic/tclObj.c: rolled back changes from 1999-10-29
	Purify noted new leaks with that code

	* generic/tclParse.c: added code in Tcl_ParseBraces to test for
	possible unbalanced open brace in a comment

	* library/init.tcl: removed the installed binary directory from the
	auto_path variable

	* tools/tcl.wse.in: updated to 8.3a1, fixed install of twind.tcl and
	koi8-r.enc files

	* unix/tcl.m4: added recognition of pthreads library for AIX

1999-10-29  Brent Welch <[email protected]>

	* generic/tclInt.h: Modified the TclNewObj and TclDecrRefCount in two
	ways. First, in the case of TCL_THREADS, we do not use the special
	Tcl_Obj allocator because that is a source of lock contention. Second,
	general code cleanup to eliminate duplicated code. In particular,
	TclDecrRefCount now uses TclFreeObj instead of duplicating that code,
	so it is now identical to Tcl_DecrRefCount.

	* generic/tclObj.c: Changed Tcl_NewObj so it uses the TclNewObj macro
	instead of duplicating the code. Adjusted TclFreeObj so it understands
	the TCL_THREADS case described above.

	* library/http2.1/http.tcl: Fixed a bug in the handling of the
	state(status) variable when the -timeout flag is specified. Previously
	it was possible to leave the status undefined instead of empty, which
	caused errors in http::status

1999-10-28  Jeff Hobbs  <[email protected]>

	* unix/aclocal.m4: made it just include tcl.m4

	* library/tcltest1.0/tcltest.tcl: updated makeFile to return full
	pathname of file created

	* generic/tclStringObj.c: fixed Tcl_AppendStringsToObjVA so it only
	iterates once over the va_list (avoiding a memcpy of it, which is not
	portable).

	* generic/tclEnv.c: fixed possible ABR error in environ array

	* tests/scan.test:
	* generic/tclScan.c: added support for use of inline scan, XPG3
	currently not included

	* tests/incr.test:
	* tests/set.test:
	* generic/tclCompCmds.c: fixed improper bytecode handling of 'eval
	{set array($unknownvar) 5}' (also for incr). [Bug 3184]

	* win/tclWinTest.c: added testvolumetype command, as atime is
	completely ignored for Windows FAT file systems
	* win/tclWinPort.h: added sys/utime.h to includes
	* unix/tclUnixPort.h: added utime.h to includes
	* doc/file.n:
	* tests/cmdAH.test:
	* generic/tclCmdAH.c: added time arguments to atime and mtime file
	command methods (support 'touch' functionality)

1999-10-20  Jeff Hobbs  <[email protected]>

	* unix/tclUnixNotfy.c: fixed event/io threading problems by making
	triggerPipe non-blocking. [Bug 2792]

	* library/tcltest1.0/tcltest.tcl:
	* generic/tclThreadTest.c: fixed mem leaks in threads

	* generic/tclResult.c: fixed Tcl_AppendResultVA so it only iterates
	once over the va_list (avoiding a memcpy of it, which is not
	portable).

	* generic/regc_color.c: fixed mem leak and assertion, from HS

	* generic/tclCompile.c: removed savedChar trick that appeared to be
	causing a segv when the literal table was released

	* tests/string.test:
	* generic/tclCmdMZ.c: fixed [string index] to return ByteArrayObj when
	indexing into one (test case string-5.16). [Bug 2871]

	* library/http2.1/http.tcl: protected gets with catch. [Bug 2665]

1999-10-19  Jennifer Hom  <[email protected]>

	* tests/tcltest.test:
	* doc/tcltest.n:
	* library/tcltest1.0/tcltest.tcl: Removed the extra return at the end
	of the tcltest.tcl file, added version information about tcl.

	Applied patches sent in by Andreas Kupries to add helper procs for
	debug output, add 3 new flags (-testsdir, -load, -loadfile), and
	internally refactors common code for dealing with paths into separate
	procedures. [Bug 2838, 2842]

	Merged code from core-8-2-1 branch that changes the checks for the
	value of tcl_interactive to also incorporate a check for the existence
	of the variable.

	* tests/autoMkindex.test:
	* tests/pkgMkIndex.test: Explicitly cd to ::tcltest::testsDirectory at
	the beginning of the test run

	* tests/basic.test: Use version information defined in tcltest instead
	of hardcoded version number

	* tests/socket.test: package require tcltest before attempting to use
	variable defined in tcltest namespace

	* tests/unixInit.test:
	* tests/unixNotfy.test: Added explicit exits needed to avoid problems
	when the tests area run in wish.

1999-10-12  Jim Ingham  <[email protected]>

	* mac/tclMacLoad.c: Stupid bug - we converted the filename to
	external, but used the unconverted version.
	* mac/tclMacFCmd.c: Fix a merge error in the bug fix for [Bug 2869]

1999-10-12  Jeff Hobbs  <[email protected]>

	* generic/regc_color.c:
	* generic/regc_cvec.c:
	* generic/regc_lex.c:
	* generic/regc_locale.c:
	* generic/regcomp.c:
	* generic/regcustom.h:
	* generic/regerrs.h:
	* generic/regex.h:
	* generic/regexec.c:
	* generic/regguts.h:
	* generic/tclRegexp.c:
	* generic/tclTest.c:
	* tests/reg.test: updated to Henry Spencer's new regexp engine
	(mid-Sept 99). Should greatly reduce stack space reqs.

	* library/tcltest1.0/pkgIndex.tcl: fixed procs in pkgIndex.tcl file

	* generic/tclEnv.c: fixed mem leak with putenv and DStrings
	* doc/Encoding.3: corrected docs
	* tests/basic.test: updated test cases for 8.3
	* tests/encoding.test: fixed test case that change system encoding to
	a double-byte one (this causes a bogus mem read error for purify)
	* unix/Makefile.in: purify has to use -best-effort to instrument
	* unix/tclAppInit.c: identified potential mem leak when compiling
	tcltest (not critical)
	* unix/tclUnixPipe.c: fixed mem leak in TclpCreateProcess when doing
	alloc between vfork and execvp.
	* unix/tclUnixTest.c: fixed mem leak in findexecutable test command

1999-10-05  Jeff Hobbs  <[email protected]>

	* {win,mac,unix,tools,}/README:
	* win/README.binary:
	* win/makefile.vc:
	* {win,unix}/configure.in:
	* generic/tcl.h:
	* library/init.tcl: updated to 8.3a1 from 8.2.0.

	* library/http2.1/http.tcl: fixed possible use of global c var.

	* win/tclWinReg.c: fixed registry command to properly 'get'
	HKEY_PERFORMANCE_DATA root key data. Needs more work.

	* generic/tclNamesp.c:
	* generic/tclVar.c:
	* generic/tclCmdIL.c: fixed comment typos

	* mac/tclMacFCmd.c: fixed filename stuff to support UTF-8. [Bug 2869]

	* win/tclWinSerial.c: changed SerialSetOptionProc to return TCL_OK by
	default. (patch from Rolf Schroedter)

1999-09-21  Jennifer Hom  <[email protected]>

	* library/tcltest1.0/tcltest.tcl: Applied patches sent in by Andreas
	Kupries to fix typos in comments and ::tcltest::grep, fix hook
	redefinition problems, and change "string compare" to "string equal".
	[Bug 2836, 2837, 2839, 2840]

1999-09-20  Jeff Hobbs  <[email protected]>

	* tests/env.test:
	* unix/Makefile.in: added support for AIX LIBPATH env var. [Bug 2793]
	removed second definition of INCLUDE_INSTALL_DIR (the one that
	referenced @includedir@) [Bug 2805]
	* unix/dltest/Makefile.in: added -lc to LIBS. [Bug 2794]

1999-09-16  Jeff Hobbs  <[email protected]>

	* tests/timer.test: changed after delay in timer test 6.29 from 1 to
	10. [Bug 2796]

	* tests/pkg.test:
	* generic/tclPkg.c: fixed package version check to disallow 1.2..3
	[Bug 2539]

	* unix/Makefile.in: fixed gendate target - this never worked since RCS
	was intro'd.
	* generic/tclGetDate.y: updated to reflect previous changes to
	tclDate.c (leap year calc) and added CEST and UCT time zone
	recognition. Fixed 4 missing UCHAR() casts. [Bug 2717, 954, 1245,
	1249]

	* generic/tclCkalloc.c: changed Tcl_DumpActiveMemory to really dump to
	stderr and close it [Bug 725] and changed Tcl_Ckrealloc and
	Tcl_Ckfree to not bomb when NULL was passed in [Bug 1719] and changed
	Tcl_Alloc, et al to not panic when a alloc request for zero came
	through and NULL was returned (valid on AIX, Tru64) [Bug 2795, etc]

	* tests/clock.test:
	* doc/clock.n:
	* generic/tclClock.c: added -milliseconds switch to clock clicks to
	guarantee that the return value of clicks is in the millisecs
	granularity. [Bug 2682, 1332]

1999-09-15  Jeff Hobbs  <[email protected]>

	* generic/tclIOCmd.c: fixed potential core dump in conjunction with
	stacked channels with result obj manipulation in Tcl_ReadChars. [Bug
	2623]

	* tests/format.test:
	* generic/tclCmdAH.c: fixed translation of %0#s in format. [Bug 2605]

	* doc/msgcat.n: fixed \\ bug in example. [Bug 2548]

	* unix/tcl.m4:
	* unix/aclocal.m4: added fix for FreeBSD-[1-2] recognition [Bug 2070]
	and fix for IRIX SHLIB_LB_LIBS. [Bug 2610]

	* doc/array.n:
	* tests/var.test:
	* tests/set.test:
	* generic/tclVar.c: added an array unset operation, with docs and
	tests. Variation of [Bug 1775]. Added fix in TclArraySet to check
	when trying to set in a non-existent namespace. [Bug 2613]

1999-09-14  Jeff Hobbs  <[email protected]>

	* tests/linsert.test:
	* doc/linsert.n:
	* generic/tclCmdIL.c: fixed end-int interpretation of linsert to
	correctly calculate value for end, added test and docs. [Bug 2693]

	* doc/regexp.n:
	* doc/regsub.n:
	* tests/regexp.test:
	* generic/tclCmdMZ.c: add -start switch to regexp and regsub with docs
	and tests

	* doc/switch.n: added proper use of comments to example.
	* generic/tclCmdMZ.c: changed switch to complain when an error occurs
	that seems to be due to a misplaced comment.

	* generic/tclCmdMZ.c: fixed illegal ref for \[0-9] substitutions in
	regsub. [Bug 2723]

	* generic/tclCmdMZ.c: changed [string equal] to return an Int type
	object (was a Boolean)

1999-09-01  Jennifer Hom  <[email protected]>

	* library/tcltest1.0/tcltest.tcl: Process command-line arguments only
	::tcltest doesn't have a child namespace (requires that command-line
	args are processed in that namespace)

1999-09-01  Jeff Hobbs  <[email protected]>

	* generic/tclParseExpr.c: changed '"' to '\"' to make FreeBSD happy.
	[Bug 2625]
	* generic/tclProc.c: moved static buf to better location and changed
	static msg that would overflow in ProcessProcResultCode [Bug 2483]
	and added Tcl_DStringFree to Tcl_ProcObjCmd. Also reworked size of
	static buffers.
	* tests/stringObj.test: added test 9.11
	* generic/tclStringObj.c: changed Tcl_AppendObjToObj to properly
	handle the 1-byte dest and mixed src case where both had had Unicode
	string len checks made on them. [Bug 2678]
	* unix/aclocal.m4:
	* unix/tcl.m4: adjusted fix from 8-21 to add -bnoentry to the AIX-*
	case and readjusted the range

1999-08-31  Jennifer Hom  <[email protected]>

	* library/tcltest1.0/tcltest.tcl:
	* doc/tcltest.n:
	* tests/README: Modified testConstraints variable so that it isn't
	unset every time ::tcltest::initConstraints is called and cleaned up
	documentation in the README file and the man page.

1999-08-27  Jennifer Hom  <[email protected]>

	* tests/env.test:
	* tests/exec.test:
	* tests/io.test:
	* tests/event.test:
	* tests/tcltest.test: Added 'exit' calls to scripts that the tests
	themselves write, and removed accidental checkin of knownBugThreaded
	constraints for Solaris and Linux.

	* library/tcltest1.0/tcltest.tcl: Modified tcltest so that variables
	are only initialized to their default values if they did not
	previously exist.

1999-08-26  Jennifer Hom  <[email protected]>

	* tests/tcltest.test:
	* library/tcltest1.0/tcltest.tcl: Added a -args flag that sets a
	variable named ::tcltest::parameters based on whatever's being sent in
	as the argument to the -args flag.

1999-08-23  Jennifer Hom  <[email protected]>

	* tests/tcltest.test: Added additional tests for -tmpdir, marked all
	tests that use exec as unixOrPc.

	* tests/encoding.test:
	* tests/interp.test:
	* tests/macFCmd.test:
	* tests/parseOld.test:
	* tests/regexp.test: Applied patches from Jim Ingham to add encoding
	to a Mac only interp test, change an error message in macFCmd.tet, put
	a comment in parseOld.test, fix tests using the testencoding path
	command, and put unixOrPc constraints on tests that use exec.

1999-08-21  Jeff Hobbs  <[email protected]>

	* unix/aclocal.m4: Changed AIX-4.[2-9] check to AIX-4.[1-9] [Bug 1909]

1999-08-20  Jeff Hobbs  <[email protected]>

	* generic/tclPosixStr.c: fixed typo. [Bug 2592]

	* doc/*: fixed various nroff bugs in man pages. [Bug 2503 2588]

1999-08-19  Jeff Hobbs  <[email protected]>

	* win/README.binary: fixed version info and some typos. [Bug 2561]

	* doc/interp.n: updated list of commands available in a safe
	interpreter. [Bug 2526]

	* generic/tclIO.c: changed Tcl_GetChannelNames* to use style guide
	headers (pleases HP cc)

1999-08-18  Jeff Hobbs  <[email protected]>

	* doc/Eval.3: fixed doc on input args. [Bug 2114]

	* doc/OpenFileChnl.3:
	* doc/file.n:
	* tests/cmdAH.test:
	* tclIO.c:
	* tclCmdAH.c: added "file channels ?pattern?" tcl command, with
	associated Tcl_GetChannelNames and Tcl_GetChannelNamesEx public C APIs
	(added to tcl.decls as well), with docs and tests.

	* tests/expr.test:
	* generic/tclCompile.c: add TCL_TOKEN_VARIABLE to the part types that
	cause differed compilation for exprs, to correct the expr
	double-evaluation problem for vars. Added test cases. Related to [Bug
	732]

	* unix/Makefile.in: changed the dependency structure so that install-*
	is dependent on * (ie - install-binaries is dependent on binaries).

	* library/auto.tcl:
	* library/init.tcl:
	* library/ldAout.tcl:
	* library/package.tcl:
	* library/safe.tcl:
	* library/word.tcl:
	* library/http2.1/http.tcl:
	* library/msgcat1.0/msgcat.tcl: updated libraries to better Tcl style
	guide (no more string comparisons with == or !=, spacing changes).

1999-08-05  Jim Ingham  <[email protected]>

	* mac/tclMacProjects.sea.hqx: Rearrange the projects so that the build
	directory is separate from the sources. Much more convenient!

1999-08-13  Scott Redman <[email protected]>

	* /: 8.2.0 tagged for final release

1999-08-12  Scott Stanton  <[email protected]>

	* win/Makefile.in: Added COMPILE_DEBUG_FLAGS macro to make it easier
	to turn on compiler tracing.

	* tests/parse.test:
	* generic/tclParse.c: Fixed bug in Tcl_EvalEx where the termOffset was
	not being updated in cases where the evaluation returned a non TCL_OK
	error code. [Bug 2535]

1999-08-12  Scott Redman  <[email protected]>

	* win/tclWinSerial.c: Applied patch from Petteri Kettunen to remove
	compiler warning.

1999-08-10  Scott Redman  <[email protected]>

	* generic/tclAlloc.c:
	* generic/tclCmdIL.c:
	* generic/tclIO.c:
	* generic/tclThread.c:
	* win/tclWinThrd.c:
	* unix/tclUnixThrd.c: Fixed Brent's changes so that they work on
	Windows (and he fixed the bug in the Unix thread implementation).

1999-08-09  Brent Welch  <[email protected]>

	* generic/tcl.decls:
	* generic/tclAlloc.c:
	* generic/tclCkalloc.c:
	* generic/tclCmdIL.c:
	* generic/tclDecls.h:
	* generic/tclIO.c:
	* generic/tclInt.decls:
	* generic/tclIntDecls.h:
	* generic/tclStubInit.c:
	* generic/tclVar.c:
	* mac/tclMacThrd.c:
	* unix/tclUnixThrd.c:
	* win/tclWinThrd.c: Added use of Tcl_GetAllocMutex to tclAlloc.c and
	tclCkalloc.c so they can be linked against alternate thread packages.
	Added Tcl_GetChannelNames to tclIO.c. Added TclVarTraceExists hook so
	"info exists" triggers read traces exactly like it did in Tcl 7.6.
	Stubs table changes to reflect new internal and external APIs.

1999-08-09  Jeff Hobbs  <[email protected]>

	* tests/string.test: added largest_int proc to adapt for >32 bit
	machines and int overflow testing.
	* tests/tcltest.test: fixed minor error in 8.2 result (from dgp)

	* doc/Object.3: clarified Tcl_DecrRefCount docs. [Bug 1952]
	* doc/array.n: clarified array pattern docs. [Bug 1330]
	* doc/clock.n: fixed clock docs. [Bug 693]
	* doc/lindex.n: clarified to account for new end-int behavior.
	* doc/string.n: fixed formatting errors. [Bug 2188 2189]
	* doc/tclvars.n: fixed doc error. [Bug 2042]
	* library/init.tcl: fixed path handling in auto_execok (it could miss
	including the normal path on some Windows machines). [Bug 1276]

1999-08-05  Jeff Hobbs  <[email protected]>

	* doc/tclvars.n: Made it clear that tcl_pkgPath was not set for
	Windows (already mentioned in init.tcl). [Bug 2455]
	* generic/tclLiteral.c: fixed reference to bytes that might not be
	null terminated (using objPtr->bytes, which is). [Bug 2496]
	* library/http2.1/http.tcl: Made use of "i" in init section use local
	var and start at 0 (was 1). [Bug 2502]

1999-08-04  Scott Stanton  <[email protected]>

	* tests/reg.test: Added test for REG_EXPECT bug fixed by Henry's
	patch.

	* generic/regc_nfa.c:
	* generic/regcomp.c:
	* generic/rege_dfa.c:
	* generic/regexec.c:
	* generic/regguts.h: Applied patches supplied by Henry Spencer to
	greatly enhance the performance of certain classes of regular
	expressions. [Bug 2440, 2447]

1999-08-03  Scott Redman  <[email protected]>

	* win/tclWinInt.h: Remove function declarations in header that was
	moved to tclInt.decls file in previous changes.

1999-08-02  Scott Redman  <[email protected]>

	* unix/configure.in:
	* win/configure.in: Change beta level to b2.

	* generic/tcl.h:
	* generic/tcl.decls:
	* generic/tclDecls.h:
	* generic/tclInt.h:
	* generic/tclInt.decls:
	* generic/tclIntDecls.h:
	* generic/tclRegexp.h:
	* generic/tclStubInit.c: Move some exported public and internal
	functions to the stub tables. Removed functions that are in the stub
	tables (from this and previous changes) from the original header
	files.

1999-08-01  Scott Redman  <[email protected]>

	* win/tclWinSock.c: Added comment block to SocketThread() function.
	Added code to avoid calling TerminateThread(), but instead to send a
	message to the socket event window to tell it to terminate its thread.

1999-07-30  Jennifer Hom  <[email protected]>

	* tests/tcltest.test:
	* library/tcltest1.0/tcltest.tcl: Exit with non-zero status if there
	were problems with the way the test suite was started (e.g. wrong #
	arguments).

1999-07-30  Jeff Hobbs  <[email protected]>

	* generic/tclInt.decls: added declaractions necessary for the Tcl test
	code to work wth stubs. [Bug 2445]

1999-07-30  Scott Redman  <[email protected]>

	* win/tclWinPipe.c:
	* win/Makefile.in: Fixing launching of 16-bit apps on Win9x from wish.
	The command line was primed with tclpip82.dll, but it was ignored.
	Fixed that, then fixed the gmake makefile to build tclpip82.dll as an
	executable.

	* win/tclWinSock.c: Applied small patch to get thread-specific data
	after initializing the socket driver.

	* unix/tclUnixThrd.c: Applied patch to fix threads on Irix 6.5. Patch
	from James Dennett. [Bug 2450]

	* tests/info.test: Enable test for tclParse.c change (info complete).

1999-07-30  Jeff Hobbs  <[email protected]>

	* tclIO.c: added fix for Kupries' trf patch. [Bug 2386]

	* tclParse.c: fixed bug in info complete regarding nested square
	brackets. [Bug 2382, 2466]

1999-07-29  Scott Redman  <[email protected]>

	* win/tclWinChan.c: Allow tcl to open CON and NUL, even for std
	channels. Checking for bad/unusable std channels was moved to Tk since
	its only purpose was to check whether to use the Tk Console Window for
	the std channels. [Bug 2393 2392 2209 2458]

	* unix/mkLinks.tcl: Applied patch to avoid linking pack.n to
	pack-old.n. Patch from Don Porter. [Bug 2469]

	* doc/Encoding.n: Applied patch to fix typo in .SH NAME line. Patch
	from Don Porter. [Bug 2451]

	* win/tclWinSock.c: Free Win32 Event handles when destroying the
	socket helper thread.

1999-07-28  Jennifer Hom  <[email protected]>

	* tests/tcltest.test:
	* library/tcltest1.0/tcltest.tcl: Fixed the condition under which
	::tcltest::PrintError had an infinite loop problem and added a test
	case for it. Added an optional argument to ::tcltest::getMatchingFiles
	telling it where to search for test files.

1999-07-27  Scott Redman  <[email protected]>

	* tools/tclSplash.bmp: Updated Windows installer bitmap to ready
	Tcl/Tk Version 8.2.

1999-07-26  Scott Redman  <[email protected]>

	* tests/tcltest.test: Need to close the new core file, there seems to
	be a hang in threaded WinNT if the file isn't closed. Open issue, need
	to fix that hang.

	* tests/httpold.test: Add time delay in response from Http server so
	that test cases can properly detect timeout conditions with threads
	enabled on multi-CPU WinNT.

	* tests/winFCmd.test: Test case winFcmd-1.33 was looking for
	c:\windows, which may not exist. Instead, create a new directory on
	c:\ and use it for the test.

	* win/tclWinConsole.c:
	* win/tclWinPipe.c:
	* win/tclWinSock.c: Fix terminating helper threads by holding any
	mutexes from the primary thread while waiting for the helper thread to
	terminate. Without these changes, the test suite hangs on WinNT with 2
	CPUs and threads enabled. Open issue, seems to be a sporadic hang on
	dual CPU systems still (very rare).

1999-07-26  Jennifer Hom  <[email protected]>

	* tests/tcltest.test:
	* library/tcltest1.0/tcltest.tcl:
	* doc/tcltest.n: Cleaned up code in ::tcltest::PrintError, revised
	documentation, and added tests for the tcltest package.

1999-07-23  Scott Redman  <[email protected]>

	* tests/info.test:
	* generic/tclParse.c: Removed patch for info command, breaks test
	cases on Unix. Patch was bad and needs to be redone properly. [Bug
	2382]

1999-07-22  Scott Redman  <[email protected]>

	* Changed version to 8.2b2.

	* win/tclWinSock.c: Fixed hang with threads enabled, fixed semaphores
	with threads disabled.

	* win/safe.test: Fixed safe-6.3 with threads enabled.

	* win/Makefile.in: Fixed calling of tcltest to fix safe.test failures
	due to path TCL_LIBRARY path.

	* win/tclWinPort.h: Block out include of sys/*.h in order to build
	extensions with MetroWerks compiler for Win32. [Bug 2385]

	* generic/tclCmdMZ.c:
	* generic/tclIO.c: Fix ANSI-style prototypes based on patch from
	Ulrich Ring. [Bug 2391]

	* unix/Makefile.in: Need to make install-sh executable before calling
	(with chmod +x). [Bug 2413]

	* tests/var.test:
	* generic/tclVar.c: Fixed bug that caused a seg. fault when using
	"array set a(b) {}", which is a bad array name anyway. Now the "array
	set" command will return an error in this case. Added test case and
	fixed existing test. [Bug 2427]

1999-07-21  Scott Redman  <[email protected]>

	* tests/info.test:
	* generic/tclParse.c: Applied patch to fix "info complete" for the
	string {[a [b]}. Patch from Peter Spjuth. [Bug 2382]

	* doc/Utf.3:
	* generic/tcl.decls:
	* generic/tclDecls.h:
	* generic/tclUtf.c: Changed function declarations in
	non-platform-specific public APIs to use "unsigned long" instead of
	"size_t", which may not be defined on certain compilers (rather than
	include sys/types.h, which may not exist).

	* unix/Makefile.in: Added the Windows configure script to the
	distribution file list, already shipping configure.in and the .m4
	files, but needed the configure script itself.

	* win/makefile.vc: Changed version number of DDE package in VC++
	makefile to use 1.1 instead of 1.0.

	* doc/open.n: Added documentation of \\.\comX notation for opening
	serial ports on Windows (alternative to comX:).

	* tests/ioCmd.test:
	* doc/open.n:
	* win/tclWinSerial.c: Applied patch from Rolf Schroedter to add
	-pollinterval option to fconfigure to modify the maxblocktime used in
	the fileevent polling. Added documentation and fixed the test case as
	well.

	* win/tclWinSock.c: Modified 8.1.0 version of the Win32 socket driver
	to move the handling of the socket event window in a separate thread.
	It also turned out that Win95 & Win98 were, in some cases, getting
	multiple FD_ACCEPTs but only handling one. Added a count for the
	FD_ACCEPT to take care of this. Tested on NT4 SP3, NT4 SP4, Win95, and
	Win98. [Bug 2178 2256 2259 2329 2323 2355]

1999-07-21  Jerry Peek  <[email protected]>

	* README: Small tweaks to clean up typos and wording.

1999-07-20  Melissa Hirschl  <[email protected]>

	* generic/tclInitScript.h:
	* unix/tclUnixInit.c: merged code with 8.0.5. We now use an
	intermediate global tcl var "tclDefaultLibrary" to keep the
	"tcl_library" var from being set by the default value in the Makefile.
	Also fixed a bug in which caused the value of TCL_LIBRARY env var to
	be ignored.
	* unix/tclWinInit.c: just updated some comments.

1999-07-19  Melissa Hirschl  <[email protected]>

	* library/http2.1/http.tcl: updated -useragent text to say version
	2.1.

1999-07-16  Scott Redman  <[email protected]>

	* generic/tcl.decls:
	* generic/tclDecls.h:
	* generic/tclStubInit.c: Add Tcl_SetNotifier to stub table. [Bug 2364]

	* unix/aclocal.m4:
	* unix/tcl.m4: Add check for Alpha/Linux to correct the IEEE floating
	flag to the compiler, should be -mieee. Patch from Don Porter.

	* tools/tcl.hpj.in: Change version number of .cnt file referenced in
	.HPJ file.

1999-07-15  Scott Redman  <[email protected]>

	* tools/tcl.wse.in: Fixed naming of target files for Windows.

1999-07-14  Jerry Peek  <[email protected]>

	* doc/re_syntax.n: Deleted sentence as suggested by Scott S.

1999-07-12  Jerry Peek  <[email protected]>

	* doc/re_syntax.n: Removed two notes to myself (oops), cleaned up
	wording, fixed changebars, made two examples easier to read.

1999-07-11  Scott Redman  <[email protected]>

	* win/makefile.vc: Since the makefile.vc should continue to work while
	we're working out bugs/issues in the new TEA-style
	autoconf/configure/gmake build mechanism for Windows, the version
	numbers of the Tcl libraries need to remain in sync. Modified the
	version numbers in the makefile to reflect the change to 8.2b1.

1999-07-09  Scott Redman  <[email protected]>

	* win/configure.in: Eval DLLSUFFIX, LIBSUFFIX, and EXESUFFIX in the
	configure script so that substitutions get expanded before being
	placed in the Makefile. The "d" portion for debug libraries and DLLs
	was not being set properly.

1999-07-08  Scott Stanton  <[email protected]>

	* tests/string.test:
	* generic/tclCmdMZ.c: Fixed bug in string range bounds checking code.

1999-07-08  Jennifer Hom  <[email protected]>

	* doc/tcltest.n:
	* library/tcltest1.0/tcltest.tcl: Removed -asidefromdir and
	-relateddir flags, removed unused ::tcltest::dotests proc, cleaned up
	implementation of core file checking, and fixed the code that checks
	for 1-letter flag abbreviations.

1999-07-08  Scott Stanton  <[email protected]>

	* win/Makefile.in: Added tcltest target so runtest works properly.
	Added missing names to the clean/distclean targets.

	* tests/reg.test:
	* generic/rege_dfa.c: Applied fix supplied by Henry Spencer for bug in
	DFA state caching under lookahead conditions. [Bug 2318]

1999-07-07  Scott Stanton  <[email protected]>

	* doc/fconfigure.n: Clarified default buffering behavior for the
	standard channels. [Bug 2335]

1999-07-06  Scott Redman  <[email protected]>

	* win/tclWinSerial.c: New implementation of serial port driver from
	Rolf Shroedter ([email protected]) that allows more than one byte
	to be read from the port. Implemented using polling instead of
	threads, there is a max. 10ms latency between checking the port for
	file events. [Bug 1980 2217]

1999-07-06  Brent Welch  <[email protected]>

	* library/http2.0/http.tcl: Fixed the -timeout option so it handles
	timeouts that occur during connection attempts to hosts that are down
	(the only case that really matters!)

1999-07-03  Brent Welch  <[email protected]>

	* doc/ChnlStack.3:
	* generic/tcl.decls:
	* generic/tclIO.c: Added a new variant of the "Trf patch" from Andreas
	Kupres that adds new C APIs Tcl_StackChannel, Tcl_UnstackChannel, and
	Tcl_GetStackedChannel.

1999-07-03  Brent Welch  <[email protected]>

	* generic/tclNotify.c:
	* unix/tclUnixNotfy.c:
	* unix/tclXtTest.c:
	* unix/tclXtNotify.c:
	* win/tclWinNotify.c:
	* mac/tclMacNotify.c: Added Tcl_SetNotifier and the associated hook
	points in the notifiers to be able to replace the notifier calls at
	runtime. The Xt notifier and test program use this hook.

1999-07-03  Brent Welch  <[email protected]>

	* generic/tclParse.c: Changed parsing of variable names to allow empty
	array names. Now "$(foo)" is a variable reference! Previous you had to
	use something like $::(foo), which is slower. This change is requested
	by Jean-Luc Fontaine for his STOOOP package.

1999-07-01  Scott Redman  <[email protected]>

	* generic/tclCmdAH.c:
	* generic/tclFCmd.c: Call TclStat instead of TclpStat in order to
	allow Tcl_Stat hooks to work properly.

1999-06-29  Jennifer Hom  <[email protected]>

	* library/tcltest1.0/pkgIndex.tcl:
	* library/tcltest1.0/tcltest.tcl:
	* doc/tcltest.n:
	* tests/all.tcl: Added -preservecore, -limitconstraints, -help, -file,
	-notfile, -relateddir and -asidefromdir flags to the tcltest package
	along with exported proc ::tcltest::getMatchingFiles. The
	documentation was modified to match and all.tcl was modified to use
	the new functionality instead of implementing -file itself.

1999-06-28  Scott Redman  <[email protected]>

	* generic/tclIndexObj.c:
	* doc/GetIndex.3:
	* tests/binary.test:
	* tests/winDde.test: Applied patch from Peter Hardie (with changes) to
	fix problem with Tcl_GetIndexFromObj() when the key being passed is
	the empty string. It used to match "" and return TCL_OK, but it should
	have returned TCL_ERROR instead. Added test case to "binary" and "dde"
	commands to check the behavior. Added documentation note as well.

1999-06-26  Scott Redman  <[email protected]>

	* win/tclWinDde.c: Applied patch from Peter Hardie to add poke command
	to dde. Also rev'd version of dde package to 1.1. [Bug 1738]

1999-06-25  Jennifer Hom  <[email protected]>

	* unix/Makefile.in:
	* win/Makefile.in:
	* library/tcltest1.0/pkgIndex.tcl:
	* library/tcltest1.0/tcltest.tcl:
	* library/tcltest1.0: Added initial implementation of the Tcl test
	harness package. This package was based on the defs.tcl file that was
	part of the tests directory. Reversed the way that tests were
	evaluated to fix a problem with false passes.

	* doc/tcltest.n: Added documentation for the tcltest package.

	* tests/README:
	* tests/defs.tcl:
	* tests/all.tcl: Modified all test files (tests/*.test) and all.tcl to
	use the new tcltest package and removed references to the defs.tcl
	file. Modified the README file to point to the man page for tcltest.

1999-06-25  Scott Stanton  <[email protected]>

	* tests/reg.test:
	* generic/regexec.c: Fixed bugs in non-greedy quantifiers.

1999-06-23  Jerry Peek  <[email protected]>

	* doc/re_syntax.n:
	* doc/switch.n:
	* doc/lsearch.n:
	* doc/RegExp.3:
	* doc/regexp.n:
	* doc/regsub.n: Moved information about syntax of 8.1 regular
	expressions from regexp(n) manpage into new re_syntax(n) page. Added
	pointers from other manpages to new re_syntax(n) page.

1999-06-23  Scott Stanton  <[email protected]>

	* unix/Makefile.in: Changed install-doc to install-man.

	* tools/uniParse.tcl:
	* tools/uniClass.tcl:
	* tools/README:
	* tests/string.test:
	* generic/regc_locale.c:
	* generic/tclUniData.c:
	* generic/tclUtf.c:
	* doc/string.n: Updated Unicode character tables to reflect latest
	Unicode 2.1 data. Also rationalized "regexp" and "string is"
	definitions of character classes.

1999-06-21  Scott Stanton  <[email protected]>

	* unix/tclUnixThrd.c (TclpThreadCreate): Fixed memory leak where
	thread attributes were not being released. [Bug 2254]

1999-06-17  Scott Stanton  <[email protected]>

	* tests/regexp.test:
	* generic/tclCmdMZ.c:
	* generic/tclCmdIL.c: Changed to use new regexp interfaces. Added
	-expanded, -line, -linestop, and -lineanchor switches to regsub.

	* doc/RegExp.3: Documented the new regexp interfaces and the
	compile/execute flags.

	* generic/tclTest.c:
	* generic/tclRegexp.h:
	* generic/tclRegexp.c:
	* generic/tcl.h:
	* generic/tcl.decls: Renamed Tcl_RegExpMatchObj to Tcl_RegExpExecObj
	and added a new Tcl_RegExpMatchObj that is equivalent to
	Tcl_RegExpMatch. Added public macros for the regexp compile/execute
	flags. Changed to store either an object pointer or a string pointer
	in the TclRegexp structure. Changed to avoid adding a reference to the
	object or copying the string.

	* generic/regcomp.c: lint

	* tests/reg.test:
	* generic/regex.h:
	* generic/regc_lex.c: Added REG_BOSONLY flag to allow Expect to
	iterate through a string an only find matches that start at the
	current position within the string.

1999-06-16  Michael Thomas  <[email protected]>

	* unix/configure.in:
	* unix/Makefile.in:
	* unix/tcl.m4:
	* unix/aclocal.m4: Numerous build changes to make Tcl conform to the
	proposed TEA spec

1999-06-16  Melissa Hirschl  <[email protected]>

	* generic/tclVar.c (Tcl_VariableObjCmd): fixed premature increment in
	loop that was causing out-of-bounds reads on array "varName".

1999-06-16  Scott Stanton  <[email protected]>

	* tests/execute.test:
	* generic/tclExecute.c (TclExecuteByteCode): Fixed crash caused by a
	bug in INST_LOAD_SCALAR1 where the scalar index was read as a signed 1
	byte value instead of unsigned. [Bug 2243]

1999-06-14  Melissa Hirschl  <[email protected]>

	* doc/StringObj.3
	* test/stringObj.test
	* unix/Makefile.in
	* win/Makefile.in
	* win/makefile.vc
	* generic/tclStringObj.c:
	Merged String and Unicode object types. Added new functions to the
	puplic API: Tcl_NewUnicodeObj, Tcl_SetUnicodeObj, Tcl_GetUnicode,
	Tcl_GetUniChar, Tcl_GetCharLength, Tcl_GetRange,
	Tcl_AppendUnicodeToObj.

1999-06-09  Scott Stanton  <[email protected]>

	* generic/tclUnicodeObj.c: Lots of cleanup and simplification. Fixed
	several memory bugs. Added TclAppendUnicodeToObj.

	* generic/tclInt.h: Added declarations for various Unicode string
	functions.

	* generic/tclRegexp.c:
	* generic/tclCmdMZ.c: Changed to use new Unicode string interfaces for
	better performance.

	* generic/tclRegexp.h:
	* generic/tclRegexp.c:
	* generic/tcl.h:
	* generic/tcl.decls: Added Tcl_RegExpMatchObj and Tcl_RegExpGetInfo
	calls to access lower level regexp API. These features are needed by
	Expect. This is a preliminary implementation pending final review and
	cleanup.

	* generic/tclCmdMZ.c:
	* tests/string.test: Fixed bug where string map failed on null strings

	* generic/regexec.c:
	* unix/tclUnixNotfy.c: lint

	* tools/genStubs.tcl: Changed to always write output in LF mode.

1999-06-08  Scott Stanton  <[email protected]>

	* win/tclWinSock.c: Rolled back to the 8.1.0 implementation because of
	serious problems with the new driver. Basically no incoming socket
	connections would be reported to a server port. The 8.1.1 code needs
	to be redesigned and fixed correctly.

1999-06-07  Melissa Hirschl  <[email protected]>

	* tests/string.test:
	* generic/tclVar.c (Tcl_SetVar2Ex):
	* generic/tclStringObj.c (Tcl_AppendObjToObj):
	* generic/tclCmdMZ.c (Tcl_StringObjCmd): optimized the string index,
	string length, string range, and append command in cases where the
	object's internal rep is a bytearray. Objects with other internal reps
	are converted to have the new unicode internal rep.

	* unix/Makefile.in:
	* win/Makefile.in:
	* win/Makefile.vc:
	* tests/unicode.test:
	* generic/tclInt.h:
	* generic/tclObj.c:
	* generic/tclUnicodeObj.c: added a new object type to store the
	unicode representation of a string.

	* generic/tclTestObj.c: added the objtype option to the testobj
	command. This option returns the name of the type of internal rep an
	object has.

1999-06-04  Scott Stanton  <[email protected]>

	* win/configure.in:
	* win/Makefile.in: Windows build now handles static/dynamic
	debug/nodebug builds and supports the standard targets using Cygwin
	user tools plus GNU make and autoconf.

1999-06-03  Scott Stanton  <[email protected]>

	* generic/tclCmdMZ.c (Tcl_StringObjCmd):
	* tests/string.test: Fixed bug where string equal/compare -nocase
	reported wrong result on null strings. [Bug 2138]

1999-06-02  Scott Stanton  <[email protected]>

	* generic/tclUtf.c (Tcl_UtfNcasecmp): Fixed incorrect computation of
	relative ordering. [Bug 2135]

1999-06-01  Scott Stanton  <[email protected]>

	* unix/configure.in: Fixed various small configure.in patches
	submitted by Jan Nijtmans. [Bug 2121]

	* tests/reg.test:
	* generic/regc_color.c:
	* generic/regc_cvec.c:
	* generic/regc_lex.c:
	* generic/regc_locale.c:
	* generic/regc_nfa.c:
	* generic/regcomp.c:
	* generic/regcustom.h:
	* generic/rege_dfa.c:
	* generic/regerror.c:
	* generic/regerrs.h:
	* generic/regex.h:
	* generic/regexec.c:
	* generic/regfree.c:
	* generic/regfronts.c:
	* generic/regguts.h:
	* generic/tclCmdMZ.c:
	* generic/tclRegexp.c:
	* generic/tclRegexp.h:
	* generic/tclTest.c: Applied Henry Spencer's latest regexp patches
	that fix an infinite loop bug and add support for testing whether a
	string could match with additional input. [Bug 2117]

1999-05-28  Scott Stanton  <[email protected]>

	* generic/tclObj.c: Changed to eliminate use of isupper/tolower in
	favor of the Unicode versions.

	* win/Makefile.in:
	* win/configure.in: Added preliminary TEA implementation.

	* win/tclWinDde.c: Fixed bug where dde calls were being passed an
	invalid dde handle because Initialize had not been called. [Bug 2124]

1999-05-26  Scott Redman  <[email protected]>

	* generic/tclThreadTest.c: Fixed race condition in testthread code
	that showed up in the WinNT test suite intermittently.

	* win/tclWinSock.c: Fixed a hang in the WinNT socket driver, wake up
	the socket thread every 100ms to check for events on the sockets that
	did not wake up the thread (race condition).

1999-05-24  Scott Stanton  <[email protected]>

	* tools/genStubs.tcl: Changed to allow a list of platforms instead of
	just one at a time.

	* generic/tcl.decls:
	* generic/tclCmdMZ.c:
	* generic/tclDecls.h:
	* generic/tclInt.decls:
	* generic/tclIntDecls.h:
	* generic/tclPort.h:
	* generic/tclStubInit.c:
	* generic/tclStubLib.c: Various header file related changes and other
	lint to try to get the Mac builds working.

1999-05-21  Scott Redman  <[email protected]>

	* win/tclWinPipe.c: Fix bug when launching command.com on Win95/98.
	Need to wait for the procInfo.hProcess of the process that was
	created, not the hProcess of the current process. [Bug 2105]

1999-05-20  Scott Redman  <[email protected]>

	* library/init.tcl: Add the directory where the executable is, and the
	../lib directory relative to that, to the auto_path variable.

1999-05-19  Scott Stanton  <[email protected]>

	Merged in various changes submitted by Jeff Hobbs:

	* generic/tcl.decls:
	* generic/tclUtf.c: Added Tcl_UniCharIs* functions for control, graph,
	print, and punct classes.

	* generic/tclUtil.c:
	* doc/StrMatch.3: Added Tcl_StringCaseMatch() implementation to
	support case-insensitive globbing.

	* doc/string.n:
	* unix/mkLinks:
	* tests/string.test:
	* generic/tclCmdMZ.c: Added additional character class tests, added
	-nocase switch to "string match", changed string first/last to use
	offsets.

1999-05-19  Scott Redman  <[email protected]>

	* generic/tcl.h: Add extern "C" block around entire header file for
	C++ compilers to fix linkage issues. Submitted by Don Porter and Paul
	Duffin.

	* generic/tclRegexp.c: Fix bug when the regexp cache is empty and an
	empty pattern is used in regexp ( such as {} or "" ).

1999-05-18  Scott Stanton  <[email protected]>

	* win/tclWinChan.c: Modified initialization code to avoid inherenting
	closed or invalid channels. If the standard input is anything other
	than a console, file, serial port, or pipe, then we fall back to the
	standard Tk window console.

1999-05-14  Scott Stanton  <[email protected]>

	* generic/tclCmdAH.c (Tcl_ForObjCmd): Fixed crash caused by failure to
	reset the result before evaluating the test expression.

1999-05-14  Bryan Surles  <[email protected]>

	* generic/tclBasic.c (Tcl_CreateInterp): Added introspection variable
	for threaded interps. If the interp was compiled with threads enabled,
	the tcl_platform(threaded) variable will exist.

1999-05-14  Scott Redman  <[email protected]>

	* generic/tclDate.c: Applied patch to fix 100-year and 400-year
	boundaries in leap year code, from Isaac Hollander. [Bug 2066]

1999-05-13  Scott Stanton  <[email protected]>

	* unix/Makefile.in:
	* unix/tclAppInit.c: Minor cleanup related to Xt notifier.

	* unix/tclUnixInit.c (TclpSetInitialEncodings): Tcl now looks for an
	encoding subfield in the LANG/LC_ALL variables in cases where the
	locale is not found in the locale table. Ensure that setlocale() is
	called at least once so X11 will initialize properly. Also, forces the
	LC_NUMERIC locale to be "C" so numeric processing in scripts is not
	affected by the current locale setting. [Bug 1989]

	* generic/tclRegexp.c: Increased per-thread regexp cache to 30 slots.
	This seems to be about the right number for larger applications like
	exmh. [Bug 1063]

1999-05-12  Scott Stanton  <[email protected]>

	* doc/tclsh.1: Updated references to rc script names to accurately
	reflect the platform differences on Windows.

	* tests/regexp.test:
	* generic/tclInt.h:
	* generic/tclBasic.c:
	* generic/tclRegexp.h:
	* generic/tclRegexp.c: Replaced the per-interpreter regexp cache with
	a per-thread cache. Changed the Regexp object to take advantage of
	this extra cache. Added a reference count to the TclRegexp type so
	regexps can be shared by multiple objects. Removed the per-interp
	regexp cache from the interpreter. Now regexps can be used with no
	need for an interpreter. [Bug 1063]

	* win/tclWinInit.c (TclpSetVariables): Avoid calling GetUserName if
	the value can be determined from the USERNAME environment variable.
	GetUserName is very slow.

1999-05-07  Scott Stanton  <[email protected]>

	* win/winDumpExts.c:
	* win/makefile.vc: Removed incorrect patch. [Bug 1998]

	* generic/tcl.decls: Replaced const with CONST.

	* generic/tclResult.c (Tcl_AppendResultVA):
	* generic/tclStringObj.c (Tcl_AppendStringsToObjVA): Fixed to copy
	arglist using memcpy instead of assignment so it works properly on
	OS/390. [Bug 1997]

	* generic/tclLoadNone.c: Updated to use current interfaces, added
	TclpUnloadFile. [Bug 2003]

	* win/winDumpExts.c:
	* win/makefile.vc: Changed to emit library name in defs file. [Bug
	1998]

	* unix/configure.in: Added fix for OS/390. [Bug 1976]

1999-05-06  Scott Stanton  <[email protected]>

	* tests/string.test:
	* generic/tclCmdMZ.c:
	* doc/string.n: Fixed bug in string equal/compare code when using
	-length option. Cleaned up docs a bit more.

	* tests/http.test: Unset "data" array before running tests to avoid
	failures due to previous tests.

	* doc/string.n:
	* tests/cmdIL.test:
	* tests/cmdMZ.test:
	* tests/error.test:
	* tests/ioCmd.test:
	* tests/lindex.test:
	* tests/linsert.test:
	* tests/lrange.test:
	* tests/lreplace.test:
	* tests/string.test:
	* tests/cmdIL.test:
	* generic/tclUtil.c:
	* generic/tclCmdMZ.c: Replaced "string icompare/iequal" with -nocase
	and -length switches to "string compare/equal". Added a -nocase option
	to "string map". Changed index syntax to allow integer or
	end?-integer? instead of a full expression. This is much simpler with
	safeTcl scripts since it avoids double substitution issues.

	* doc/Utf.3:
	* generic/tclStubInit.c:
	* generic/tclDecls.h:
	* generic/tclUtf.c:
	* generic/tcl.decls: Added Tcl_UtfNcmp and Tcl_UtfNcasecmp.

1999-05-05  Scott Stanton  <[email protected]>

	* win/makefile.vc: Added encoding directory to install-libraries
	target.

1999-05-03  Scott Stanton  <[email protected]>

	* doc/string.n:
	* tests/cmdMZ.test:
	* tests/string.test:
	* generic/tclCmdMZ.c (Tcl_StringObjCmd): Changed "string length" to
	avoid regenerating the string rep of a ByteArray object.

	* tests/cmdIL.test:
	* tests/cmdMZ.test:
	* tests/error.test:
	* tests/lindex.test:
	* tests/linsert.test:
	* tests/lrange.test:
	* tests/lreplace.test:
	* tests/string.test:
	* generic/tclCmdMZ.c (Tcl_StringObjCmd):
	* generic/tclUtil.c (TclGetIntForIndex): Applied Jeff Hobbs's string
	patch which includes the following changes [Bug 1845]:
	- string compare now takes optional length arg (for strncmp behavior)
	- added string equal (just a few lines of code blended in with string
	  compare)
	- added string icompare/iequal for case-insensitive comparisons
	- string index's index can now be ?end[+-]?expression
	  I made this change in the private TclGetIntForIndex, which means
	  that the list commands also benefit, as well as string range, et al.
	- added [string repeat string count]
	  Repeats given string number of times
	- added string replace, string equiv to lreplace
	  (quasi opposite of string range):
		string replace first last ?string?
	  Example of use, replacing end of string with ... should the string
	  be more than 16 chars long:
		string replace $string 16 end "..."
	  This just returns the string len < 16, so it will only affect the
	  long strings.
	- added optional first and last args to string to*
	  This allows you to just affect certain regions of a string with the
	  command (like just capping the first letter). I found the original
	  totitle to be too draconian to be useful.
	- added [string map charMap string]
	  where charMap is a {from to from to} list that equates to what one
	  might get from [array get]. Each and can be multiple chars (or none
	  at all). For Tcl/CGI users, this is a MAJOR speed booster.

	* generic/tclParse.c (Tcl_ParseCommand): Changed to avoid modifying
	eval'ed strings that are already null terminated. [Bug 1793]

	* tests/binary.test:
	* generic/tclBinary.c (DupByteArrayInternalRep): Fixed bug where type
	was not being set in duplicated object. [Bug 1975, 2047]

1999-04-30  Scott Stanton  <[email protected]>

	* Changed version to 8.1.1.

1999-04-30  Scott Stanton  <[email protected]>

	* Merged changes from 8.1.0 branch:

	* generic/tclParse.c: Fixed memory leak in CommandComplete.

	* generic/tclPlatDecls.h:
	* generic/tclIntPlatDecls.h:
	* generic/tclIntDecls.h:
	* generic/tclDecls.h:
	* tools/genStubs.tcl: Added 'extern "C" {}' block around the stub
	table pointer declaration so the stub library can be used from C++.
	[Bug 1934]

	* Lots of documentation and other release engineering fixes.

1999-04-28  Scott Stanton  <[email protected]>

	* mac/tclMacResource.c:
	* generic/tclListObj.c:
	* generic/tclObj.c:
	* generic/tclStringObj.c: Changed to avoid freeing the string
	representation before freeing the internal rep. This helps with
	debugging since the string rep will still be valid when the free proc
	is invoked.

1999-04-27  Scott Stanton  <[email protected]>

	* generic/tclLiteral.c (TclHideLiteral): Fixed so hidden literals get
	duplicated to avoid accidental sharing in the global object table.

1999-04-23  Scott Stanton  <[email protected]>

	* generic/tclStubInit.c:
	* tools/genStubs.tcl: Changed to avoid the need for forward
	declarations in stub initializers.

1999-04-23  Scott Stanton  <[email protected]>

	* library/encoding/koi8-r.enc:
	* tools/encoding/koi8-r.txt: Added support for the koi8-r Cyrillic
	encoding. [Bug 1771]

1999-04-22  Scott Stanton  <[email protected]>

	* win/tclWinFCmd.c:
	* win/tclWin32Dll.c: Changed uses of "try" to "__try", since that is
	the actual keyword. This eliminates the need for some -D flags from
	the makefile.

	* generic/tclPort.h: Added include of tcl.h since it defines various
	Windows macros that are needed before deciding which platform porting
	file to use.

	* generic/tclEvent.c: lint

	* win/tclWinInit.c (TclpInitPlatform): Added call to TclWinInit when
	building a static library since DllMain will not be invoked. This
	could break old code that explicitly called TclWinInit, but should be
	simpler in the long run.

1999-04-22  Scott Stanton  <[email protected]>

	* generic/tclInt.h:
	* generic/tclInt.decls:
	* generic/tclCompile.c: Added TclSetByteCodeFromAny that takes a hook
	procedure to invoke after compilation but before the byte codes are
	emitted. This makes it possible to do postprocessing on the compiled
	byte codes before the ByteCode is generated.

	* generic/tclLiteral.c: Added TclHideLiteral and TclAddLiteralObj to
	make it possible to create local unshared literal objects.

	* win/tclWinInit.c:
	* unix/tclUnixInit.c: Changed initial search path to match that
	found used by tcl_findLibrary.

1999-04-22  Scott Redman  <[email protected]>

	* win/tclWinPort.h:
	* win/tclWinSock.c: Added code to use WinSock 2.0 API on NT to avoid
	creating a window to handle sockets. API not available on Win95 and
	needs to be fixed on Win98, until then continue to use the older
	(window-based) scheme on those two OSes.

1999-04-15  Scott Stanton  <[email protected]>

	* Merged 8.1 back into the main trunk

1999-04-13  Scott Stanton  <[email protected]>

	* library/encoding/gb2312.enc:
	* library/encoding/euc-cn.enc:
	* tools/encoding/gb2312.txt:
	* tools/encoding/cp950.txt:
	* tools/encoding/Makefile: Restored the double byte definition of
	GB2312 and added the EUC-CN encoding. EUC-CN is a variant of GB2312
	that shifts the characters into bytes with the high bit set and
	includes ASCII as a subset. [Bug 632]

1999-04-13  Scott Redman  <[email protected]>

	* win/tclWinSock.c: Apply patch to allow write access to a socket if
	FD_WRITE is sent but FD_CONNECT is not. Some strange problem with
	either Win32 or a socket driver. [Bug 1664 1776]

1999-04-09  Scott Redman  <[email protected]>

	* unix/tclUnixNotfy.c: Fixed notifier deadlock situation when the pipe
	used to talk back notifier thread is filled with data. When calling
	the write() function to feed data down that pipe, unlock the
	notifierMutex to allow the notifier to wake up again. Found as a
	result of the focus.test for Tk hanging. [Bug 1700]

1999-04-06  Scott Stanton  <[email protected]>

	* tests/unixNotfy.test: Fixed hang in tests when built with thread
	support.

	* tests/httpold.test: Fixed broken test that didn't wait long enough
	for events to arrive.

	* tests/unixInit.test: Fixed race condition in test.

	* tests/unixInit.test:
	* tests/fileName.test: Minor test nits.

	* unix/tclUnixInit.c (TclpSetInitialEncodings): Fixed bad initial
	encoding string.

1999-04-06  Bryan Surles  <[email protected]>

	* generic/tclVar.c:
	* generic/tclEnv.c: Moved the "array set" C level code into a common
	routine (TclArraySet). The TclSetupEnv routine now uses this API to
	create an env array w/ no elements.

	* generic/tclEnv.c:
	* generic/tclWinInit.h:
	* generic/tclUnixInit.h:
	* generic/tclInt.h: Made the Env module I18N compliant. Changed the
	FindVariable routine to TclpFindVariable, that now does a case
	insensitive string comparison on Windows, and not on UNIX. [Bug 1299,
	1500]

1999-04-05  Scott Stanton  <[email protected]>

	* tests/io.test: Minor test cleanup.

	* generic/tclEncoding.c (Tcl_CreateEncoding): Minor lint to make it
	easier to compile on Digital-unix. [Bug 1659]

	* unix/configure.in:
	* unix/tclUnixPort.h: Applied patch for OS/390 to handle lack of
	sys/param.h. [Bug 1725]

	* unix/configure.in: Fixed BSD/OS 4.* configuration to support shared
	libraries properly. [Bug 1730]

1999-04-05  Scott Redman  <[email protected]>

	* win/tclWinDde.c: decrease timeout value for DDE calls to 30k. [Bug
	1639]

	* generic/tcl.decls:
	* generic/tcl.h:
	* generic/tclDecls.h:
	* generic/tclInt.decls:
	* generic/tclInt.h:
	* generic/tclIntDecls.h:
	* generic/tclStubInit.c:
	* generic/tclUtil.c: Added more functions to the Tcl stubs table,
	including all Tcl_ functions not already in it (except Cmd functions)
	and Tcl_GetCwd() and Tcl_Chdir() (new functions).

	* tests/safe.test:
	* doc/safe.n:
	* generic/tclBasic.c:
	* library/safe.tcl: The encoding command is not safe as-is, so create
	a safe alias to mask out the "encoding system <name>" but allow all
	other uses including "encoding system". Added test cases and updated
	the man page for Safe Tcl.

1999-04-05  Scott Stanton  <[email protected]>

	* tests/winTime.test:
	* win/tclWinTime.c: Fixed crash in clock command that occurred when
	manipulating negative time values in timezones east of GMT. [Bug
	1142, 1458]

	* tests/platform.test:
	* tests/fileName.test: Fixed broken tests.

	* generic/tclFileName.c: Moved global regexps into thread local
	storage.

	* tests/socket.test: Changed so tests don't reuse sockets, since
	Windows is slow to release sockets.

	* win/tclWinConsole.c:
	* win/tclWinPipe.c:
	* win/tclWinSerial.c: Fixed race condition where background threads
	were terminated while they still held a lock in the notifier.

1999-04-02  Scott Stanton  <[email protected]>

	* tests/http.test: Fixed bad test initialization code.

	* generic/tclThreadTest.c (ThreadExitProc): Fixed bug where static
	memory was being returned instead of a dynamically allocated result in
	error cases.

1999-04-02  Scott Redman  <[email protected]>

	* doc/dde.n:
	* tools/tcl.wse.in:
	* win/makefile.vc:
	* win/pkgIndex.tcl:
	* win/tclWinDde.c: Add new DDE package, code removed from Tk now
	separated into its own package. Changed DDE-based send code into "dde
	eval" command. Can be loaded into tclsh (not just wish). Windows only.

1999-04-02  Scott Stanton  <[email protected]>

	* tests/expr.test:
	* tests/for-old.test:
	* tests/for.test:
	* tests/foreach.test:
	* tests/format.test:
	* tests/httpold.test:
	* tests/if.test:
	* tests/init.test:
	* tests/interp.test:
	* tests/while.test: Added some tests for known bugs (marked with
	knownBug constraint), and cleaned up a few bad tests.

	* generic/regc_locale.c:
	* generic/regcustom.h:
	* generic/tcl.decls:
	* generic/tclCmdIL.c:
	* generic/tclCmdMZ.c:
	* generic/tclInt.h:
	* generic/tclRegexp.c:
	* generic/tclScan.c:
	* generic/tclTest.c:
	* generic/tclUtf.c:
	* win/tclWinFCmd.c:
	* win/tclWinFile.c: Made various Unicode utility functions public. The
	following functions were made public and added to the stubs table:
		Tcl_UtfToUniCharDString, Tcl_UniCharToUtfDString,
		Tcl_UniCharLen, Tcl_UniCharNcmp, Tcl_UniCharIsAlnum,
		Tcl_UniCharIsAlpha, Tcl_UniCharIsDigit, Tcl_UniCharIsLower,
		Tcl_UniCharIsSpace, Tcl_UniCharIsUpper, Tcl_UniCharIsWordChar

1999-04-01  Scott Stanton  <[email protected]>

	* tests/registry.test:
	* win/tclWinReg.c: Internationalized the registry code. It now uses
	Unicode interfaces on NT. [Bug 1197]

	* tests/parse.test:
	* generic/tclParse.c: Fixed crash due to multiple frees in parser
	during error cleanup when parsing commands with more tokens than will
	fit in the static area of the parse structure. [Bug 1681]

	* generic/tclInt.h: Removed duplicate declarations.

	* generic/tclInt.decls:
	* generic/tcl.decls: Added Tcl_WinUtfToTChar and Tcl_WinTCharToUtf to
	the tclPlat table.

1999-04-01  Scott Redman  <[email protected]>

	* generic/tcl.decls:
	* generic/tcl.h:
	* generic/tclBasic.c:
	* generic/tclDecls.h:
	* generic/StubInit.c:
	* tools/genStubs.tcl:
	* unix/Makefile.in:
	* win/makefile.vc: Applied patch from Jan Nijtmans to fix Ultrix
	multiple symbol definition problem. Now, even Tcl includes a copy of
	the Tcl stub library. Also fixed TCL_MEM_DEBUG mode (for Tk).

1999-03-31  Scott Redman  <[email protected]>

	* win/tclWinConsole.c: WinNT has a bug when reading a single character
	from the console. Rewrote the code for the console to read an entire
	line at a time using the reader thread.

1999-03-30  Scott Stanton  <[email protected]>

	* unix/Makefile.in: Removed trailing backslash that broke the "depend"
	target.

	* unix/tclUnixInit.c (TclpSetInitialEncodings): Changed to avoid
	calling setlocale(). We now look directly at env(LANG) and
	env(LC_CTYPE) instead. [Bug 1636]

	* generic/tclFileName.c:
	* generic/tclDecls.h:
	* generic/tcl.decls: Removed CONST from Tcl_JoinPath and
	Tcl_TranslateFileName because it changes the signature of Tcl_JoinPath
	in an incompatible manner.

	* generic/tclInt.h:
	* generic/tclLoad.c (TclFinalizeLoad):
	* generic/tclEvent.c (Tcl_Finalize): Defer unloading of loadable
	modules until all exit handlers have been invoked. [Bug 998, 1273,
	1573, 1593]

1999-03-29  Scott Stanton  <[email protected]>

	* generic/tclFileName.c:
	* generic/tclDecls.h:
	* generic/tcl.decls: Added CONST to Tcl_JoinPath and
	Tcl_TranslateFileName.

1999-03-29  Scott Redman  <[email protected]>

	* tools/genStubs.tcl:
	* unix/configure.in:
	* unix/Makefile.in:
	* win/makefile.vc:
	* generic/tcl.h:
	* generic/tclBasic.c:
	* generic/tclDecls.h:
	* generic/tclIntDecls.h:
	* generic/tclPlatDecls.h:
	* generic/tclIntPlatDecls.h: Removed the stub functions and changed
	the stub macros to just use the name without params. Pass &tclStubs
	into the interp (don't use tclStubsPtr because of collisions with the
	stubs on Solaris).

1999-03-27  Scott Redman  <[email protected]>

	* win/makefile.bc: Removed makefile for Borland compiler, no longer
	supported.

1999-03-26  Scott Redman  <[email protected]>

	* win/tclWinSerial.c:
	* win/tclWinConsole.c:
	* win/tclWinPipe.c: Don't close the Win32 handle for a channel if it's
	a stdio handle (GetStdHandle()) during shutdown of a thread to prevent
	it from destroying the stdio of other threads.

1999-03-26  Suresh Ankolekar  <[email protected]>

	* unix/configure.in: --nameble-shared is now the default and build Tcl
	as a shared library; specify --disable-shared to build a static Tcl
	library and shell.

1999-03-25  Scott Stanton  <[email protected]>

	* tests/interp.test:
	* generic/tclInterp.c (AliasObjCmd): Changed so aliases are invoked at
	current scope in the target interpreter instead of at the global
	scope. This was an incompatibility introduced in 8.1 that is being
	removed. [Bug 1153, 1556]

	* library/encoding/big5.enc:
	* library/encoding/gb2312.enc:
	* tools/encoding/big5.enc:
	* tools/encoding/gb2312.enc: Added ASCII to big5 and gb2312 encodings.
	[Bug 632]

	* generic/tclPkg.c (Tcl_PkgRequireEx): Fixed broken clientData
	initialization in package code.

	* unix/Makefile.in (dist): Added tcl.decls and tclInt.decls to source
	distribution. [Bug 1571]

	* doc/Thread.3: Updated documentation of Tcl_MutexLock to indicate
	that the recursive locking behavior is undefined. On Windows, it does
	not block, on Unix it deadlocks. [Bug 1275]

1999-03-24  Scott Stanton  <[email protected]>

	* tests/execute.test:
	* generic/tclExecute.c (TclExecuteByteCode): Fixed expression code
	that incorrectly returned floating point values for integers if the
	internal rep happened to be a double. Now we check to see if the
	object has a string rep that looks like an integer before using the
	double internal rep. [Bug 1516]

1999-03-24  Scott Redman  <[email protected]>

	* generic/tclAlloc.c:
	* generic/tclEncoding.c:
	* generic/tclProc.c:
	* unix/tclUnixTime.c:
	* win/tclWinSerial.c: Fixed compilation warnings/errors for VC++ 5.0
	and 6.0 and HP-UX native compiler without -Aa or -Ae. [Bug 1323 1518
	1324 1583 1585 1586]

	* win/tclWinSock.c: Make sockets thread-safe on Windows. The current
	implementation uses windows to handle events on the socket, one for
	each thread (thread local storage). Previously, there was only one
	window shared between threads, which didn't work. [Bug 1326]

1999-03-23  Scott Stanton  <[email protected]>

	* tools/tcl.wse: Fixed file association to look in the right place for
	the wish icon. [Bug 1544]

	* tests/winNotify.test:
	* tests/ioCmd.test:
	* tests/event.test: Changed to use new style conditionals.

	* tests/encoding.test: Fixed nonportable test.

	* unix/dltest/configure.in:
	* unix/dltest/Makefile.in: Added missing DBGX macros. [Bug 1564]

	* tests/winNotify.test:
	* mac/tclMacNotify.c:
	* win/tclWinNotify.c:
	* unix/tclUnixNotfy.c:
	* generic/tclNotify.c: Added a new Tcl_ServiceModeHook interface that
	is invoked whenever the service mode changes. This is needed to allow
	the Windows notifier to create a communication window the first time
	Tcl is about to enter an external modal event loop instead of at
	startup time. This will avoid the various problems that people have
	been seeing where the system hangs when tclsh is running outside of
	the event loop. [Bug 783]

	* generic/tclInt.h:
	* generic/tcl.decls: Renamed TclpAlertNotifier back to
	Tcl_AlertNotifier since it is part of the public notifier driver API.

1999-03-23  Scott Redman  <[email protected]>

	* win/tclWinSerial.c: Fixed problem with fileevent on the serial port
	and nonblocking mode. Gets no longer hangs, fileevents fire whenever
	there is any character data on the port.

	* tests/winConsole.test:
	* win/tclWinConsole.c: Fixed problem with fileevents and gets from a
	console stdin. Previously, fileevents were firing before an entire
	line was available for reading, which meant that when you did a gets
	or read, it blocked (even in nonblocking mode). Now, it should work
	the same as Unix: fileevents fire when an entire line is ready, and
	gets and read do not block in non-blocking mode. Added an interactive
	test case to check for this.

1999-03-22  Scott Stanton  <[email protected]>

	* tests/reg.test:
	* generic/regc_color.c: Applied regexp bug fix from Henry Spencer.

1999-03-19  Scott Redman  <[email protected]>

	* generic/tclCmdIL.c: Fixed the initialization of an array so that the
	Sun 5.0 C compiler wouldn't complain.

	* unix/configure.in: Added support for --enable-64bit. For now, this
	is only supported on Solaris 7 64bit (SunOS 5.7) using the Sun
	compiler (not gcc).

1999-03-18  Scott Stanton  <[email protected]>

	* win/tclWinChan.c (TclpOpenFileChannel, Tcl_MakeFileChannel): Changed
	to only test for console or comm handles when the type is
	FILE_TYPE_CHAR to avoid useless tests on simple files. Also reordered
	tests so consoles are tested first as this is more common.

	* win/makefile.vc: Regularized usage of mkd and rmd and rm.

	* library/encoding/shiftjis.enc:
	* tools/encoding/shiftjis.txt: Missing/incorrect characters in
	shift-jis table. [Bug 1008, 1526]

	* generic/tclInt.decls:
	* generic/tcl.decls: Eliminated use of "string" and "list" from
	argument lists to avoid conflicts with C++ STL. [Bug 1181]

	* win/tclWinFile.c (TclpMatchFiles): Changed to ignore the
	FS_CASE_IS_PRESERVED bit and always return exactly what we get from
	the system.

1999-03-17  Scott Stanton  <stanton@GASPODE>

	* win/README.binary:
	* win/README:
	* unix/configure.in:
	* generic/tcl.h:
	* README: Updated version to 8.1b3.

1999-03-14  Scott Stanton  <stanton@GASPODE>

	* win/tclWinConsole.c:
	* win/tclWinPipe.c:
	* win/tclWinSerial.c: Changed so channel drivers wait for the
	reader/writer threads to exit before returning during a close
	operation. This ensures that the main thread is the last thread to
	exit, so the process return value is set properly.

	* generic/tclIntDecls.h:
	* generic/tclIntPlatDecls.h:
	* generic/tclIntPlatStubs.c:
	* generic/tclIntStubs.c:
	* generic/tclPlatDecls.h:
	* generic/tclPlatStubs.c:
	* generic/tclStubInit.c:
	* generic/tclStubs.c: Fixed bad eol characters.

	* generic/tclInt.decls: Changed "const" to "CONST" in declarations for
	better portability.

	* generic/tcl.decls: Renamed panic and panicVA to Tcl_Panic and
	Tcl_PanicVA in the stub files.

	* generic/tclInterp.c (Tcl_MakeSafe): Remove tcl_platform(user) from
	safe interps.

1999-03-11  Scott Stanton  <stanton@GASPODE>

	* unix/Makefile.in:
	* unix/configure.in: Include compat files in the stub library in
	addition to the main library. Compat files are now built for dynamic
	use in all cases.

	* generic/tcl.h: Changed magic number so it doesn't match the plus
	patch, at Jan's request.

	* unix/tclConfig.sh.in:
	* unix/dltest/Makefile.in:
	* unix/dltest/configure.in:
	* unix/dltest/pkga.c:
	* unix/dltest/pkgb.c:
	* unix/dltest/pkgc.c:
	* unix/dltest/pkgd.c:
	* unix/dltest/pkge.c:
	* unix/dltest/pkgf.c: Changed package tests to build against the stubs
	library.

1999-03-10  Scott Stanton  <stanton@GASPODE>

	* generic/tcl.h:
	* generic/tcl.decls: Changed Tcl_ReleaseType from an enum to macros so
	it can be used in .rc files. Added Tcl_GetString.

	* mac/tclMacNotify.c:
	* generic/tclNotify.c:
	* generic/tclInt.h:
	* win/tclWinNotify.c:
	* generic/tcl.h: Renamed Tcl_AlertNotifier to TclpAlertNotifier.

	* generic/tclInt.decls: Added TclWinAddProcess to make it possible for
	expect to use Tcl_WaitForPid(). This patch is from Gordon Chaffee.

	* mac/tclMacPort.h:
	* win/tclWinInit.c:
	* unix/tclUnixPort.h:
	* generic/tclAsync.c: Added TclpAsyncMark to fix bug in async handling
	on Windows where async events don't wake up the event loop. This patch
	comes from Gordon Chaffee.

	* generic/tcl.decls: Fixed declarations of reserved slots.

1999-03-10  Scott Redman  <[email protected]>

	* generic/tclCompile.h: Ensure that the ByteCode struct is binary
	compatible with the version in 8.0.6.

	* generic/tcl.h:
	* generic/tclBasic.c: Add Tcl_GetVersion() function to the public C
	API to allow programs to check the version number of the Tcl library
	at runtime. Also added an enum to clarify the release level (alpha,
	beta, final).

1999-03-09  Scott Stanton  <stanton@GASPODE>

	* Integrated changes from Tcl 8.0 including:
		stubs mechanism
		configure patches from Jan Nijtmans
		rename of panic to Tcl_Panic

1999-03-08  Lee Bernhard  <[email protected]>

	* win/tclWin32Dll.c: Removed Dll instance from thread-local storage.

1999-03-08  Scott Stanton  <stanton@GASPODE>

	* generic/tcl.h: Moved Tcl_Mutex, etc. macros above the inclusion of
	tclDecls.h to avoid macro conflicts.

	* generic/tclInt.h:
	* generic/regc_color.c:
	* generic/regcomp.c:
	* generic/tclCmdIL.c:
	* generic/tclCmdAH.c:
	* generic/tclIOCmd.c:
	* generic/tclParse.c:
	* generic/tclStringObj.c:
	* unix/tclUnixNotfy.c: Cleaned up various compiler warnings,
	eliminated UCHAR bugs.

	* unix/tclUnixNotfy.c:
	* unix/tclUnixThrd.c:
	* generic/tclThreadTest.c:
	* mac/tclMacThrd.c: Changed TclpCondition*() to Tcl_Condition*().

	* INTEGRATED PATCHES FROM 8.0.6:

	* generic/tcl.decls:
	* generic/tcl.h:
	* generic/tclBasic.c:
	* generic/tclDecls.h:
	* generic/tclInt.decls:
	* generic/tclInt.h:
	* generic/tclIntDecls.h:
	* generic/tclIntPlatDecls.h:
	* generic/tclIntPlatStubs.c:
	* generic/tclIntStubs.c:
	* generic/tclPlatDecls.h:
	* generic/tclPlatStubs.c:
	* generic/tclStubInit.c:
	* generic/tclStubLib.c:
	* generic/tclStubs.c:
	* tools/genStubs.tcl:
	* unix/configure.in:
	* unix/Makefile.in:
	* unix/tclConfig.sh.in:
	* win/makefile.vc:
	* win/tclWinPort.h: Added Tcl stubs implementation. There are now two
	new macros USE_TCL_STUBS and USE_TCL_STUB_PROCS that enable use of
	stubs and disable stub macros respectively. All of the public and
	private function declarations from tcl.h and tclInt.h have moved into
	the *.decls files and the *Stubs.c and *Decls.h files are generated
	using the genStubs.tcl script.

	* unix/Makefile.in:
	* unix/configure.in:
	* unix/ldAix: Enhanced AIX shared library support.

	* win/tclWinSock.c: Removed a bunch of extraneous PASCAL FAR
	attributes from internal functions.

	* win/tclWinReg.c: Changed registry package to use stubs mechanism so
	it no longer depends on the specific version of Tcl.

	* doc/AddErrInfo.3:
	* doc/Eval.3:
	* doc/PkgRequire.3:
	* doc/SetResult.3:
	* doc/StringObj.3:
	* generic/tcl.h:
	* generic/tclBasic.c:
	* generic/tclPanic.c:
	* generic/tclStringObj.c:
	* generic/tclUtil.c:
	* unix/mkLinks: Added va_list versions of all VARARGS functions so
	they can be invoked from the stub functions.

	* doc/package.n:
	* doc/PkgRequire.3:
	* generic/tclPkg.c: Added Tcl_PkgProvideEx, Tcl_RequireEx,
	Tcl_PresentEx, and Tcl_PkgPresent. Added "package present" command.

	* generic/tclFileName.c:
	* mac/tclMacFile.c:
	* mac/tclMacShLib.exp:
	* unix/tclUnixFile.c:
	* win/tclWinFile.c: Changed so TclGetUserHome is defined on all
	platforms, even though it is currently a noop on mac and windows, and
	renamed it to TclpGetUserHome.

	* generic/tclPanic.c:
	* generic/panic.c: Renamed panic to Tcl_Panic.

1999-02-25  Scott Redman  <[email protected]>

	* win/makefile.vc: Added tclWinConsole.c and tclWinSerial.c

	* win/tclWinConsole.c: New code to properly deal with fileevents and
	nonblocking mode on consoles.

	* win/tclWinSerial.c: New code to properly deal with fileevents and
	nonblocking mode on serial ports.

	* win/tclWinPipe.c:
	* win/tclWinPort.h: Exported functions to allow creation of pipe
	channels from tclWinChan.c

	* win/tclWinChan.c: Check the type of a channel, including for the
	standard (stdin/stdout/stderr), and use the correct channel type to
	create the channel (file, serial, console, or pipe).

1999-02-11  Scott Stanton  <stanton@GASPODE>

	* README:
	* generic/tcl.h:
	* win/README.binary:
	* win/README:
	* unix/configure.in:
	* mac/README: Updated version numbers to 8.1b2.

1999-02-10  Scott Stanton  <stanton@GASPODE>

	* library/auto.tcl: Fixed auto_mkindex so it handles .tbc files. Did
	some general cleanup to handle bad eval statements that didn't use
	"list".

	* unix/mkLinks:
	* doc/SetVar.3:
	* generic/tcl.h:
	* generic/tclVar.c: Restored Tcl_ObjGetVar2 and Tcl_ObjSetVar2 from
	8.0. Renamed Tcl_Get/SetObjVar2 to Tcl_GetVar2Ex and Tcl_SetVar2Ex.

1999-02-10  Scott Stanton  <stanton@GASPODE>

	INTEGRATED PATCHES FROM 8.0.5b2:

	* test/winPipe.test: Changed to remove echoArgs.tcl temporary file
	when done.

	* tests/cmdAH.test:
	* generic/tclFileName.c (TclGetExtension): Changed behavior so the
	split happens at the last period in the name instead of the first
	period of the last run of periods. So, "foo..o" is split into "foo."
	and ".o" now. [Bug 1126]

	* win/makefile.vc: Added better support for paths with spaces in the
	name. Added .lib and support .dlls to the install-binaries target.
	Added generate of a pkgIndex.tcl script to the install-libraries
	target.

	* win/tclAppInit.c:
	* unix/tclAppInit.c:
	* mac/tclMacAppInit.c:
	* generic/tclTest.c: Changed some EXTERN declarations to extern since
	they are not defining exported interfaces. This avoids generating
	useless declspec() attributes and makes the windows makefile simpler.

	* generic/tcl.h: Moved Tcl_AppInit declaration to end and cleared out
	TCL_STORAGE_CLASS so it is not declared with a declspec().

	* tests/interp.test:
	* generic/tclInterp.c (DeleteAlias): Changed to use
	Tcl_DeleteCommandFromToken so we handle renames properly. This avoids
	senseless panic. [Bug 736]

	* unix/tclUnixChan.c:
	* win/tclWinSock.c:
	* doc/socket.n: Applied Gordon Chaffee's patch to handle failures
	during asynchronous socket connection operations. This adds a new
	"-error" fconfgure option to socket channels. [Bug 893]

	* generic/tclProc.c:
	* generic/tclNamesp.c:
	* generic/tclInt.h:
	* generic/tclCmdIL.c:
	* generic/tclBasic.c:
	* generic/tclVar.c: Applied patch from Viktor Dukhovni to rationalize
	TCL_LEAVE_ERR_MSG behavior when creating variables.

	* generic/tclVar.c: Fixed bug in namespace tail computation. Fixed bug
	where upvar could resurrect a namespace variable whose namespace had
	been deleted.

	* generic/tclCompile.c (TclCompileExprCmd): Eliminated yet another
	bogus optimization in expression compilation.

	* unix/configure.in: Added branch for BSD/OS-4* to shared library case
	statement. [Bug 975]
	Fixed to correctly handle IRIX 6.5 n32 library support. [Bug 1117]

	* win/winDumpExts.c: Patched to be pickier about stripping @'s. [Bug
	920]

	* library/http2.0/http.tcl: Added catch around eof test in CopyDone
	since the user may have already called http::reset. [Bug 1108]

	* unix/configure.in: Changed Linux and IRIX to set SHLIB_LIBS to LIBS
	so shared libraries are linked with the system libraries. [Bug 1018]

	* generic/tclCompile.c (CompileExprWord): Fixed exception stack
	overflow bug caused by missing statement. [Bug 928]

	* generic/tclIOCmd.c:
	* generic/tclBasic.c: Objectified the "open" command. [Bug 1113]

	* generic/tclPosixStr.c (Tcl_ErrnoId, Tcl_ErrnoMsg): When using egcs,
	ENOTSUP and EOPNOTSUPP are the same, so now we handle that case. [Bug
	1137]

	* library/init.tcl: Various small changes requested by Jan Nijtmans.
	- If the variable $tcl_library contains the empty string, this empty
	  string will be put in $auto_path. This is not useful at all, it only
	  slows down later package processing.
	- If the variable tcl_pkgPath is not set, the "unset __dir" fails.
	  Thich makes init.tcl totally unusable. Better put a "catch" around
	  it.
	- In the function tcl_findLibraries, the "string match" function only
	  works correctly if $tcl_patchLevel is in one of the forms "?.?a?",
	  "?.?b?" or "?.?.?". Could a "regexp" be used instead, then it allows
	  anything to be appended to the patchLevel string. And it is more
	  efficient.
	- The tclPkgSetup function assumes that if $type != "load" then the
	  type must be "source". This needn't be true. Some users want to add
	  their own setup types.
	[RFE 1138] [Bug 978]

	* win/tclWinReg.c:
	* doc/registry.n: Added support for HKEY_PERFORMANCE_DATA and
	HKEY_DYN_DATA keys. [Bug 1109]

	* win/tclWinInit.c (TclPlatformInit): Added code to ensure tcl_pkgPath
	is set to "" when no registry entry is found. [Bug 978]

1999-02-01  Scott Stanton  <stanton@GASPODE>

	* generic/tclBasic.c:
	* generic/tclCmdAH.c:
	* generic/tclCmdIL.c:
	* generic/tclCmdMZ.c:
	* generic/tclExecute.c:
	* generic/tclHistory.c:
	* generic/tclIO.c:
	* generic/tclIOUtil.c:
	* generic/tclInterp.c:
	* generic/tclMain.c:
	* generic/tclNamesp.c:
	* generic/tclParse.c:
	* generic/tclProc.c:
	* generic/tclTest.c:
	* generic/tclTimer.c:
	* generic/tcl.h: Made eval interfaces compatible with 8.0 by renaming
	Tcl_EvalObj to Tcl_EvalObjEx, renaming Tcl_Eval2 to Tcl_EvalEx and
	restoring Tcl_EvalObj and Tcl_GlobalEvalObj interfaces so they match
	Tcl 8.0.

1999-01-28  Scott Stanton  <stanton@GASPODE>

	* Merged Tcl 8.0.5b1 changes.

	* generic/tclUtil.c (Tcl_DStringSetLength): Changed so the buffer
	overallocates in a manner similar to Tcl_DStringAppend. This should
	improve performance for TclUniCharToUtfDString.

1998-12-11    === Tcl 8.1b1 Release ===

1998-12-10  Scott Stanton  <stanton@GASPODE>

	* Fixed lots of files that used TCL_THREAD instead of TCL_THREADS.

	* generic/tclEncoding.c (Tcl_FreeEncoding): Moved most of the code
	into a static FreeEncoding routine that does not grab the
	encodingMutex to avoid deadlocks/races when called from other routines
	that already have the mutex.

1998-12-09  Scott Stanton  <stanton@GASPODE>

	* library/msgcat1.0/msgcat.tcl: Fixed bad export list, fixed so all
	locale strings are converted to lower case, including file names.

	* generic/regcomp.c (makescan): Fixed bug in longest match case that
	caused anchored patterns to fail. [Bug 897]

1998-12-08  Scott Stanton  <stanton@GASPODE>

	* library/msgcat1.0/msgcat.tcl: changed mc to invoke mcunknown in the
	calling context, changed locale lookups to be case insensitive

1998-12-07  Scott Stanton  <stanton@GASPODE>

	* generic/tclAlloc.c (TclpRealloc): Fixed a memory allocation bug
	where big blocks that were reallocated into a different heap location
	were not being placed into the bigBlocks list. [Bug 933]

	* tests/msgcat.test: Added message catalog test suite.

	* library/msgcat1.0/msgcat.tcl: minor bug fixes, integrated latest
	changes from Mark Harrison.

1998-12-04  Scott Stanton  <stanton@GASPODE>

	* library/msgcat1.0/msgcat.tcl: Changed code to conform to Tcl coding
	standards. Changed to use file join for portability.

	* library/msgcat1.0: Added initial implementaion of Tcl message
	catalog package contributed by Mark Harrison.

1998-12-03  Scott Stanton  <stanton@GASPODE>

	* win/tclWinPipe.c (BuildCommandLine): Fixed bug that kept arguments
	containing spaces from being properly quoted.

	* tests/defs: Changed so auto_path is set to only contain the Tcl
	library directory. This keeps the tests from accidentally picking up
	stuff in installed packages.

	* generic/tclUtil.c (Tcl_StringMatch): Changed to match 8.0 behavior
	in corner case where there is no closing bracket.

1998-12-02  Scott Stanton  <stanton@GASPODE>

	* win/tclWinPipe.c (TclpCreateCommandChannel): Changed reader/writer
	threads to have THREAD_PRIORITY_HIGHEST so they will have a chance to
	run whenever there is something to do.

	* generic/tclIO.c (WriteBytes, WriteChars): Fixed so extraneous
	flushes do not happen in line mode.
	(TranslateOutputEOL): Made translation more efficient in line mode and
	fixed a buffer overflow bug in CRLF translation. [Bug 887]

1998-12-02  Brent Welch  <welch@SAGE>

	* Updated patchlevel to 8.1b1

1998-12-02  Scott Stanton  <stanton@GASPODE>

	* generic/regc_color.c (subcolor): Added check for error case to avoid
	an out of bounds array reference.

	* generic/tclCmdAH.c (Tcl_EncodingObjCmd): Changed to avoid using
	Tcl_DStringResult because it is not binary clean.

	* generic/tclParse.c (Tcl_ParseCommand): Fixed bug in comment parsing
	where a trailing comment looked like an incomplete command.

1998-12-02  Brent Welch  <welch@SAGE>

	* Merged changes from 8.0.4, especially the new pkg_mkIndex

1998-12-01  Scott Stanton  <stanton@GASPODE>

	* generic/tclIO.c (Tcl_ReadChars): Added a call to UpdateInterest so
	we don't block when there is data sitting in the buffers.

	* generic/tclTest.c (TestevalobjvObjCmd): Updated for EvalObjv change.

	* tests/parse.test: Updated tests for EvalObjv change.

	* generic/tclParse.c (EvalObjv, Tcl_EvalObjv): Changed Tcl_EvalObjv
	interface to remove string and length arguments, preserved original
	interface as EvalObjv for internal use.

	* generic/tcl.h: Changed Tcl_EvalObjv interface to remove string and
	length arguments.

	* doc/Eval.3: Updated documentation for Tcl_EvalObjv to remove string
	and length arguments.

	* generic/tclCompCmds.c (TclCompileForeachCmd): Fixed code that
	corrupted the exceptDepth value in the compile environment when
	foreach failed to compile inline. [Bug 884]

	* library/encoding/euc-kr.enc:
	* library/encoding/ksc5601.enc:
	* tools/encoding/ksc5601.txt:
	* unix/tclUnixInit.c: Added support for Korean EUC.

	* win/tclWinChan.c (TclpGetDefaultStdChannel): added check for a
	failure during Tcl_MakeFileChannel.

1998-11-30  Scott Stanton  <stanton@GASPODE>

	* unix/tclUnixNotfy.c (Tcl_WaitForEvent): Fixed hang that occurs when
	trying to close a pipe that is currently being waited on by the
	notifier thread. [Bug 607]

	* unix/tclUnixFCmd.c (GetPermissionsAttribute): Increase size of
	returnString buffer to avoid overflow. [Bug 584]

	* generic/tclThreadTest.c (TclThreadSend): Fixed memory leak due to
	use of TCL_VOLATILE instead of TCL_DYNAMIC.

	* generic/tclThread.c (TclRememberSyncObject): Fixed memory leak
	caused by failure to reuse condition variables.

	* unix/tclUnixNotfy.c (Tcl_AlertNotifier, Tcl_WaitForEvent,
	(NotifierThreadProc, Tcl_InitNotifier): Fixed race condition caused by
	incorrect use of condition variables when sending messages between
	threads. [Bug 607]

	* generic/tclTestObj.c (TeststringobjCmd): MAX_STRINGS was off by one
	so the strings array was too small.

	* generic/tclCkalloc.c (Tcl_DbCkfree): Moved mutex lock so
	ValidateMemory is done inside the mutex to avoid a race condition when
	validate_memory is enabled. [Bug 880]

1998-11-23  Scott Stanton  <stanton@GASPODE>

	* regexec.c: more performance tuning from Henry Spencer.

1998-11-17  Scott Stanton  <stanton@GASPODE>

	* tclScan.c: moved "scan" implementation out of tclCmdMZ.c and added
	Unicode support. This required a complete reimplementation of the
	command to avoid using scanf(), which isn't Unicode aware. Two new
	features were added in the process: %n to return the current number of
	characters consumed, and XPG3-style %n$ argument order specifiers
	similar to those provided by the "format" command. [Bug 833]

	* tclAlloc.c: changed so allocated memory is always 8-byte aligned to
	improve memory performance and to ensure that it will work on systems
	that don't like accessing 4-byte aligned values (e.g. Solaris and
	HP-UX). [Bug 834]

1998-11-06  Scott Stanton  <stanton@GASPODE>

	* tclVar.c (TclGetIndexedScalar): Fixed bug 796, var name was getting
	lost before being passed to CallTraces.

1998-10-21  Scott Stanton  <stanton@GASPODE>

	* added "encoding" command

	* Moved internal regexp declarations from tclInt.h to tclRegexp.h

	* integrated regexp updates from Henry Spencer

1998-10-15  Scott Stanton  <stanton@GASPODE>

	* tclUtf.c: added Unicode character table support

	* tclInt.h: added TclUniCharIsWordChar

	* tclCmdMZ.c (Tcl_StringObjCmd): added "totitle" subcommand, changed
	"wordend" and "wordstart" to properly handle Unicode word characters
	and connector punctuation

1998-10-05  Scott Stanton  <stanton@GASPODE>

	* auto.tcl, package.tcl: fixed SCCS strings

	* tclIndex: updated index to reflect 8.1 files

	* tclCompile.c (TclCompileScript): changed to avoid modifying the
	input string in place because name lookup operations could have
	arbitrary side effects

	* tclInterp.c: added guard against deleting current interpreter

	* tclMacFile.c, tclUnixFile.c, tclWinFile.c, tclFileName.c: added
	warnings around code that modifies strings in place

	* tclExecute.c: fixed off-by-one copying error, fixed merge bugs

	* tclEvent.c: changed so USE_TCLALLOC is tested for value instead of
	definition

	* tclCompCmds.c: replaced SCCS strings, added warnings around code
	that modifies strings in place

	* interp.test: added test for interp deleting itself

1998-09-30  Scott Stanton  <stanton@GASPODE>

	* makefile.vc: fixed so TCL_LIBRARY is set before running tcltest

	* tclWin32Dll.c: removed TclpFinalize, cleanup of merges
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<




















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































Deleted ChangeLog.2000.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
2000-12-14  Don Porter  <[email protected]>

	* generic/tclExecute.c:
	* tests/expr-old.test: Re-wrote Tcl's [expr rand()] and [expr
	srand($seed)] implementations, fixing a range error on some 64-bit
	platforms. Added tests that detect the bug. The rewrite changes the
	seed -> sequence map on 64-bit platforms, only for seed >= 2^31, a
	slight incompatibility. [Bug 121072, Patch 102781]

2000-12-10  Don Porter  <[email protected]>

	* library/init.tcl:
	* library/msgcat/msgcat.tcl:
	* library/msgcat/pkgIndex.tcl:
	* library/opt/optparse.tcl:
	* library/opt/pkgIndex.tcl: Where [uplevel] is used in a proc to
	evaluate a Tcl built-in command in the caller's context, the built-in
	commands are now fully namespace-qualified. This prevents problems
	when the caller context is in a namespace where the built-in command
	name has been used by a command in the namespace. (For example,
	[::ns::set] might be called instead of the intended [::set]). [Bug
	119422, Patch 102545]

2000-12-09  Jeff Hobbs  <[email protected]>

	* win/tclWinTime.c (CalibrationThread): added lint return value to
	prevent compiler warning. [Bug 125005]

	* docs/scan.n:
	* tests/scan.test:
	* generic/tclScan.c (Tcl_ScanObjCmd): changed %o and %x to use strtoul
	instead of strtol to correctly preserve scan<>format conversion of
	large integers. [Patch 102663, Bug 124600]

	* generic/tclExecute.c (TclExecuteByteCode): Commited patch fixing
	handling of {!<boolean>} in expressions. [Patch 102702]

2000-12-08  Jeff Hobbs  <[email protected]>

	* library/init.tcl: Added support for PATHEXT variable in auto_execok,
	recognizing the proper set of executable extensions on Windows. [Patch
	102719]

2000-12-08  Andreas Kupries  <[email protected]>

	* generic/tclEncoding.c (LoadTableEncoding): Changed dangerous code to
	something less critical. This fixes [Bug 119417], part A without
	affecting the speed when loading encodings.

2000-12-08  Donal K. Fellows  <[email protected]>

	* doc/open.n: Added xref to fconfigure and advice on the opening of
	binary files. Should help prevent a recurrence of bugs like [Bug
	124558]

2000-12-07  Jeff Hobbs  <[email protected]>

	* generic/tcl.h: added note about need to updated
	library/dde/pkgIndex.tcl with minor version increment.

	* library/dde/pkgIndex.tcl: updated to use 84 version to reflect the
	makefile. Should probably be updated to use its real version at some
	point. [Patch 102560, Bug 119421]

2000-12-06  Eric Melski  <[email protected]>

	* generic/tcl.h (attemptckalloc): Fixed typo for #define of
	attemptckalloc (was defined to Tcl_AttempDbCkalloc, should have been
	Tcl_AttemptDbCkalloc). [Bug 124384]

	* generic/tclCkalloc.c: Added TCL_MEM_DEBUG versions of
	Tcl_AttemptDbCkrealloc and Tcl_AttemptDbCkalloc. [Bug 124384].

2000-11-24  Donal K. Fellows  <[email protected]>

	* generic/tclExecute.c (TclExecuteByteCode): Logical negation "!"  can
	now handle string booleans, provided those values are placed in
	variables.

	* tests/expr.test (expr-13.17): Check that [expr {!$var}] can negate
	the string-versions of booleans "yes", "false", etc.

	* library/tcltest/tcltest.tcl (getMatchingFiles,
	(getMatchingDirectories):
	* tools/man2html.tcl (doDir):
	* tools/man2help.tcl (doDir):
	* library/package.tcl (tclPkgUnknown,tclMacPkgSearch):
	* library/safe.tcl (AddSubDirs): [glob] uses -directory instead of
	unsafe [file join]. [Bug 123313]

	* generic/tclIndexObj.c:
	* generic/tclTestObj.c (TestindexobjCmd): Changed internal
	representation of index objects to fix [Bug 119082]; fix shouldn't be
	visible to outside world...

	* generic/tclTest.c (TestGetIndexFromObjStructObjCmd):
	* tests/indexObj.test: (indexObj-6.*) Added to test for presence of
	[Bug 119082].

2000-11-23  Donal K. Fellows  <[email protected]>

	* generic/tclCmdIL.c (Tcl_LsortObjCmd): Fixed memory leak from [Bug
	119398]

	* library/init.tcl (unknown): Added specific level parameters to
	all uplevel invokations to boost performance; didn't dare touch
	the "namespace inscope" stuff though, since it looks sensitive
	to me!  Should fix [Bug 123217], though testing is tricky...

2000-11-21  Andreas Kupries  <[email protected]>

	All of the changes below are described in TIP #7 ~ Specification and
	result from the application of the patch contained therein. Creator of
	the patch is Kevin Kenny <[email protected]>. The patch used here is
	actually a bit different. Two MS specific constant values (format
	FOOui64) were replaced with a more portable formatting of the values
	and an additional cast to LONGLONG. My cross-compiling gcc was unable
	to process the original form. [Patch 102459]

	* tclWinTime.c: Add to the static data a set of variables that manage
	the phase-locked techniques, including a ''CRITICAL_SECTION'' to guard
	them so that multi-threaded code is stable.

	* tclWinTime.c: Modify ''TclpGetSeconds'' to call ''TclpGetTime'' and
	return the 'seconds' portion of the result. This change is necessary
	to make sure that the two times are consistent near the rollover from
	one second to another.

	* tclWinTime.c: Modify ''TclpGetClicks'' to use TclpGetTime to
	determine the click count as a number of microseconds.

	* tclWinTime.c: Modify ''TclpGetTime'' to return the time as M*Q+B,
	where Q is the result of ''QueryPerformanceCounter'', and M and B are
	variables maintained by the phase-locked loop to keep the result as
	close as possible to the system clock. The ''TclpGetTime'' call will
	also launch the phase-lock management in a separate thread the first
	time that it is invoked. If the performance counter is unavailable, or
	if its frequency is not one of the two common 8254-compatible rates,
	then ''TclpGetTime'' will return the result of ''ftime'' as it does in
	Tcl 8.3.2.

	* tclWinTime.c: Add the clock calibration procedure. The calibration
	is somewhat complex; to save space, the reader is referred to the
	reference implementation for the details of how the time base and
	frequency are maintained.

	* tclWinNotify.c: Modify ''Tcl_Sleep'' to test that the process has,
	in fact, slept for the requisite time by calling ''TclpGetTime'' and
	comparing with the desired time. Otherwise, roundoff errors may cause
	the process to awaken early.

	* tclWinTest.c: Add a ''testwinclock'' command. This command returns a
	four element list comprising the seconds and microseconds portions of
	the system clock and the seconds and microseconds portions of the Tcl
	clock.

	* winTime.test: Add to the test suite a test that makes sure that the
	Tcl clock stays within 1.1 ms of the system clock over the duration of
	the test.

2000-11-21  Donal K. Fellows  <[email protected]>

	* doc/global.n:
	* doc/upvar.n:
	* doc/variable.n: Improved documentation to mention that variables so
	created are listed in [info locals] and added a few more cross-links
	between these commands. [Bug 119387]

2000-11-17  Donal K. Fellows  <[email protected]>

	* tests/safe.test: (safe-4.3):
	* generic/tclVar.c (TclLookupVar): Changed again. Now passes all the
	tests, though one needed modifying since it required the wrong answer.
	(Why on earth do we have inline modification of argument strings? This
	sort of thing is horrendous to debug and doesn't work well in a
	multithreaded environment!) [Bug 119192]

	* tests/var.test: (var-1.19) If my attempts to fix the problem aren't
	right yet, my attempts to describe it look pretty good to me...

2000-11-16  Andreas Kupries  <[email protected]>

	* win/tclWinPort.h (line 69): Changed reference to winsock2.h into
	winsock.h. This was a leftover from a foray into using winsock version
	2 (History lesson from Scott Redman and Jeff Hobbs). This code was no
	problem when compiling Tcl itself, but could trip extensions. [Bug
	122568]

2000-11-15  Jeff Hobbs  <[email protected]>

	* unix/Makefile.in: removed bp.c references (hasn't existed in a long
	time). Corrected 'make dist' to make dist with unversioned library
	directories (same as out of cvs), so make install works correctly with
	either source tree.

2000-11-15  Jeff Hobbs  <[email protected]>

	* generic/tclVar.c (TclLookupVar): reverted fix below as it broke all
	other array unset error reporting.  Bug 119192 is still open.

2000-11-15  Donal K. Fellows  <[email protected]>

	* generic/tclVar.c (TclLookupVar): Changed references to part2 to use
	elName instead in various error message generating spots. [Bug 119192]

2000-11-03  David Gravereaux  <[email protected]>

	* win/.cvsignore: Removed 'configure' from the glob list now that it's
	included.

2000-11-03  Jeff Hobbs  <[email protected]>

	8.4a2 RELEASE

	* unix/Makefile.in (install-libraries, dist):
	* win/makefile.vc (install-libraries):
	* win/Makefile.in (install-libraries): updated to install unversioned
	library directories into versioned directories.

	* tools/tcl.wse.in: updated for unversioning of library dirs

	* unix/mkLinks: updated mkLinks with latest doc updates

	* doc/Tcl_Main.3: added docs for Tcl_SetMainLoop

	* generic/tclStubInit.c:
	* generic/tclDecls.h:
	* generic/tcl.decls: added Tcl_SetMainLoop proc that allows people to
	set a main loop that will run for tclsh.
	* generic/tcl.h: added Tcl_MainLoopProc typedef
	* generic/tclMain.c (Tcl_SetMainLoop, StdinProc, Prompt): new
	StdinProc and Prompt static procs and Tcl_SetMainLoop stubs proc. The
	first two handle a fileevent based prompt (taken from tkMain.c).
	Tcl_SetMainLoop enables the interactive setting of a main loop
	procedure. This enables Tk to be a loadable package.

2000-11-02  David Gravereaux  <[email protected]>

	* generic/tclEvent.c: tclLibraryPath Tcl_Obj didn't have a way to
	share its data among threads. This caused Tcl_Init() to always fail in
	threads. Added a way to pass the data around with a global char*.
	[BUG: 5301]

2000-11-02  Jeff Hobbs  <[email protected]>

	* unix/configure:
	* unix/dltest/configure:
	* win/configure:
	* tools/configure: checked in configure scripts so people doing CVS
	checkouts aren't required to have autoconf. Changes to configure.in in
	the future will require the corresponding configure script to also be
	re-autoconf'ed and checked in.

	* win/makefile.vc:
	* win/tcl.m4: makefile fixes for Win64 support

	* generic/tclIndexObj.c (Tcl_GetIndexFromObjStruct): minor cast
	changes.

2000-11-01  Jeff Hobbs  <[email protected]>

	* unix/tcl.m4: removed use of -lbsd and -ldl for AIX-5.

	* tests/subst.test: added tests for non-zero return code handling by
	subst.
	* generic/tclParse.c (Tcl_EvalEx): corrected handling of non-zero,
	non-error return code cases for subst. [Bug 119829]

	* generic/tclVar.c (TclVarTraceExists): Corrected excessive mem use
	when info exists was called on a non-existent array element. [Bug
	119213, 119336]

2000-10-30  David Gravereaux  <[email protected]>

	* win/configure.in:
	* win/Makefile.in:
	* win/makefile.vc:
	* win/tcl.rc:
	* win/tclsh.rc: Added logic to derive filenames better in the resource
	scripts based on compile options.

2000-10-30  Jeff Hobbs  <[email protected]>

	* unix/tclUnixInit.c: added default encoding map from "ja_JP.eucJP" to
	"euc-jp". (takahashi)

	* tests/clock.test: corrected clock-2.* test numbering

	* unix/configure.in (SC_TCL_LINK_LIBS): removed code that was
	commented out (it had been moved to tcl.m4's SC_TCL_LINK_LIBS
	already).

	* unix/tcl.m4: consolidated gettimeofday check for AIX.

2000-10-27  Jeff Hobbs  <[email protected]>

	* unix/configure.in:
	* unix/tcl.m4: added support for AIX-5.

	* generic/tclIO.c (Tcl_NotifyChannel): removed #ifdef around code for
	old channel structures, placed preserve/release around statePtr
	* generic/tclIO.c (CloseChannel): the statePtr for a channel was not
	being freed when the last channel in a stack was freed, causing a mem
	leak.

	* unix/tclUnixChan.c: updated channel types to strict
	TCL_CHANNEL_VERSION_2 style to avoid compiler warnings. They work
	either way, but this avoids compiler warnings (that worries people).

2000-10-27  Jennifer Hom  <[email protected]>

	* library/tcltest1.0/tcltest.tcl: Removed a cd into the test directory
	in runAllTests that screwed up the temporary directory setting,
	effectively preventing users from running tests on multiple platforms
	at the same time.

2000-10-26  David Gravereaux <[email protected]>

	* win/tclWinFile.c (TclpMatchFilesTypes): NULL was being set to "attr"
	which was a DWORD. Changed NULL to zero because a 'void *' can't be
	set to a DWORD to avoid the compiler warning.

2000-10-24  Jennifer Hom  <[email protected]>

	* tests/all.tcl: Removed support for tcltest 1.0.

	* tests/tcltest.test:
	* library/tcltest1.0/tcltest.tcl:
	* library/tcltest1.0/pkgIndex.tcl:
	* docs/tcltest.n: Moved tcltest2 code so that it's the standard
	version of tcltest. Removed all tcltest2 files (tests/tcltest2.test,
	library/tcltest1.0/tcltest2.tcl, docs/tcltest2.n).

2000-10-20  Jeff Hobbs  <[email protected]>

	* win/tclWinFile.c (TclpMatchFilesTypes): made the stat call only
	occur when necessary (for 'glob' command). Significantly speeds up
	glob command from 8.3. [BUG: 6216]

2000-10-19  Jennifer Hom  <[email protected]>

	* library/tcltest1.0/tcltest2.tcl:
	* tests/tcltest2
	* doc/tcltest2.n: Code and documentation cleanup. Modified -verbose to
	take list of keywords as well as string of letters. Removed Tcl
	version information from tcltest. Removed tcltest::grep from tcltest
	package. Added optional 3rd directory argument to
	makeFile/makeDirectory and removeFile/removeDirectory.

	* tests/basic.test: Changed references to tcltest::tclVersion to
	hardcoded numbers.
	* generic/tcl.h: Changed reference to tcltest2.tcl and tcltest.tcl in
	comments to tests/basic.test.

2000-10-06  David Gravereaux  <[email protected]>

	* win/tclWinChan.c: moved Win2K bug case test with GetStdHandle() from
	TclpGetDefaultStdChannel into Tcl_MakeFileChannel to enable a more
	general method in detecting invalid OS handles rather than just a
	specific known case. [BUG: 5971]

2000-10-06  Jeff Hobbs  <[email protected]>

	* tests/cmdAH.test: extra tests for 'file channels' that include
	multiple interpreter tests and channel sharing
	* generic/tclIO.c (Tcl_GetChannelNamesEx): corrected function (and
	consequently 'file channels') to return channels that are actually
	registered for this specific interp, rather than this thread.

	* doc/CrtChannel.3: fixed spelling mistakes

2000-09-29  Jennifer Hom  <[email protected]>

	* library/tcltest1.0/tcltest2.tcl:
	* tests/tcltest2.test:
	* doc/tcltest2.n: Modified the new form of the test command to accept
	both attribute-value pairs and command line options. Updated the tests
	and the documentation for this new format. Also changed the option
	names for the test command.

2000-09-29  Jeff Hobbs  <[email protected]>

	* win/tclWinSerial.c (SerialGetOptionProc): corrected reporting of
	space parity on Windows (Eason) [Bug 6057].

	* win/Makefile.in: commented use of TESTFLAGS
	* unix/Makefile.in: added TESTFLAGS to test target to conform with
	Windows makefile and TEA style.

	* tests/stack.test: prevented possible crash on systems with low
	default stacksize (Tru64, AIX) in infinite recursion test. A solution
	to check remaining stack space in the core is best, but hard to do in
	a cross-platform manner.

	* generic/tclIOGT.c (FLUSH_DELAY): renamed DELAY define to FLUSH_DELAY
	to avoid defn conflict using Tru64's cc.

2000-09-28  Jeff Hobbs  <[email protected]>

	* tools/tcl.wse.in: added tclPlatDecls.h and tkPlatDecls.h to the
	Windows .exe install.

	* tests/fCmd.test (fCmd-6.20): corrected test to remove c:/tcl8975@
	after creating it.

	* tests/fileName.test: cleaned up the testing of glob patterns for
	c:/globTest (Windows) to directly create/remove directory.

2000-09-27  Jeff Hobbs  <[email protected]>

	* generic/tcl.decls:
	* generic/tclIO.c: updated Tcl_IsChannelShared,
	Tcl_IsChannelRegistered, Tcl_CutChannel, Tcl_SpliceChannel,
	Tcl_IsChannelExisting, and Tcl_ClearChannelHandlers to conform to the
	new stacked channel implementation. Their stub slots were also moved
	to give preference to the new 8.3.2 stub functions. This will cause an
	incompatibility with 8.4a1 only.
	(StopCopy): fixed a bug introduced by a partial fix in 8.3.2 that
	didn't set nonBlocking correctly when resetting the flags for the
	write side. [Bug: 6261]

	* doc/ChnlStack.3:
	* doc/CrtChannel.3:
	* generic/tcl.decls:
	* generic/tcl.h:
	* generic/tclDecls.h:
	* generic/tclIO.c:
	* generic/tclIO.h:
	* generic/tclIOGT.c:
	* generic/tclInt.decls:
	* generic/tclIntDecls.h:
	* generic/tclStubInit.c:
	* generic/tclTest.c:
	* tests/iogt.test:
	* unix/Makefile.in:
	* win/Makefile.in:
	* win/makefile.vc:
	* win/tclConfig.sh.in:
	* win/tclWinChan.c:
	* win/tclWinConsole.c:
	* win/tclWinPipe.c:
	* win/tclWinSerial.c:
	* win/tclWinSock.c: Up-port of changes made in 8.3.2 to 8.4a2 code
	base. Most of these changes relate to the rewrite of the stacked
	channel implementation, with a few config related fixes.

	Following is an asynchronous include of the applicable ChangeLog
	entries from 8.3.2.

	********************************************************
	** START OF ASYNCHRONOUS UP-PORT LOG (8.3.2 -> 8.4a2) **
	********************************************************

2000-08-07  Jeff Hobbs  <[email protected]>

	* doc/ChnlStack.3:
	* doc/CrtChannel.3: updated the docs to be aware of the
	TCL_CHANNEL_VERSION_2 style of Tcl channels.

	* generic/tclIO.c (Tcl_CreateChannel): added assertion to verify that
	the new channel versioning will be binary compatible with older
	channel drivers.

2000-08-05  Jeff Hobbs  <[email protected]>

	* generic/tclIOGT.c (TclChannelTransform): fixed segfault that would
	occur when transforming a channel with a proc that did not yet exist.
	(Kupries)

	* generic/tclTest.c (TestChannelCmd): added some lint init'ing of
	statePtr and chan vars.

2000-07-26  Jeff Hobbs  <[email protected]>

	Merged core-8-3-1-io-rewrite back into core-8-3-1-branch. The
	core-8-3-1-io-rewrite branch should now be considered defunct.

	* generic/tclStubInit.c:
	* generic/tclDecls.h:
	* generic/tcl.decls:
	* generic/tcl.h:
	* generic/tclIO.c: moved the Tcl_Channel* macros from tcl.h to tclIO.c
	and made them proper stubbed functions. These are: Tcl_ChannelName,
	Tcl_ChannelVersion, Tcl_ChannelBlockModeProc, Tcl_ChannelCloseProc,
	Tcl_ChannelClose2Proc, Tcl_ChannelInputProc, Tcl_ChannelOutputProc,
	Tcl_ChannelSeekProc, Tcl_ChannelSetOptionProc,
	Tcl_ChannelGetOptionProc, Tcl_ChannelWatchProc,
	Tcl_ChannelGetHandleProc, Tcl_ChannelFlushProc, and
	Tcl_ChannelHandlerProc. These should be used to access the
	Tcl_ChannelType structure instead of direct pointer dereferencing.

	* tests/iogt.test: added RCS string, marked tests 2.* to be unixOnly
	due to underlying system differences.

2000-07-25 Andreas Kupries <[email protected]>

	* tests/iogt.test: (line 866f) New tests iogt-6.[01], highlighting
	buffering trouble when stacking and unstacking transformations.
	iogt-6.0 is solved, see the changes below. iogt-6.1 remains, for now,
	due to the perceived complexity of solutions.

	* generic/tclIO.h: (line 139f) struct Channel, added a buffer queue,
	to hold data pushed back when stacking a transformation.

	* generic/tclIO.c:
	(line 91f, line 7434f) New internal function 'CopyBuffer'.  Derived
	from 'CopyAndTranslateBuffer', with translation removed.
	(line 1025f, line 1212f): Initialization of new queue.
	(line 1164f, Tcl_StackChannel): Pushback of input queue.
	(line 1293f, Tcl_UnstackChannel): Discard input and pushback.
	(line 3748f, Tcl_ReadRaw): Modified to use data in the push back area
	before going to the driver. Uses 'CopyBuffer', s.a.
	(line 4702f, GetInput): Modified to use data in the push back area
	before going to the driver.
 	(line 4867f, Tcl_Seek): Modified to take pushback of the topmost
	channel in a stack into account.
	(line 5620f, Tcl_InputBuffered): See above. Added
	'Tcl_ChannelBuffered'. Analog to 'Tcl_InputBuffered' but for the
	buffer area in the channel.

	* generic/tcl.decls: New public API 'Tcl_ChannelBuffered'. S.a.

2000-07-17  Jeff Hobbs  <[email protected]>

	* unix/Makefile.in:
	* win/Makefile.in:
	* win/makefile.vc: added tclIOGT.c to objects list to compile.

	* generic/tclStubInit.c:
	* generic/tclIntDecls.h:
	* generic/tclInt.decls: commented out internal decls for
	TclTestChannelCmd and TclTestChannelEventCmd as they were moved to
	tclTest.c. Added new decls for TclChannelEventScriptInvoker and
	TclChannelTransform.

	* generic/tclIO.c (CloseChannel): stopped masking out of the
	TCL_READABLE|TCL_WRITABLE bits from the state flags in CloseChannel,
	instead adding extra intelligence to CheckChannelErrors with a new
	CHANNEL_RAW_MODE bit for special behavior when called from Raw channel
	APIs.

2000-07-13  Jeff Hobbs  <[email protected]>

	* generic/tclIO.c (StackSetBlockMode): moved set of chanPtr outside of
	blockModeProc check to avoid infinite loop when blockModeProc was
	NULL. Updated TransformSeekProc to not call Tcl_Seek directly
	(Kupries).

	* win/tclWinChan.c: updated fileChannelType to v2 channel struct
	* win/tclWinConsole.c: updated consoleChannelType to v2 channel struct
	* win/tclWinPipe.c: updated pipeChannelType to v2 channel struct
	* win/tclWinSerial.c: updated serialChannelType to v2 channel struct
	* win/tclWinSock.c: updated tcpChannelType to v2 channel struct

2000-07-11  Brent Welch	<[email protected]>

	* win/tclConfig.sh.in (TCL_LIBS): Cleaned up unix-specific autoconf
	variables.

2000-07-11  Jeff Hobbs  <[email protected]>

	* tests/iogt.test: made tests [345].0 not run by default as they were
	failing in the new design, but I'm not convinced that the returned
	result isn't correct.

	* generic/tclDecls.h:
	* generic/tclStubInit.c:
	* generic/tcl.decls: added Tcl_GetTopChannel C API that returns the
	current top channel of a channel stack. Tcl_GetChannel was changed
	earlier to return the bottommost channel of a stack because that is
	the one that is guaranteed to stay around the longest, and this was
	needed to compensate for certain operations that want to look at the
	state of the main channel. Most channel APIs already compensate for
	grabbing the top, so it shouldn't be needed often.

	* generic/tclIO.c (Tcl_StackChannel, Tcl_UnstackChannel): Added
	flushing of buffers (Kupries), removed use of DownChannel macro, added
	Tcl_GetTopChannel public API to get to the top channel of the channel
	stack (necessary for TLS). Rewrote Tcl_NotifyChannel for new channel
	design (Kupries). Did some code cleanup in the transform code.
	tclIO.c must still be broken into bits (separate out test code and
	giot code, create tclIO.h).

2000-07-10  Andreas Kupries <[email protected]>

	* tests/iogt.test: Reverted some earlier changes as a fix by Jeff
	revived the original and correct behaviour. IOW, the tests showed a
	genuine error and I didn't see it :(.

	* generic/tclIO.c (Tcl_Read|Write_Raw): Changed to directly use the
	drivers and not DoRead|DoWrite. The latter use the buffering system,
	encoding and eol-translation and this wreaks havoc with the data going
	through the transformations. Both procedures use CheckForchannelErrors
	and let it believe that there is no background copy in progress or
	else stacked channels could not be used for that.

	* generic/tclIO.c (TclCopyChannel, CopyData): Moved access to the
	topmost channel from the first to the second procedure to make the
	decision about that at the last possible time (Callbacks can change
	the stacking).

	test suite: failures of iogt-[345].0

2000-07-06  Jeff Hobbs  <[email protected]>

	* tests/iogt.test: new tests for stacked channel stuff based off new
	'testchannel transform|unstack' code (Kupries IOGT extension).
	* generic/tcl.decls:
	* generic/tcl.h:
	* generic/tclDecls.h:
	* generic/tclStubsInit.c:
	* generic/tclIO.c: complete rewrite of Tcl Channel code for stacked
	channels. Channels are now designed to work in a more stacked fashion
	with a shared ChannelState data structure.

2000-06-02  Jeff Hobbs  <[email protected]>

	* generic/tclIO.c (CloseChannel): removed the &ing out of
	(TCL_READABLE|TCL_WRITABLE) from the flags, as CloseChannel does this
	on the next pass through for the top channel, and it appeared to be
	causing hangs by not allowing the final flush.

2000-06-01  Jeff Hobbs  <[email protected]>

	* generic/tclIO.c (CloseChannel): Rewrote CloseChannel code to unstack
	a channel during the close process. Fixed a refcount bug in
	Tcl_UnstackChannel. [Bug: 5623]
	(CloseChannel): further extended CloseChannel in the stacked case to
	effect certain operations on the next channel that would have been
	done in Tcl_Close.  Also added CHANNEL_CLOSED and removed
	(TCL_READABLE|TCL_WRITABLE) bits from chanPtr->flags. Changed final
	reset of the WatchProc to check the chanDownPtr's (next) interestMask.

	******************************************************
	** END OF ASYNCHRONOUS UP-PORT LOG (8.3.2 -> 8.4a2) **
	******************************************************

2000-09-20  Jeff Hobbs  <[email protected]>

	* tests/socket.test: removed doTestsWithRemoteServer constraint from
	socket-12.*. It requires 'exec', not a remote server. Cleaned up some
	coding errors.

2000-09-20  Jennifer Hom  <[email protected]>

	* library/tcltest1.0/pkgIndex.tcl: Updated to load tcltest 2.0.
	* library/tcltest1.0/tcltest2.tcl: New version of tcltest.
	Cleanup of command line parsing: allows users to specify command line
	arguments through an environment variable named TCLTEST_OPTIONS [RFE:
	3748], does not respond to incorrect arguments, and forces usage of
	entire flag name when using command line arguments. Defines accessor
	procs for all tcltest variables. Allows users to use 'return' in test
	scripts. Allow users to specify whether test files should be sourced
	or run in a separate process. 'all.tcl' code moved to tcltest package.
	'test' proc modified to use attribute-value pairs. Allow users to
	specify what return codes, output, and errors can be compared and
	whether these values should be compared using regexp, glob, or exact
	matching. makeDirectory & removeDirectory now operate with respect to
	temporaryDirectory [Bug: 6001]. Test results from tests run in slave
	interpreters are now included in test totals [Bug: 1493]. Test files
	that return error values are now reported.
	* tests/all.tcl: Added code to check for the tcltest version loaded;
	modified to figure out which tests to run based on the tcltest version
	loaded.
	* tests/tcltest.test: Modified to explicitly load version 1.0 of
	tcltest.
	* tests/tcltest2.test: New test suite for tcltest; includes all of the
	old tests plus new ones reflecting changes made for version 2.0.
	* tests/cmdAH.test: Added singleTestInterp constraint to cmdAH-31.2;
	this test does not run if tests aren't sourced into a single
	interpreter.
	* tests/socket.test: Fixed two tests that were referencing variables
	outside of scope.

	* tools/tcl.wse.in: Added code to install tcltest2.tcl.

	* doc/tcltest2.n: New documentation for tcltest version 2.0. Removes
	documentation for tcltest namespace variables. Adds documentation for
	new tcltest procs.

	* unix/mkLinks: Added code to link to tcltest2.n.

	* generic/tcl.h: Added comment to modify tcltest2.tcl as well as
	tcltest.tcl for version changes.

2000-09-19  Eric Melski  <[email protected]>

	* generic/tclCmdMZ.c (Tcl_RegexpObjCmd): When using -all, all attempts
	after the first to match the regexp against the string should include
	the TCL_REG_NOTBOL flag, to avoid erroneously matching ^ in the middle
	of the string. Added code to set this flag after the first pass
	through the matching loop. [Bug: 6284].

2000-09-19  David Gravereaux  <[email protected]>

	* doc/Eval.3: Added a note about the script argument to Tcl_Eval()
	should be in UTF-8 or risk implied conversion errors when possible
	combinations of upper ascii can be valid UTF-8 special codes.

2000-09-17  Eric Melski  <[email protected]>

	* tests/cmdIL.test: Added a test for fix for [Bug: 6212].

	* generic/tclCmdIL.c (Tcl_LsortObjCmd): Applied patch from [Bug:
	6212], which corrected an error in the handling of the -index option.

2000-09-14  Eric Melski  <[email protected]>

	* doc/Alloc.3: Added entries for Tcl_AttemptAlloc, Tcl_AttempRealloc.

	* doc/StringObj.3: Added entry for Tcl_AttemptSetObjLength.

	* generic/tclDecls.h:
	* generic/tclStubInit.c: Regen'ed stubs files from new tcl.decls.

	* generic/tcl.decls: Added stubs for the Tcl_Attempt* memory
	allocators and for Tcl_AttemptSetObjLength.

	* generic/tcl.h: Added #define's for attemptckalloc, attemptckrealloc,
	which map to the Tcl_Attempt* memory allocators.

	* generic/tclCkalloc.c: Added non-panic'ing versions of Tcl_Alloc,
	Tcl_Realloc, etc.; these are called Tcl_AttemptAlloc,
	Tcl_AttemptRealloc, etc. These are used by Tcl_AttemptSetObjLength and
	the string obj append functions.

	* generic/tclStringObj.c: Modified string growth algorithm to use
	doubling algorithm as long as possible, and only fall back when that
	fails. Added Tcl_AttemptSetObjLength, and modified
	AppendUnicodeToUnicodeRep, AppendUtfToUtfRep, and
	Tcl_AppendStringsToObjVA to support this.

2000-09-07  David Gravereaux <[email protected]>

	* win/.cvsignore: changed the glob patterns a bit to exclude VC++
	project conversion backups.

	* win/tclWinPipe.c: Stage-1 bug fix for TR#2460 "exec leaks memory".
	Added more logic around the close-down of the pipe reader thread so as
	to avoid, at all cost, a TerminateThread. Most cases with exec are
	fixed, but I don't consider 2460 done yet. Closing down the read side
	of a pipe before the child process, doesn't really fit the windows
	model. [BUG: 2460]

2000-09-07  Jeff Hobbs  <[email protected]>

	* doc/trace.n: minor doc cleanup

2000-09-06  André Pönitz <[email protected]>

	* doc/*.n: added or changed "SEE ALSO:" section

2000-09-06  Jeff Hobbs  <[email protected]>

	* win/tclWinLoad.c (TclpLoadFile): added special message for
	ERROR_PROC_NOT_FOUND exception in loading a dll.
	* win/tclWinError.c: changed ERROR_PROC_NOT_FOUND to map from ESRCH
	(POSIX: no such process) to EINVAL because there is no good mapping
	for "procedure not found".

	* README:
	* generic/tcl.h:
	* library/tcltest1.0/tcltest.tcl:
	* tools/tcl.wse.in:
	* tools/tcltk-man2html.tcl:
	* unix/configure.in:
	* unix/tcl.spec:
	* win/README.binary:
	* win/configure.in: updated patchlevel to 8.4a2

	* unix/tclUnixPipe.c (TclpCreateProcess): Removed WNOHANG from
	Tcl_WaitPid call in error case of process creation on Unix, as it
	would lead to defunct processes. [Bug: 6148]

	* tests/string.test: extended string repeat tests
	* generic/tclCmdMZ.c (Tcl_StringObjCmd): changed STR_REPEAT to
	preallocate the full space of the final string, avoided repeated
	appends.

	* doc/source.n:
	* doc/Eval.3: added extra note about how to safe use ^Z in code, as it
	is now a cross-platform (was just Windows) EOF char.

2000-09-05  Jeff Hobbs  <[email protected]>

	* generic/tclHash.c: fixed pedantic warning of incorrectly placed
	#endif

	* generic/tclExecute.c (TclExecuteByteCode): INST_STR_INDEX fixed
	pedantic cast warning.
	Corrected support for building with -DTCL_COMPILE_STATS.
	Added efficiency check of object equality.

2000-08-29  Eric Melski  <[email protected]>

	* generic/tclStringObj.c: Applied patch from Gerhard Hintermayer to
	provide a more conservative string growth algorithm for strings larger
	than one megabyte; this allows more efficient use of memory for very
	large strings.

2000-08-25  Eric Melski  <[email protected]>

	* tests/trace.test: Extended array tracing tests.

	* doc/trace.n: Clarified information about when array traces will be
	fired.

	* generic/tclVar.c (Tcl_ArrayObjCmd): Corrected call to CallTraces
	(for TCL_TRACE_ARRAY) to only be called when the variable is either an
	array or is undefined, to ensure that array traces do not fire for
	scalar variables.

2000-08-24  Eric Melski  <[email protected]>

	* doc/man.macros: Tweaked tab settings for .SO (Standard Options)
	sections, based on suggestion from Peter Spjuth.

2000-08-24  Mo DeJong  <[email protected]>

	* unix/README: Update to account for removal of --enable-gcc.
	* unix/configure.in:
	* unix/tcl.m4 (SC_ENABLE_GCC): Remove --enable-gcc option.
	* win/README: Add note about building with Cygwin.
	* win/configure.in:
	* win/tcl.m4 (SC_ENABLE_GCC): Remove --enable-gcc option. Remove quick
	hack that provided cross compile support for windows builds.

2000-08-24  Eric Melski  <[email protected]>

	Overall change: Added support for command rename/delete traces and new
	trace syntax, from patch from Vince Darley. Added support for array
	traces for variables. [RFE: 5048, 5967].

	* doc/trace.n: Updated documentation for new syntax; flagged old
	syntax as deprecated; added documentation for command rename/delete
	traces and variable array traces.

	* tests/trace.test: Updated tests for new trace syntax; new tests for
	command rename/delete traces; new tests for array traces.

	* generic/tclVar.c: Support for new trace syntax; support for
	TCL_TRACE_ARRAY.

	* generic/tclStubInit.c:
	* generic/tclDecls.h:
	* generic/tcl.decls: Stub functions for command rename/delete traces.

	* generic/tcl.h:
	* generic/tclInt.h:
	* generic/tclBasic.c: Support for command traces.

	* generic/tclCmdMZ.c (TclTraceVariableObjCmd): Patched to support new
	[trace] syntax:
	trace {add|remove|list} {variable|command} name ops command
	Added support for command traces (rename, delete operations).
	Added support for TCL_TRACE_ARRAY at Tcl level (array operation for
	variable traces).

2000-08-20  Eric Melski  <[email protected]>

	* generic/tclVar.c: Added check for non-arrays for [array statistics]
	command (patch from Mark Patton).

2000-08-19  David Gravereaux <[email protected]>

	* generic/tclPlatDecls.h: without a previous '#include <windows.h>',
	tclPlatDecls.h can't be parsed due to a missing definition of TCHAR.
	Added a check to include it when not defined.

	***POSSIBLE OBSCURE BUG*** could be caused when the compile flags for
	the core happen to be different than a project who uses these publics
	regarding -D_MBCS and -D_UNICODE. This added check might have to be
	revisited later with a better understanding of the reprocusions. I
	think TCHAR should be replaced with it's expansion.

2000-08-18  David Gravereaux <[email protected]>

	* win/.cvsignore (added): provides a cleaner build environment with
	graphical CVS clients.

2000-08-15  Eric Melski  <[email protected]>

	* library/tcltest1.0/tcltest.tcl: Set debug level in
	tcltest::restoreState to 2, for consistancy with the debug level in
	tcltest::saveState [Bug: 4505].

2000-08-14  Eric Melski  <[email protected]>

	* win/makefile.vc:
	* win/Makefile.in:
	* unix/Makefile.in: Added tclPlatDecls.h to the list of installed
	headers, for more complete stubs support. [Bug: 5241].

	* generic/tcl.h: Added #include "tclPlatDecls.h" to get
	platform-specific stubs declarations (Tcl_WinTCharToUtf, etc)
	[Bug: 5241].

	* README: Updated link for instructions on compiling Tcl from sources
	to point to correct location (http://dev.scriptics.com/doc/... instead
	of http://dev.scriptics.com/support/...).

2000-08-11  Eric Melski  <[email protected]>

	* generic/tclEnv.c (TclUnsetEnv): Changed declaration of length
	variable from "unsigned int" to "int", to match usage when passed to
	TclpFindVariable [Bug: 6126].

2000-08-10  Eric Melski  <[email protected]>

	* library/msgcat1.0/pkgIndex.tcl: Bumped version number to 1.2 [Bug:
	6100].

	* library/msgcat1.0/msgcat.tcl: Removed erroneous [package forget] in
	msgcat namespace initializer. Bumped version number to 1.2 [Bug: 6100]

2000-08-10  David Gravereaux <[email protected]>

	* generic/tclObj.c: r1.15 accidentally changed a global mutex name
	tclObjMutex to ObjMutex.  Put the correct name back.

2000-08-07  Eric Melski  <[email protected]>

	* tests/indexObj.test: Added tests using the [testwrongnumargs]
	command to test Tcl_WrongNumArgs.

	* generic/tclTest.c (TestWrongNumArgsObjCmd): Added test function for
	the Tcl_WrongNumArgs function.

	* generic/tclIndexObj.c (Tcl_WrongNumArgs): Corrected algorithm to not
	insert a space before the message component when objc == 0 [Bug: 6078]

2000-07-27  Mo DeJong  <[email protected]>

	* win/configure.in: TCL_STUB_LIB_FLAG should not include ${TCL_DBGX}
	in win/tclConfig.sh, fix that.

2000-07-25  David Gravereaux  <[email protected]>

	* doc/Async.3:
	* generic/tclAsync.c:
	* generic/tclInt.decls:
	* generic/tclIntPlatDecls.h:
	* generic/tclStubInit.c:
	* generic/tclTest.c:
	* mac/tclMacPort.h:
	* unix/tclUnixPort.h:
	* win/tclWinInit.c: Thread-safe rewrite for tclAsync.c. Added notifier
	alerting on all platforms as it was only working on Win before.
	Removed older Win hacks that would end-up waking the wrong notifier in
	the presence of a threaded build. All tests pass as before. New test
	cases will be added soon for the new behavior. [BUG: 5791]

2000-07-25  Eric Melski  <[email protected]>

	* generic/tclVar.c (CallTraces): Added check for VAR_TRACE_ACTIVE on
	the array containing the variable before executing traces on that
	array, to conform with normal variable traces and the documentation,
	which states that while executing a trace, other traces on that
	variable are disabled. [Bug: 6049].

	* win/tclWinPipe.c (BuildCommandLine): Added Tcl_DStringFree call to
	prevent potential memory leaks [Bug: 6041].

2000-07-24  Eric Melski  <[email protected]>

	* doc/msgcat.n: Added documentation about the selection of the default
	locale on Windows.

2000-07-23  Joe English  <[email protected]>

	* doc/AddErrInfo.3:
	* doc/ChnlStack.3:
	* doc/Exit.3:
	* doc/GetIndex.3:
	* doc/Notifier.3:
	* doc/Object.3:
	* doc/RegExp.3:
	* doc/SetResult.3:
	* doc/SplitList.3:
	* doc/Thread.3:  Added missing entries to NAME section.

	* doc/AddErrInfo.3:
	* doc/CrtObjCmd.3:
	* doc/RecEvalObj.3: Changed Tcl_EvalObj to Tcl_EvalObjEx

2000-07-21  Eric Melski  <[email protected]>

	* generic/tclStubInit.c:
	* generic/tclObj.c:
	* generic/tclInt.h:
	* generic/tclHash.c:
	* generic/tclDecls.h:
	* generic/tcl.h:
	* generic/tcl.decls:
	* doc/Hash.3: Reapplied patch from Paul Duffin to extend hash tables
	to allow custom key types, such as Tcl_Obj *'s, and others.

	* doc/binary.n: Noted that the example in the introduction assumes a
	32-bit system [Bug: 6035].

2000-07-21  Mo DeJong  <[email protected]>

	* win/configure.in: Define ${prefix} and ${exec_prefix} like
	unix/configure.in. Fix or add TCL_SRC_DIR, TCL_STUB_LIB_FILE,
	TCL_STUB_LIB_FLAG, TCL_BUILD_STUB_LIB_SPEC, TCL_STUB_LIB_SPEC,
	TCL_BUILD_STUB_LIB_PATH, TCL_STUB_LIB_PATH.

2000-07-20  Eric Melski  <[email protected]>

	* generic/tclStubInit.c:
	* generic/tclObj.c:
	* generic/tclInt.h:
	* generic/tclHash.c:
	* generic/tclDecls.h:
	* generic/tcl.h:
	* generic/tcl.decls:
	* doc/Hash.3: Reverted patch from Paul Duffin to extend hash tables to
	allow custom key types, such as Tcl_Obj *'s, and others; it seems to
	break Tk.

2000-07-19  Eric Melski  <[email protected]>

	* generic/tclStubInit.c:
	* generic/tclObj.c:
	* generic/tclInt.h:
	* generic/tclHash.c:
	* generic/tclDecls.h:
	* generic/tcl.h:
	* generic/tcl.decls:
	* doc/Hash.3: Applied patch from Paul Duffin to extend hash tables to
	allow custom key types, such as Tcl_Obj *'s, and others.

	* tests/pkgMkIndex.test: Added tests for pkg_compareExtension.

	* library/package.tcl: Enhanced pkg_compareExtension to handle Unixes
	which tack the version number on to the end of library names (eg,
	foo.so.1.2); such filenames will be correctly matched. (Patch from
	Vince Darley).

	* win/makefile.vc: Applied patch from Don Porter to provide better
	nmake support for NT/Alpha [RFE: 5938].

2000-07-18  Mo DeJong  <[email protected]>

	* unix/configure.in:
	* unix/tcl.m4:
	* win/tcl.m4: Properly quote arguments to m4 macros. This allows Tcl
	to work with the new version of autoconf.

2000-07-18  Eric Melski  <[email protected]>

	* tests/opt.test: Removed references to Lfirst, Lrest functions.

	* library/opt0.4/optparse.tcl: Applied patch from Chris Nelson, which
	replaces the [Lfirst] function with an inline [lindex ... 0] and
	[Lrest] with [lrange ... 1 end], for better performance. [RFE: 6019]

2000-07-18  Eric Melski  <[email protected]>

	* compat/string.h: Fixed function prototypes for strpbrk and strtok
	[Bug: 6020].

2000-07-17  David Gravereaux  <[email protected]>

	* win/tclWinChan.c: Win2K OS bug with GetStdHandle(STD_OUTPUT_HANDLE)
	giving the wrong answer. This made TclpGetDefaultStdChannel grab what
	it thought was a valid native stdout handle. Added a new WriteFile()
	test to make sure it's really valid. This OS bug doesn't affect the
	shells. Only -subsystem:windows (aka WinMain) application that
	dynamically load tclXX.dll [BUG: 5971]

2000-07-17  Eric Melski  <[email protected]>

	* library/msgcat1.0/msgcat.tcl:
	* doc/msgcat.n:
	* tests/msgcat.test: Applied patches from Chris Nelson, to provide the
	mcmset function, which allows the translator to set multiple string
	translations in a single function call, rather than requiring many
	calls to mcset. [RFE: 6000, 5993]. In addition, these patches correct
	mcload to use utf-8 encoding on when reading message catalog files,
	and provides for better default behavior for determining the locale on
	a Windows system.

2000-07-17  Mo DeJong  <[email protected]>

	* unix/tcl.m4 (SC_ENABLE_GCC): Don't set CC=gcc before running
	AC_PROG_CC if CC is already set.

2000-07-13  André Pönitz <[email protected]>

	* doc/lappend.n:
	* doc/lindex.n:
	* doc/linsert.n:
	* doc/list.n:
	* doc/llength.n:
	* doc/lrange.n:
	* doc/lreplace.n:
	* doc/lsearch.n:
	* doc/lsort.n: Added SEE ALSO sections.

2000-07-07  Mo DeJong  <[email protected]>

	* win/configure.in: Fix definition of TCL_SRC_DIR so that it matches
	the Unix version.
	* win/tclConfig.sh.in: Removed duplicate variables.

2000-07-06  Eric Melski  <[email protected]>

	* tests/msgcat.test:
	* library/msgcat1.0/msgcat.tcl: Applied patch from Christian Krone, to
	provide extended args support for msgcat::unknown, which is used for
	strings without a known translation in the current locale [Bug: 5984].

2000-06-29  Eric Melski  <[email protected]>

	* doc/msgcat.n: Doc's for mcmax function.

	* library/msgcat1.0/msgcat.tcl: Applied patches from Laurent Duperval,
	to add mcmax function, which computes the length of the longest of
	several translated strings. Bumped version number to 1.1.

2000-06-27  Eric Melski  <[email protected]>

	* tests/stringObj.test: Tweaked tests to avoid hardcoded high-ASCII
	characters (which will fail in multibyte locales); instead used \uXXXX
	syntax. [Bug: 3842].

2000-06-26  Eric Melski  <[email protected]>

	* doc/package.n: Corrected information about [package forget]
	arguments [Bug: 5418].

2000-06-23  Eric Melski  <[email protected]>

	* doc/Hash.3: Added documentation patch for Tcl_Obj *'s as keys in Tcl
	hash tables [RFE: 5934].

	* generic/tcl.h:
	* generic/tclHash.c: Applied patch from [RFE: 5934], which extends Tcl
	hash tables to allow Tcl_Obj *'s as the key.

2000-06-20  Eric Melski  <[email protected]>

	* tests/opt.test:
	* library/opt0.4/optparse.tcl: Applied patch from [Bug: 5922], which
	corrected an incorrect use of [string match].

	* unix/tclConfig.sh.in:
	* win/tclConfig.sh.in: Applied patch from [Bug: 5921], which corrects a
	typo in the comments in these files.

2000-06-19  Eric Melski  <[email protected]>

	* doc/RegExp.3: Replaced instances of "Tcl_GetRegExpInfo" with
	"Tcl_RegExpGetInfo", the correct name of the function [Bug: 5901].

2000-06-13  Eric Melski  <[email protected]>

	* win/tcl.m4:
	* win/configure.in:
	* win/Makefile.in: Applied patch from [RFE: 5844], to extend support
	for mingw compile environment on Windows.

	* win/tclWinDde.c:
	* win/tclWinInit.c:
	* win/tclWinNotify.c:
	* win/tclWinPipe.c:
	* win/tclWinReg.c:
	* win/tclWinThrd.c: Applied patch from [Bug: 5794], to fix compiler
	warnings when using mingw on Windows.

2000-05-31  Jeff Hobbs  <[email protected]>

	* tests/set-old.test:
	* doc/unset.n:
	* generic/tclVar.c (Tcl_UnsetObjCmd): added -nocomplain and -- options
	to unset, to allow for a silent unset operation.

2000-05-31  Eric Melski  <[email protected]>

	* generic/tclVar.c (Tcl_ArrayObjCmd): Added support for regexp and
	exact matching for [array names] command. [RFE: 3684].

	* doc/array.n: Added documentation for [array names
	-exact/-regexp/-glob] [RFE: 3684].

	* tests/set-old.test: Added tests for [array names
	-exact/-regexp/-glob] [RFE: 3684].

2000-06-06  Jeff Hobbs  <[email protected]>

	8.4a1 RELEASE

	* generic/tclExecute.c (TclExecuteByteCode INST_STR_CMP): added test
	of iResult return from memcmp, as memcmp isn't required to return only
	-1,0,1.

2000-06-03  Jeff Hobbs  <[email protected]>

	* generic/tclIndexObj.c (Tcl_GetIndexFromObjStruct): Corrected caching
	of the index ptr to account for offsets != sizeof(char *). [Bug: 5153]

2000-05-29  Sandeep Tamhankar <[email protected]>

	* tests/http.test
	* doc/http.n
	* library/http2.3/http.tcl: Fixed bug 5741, where unsuccessful geturl
	calls sometimes leaked memory and resources (sockets). Also, switched
	around some of the logic so that http::wait never throws an exception.
	This is because in an asynchronous geturl, the command callback will
	probably end up doing all the error handling anyway, and in an
	asynchronous situation, the user expects to check the state when the
	transaction completes, as opposed to being thrown an exception.	For
	the http package, this menas the user can check http::status for
	"error" and http::error for the error message after doing the
	http::wait.

2000-05-27  Jeff Hobbs  <[email protected]>

	* tests/info.test:
	* doc/info.n:
	* generic/tclIOUtil.c (Tcl_EvalFile):
	* generic/tclCmdIL.c (InfoScriptCmd): added ability to set the info
	script return value [info script ?newFileName?]. This will be
	beneficial for virtual file system programs. [Bug: 4225]

2000-05-26  Jeff Hobbs  <[email protected]>

	* generic/tclCmdMZ.c (Tcl_RegsubObjCmd): reworked to operate in
	Unicode, tweaked for performance.
	(Tcl_StringObjCmd) changed STR_FIRST/STR_LAST error message to
	something more understandable, reworked STR_FIRST, STR_LAST, STR_MAP,
	STR_MATCH, STR_RANGE, STR_REPLACE to operate in Unicode. Removed
	inneffectual STR_RANGE "special" ByteArray support. Optimized STR_MAP
	algorithm, especially optimized for one-pair case. Fixed possible mem
	overrun in STR_INDEX bytearray case.

	* generic/tclCompExpr.c: changed INST_STREQ -> INST_STR_EQ,
	INST_STRNEQ -> INST_STR_NEQ
	* generic/tclCompile.c: added streq, strneq, strcmp, strlen &
	strmatch to the compiled stats instructionTable
	* generic/tclCompile.h: added instructions INST_STR_CMP,
	INST_STR_INDEX, INST_STR_MATCH
	* generic/tclCompCmds.c: added byte compiler support for [string
	compare|match|index].
	* generic/tclExecute.c: Changed INST_STR_(N)EQ to return an Int object
	and not bother trying to reuse the top stack object. Added
	INST_STR_CMP, INST_STR_INDEX, INST_STR_MATCH bytecode ops. Extended
	evalstats output info with Tcl_IsShared stat info.

	* generic/tclInt.h:
	* generic/tclObj.c (Tcl_DbIsShared): added support for checking result
	of Tcl_IsShared in evalstats (TCL_COMPILE_STATS).

	* generic/tclStringObj.c (Tcl_AppendUnicodeToObj): removed dead code.
	(AppendUnicodeToUnicodeRep) removed overallocation by extra
	sizeof(Tcl_UniChar) multiplier.

	* tests/string.test: added string map tests for the one-pair case,
	corrected tests to reflect improved error messages in first/last.
	Added tests against mem overrun in string index bytearray case.

2000-05-23  Eric Melski  <[email protected]>

	* generic/tclInt.h: Added function prototypes for TclCompileStringCmd
	and TclCompileReturnCmd.

	* generic/tclCompile.h: Added definition of INST_STRLEN opcode and
	updated LAST_INST_OPCODE value.

	* generic/tclBasic.c: Added information about TclCompileStringCmd and
	TclCompileReturnCmd to BuiltInCmds table.

	* generic/tclExecute.c (TclExecuteByteCode): Added support for the
	INST_STRLEN opcode.

	* generic/tclCompCmds.c (TclCompileStringCmd): Basic implementation of
	byte-compiled [string] command. Not all subcommands are implemented;
	those that are not an out-line compiled.

	(TclCompileReturnCmd): Byte-compiled implementation of [return]
	command. Only "simple" returns are byte-compiled; in particular, if
	the -code, -errorinfo or -errorcode flags are used, the command is not
	byte-compiled.

2000-05-22  Jeff Hobbs  <[email protected]>

	* doc/scan.n:
	* doc/array.n: minor doc fixes [Bug: 5396]

	* generic/tclEnv.c: cast cleanup [Bug: 5624]
	* win/tclWinConsole.c: cast and header cleanup [Bug: 5625]
	* win/tclWinSerial.c: cast cleanup [Bug: 5626]
	* win/tclWinFCmd.c: cast cleanup [Bug: 5627]

2000-05-19  Jeff Hobbs  <[email protected]>

	* generic/tclTest.c:
	* generic/tclIO.c: moved channel test commands from tclIO.c to
	tclTest.c.
	* generic/tclIO.h: new file, split out from tclIO.c to allow test
	commands to be moved to tclTest.c.

	* generic/tclStubInit.c:
	* generic/tclIntDecls.h:
	* generic/tclInt.decls: removed TclTestChannel*Cmd from internal stubs
	table and added TclChannelEventScriptInvoker to the internal stubs
	table so it can be used from the test code.

2000-05-18  Eric Melski  <[email protected]>

	* tests/clock.test: Added test for "2 days 2 hours ago" style
	specifications.

	* generic/tclDate.c: Regenerated from tclGetDate.y.

	* generic/tclGetDate.y: Tweaked grammar to properly handle the "ago"
	keyword when it follows multiple relative unit specifiers, as in "2
	days 2 hours ago". [Bug: 5497]

2000-05-18  Jeff Hobbs  <[email protected]>

	* win/{tcl.m4,Makefile.in,configure.in}: added support for mingw
	compile env and cross-compiling. [Bug: 5499]

	* generic/tclClock.c (FormatClock): correct code to handle locale
	specific return values from strftime, if any. [Bug: 3345]

	* unix/tclUnixInit.c (TclpSetInitialEncodings): attempt to correct
	setlocale calls for XIM support and locale issues. [BUG: 5422 3345
	4236 2522 2521]

2000-05-17  Jeff Hobbs  <[email protected]>

	* library/init.tcl (auto_import): added check to see if a valid
	pattern was coming in, to avoid simple error cases [Bug: 3326]

	* doc/regsub.n: correct regsub docs [Bug: 5346]

2000-05-15  Eric Melski  <[email protected]>

	* library/history.tcl: Corrected an off-by-one error in HistIndex,
	which was causing [history redo] to start its search at the wrong
	event index. [Bug: 1269].

2000-05-10  Jeff Hobbs  <[email protected]>

	* generic/tclPosixStr.c (Tcl_SignalMsg): clarified #defines for Linux
	on Sparc to compile correctly. [Bug: 5364]

	* doc/namespace.n:
	* tests/namespace.test:
	* generic/tclNamesp.c (Tcl_NamespaceObjCmd): added 'namespace exists'
	command. [Bug: 4665]

	* doc/source.n:
	* doc/Eval.3:
	* tests/source.test:
	* generic/tclIOUtil.c (Tcl_EvalFile): added explicit \x1A (^Z) eofchar
	(affects Tcl_EvalFile in C, "source" in Tcl). This was implicit on
	Windows already, and is now cross-platform to allow for scripted
	documents.

2000-05-09  Andreas Kupries  <[email protected]>
	operating as proxy for David Gravereaux <[email protected]>

	* win/tclWinThrd.c (TclpInitLock, TclpMasterLock): Added missing
	initialization of joinLock.

2000-05-09  Eric Melski  <[email protected]>

	* tests/lsearch.test:
	* doc/lsearch.n:
	* generic/tclCmdIL.c (Tcl_LsearchObjCmd): Extended [lsearch] to
	support sorted list searching and typed list searching. [RFE: 4098].

2000-05-08  Jeff Hobbs  <[email protected]>

	* doc/expr.n:
	* tests/expr.test:
	* tests/expr-old.test: added tests for 'eq' and 'ne'
	* generic/tclExecute.c:
	* generic/tclCompile.h: added INST_STREQ and INST_STRNEQ opcodes that
	do strict string comparisons.
	* generic/tclCompExpr.c: added 'eq' and 'ne' string comparison
	operators.
	* generic/tclParseExpr.c (GetLexeme): added 'eq' and 'ne' expr parse
	terms (string (in)equality check).

	* generic/tclCmdIL.c (Tcl_LinsertObjCmd): made use of
	Tcl_DuplicateObj where code was otherwise duplicated. Made special
	case of inserting one element at the end work again (where index ==
	len).
	(Tcl_LreplaceObjCmd): moved Tcl_DuplicateObj call lower and cleaned
	up use of other arguments.

	* generic/tclObj.c (Tcl_DuplicateObj): simplified code to call
	TclInitStringRep, which the code was just duplicating in part.

	* doc/Utf.3:
	* generic/tclStubInit.c:
	* generic/tcl.decls:
	* generic/tclDecls.h:
	* generic/tclUtf.c: Added new functions Tcl_UniCharNcasecmp and
	Tcl_UniCharCaseMatch (unicode parallel to Tcl_StringCaseMatch)
	* generic/tclUtil.c: rewrote Tcl_StringCaseMatch algorithm for
	optimization and made Tcl_StringMatch just call Tcl_StringCaseMatch
	* tests/string.test: extended string match tests

2000-05-08  Eric Melski  <[email protected]>

	* tests/set-old.test:
	* doc/array.n:
	* generic/tclVar.c: Added [array statistics] command [RFE: 4557]

2000-05-06  Andreas Kupries <[email protected]>
	operating as proxy for David Gravereaux <[email protected]>

	* tclThreadJoin.c: Fixed several places with missing a & in arguments
	to calls of Tcl_Mutex(Un)lock and Tcl_ConditionNotify functions.

2000-05-02  Jeff Hobbs  <[email protected]>

	* README:
	* generic/tcl.h:
	* library/init.tcl:
	* library/reg1.0/pkgIndex.tcl:
	* library/tcltest1.0/tcltest.tcl:
	* mac/README:
	* tools/tcl.hpj.in:
	* tools/tcl.wse.in:
	* unix/README:
	* unix/configure.in:
	* unix/tcl.spec:
	* win/README:
	* win/README.binary:
	* win/configure.in:
	* win/makefile.vc:
	* win/tcl.m4: updated patchlevel to 8.4a1

	* tests/compile.test:
	* tests/init.test:
	* tests/proc.test:
	* tests/proc-old.test:
	* tests/rename.test:
	* generic/tclProc.c: reworked error return for procedures with
	incorrect args to be like the C Tcl_WrongNumArgs, where a "wrong #
	args: ..." message is printed out with the args list.

	* unix/Makefile.in: add tclsh.ico and tcl.spec to dist target

2000-05-02  Andreas Kupries <[email protected]>

	Overall changes:
	  (1) Implementation of joinable threads for all platforms.
	  (2) Additional API's for channels. Required to allow the thread
	      extension to move channels between threads.

	* generic/tcl.decls (lines 1360f): Added Tcl_JoinThread,
	Tcl_IsChannelShared, Tcl_IsChannelRegistered, Tcl_CutChannel,
	Tcl_SpliceChannel, Tcl_IsChannelExisting and Tcl_ClearChannelHandlers
	(slots 394 to 400).

	* generic/tclIO.c: Implemented Tcl_IsChannelRegistered,
	Tcl_IsChannelShared, Tcl_CutChannel, Tcl_SpliceChannel,
	Tcl_IsChannelExisting and Tcl_ClearChannelHandlers.  Tcl_CutChannel
	uses code from CloseChannel. Replaced this code by a call to
	Tcl_CutChannel. Replaced several code fragments adding channels to
	the channel list with calls to Tcl_SpliceChannel. Removed now unused
	variables from CloseChannel and Tcl_UnstackChannel.
	Tcl_ClearChannelHandlers uses code from Tcl_Close. Replaced this code
	by a call to Tcl_ClearChannelHandlers. Removed now unused variables
	from Tcl_Close. Added the subcommands 'cut', 'forgetch', 'splice' and
	'isshared' to the test code (TclTestChannelCmd).

	* unix/tclUnixThread.c: Implemented Tcl_JoinThread using the
	pthread-functionality.

	* win/tclWinThrd.c: Fixed several small typos in comments.
	Implemented Tcl_JoinThread using a platform independent emulation
	layer (see generic/tclThreadJoin.c below). Added 'joinLock' to
	serialize Tcl_CreateThread and TclpExitThread to prevent a race for
	joinable threads.

	* mac/tclMacThrd.c: Implemented Tcl_JoinThread using a platform
	independent emulation layer (see generic/tclThreadJoin.c below). Due
	to the cooperative nature of threading on this platform the race
	mentioned above is not present.

	* generic/tclThreadJoin.c: New file. Contains a platform independent
	emulation layer helping in the implementation of joinable threads for
	the win and mac platforms.

	* generic/tclInt.h: Added declarations for TclJoinThread,
	TclRememberJoinableThread and TclSignalExitThread. These procedures
	define the API of the emulation layer for joinable threads (see
	generic/tclThreadJoin.c above).

	* win/Makefile.in:
	* win/makefile.vc: Added generic/tclTheadJoin.o to the rules.

	* mac/: I don't know to which file generic/tclTheadJoin.o has to be
	added to so that it compiles. Sorry.

	* unix/tclUnixChan.c: #ifdef'd the thread-local list of file channels
	as it prevents us from transfering channels. To restore this we may
	need an extended interface to drivers in the future. Target:
	9.0. Found while testing the new transfer of channels. The information
	in this list for a channel was left behind and then crashed the system
	during finalization.

	* generic/tclThreadTest.c: Added -joinable flag to 'testthread
	create'. Added subcommand 'testthread join'.

	* doc/CrtChannel.3: Added documentation for Tcl_IsChannelRegistered,
	Tcl_IsChannelShared, Tcl_CutChannel, Tcl_SpliceChannel,
	Tcl_IsChannelExisting and Tcl_ClearChannelHandlers.

	* doc/Thread.3: Added documentation for Tcl_JoinThread.

	* tests/thread.test: Added tests for joining of threads.

2000-04-27  Eric Melski  <[email protected]>

	* doc/library.n: Added entries for auto_qualify and auto_import
	[Bug: 1271].

	* doc/Init.3: Manual entry for Tcl_Init [Bug: 1820].

	* doc/expr.n: Added documentation for each of the math library
	functions that expr supports [Bug: 1054].

2000-04-26  Eric Melski  <[email protected]>

	* doc/memory.n: Man page for Tcl "memory" command, which is created
	when TCL_MEM_DEBUG is defined at compile time.

	* doc/TCL_MEM_DEBUG.3: Man page with overall information about
	TCL_MEM_DEBUG usage.

	* doc/DumpActiveMemory.3: Man page for Tcl_DumpActiveMemory,
	Tcl_InitMemory, and Tcl_ValidateAllMemory [Bug: 1816, 1835].

	* generic/tclCkalloc.c: Fixed some function headers.

	* unix/mkLinks: Regen'd with new mkLinks.tcl.

	* unix/mkLinks.tcl: Fixed indentation, made link setup more
	intelligent (only do one existance test per man page, instead of one
	per function).

	* doc/library.n: Fixed .SH NAME macro to include each function
	documented on the page, so that mkLinks will know about the functions
	listed there, and so that the Windows help file index will get set up
	correctly [Bug: 1898, 5273].

2000-04-26  Jeff Hobbs  <[email protected]>

	8.3.1 RELEASE

	* README:
	* mac/README:
	* tools/tcl.wse.in:
	* unix/README:
	* unix/tcl.spec:
	* win/README:
	* win/README.binary: Updating URLs to reference dev.scriptics.com

2000-04-25  Jeff Hobbs  <[email protected]>

	* unix/Makefile.in:
	* win/Makefile.in:
	* win/makefile.vc: updated for http change and some cleanup
	* library/http2.[13]: moved dir http2.1 to http2.3 to match version

	* doc/Utf.3: clarified docs for Tcl_(UniChar|Utf)AtIndex

	* unix/tclUnixThrd.c: removed {}s around PTHREAD_MUTEX_INITIALIZER
	[Bug: 5254]

	* unix/tclLoadDyld.c (TclpLoadFile): removed use of interp->result

2000-04-25  Eric Melski  <[email protected]>

	* unix/mkLinks:
	* doc/AddErrInfo.3: Added information about Tcl_LogCommandInfo
	[Bug: 1818].

2000-04-24  Eric Melski  <[email protected]>

	* unix/mkLinks:
	* doc/OpenFileChnl.3: Added man entry for Tcl_Ungets [Bug: 1834].

	* unix/mkLinks:
	* doc/SourceRCFile.3: Man page for Tcl_SourceRCFile [Bug: 1833].

	* unix/mkLinks:
	* doc/ParseCmd.3: Added documentation for Tcl_ParseVar [Bug: 1828].

2000-04-24  Jeff Hobbs  <[email protected]>

	* unix/tclUnixNotfy.c (Tcl_FinalizeNotifier, NotifierThreadProc):
	added write of 'q' into triggerPipe for notifier in threaded case, so
	that Tcl doesn't hang when children are still running [Bug: 4139]

	* unix/tclUnixThrd.c (Tcl_MutexLock): minor comment fixes.

2000-04-23  Jim Ingham  <[email protected]>

	These changes make some error handling marginally better for Mac
	sockets. It is still somewhat flakey, however.

	* mac/tclMacSock.c (TcpClose): Add timeouts to the close - these don't
	seem to be honored, however. Use a separate PB for the release, since
	an async connect socket will still be using the original buffer. Make
	sure TCPRelease returns noErr before freeing the recvBuff. If the call
	returns an error, then the buffer is not right.
	* mac/tclMacSock.c (CreateSocket): Add timeouts to the async create.
	These don't seem to trigger, however. Sigh...
	* mac/tclMacSock.c (WaitForSocketEvent): If an TCP_ASYNC_CONNECT
	socket errors out, then return EWOULDBLOCK & error out.
	* mac/tclMacSock.c (NotifyRoutine): Added a NotifyRoutine for
	experimenting with MacTCP.

2000-04-22  Jim Ingham <[email protected]>

	* library/package.tcl (tclPkgUnknown): Fixed a typo in the Mac package
	search part of tclPkgUnknown.

2000-04-21  Sandeep Tamhankar <[email protected]>

	* library/http2.1/http.tcl: Fixed a newly introduced bug where if
	there's a -command callback and something goes wrong, geturl threw an
	exception, called the callback, and unset the token. I changed it so
	that it will not call the callback when throwing an exception (so the
	caller only finds out about a given error from one place).  Also,
	fixed http::ncode so that it actually gives you back the http return
	code (i.e. 200, 404, etc.) instead of the first digit of the version
	of HTTP being used (i.e. 1).

2000-04-21  Brent Welch <[email protected]>

	* library/http2.1/http.tcl: More thrashing with the "server closes
	without reading post data" scenario. Reverted to the previous filevent
	configuratiuon, which seems to work better with small amounts of post
	data.

2000-04-20  Jeff Hobbs  <[email protected]>

	* generic/tclAlloc.c: wrapped caddr_t define to not be done on Unix
	* unix/tclUnixPort.h: added Tclp*Alloc defines to allow the use of
	USE_TCLALLOC on Unix. [Bug: 4731]

2000-04-19  Jeff Hobbs  <[email protected]>

	* library/dde1.1/pkgIndex.tcl:
	* library/reg1.0/pkgIndex.tcl:
	* win/tclWinChan.c:
	* win/tclWinThrd.c: converted CRLF to LF the */tcl.hpj.in files were
	not converted, as it confuses hcw locally. [Bug: 5096]

	* win/Makefile.in: expanded cleanup target for help files

	* doc/Thread.3: minor macro cleanup

	* generic/tclFileName.c (SplitUnixPath): added support for QNX node
	ids.

2000-04-18  Jeff Hobbs  <[email protected]>

	* README:
	* generic/tcl.h:
	* tools/tcl.wse.in:
	* unix/configure.in:
	* unix/tcl.spec:
	* win/configure.in:
	* win/README.binary: bumped version to 8.3.1

	* win/tcl.hpj.in: updated copyright date

	* generic/tclEnv.c: environment support for Mac OS/X
	* unix/tclUnixPort.h: environment support for Mac OS/X
	* unix/tclLoadDyld.c: new file for Mac OS/X dl functions
	* unix/Makefile.in: added install-strip target; bindir, libdir,
	mandir, includedir vars; tclLoadDyld.c target [Bug: 2527]

	* unix/tclUnixChan.c (CreateSocket): force a socket back into blocking
	mode (default state) after a -async connect succeeds. [Bug: 4388]

	* generic/tclEvent.c (TclInitSubsystems): Moved tclLibraryPath to
	thread-local storage to prevent thread-related race condition.
	[Bug: 5033]
	* unix/tclAppInit.c (main): removed #ifdef TCL_TEST that sets the
	library path as it was unnecessary and conflicts with move of
	tclLibraryPath to thread-local storage.

2000-04-18  Scott Redman  <[email protected]>

	* win/Makefile.in:
	* win/tcl.rc:
	* win/tclsh.rc:
	* win/tclsh.ico:  Modified copyright dates in Windows resource files.
	Added an icon for tclsh.exe.

2000-04-17  Brent Welch <[email protected]>

	* generic/tcl.h, generic/tclThreadTest.c, unix/tclUnixThrd.c,
	* win/tclWinThread.c, mac/tclMacThread.c: Added Tcl_CreateThreadType
	and TCL_RETURN_THREAD_TYPE macros for declaring the NewThread callback
	proc.

2000-04-14  Jeff Hobbs  <[email protected]>

	* unix/tclUnixChan.c (TtyParseMode): Only allow setting mark/space
	parity on platforms that support it [Bug: 5089]

	* generic/tclBasic.c (Tcl_GetVersion): adjusted use of major/minor to
	not conflict with global decl on some systems [Bug: 2882]

	* doc/AppInit.3:
	* doc/Async.3:
	* doc/BackgdErr.3:
	* doc/CrtChannel.3:
	* doc/CrtInterp.3:
	* doc/CrtMathFnc.3:
	* doc/DString.3:
	* doc/Eval.3:
	* doc/ExprLong.3:
	* doc/GetInt.3:
	* doc/GetOpnFl.3:
	* doc/Interp.3:
	* doc/LinkVar.3:
	* doc/OpenFileChnl.3:
	* doc/OpenTcp.3:
	* doc/PkgRequire.3:
	* doc/RecordEval.3:
	* doc/SetResult.3:
	* doc/SplitList.3:
	* doc/StaticPkg.3:
	* doc/TraceVar.3:
	* doc/Translate.3:
	* doc/UpVar.3:
	* doc/load.n: removed or updated references to interp->result use.

2000-04-13  Jeff Hobbs  <[email protected]>

	* doc/regexp.n: doc clarification [Bug: 5037]
	* doc/update.n: typo fix [Bug: 4996]

	* unix/tcl.m4 (SC_ENABLE_THREADS): enhanced the detection of
	pthread_mutex_init [Bug: 4359] and (SC_CONFIG_CFLAGS) added
	--enable-64bit-vis switch for Sparc VIS compilation [Bug: 4995]

2000-04-12  Jeff Hobbs  <[email protected]>

	* doc/dde.n: corrected dde poke docs. [Bug: 4991]

2000-04-11  Eric Melski  <[email protected]>

	* win/tclWinPipe.c: Added "CONST" keyword to declaration of char
	*native in TclpCreateTempFile, to supress compiler warnings.

2000-04-10  Brent Welch <[email protected]>

	* generic/tcl.h: Fixed Tcl_CreateThread declaration.
	* library/tcltest1.0/tcltest.tcl: Fixed the "mainThread"
	initialization to work with either testthread or the thread extension
	* unix/tclUnixThrd.c: Fixed compiler warning when compiling with
	-DTCL_THREADS

2000-04-10  Eric Melski  <[email protected]>

	* win/tclWinPipe.c (TclpCreateTempFile): Added conversion of contents
	string from UTF to native encoding [Bug: 4030].

	* tests/regexp.test: Added tests for infinite looping in [regexp
	-all].

	* generic/tclCmdMZ.c: Fixed infinite loop bug with [regexp -all]
	[Bug: 4981].

	* tests/*.test: Changed all occurrences of "namespace import
	::tcltest" to "namespace import -force ::tcltest" [Bug: 3948].

2000-04-09  Brent Welch <[email protected]>

	* lib/httpd2.1/http.tcl: Worked on the "server closes before reading
	post data" case, which unfortunately causes different error cases on
	Solaris, which can read the reply, and Linux and Windows, which cannot
	read anything. This is all in the loop-back case - client and server
	on the same host. Also unified the error handling so the "ioerror"
	status goes away and errors are reflected in a more uniform way.
	Updated the man page to document the behavior.

2000-04-09  Jeff Hobbs  <[email protected]>

	* tests/reg.test (matchexpected): corrected tests to use tcltest
	constraint types to skip certain tests.

	* generic/tclBasic.c (Tcl_SetCommandInfo): comment fix

	* unix/tclUnixThrd.c (Tcl_CreateThread): moved TCL_THREADS ifdef
	inside of func as it is declared for non-threads builds as well. In
	the non-threads case, it always returns TCL_ERROR (couldn't create
	thread).

2000-04-08  Andreas Kupries <[email protected]>

	* Overall change: Definition of a public API for the creation of
	new threads.

	* generic/tclInt.h (line 1802f): Removed the definition of
	'TclpThreadCreate'. (line 793f) Removed the definition of
	'Tcl_ThreadCreateProc'.

	* generic/tcl.h (line 388f): Readded the definition of
	'Tcl_ThreadCreateProc'. Added Win32 stuff send in by David Graveraux
	<[email protected]> to that too (__stdcall, ...). Added macros for
	the default stacksize and allowed flags.

	* generic/tcl.decls (line 1356f): Added definition of
	'Tcl_CreateThread', slot 393 of the stub table. Two new arguments in
	the public API, for stacksize and flags.

	* win/tclWinThrd.c:
	* mac/tclMacThrd.c: Renamed TclpThreadCreate to Tcl_CreateThread,
	added handling of the stacksize. Flags are currently ignored.

	* unix/tclUnixThrd.c: See above, but handles joinable flag. Ignores
	the specified stacksize if the macro HAVE_PTHREAD_ATTR_SETSTACKSIZE is
	not defined.

	* generic/tclThreadTest.c (line 363): See below.

	* unix/tclUnixNotfy.c (line 210): Adapted to the changes above. Uses
	default stacksize and no flags now.

	* unic/tcl.m4 (line 382f): Added a check for
	'pthread_attr_setstacksize' to detect platforms not implementing this
	feature of pthreads. If it is implemented, configure will define the
	macro HAVE_PTHREAD_ATTR_SETSTACKSIZE (See unix/tclUnixThrd.c too).

	* doc/Thread.3: Added Tcl_CreateThread and its arguments to the list
	of described functions. Removed stuff about not providing a public
	C-API for thread-creation.

2000-04-07  Jeff Hobbs  <[email protected]>

	* doc/binary.n: clarified docs on sign extension in binary scan [Bug:
	3466]

	* library/tcltest1.0/tcltest.tcl (initConstraints): removed win32s
	references (no longer supported)

	* tests/fCmd.test: marked test 8.1 knownBug because it is dangerous on
	poorly configured systems [Bug: 3881] and added 8.2 to keep essence of
	8.1 tested.

2000-04-05  Andreas Kupries <[email protected]>

	* generic/tclIO.c (Tcl_UnstackChannel, line 1831): Forcing interest
	mask to the correct value after an unstack and re-initialization of
	the notifier via the watchProc. Without this the first fileevent after
	an unstack will come through and be processed, but no more. [Bug: ??].

2000-03-04  Brent Welch  <[email protected]>

	* {win,unix}/Makefile.in: added dependency of tclStubInit.c on
	tcl.decls and tclInt.decls
	* generic/tclThread.c: Tweak so this compiles w/out TCL_THREADS
	* generic/{tcl.decls,tclStubInit.c}:  Just touched the tcl.decls and
	regenerated the tclStubInit.c file

2000-03-29  Sandeep Tamhankar <[email protected]>

	* library/http2.1/http.tcl: For the -querychannel option, fconfigure
	the socket to be binary so that we don't translate anything while
	reading the data. This is because we determine the content length of
	the data on the channel by using seek (to the end of the file) and
	tell on the file handle, and we need the content-length to match the
	amount of data actually sent, and translation can affect the number of
	bytes posted.

2000-04-03  Andreas Kupries <[email protected]>

	* Overall change: Definition of public API's for the finalization of
	conditions and mutexes. [Bug: 4199].

	* generic/tclInt.h: Removed definitions of TclFinalizeMutex and
	TclFinalizeCondition.

	* generic/tcl.decls: Added declarations of Tcl_MutexFinalize and
	Tcl_ConditionFinalize.

	* generic/tclThread.c: Renamed TclFinalizeMutex to Tcl_MutexFinalize.
	Renamed TclFinalizeCondition to Tcl_ConditionFinalize.

	* generic/tclNotify.c: Changed usage of TclFinalizeMutex to
	Tcl_MutexFinalize.

	* unix/tclUnixNotfy.c:
	* generic/tclThreadTest.c: Changed usages of TclFinalizeCondition to
	Tcl_ConditionFinalize.

	* generic/tcl.h: Added empty macros for Tcl_MutexFinalize and
	Tcl_ConditionFinalize, to be used when the core is compiled without
	threads.

	* doc/Thread.3:	Added description the new API's.

2000-04-03  Jeff Hobbs  <[email protected]>

	* generic/tclCmdIL.c (InfoVarsCmd): checked for non-NULL procPtr to
	prevent itcl info override crash [Bug: 4064]

	* tests/foreach.test:
	* tests/namespace.test:
	* tests/var.test: Added lsorts to avoid random sorted return
	problems. [Bug: 2682]

	* tests/fileName.test: fixed 14.1 test fragility [Bug: 1482]

	* tools/man2help2.tcl: fixed winhelp cross-linking error [Bug: 4156]
	improved translation to winhelp [Bug: 3679]

	* unix/Makefile.in (MAN_INSTALL_DIR): patch to accept --mandir
	correctly [Bug: 4085]

	* unix/dltest/pkg[a-e].c: Cleaned up test packages [Bug: 2293]

2000-04-03  Eric Melski  <[email protected]>

	* unix/tclUnixFCmd.c (SetGroupAttribute):
	* unix/tclUnixFCmd.c (SetOwnerAttribute): Added (uid_t) and (gid_t)
	casts to avoid compiler warnings.

2000-03-31  Eric Melski  <[email protected]>

	* generic/tclGet.c (Tcl_GetDouble): Added additional conditions to
	error test (previously only errno was checked, but the return value of
	strtod() should be checked as well). [Bug: 4118]

	* tests/exec.test: Added test for proper conversion of UTF data when
	used with "<< $dataWithUTF" on exec's.

	* unix/tclUnixPipe.c (TclpCreateTempFile): Added
	Tcl_UtfToExternalDString call, so that if there is UTF content in the
	string it will be properly converted to the system encoding before
	being written [Bug: 4030].
	(TclpCreateTempFile): Added a check on the return value of tmpnam;
	some systems (Linux, for example) will start to return NULL after
	tmpnam has been called TMP_MAX times; not checking for this can have
	bad results (overwriting temp files, core dumps, etc.)

2000-03-30  Jeff Hobbs  <[email protected]>

	* generic/tclBasic.c (Tcl_DeleteCommandFromToken): Added comments
	noting the need to pair ckalloc with ckfree. [Bug: 4262]

	* generic/tclInt.decls:
	* generic/tclIntPlatDecls.h:
	* generic/tclStubInit.c:
	* win/tclWin32Dll.c: removed TclWinSynchSpawn (vestige of Win32s
	support).

	* win/tclWinReg.c: made use of TclWinGetPlatformId instead of getting
	info again

	* win/tclWinPort.h:
	* win/Makefile.in:
	* win/configure.in:
	* win/tcl.m4: Added support for gcc/mingw on Windows [Bug: 4234]

2000-03-29  Jeff Hobbs  <[email protected]>

	* generic/tclCompile.c (TclCleanupByteCode): made ByteCode cleanup
	more aware of TCL_BYTECODE_PRECOMPILED flagged structs (gen'd by
	tbcload), to correctly clean them up.

	* generic/tclClock.c (FormatClock): moved check for empty format
	earlier, commented 0 result return value

2000-03-29  Sandeep Tamhankar <[email protected]>

	* library/http2.1/http.tcl: Removed an unnecessary fileevent statement
	from the error processing part of the Write method. Also, fixed two
	potential memory leaks in wait and reset, in which the state array
	wasn't being unset before throwing an exception. Prior to this
	version, Brent checked in a fix to catch a fileevent statement that
	was sometimes causing a stack trace when geturl was called with
	-timeout. I believe Brent's fix is necessary because TLS closes bad
	sockets for secure connections, and the fileevent was trying to act on
	a socket that no longer existed.

2000-03-27  Jeff Hobbs  <[email protected]>

	* tests/httpd: removed unnecessary 'puts stderr "Post Dispatch"'

	* tests/namespace.test:
	* generic/tclNamesp.c (Tcl_Export): added a uniq'ing test to the
	export list so only one instance of each export pattern would exist in
	the list.

	* generic/tclExecute.c (TclExecuteByteCode): optimized case for the
	empty string in ==/!= comparisons

2000-03-27  Eric Melski  <[email protected]>

	* unix/tclUnixChan.c: Added (off_t) type casts in lseek() call [Bug:
	4409].

	* unix/tclLoadAout.c:
	* unix/tclUnixPipe.c: Added (off_t) type casts in lseek() calls [Bug:
	4410].

2000-03-22  Sandeep Tamhankar <[email protected]>

	* library/http2.1/http.tcl: Fixed a bug where string query data that
	was bigger than queryblocksize would get duplicate characters at block
	boundaries.

2000-03-22  Sandeep Tamhankar <[email protected]>

	* library/http2.1/http.tcl: Fixed bug 4463, where we were getting a
	stack trace if we tried to publish a project to a good host but a port
	where there was no server listening.  It turned out the problem was a
	stray fileevent that needed to be cleared.  Also, fixed a bug where
	http::code could stack trace if called on a bad token (one which
	didn't represent a successful geturl) by adding an http element to the
	state array in geturl.

2000-03-21  Eric Melski  <[email protected]>

	* tests/clock.test: Modified some tests that were not robust with
	respect to the time zone in which they were run and were thus failing.

	* doc/clock.n: Clarified meaning of -gmt with respect to -base when
	used with [clock scan] (-gmt does not affect the interpretation of
	-base).

2000-03-19  Sandeep Tamhankar <[email protected]>

	* library/http2.1/http.tcl: geturl used to throw an exception when the
	connection failed; I accidentally returned a token with the error
	info, breaking backwards compatibility. I changed it back to throwing
	an exception, but unsetting the state array first (thus still
	eliminating the original memory leak problem).

2000-03-19  Sandeep Tamhankar <[email protected]>

	* library/http2.1/http.tcl: Added -querychannel option and altered
	some of Brent's modifications to allow asynchronous posts (via
	-command). Also modified -queryprogress so that it calls the query
	callback as <callback> <token> <total size> <current size> to be
	consistent with -progress. Added -queryblocksize option with default
	8192 bytes for post blocksize. Fixed a bunch of potential memory leaks
	for the case when geturl receives bad args or can't open a socket,
	etc. Overall, the package really rocks now.

	* doc/http.n: Added -queryblocksize, -querychannel, and
	-queryprogress. Also, changed the description of -blocksize, which
	states that the -progress callback will be called for each block, to
	now qualify that with an "if -progress is specified".

	* tests/http.test: Added a querychannel test for synchronous and
	asynchronous posts, altered the queryprogress test such that the
	callback conforms to the -progress format. Also, had to use the
	-queryblocksize option to do the post 16K at a time to match Brent's
	expected results (and to test that -queryblocksize works).

2000-03-15  Brent Welch <[email protected]>

	* library/http2.1/http.tcl: Added -queryprogress callback to
	http::geturl and also changed it so that writing the post data is
	event driven if the queryprogress callback or a timeout is given.
	This allows a timeout to occur when writing lots of post data. The
	queryprogress callback is called after each block of query data is
	posted. It has the same signature as the -progress callback.

2000-03-06  Eric Melski  <[email protected]>

	* library/package.tcl: Applied patch from Bug: 2570; rather than
	setting geometry of slave interp to 0x0 when Tk was loaded, it now
	does "wm withdraw .". Both remove the main window from the display,
	but the former caused some internal structures to get initialized to
	zero, which caused crashes with some extensions.

2000-03-02  Jeff Hobbs  <[email protected]>

	* library/package.tcl (tclPkgUnknown): extended to allow recognizes
	changes in the auto_path while sourcing in other pkgIndex.tcl files

	* doc/FindExec.3: fixed doc for declaration of Tcl_FindExecutable
	[Bug: 4275]

	* generic/tclFileName.c (Tcl_TranslateFileName): Applied patch from
	Newman to significantly speedup file split/join on Windows (replaces
	regexp with custom parser). [Bug: 2867]

	* win/README.binary: change mailing lists from @consortium.org to
	@scriptics.com [Bug: 4173]

2000-02-28  Eric Melski  <[email protected]>

	* tests/clock.test: Added test for ISO bases < 100000

	* generic/tclDate.c: (generated on Solaris)
	* generic/tclGetDate.y: Changed condition for deciding if a number is
	an ISO 8601 base from number >= 100000 to numberOfDigits >= 6.
	Previously it would fail to recognize 000000 as an ISO base.

2000-02-14  Eric Melski  <[email protected]>

	* unix/Makefile.in: Added rpm target to generate Tcl binary RPM.

	* unix/tcl.spec: RPM specification file for a Tcl binary RPM for
	Linux.

2000-02-10  Jeff Hobbs  <[email protected]>

	8.3.0 RELEASE

	* changes: updated for 8.3.0 release

	* doc/load.n: added notes about dll load errors on Windows

	* unix/README:
	* unix/Makefile.in (dist): removed porting.notes and porting.old from
	distribution and CVS.  The information was very outdated. Now refer to
	http://dev.scriptics.com/services/support/platforms.html

	* tests/unixInit.test: fixed japanese LANG encoding test [Bug: 3549]

	* unix/configure.in:
	* unix/tcl.m4: correct CFLAG_WARNING setting, fixed gcc config for
	AIX, added -export-dynamic to LDFLAGS for FreeBSD-3+ [Bug: 2998]

	* win/tclWinLoad.c (TclpLoadFile): improved error message for load
	failures, could perhaps be even more intelligent.

2000-02-09  Jim Ingham	 <[email protected]>

	* mac/tclMacSock.c: Don't panic when you get an error closing an async
	socket. This doesn't seem to hurt anything, and we return the error so
	the caller can do the right thing.

	New Files:
	* mac/MW_TclHeader.h:
	* mac/MW_TclTestHeader.h:
	* mac/MW_TclTestHeader.pch:
	* mac/MW_TclAppleScriptHeader.h: More convenient to use .h prefix
	files in the preference panels...

	The above are curtesy of Daniel Steffen ([email protected])

2000-02-08  Eric Melski  <[email protected]>

	* tests/clock.test: Added tests for "next monthname" constructs.
	* generic/tclDate.c:
	* generic/tclGetDate.y (Message): Added a grammar rule for "next
	monthname" so that we can handle "next january" and similar constructs
	(bug #4146).

2000-02-08  Jeff Hobbs  <[email protected]>

	* README:
	* tools/tcl.wse.in:
	* unix/configure.in:
	* win/configure.in:
	* win/README:
	* win/README.binary:
	* generic/tcl.h (TCL_RELEASE_SERIAL): Moved to 8.3.0 patchlevel

	* doc/library.n:
	* library/auto.tcl: fixed crufty puts code and docs [Bug: 4122]

	* library/tcltest1.0/tcltest.tcl: correctly protected searchDirectory
	list to allow dirnames with spaces

	* unix/tcl.m4: changed all -fpic to -fPIC

	* generic/tclDecls.h:
	* generic/tcl.decls: change Tcl_GetOpenFile to use decl of 'int
	forWriting' instead of 'int write' to avoid shadowing [Bug: 4121]

	* tests/httpold.test: changed test script to source in the httpd
	server procs from httpd instead of having its own set.

	* tests/httpd: improved query support in test httpd to handle fix in
	http.tcl. [Bug: 4089 change 2000-02-01]

	* unix/README: fixed notes about --enable-shared and add note about
	--disable-shared.

2000-02-07  Eric Melski  <[email protected]>

	* tests/package.test:
	* library/tclIndex:
	* library/package.tcl: Renamed ::package namespace to ::pkg.

2000-02-03  Eric Melski <[email protected]>

	* doc/Package.n:
	* doc/packagens.n: Renamed Package.n -> packagens.n because Windows
	can't deal with case-sensitive names.

2000-02-02  Jeff Hobbs  <[email protected]>

	* tests/regexp.test: added tests for -all and -inline switches
	* doc/regexp.n: added docs for -all and -inline switches
	* generic/tclCmdMZ.c (Tcl_RegexpObjCmd): added extra comments for new
	-all and -inline switches to regexp command

2000-02-01  Eric Melski  <[email protected]>

	* library/init.tcl: Applied patch from rfe 1734 regarding auto_load
	errors not setting error message and errorInfo properly.

2000-02-01  Jeff Hobbs  <[email protected]>

	* win/Makefile.in (install-*): reduced verbosity of install

	* generic/tclFileName.c (Tcl_JoinPath): improved support for special
	QNX node id prefixes in pathnames [Bug: 4053]

	* library/http1.0/http.tcl:
	* library/http2.1/http.tcl: The query data POSTed was newline
	terminated when it shouldn't be altered [Bug: 4089]

2000-01-31  Eric Melski  <[email protected]>

	* tests/package.test:
	* library/tclIndex:
	* library/package.tcl: Added ::package namespace and ::package::create
	function.

	* library/init.tcl: Fixed problem with auto_load and determining if
	commands were loaded.

	* library/auto.tcl: "Fixed" issues with $ in files to be auto indexed.

	* doc/Package.n: New man page for package::create function.

	* doc/pkgMkIndex.n: Added additional information.

	* doc/library.n: Added additional qualification regarding auto_mkindex.

2000-01-28  Eric Melski  <[email protected]>

	* tests/pkg/magicchar2.tcl:
	* tests/autoMkindex.test: Test for auto loader fix (bug #2480).

	* library/init.tcl: auto_load was using [info commands $name] to
	determine if a given command was available; if the command name had *
	or [] it, this would fail because info commands uses glob-style
	matching. This is fixed. (Bug #2480).

	* tests/pkg/spacename.tcl:
	* tests/pkgMkIndex.test: Tests for fix for bug #2360.

	* library/package.tcl: Fixed to extract only the first element of the
	list returned by auto_qualify (bug #2360).

	* tests/pkg/magicchar.tcl:
	* tests/autoMkindex.test: Test for fix for bug #2611.

	* library/auto.tcl: Fixed the regular expression that performs $
	escaping before sourcing a file to index. It was erroneously adding \
	escapes even to $'s that were already escaped, effectively
	"un-escaping" those $'s. (bug #2611).

2000-01-27  Eric Melski  <[email protected]>

	* tests/autoMkindex.test:
	* library/auto.tcl: Applied patch (with slight modification) from bug
	#2701: auto_mkIndex uses platform dependent file paths. Added test for
	fix.

2000-01-27  Jennifer Hom  <[email protected]>

	* library/tcltest1.0/tcltest.tcl: Changed NormalizePath to
	normalizePath and exported it as a public proc. This proc creates an
	absolute path given the name of the variable containing the path to
	modify. The path is modified in place.
	* library/tcltest1.0/pkgIndex.tcl: Added normalizePath.
	* tests/all.tcl: Changed code to use normalizePath.

2000-01-27  Eric Melski  <[email protected]>

	* tests/pkg/samename.tcl: test file for bug #1983

	* tests/pkgMkIndex.test:
	* doc/pkgMkIndex.n:
	* library/package.tcl: Per rfe #4097, optimized creation of direct
	load packages to bypass computing the list of commands added by the
	new package. Also made direct loading the default, and added a -lazy
	option.
	Fixed bug #1983, dealing with pkg_mkIndex incorrectly handling
	situations with two procs by the same name but in different namespaces
	(ie, foo::baz and bar::baz).

2000-01-26  Eric Melski  <[email protected]>

	* generic/tclNamesp.c: Undid fix for #956, which broke backwards
	compatibility.

	* doc/variable.n:
	* doc/trace.n:
	* doc/namespace.n:
	* doc/info.n: Added further information about differences between
	"namespace which" and "info exists".

	* doc/SetErrno.3: Added descriptions of ErrnoId() and ErrnoMsg()
	functions.

2000-01-25  Jeff Hobbs  <[email protected]>

	* unix/tcl.m4: modified EXTRA_CFLAGS to add -DHAVE_TZSET for OSF1-V*
	and ULTRIX-4.* when not using gcc. Also added higher min stack size
	for OSF1-V* when building with threads. [Bug: 4063]

	* generic/tclClock.c (FormatClock): inlined resultPtr, as it
	conflicted with var creation for HAVE_TZSET #def [Bug: 4063]

	* generic/tclCmdIL.c (Tcl_LsortObjCmd): fixed potential leak when
	calling lsort -command with bad command [Bug: 4067]

	* generic/tclFileName.c (Tcl_JoinPath): added support for special QNX
	node id prefixes in pathnames [Bug: 4053]

	* doc/ListObj.3: clarified Tcl_ListObjGetElements docs [Bug: 4080]

	* doc/glob.n: clarified Mac path separator determination docs.

	* win/makefile.vc: added some support for building helpfile on Windows

2000-01-23  Jeff Hobbs  <[email protected]>

	* library/init.tcl (auto_execok): added 'start' to list of recognized
	built-in commands for COMSPEC on NT. [Bug: 2858]

	* unix/tclUnixPort.h: moved include of <utime.h> lower since some
	systems (UTS) require sys/types.h to be included first [Bug: 4031]

	* unix/tclUnixChan.c (CreateSocketAddress): changed comparison with -1
	to 0xFFFFFFFF, to ensure 32 bit comparison even on 64 bit systems.
	[Bug: 3878]

	* generic/tclFileName.c: improved guessing of path separator for the
	Mac. (Darley)

	* generic/tclInt.h:
	* generic/tcl.decls: moved Tcl_ProcObjCmd to stubs table [Bug: 3827]
	and removed 'register' from stub definition of
	Tcl_AppendUnicodeToObj [Bug: 4038]

2000-01-21  Eric Melski  <[email protected]>

	* unix/mkLinks:
	* doc/GetHostName.3: Man page for Tcl_GetHostName (bug #1817).

	* doc/lreplace.n: Corrected man page with respect to treatment of
	empty lists, and "prettied up" the page. (bug #1705).

2000-01-20  Eric Melski  <[email protected]>

	* tests/namespace.test: Added test for undefined variables with
	namespace which (bug #956).

	* generic/tclNamesp.c: Added check for undefined variables in
	NamespaceWhichCmd (bug #956).

	* tests/var.test: Added tests for corrected variable behavior (bug
	#981).

	* doc/upvar.n: Expanded explanation of upvar behavior with respect to
	variable traces. (bugs 3917 1433 2110).

	* generic/tclVar.c: Changed behavior of variable command when name
	refers to an element in an array (ie, "variable foo(x)") to always
	return an error, regardless of existance of that element in the array
	(now behavior is consistant with docs too) (bug #981).

2000-01-20  Jeff Hobbs  <[email protected]>

	* generic/tclCmdIL.c (InfoBodyCmd): made [info body] return a string
	if the body has been bytecompiled.
	* generic/tclBasic.c (Tcl_EvalObjEx): added pedantic check for
	originating proc body of bytecompiled code, #def'd out as the change
	for [info body] should make it unnecessary

	* unix/tclUnixNotfy.c (Tcl_InitNotifier): added cast for tsdPtr

	* tests/set.test: added test for complex array elem name compiling
	* generic/tclCompCmds.c (TclCompileSetCmd): Fixed parsing of array
	elements during compiling, and slightly optimised same [Bug: 3889]

	* doc/tclvars.n: added definitions for tcl_(non)wordchars

	* doc/vwait.n: added notes about requirement for vwait var being
	globally scoped [Bug: 3329]

	* library/word.tcl: changed tcl_(non)wordchars settings to use new
	unicode regexp char class escapes instead of char sequences

2000-01-14  Eric Melski  <[email protected]>

	* tests/var.test: Added a test for the array multiple delete
	protection in Tcl_UnsetVar2.

	* generic/tclVar.c: Added protection in Tcl_UnsetVar2 against attempts
	to multiply delete arrays when unsetting them (bug #3453). This could
	happen if there was an unset trace on an array element and the trace
	proc made a global or upvar link to the array, and then the array was
	unset at the global level. See the bug reference for more information.

	* unix/tclUnixTime.c: New clock format format.

	* compat/strftime.c: New clock format format.

	* generic/tclGetDate.y: New clock scan format.

2000-01-13  Jeff Hobbs  <[email protected]>

	* changes: updated changes file to reflect 8.3b2 mods

	* README:
	* generic/tcl.h:
	* tools/tcl.wse.in:
	* unix/configure.in:
	* unix/tcl.m4:
	* win/README.binary:
	* win/configure.in: updated to patchlevel 8.3b2

	* generic/regexec.c: added var initialization to prevent compiler
	warning

2000-01-13  Eric Melski  <[email protected]>

	* tests/cmdIL.test: Added tests for lsort -dictionary with characters
	that occur between Z and a in ASCII.

	* generic/tclCmdIL.c: Modified DictionaryCompare function (used by
	lsort -dictionary) to do upper/lower case equivalency before doing
	character comparisons, instead of after. This fixes bug #1357, in
	which lsort -dictionary [list ` AA c CC] and lsort -dictionary [list
	AA c ` CC] gave different (and both wrong) results.

2000-01-12  Eric Melski  <[email protected]>

	* tests/clock.test: Added tests for "next <day-of-week>" and
	"<day-of-week>"
	Added tests for "monday 1 week ago", etc, from RFE #3671.

	* doc/tests/clock.test: Added numerous tests for clock scan.

	* doc/generic/tclGetDate.y: Fixed some shift/reduce conflicts in clock
	grammar.

	* doc/doc/clock.n: Added documentation for new supported clock scan
	formats and additional explanation of daylight savings time correction
	algorithm.

2000-01-12  Jeff Hobbs  <[email protected]>

	* doc/file.n:
	* tests/unixFCmd.test:
	* unix/tclUnixFCmd.c: added support for symbolic permissions setting
	in SetPermissionsAttribute (file attr $file -perm ...) [Bug: 3970]

	* generic/tclClock.c: fixed support for 64bit handling of clock values
	[Bug: 1806]

	* generic/tclThreadTest.c: upped a buffer size to hold double

	* tests/info.test:
	* generic/tclCmdIL.c: fixed 'info procs ::namesp::*' behavior (Dejong)

	* generic/tclNamesp.c: made imported commands also import their
	compile proc [Bug: 2100]

	* tests/expr.test:
	* unix/Makefile.in:
	* unix/configure.in:
	* unix/tcl.m4: recognize strtod bug on Tru64 v5.0 [Bug: 3378] and
	added tests to prevent unnecessary chmod +x in sources while
	installing, as well as more intelligent setsockopt/gethostbyname
	checks [Bug: 3366, 3389]

	* unix/tclUnixThrd.c: added compile time support (through use of the
	TCL_THREAD_STACK_MIN define) for increasing the default stack size for
	a thread. [Bug: 3797, 1966]

2000-01-11  Eric Melski  <[email protected]>

	* generic/tclGetDate.y: Added comments for the Convert function. Added
	a fix for daylight savings time handling for relative time spans of
	days, weeks or fortnights. (bug 3441, 3868).

	* generic/tclDate.c: Fixed compiler warning issues.

2000-01-10  Jeff Hobbs  <[email protected]>

	* compat/waitpid.c: use pid_t type instead of int [Bug: 3999]

	* tests/utf.test: fixed test that allowed \8 as octal value
	* generic/tclUtf.c: changed Tcl_UtfBackslash to not allow non-octal
	digits (8,9) in \ooo substs. [Bug: 3975]

	* generic/tcl.h: noted need to change win/tcl.m4 and
	tools/tclSplash.bmp for minor version changes

	* library/http2.1/http.tcl: trim value for $state(meta) key

	* unix/tclUnixFile.c: fixed signature style on functions

	* unix/Makefile.in: made sure tcl.m4 would be installed with dist

	* unix/tcl.m4: added ELF support for NetBSD [Bug: 3959]

2000-01-10  Eric Melski  <[email protected]>

	* generic/tclGetDate.y: Added rules for ISO 8601 formats (BUG #847):
	CCYY-MM-DD
	CCYYMMDD
	YY-MM-DD
	YYMMDD
	CCYYMMDDTHHMMSS
	CCYYMMDD HHMMSS
	CCYYMMDDTHH:MM:SS
	Fixed "clock scan <number>" to scan the number as an hour for the
	current day, rather than a minute after 00:00 for the current day
	(bug #2732).

2000-01-07  Eric Melski  <[email protected]>

	* generic/tclClock.c: Changed switch in Tcl_ClockObjCmd to use
	enumerated values instead of constants. (ie, COMMAND_SCAN instead of
	3).
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<






















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































Deleted ChangeLog.2001.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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
2001-12-28  Jeff Hobbs  <[email protected]>

	* library/init.tcl: make sure env(COMSPEC) on Windows is executed with
	the right case, as it may otherwise fail inexplicably.

2001-12-28  Don Porter <[email protected]>

	* generic/tclCkalloc.c (MemoryCmd, TclFinalizeMemorySubsystem): Added
	the [memory onexit] command, intended to replace [checkmem].

	* doc/DumpActiveMemory.3:
	* doc/memory.n: Updated documentation for [memory] and related
	matters. [Bug 487677]

	* mac/tclMacBOAMain.c (Tcl_Main, CheckmemCmd): Removed all the
	machinery for the [checkmem] command that is completely duplicated by
	code in generic/tclCkalloc.c.

	* generic/tclBinary.c:
	* generic/tclListObj.c:
	* generic/tclObj.c:
	* generic/tclStringObj.c: Removed references to [checkmem] in
	comments, referencing [memory active] instead, since it is
	documented.

2001-12-28  Daniel Steffen <[email protected]>

	* mac/tclMacInit.c:
	* mac/tclMacTclCode.r: synced up tclInit features to unix/win:
	implemented TclSetPreInitScript support, use of existing tclInit proc
	if defined, check of default encoding dir if set. Changed script
	library resource names to lowercase (i.e. same as corresponding
	files). Used Tcl_JoinPath instead of string append. Check that system
	encoding could be loaded before utf translating the LibraryPath.
	* mac/tclMacApplication.r:
	* mac/tclMacLibrary.r:
	* mac/tclMacOSA.r:
	* mac/tclMacResource.r: minor version resources cleanup

2001-12-21  Mo DeJong  <[email protected]>

	* unix/tcl.m4 (SC_PATH_TCLCONFIG, SC_PATH_TKCONFIG):
	Search for config file using exec_prefix instead of prefix when no
	--with-tcl or --with-tk argument is used. [Bug 492418]

2001-12-21  Daniel Steffen <[email protected]>

	* unix/tcl.m4: fixed incorrect SHLIB_LD_LIBS setting for MacOSX /
	Darwin.
	* unix/configure: Regen.
	* unix/mkLinks.tcl: improved case-insensitive filesystem support.
	* unix/mkLinks: Regen.

2001-12-19  Don Porter <[email protected]>

	* unix/Makefile.in (dist): corrected use of eolFix.tcl on working
	files. It should operate on distributed files. [Bug 495120]

2001-12-19  David Gravereaux <[email protected]>

	* tools/tcl.wse.in: Fix for [Bug 495120]. tcl.wse.in was stored in cvs
	with improper <eol>. This resulted in corrupted <eol> when checked-out
	on translating CVS clients such as windows (CRCRLF) and mac (CRCR).

2001-12-19  Mo DeJong  <[email protected]>

	* unix/configure:
	* unix/tcl.m4 (SC_CONFIG_CFLAGS): Update SunOS 5.[0-6] target so that
	correct linker options are passed to gcc or ld. [Tk Bug 220863]

2001-12-19  Mo DeJong  <[email protected]>

	* unix/README: Update to account for changes in the unix/dltest
	directory, the way autoconf is run, and the new "make shell" target.

2001-12-19  Mo DeJong  <[email protected]>

	* unix/Makefile.in: Rename dltest to dlpkgs to fix problem where lib
	files were not getting built because dltest/ directory already
	existed.

2001-12-19  Jeff Hobbs  <[email protected]>

	* win/tclWinSerial.c (SerialCheckProc): corrected time calculations to
	be unsigned. (schroedter)

2001-12-18  Mo DeJong  <[email protected]>

	* unix/Makefile.in: Define new dltest target that simply does a cd to
	dltest/ before running make. There is no need for the separate
	configure script that was previously being used.
	* unix/configure: Regen.
	* unix/configure.in: Subst into dltest/Makefile.
	* unix/dltest/Makefile.in: Define LIBS using DL_LIBS, LIBS, and
	MATH_LIBS variables instead of TCL_LIBS variable from tclConfig.sh.
	* unix/dltest/README: Update readme to account for new configure free
	implementation.
	* unix/dltest/configure: Removed.
	* unix/dltest/configure.in: Removed.

2001-12-18  Donal K. Fellows  <[email protected]>

	* generic/tcl.h (TCL_STUB_MAGIC): Added cast to force type to be an
	int and get rid of a persistent and pointless warning with SunPro
	compiler.

	* generic/tclCkalloc.c (Tcl_AttemptDbCkalloc,Tcl_AttemptDbCkrealloc):
	* generic/tcl.decls (Tcl_AttemptDbCkalloc,Tcl_AttemptDbCkrealloc):
	Made the file parameters to these functions into CONST char *, like
	they always should have been to match the other Tcl*Db* API functions.

2001-12-17  Andreas Kupries  <[email protected]>

	* Applied [Bug 219311] on behalf of Rolf Schroedter
	<[email protected]> to prevent fcopy on serial ports
	from flooding the event queue.

2001-12-11  Miguel Sofer  <[email protected]>

	* doc/CrtInterp.3:
	* generic/tclBasic.c: docs and comments corrections. [Bug 493412]
	Bug & patch by Don Porter.

2001-12-14  Donal K. Fellows  <[email protected]>

	* win/tclWinNotify.c (Tcl_FinalizeNotifier): Stop Tcl on Windows from
	crashing when shutdown from a non-Tcl thread. Fixes [Bug 217982]
	[orig. 5804] reported by Hugh Vu and Gene Leache. I'm not convinced
	that the shutdown process is right even with this, but it was
	definitely wrong without...

2001-12-13  Andreas Kupries  <[email protected]>

	* win/tclWinSock.c (TcpGetOptionProc): Fix for [Bug 478565] reported
	by an unknown person. Bypasses all calls to "gethostbyaddr" for
	address "0.0.0.0" to prevent delays on Win/NT.

2001-12-12  Jeff Hobbs  <[email protected]>

	* doc/Preserve.3: doc'd TCL_DYNAMIC use. [Patch 483989] (porter)

2001-12-12  Andreas Kupries  <[email protected]>

	* generic/tclIO.c (Tcl_GetsObj): Applied patch for [Bug 491341] as
	provided by Don Porter <[email protected]>. Fixes the
	assumption of having an empty Tcl_Obj to work with.

2001-12-11  Miguel Sofer  <[email protected]>

	* generic/tclCompCmds.c:
	* generic/tclCompile.c:
	* generic/tclExecute.c: consistency patch, to make all instructions
	that pop a variable number of Tcl_Obj's off the execution stack take
	the number of popped objects as first operand. Modified *only* the new
	instructions INST_LIST_INDEX_MULTI and INST_LSET_FLAT, so this has no
	effect on bytecodes generated up to tcl8.4a3 inclusive.

	* generic/tclExecute.c: fix debug messages in INST_LSET_LIST.

	* generic/tclCompCmds.c (TclCompileLindexCmd):
	* generic/tclCompExpr.c (CompileMathFuncCall): removed the last two
	overestimates of the necessary stack depth for bytecodes in the fix of
	[Bug 483611]

2001-12-10  Andreas Kupries  <[email protected]>

	* unix/tclUnixPipe.c (TclpCreateProcess): Applied Don Porter's patch
	fixing [Bug 437489].

2001-12-10  Miguel Sofer  <[email protected]>

	* generic/tclEvent.c:
	* tests/event.test: fix background error reporting in the absence of a
	bgerror proc [Bug 219142].

2001-12-10  Don Porter <[email protected]>

	* doc/Access.3:
	* doc/CrtChannel.3:
	* doc/DString.3:
	* doc/ExprLong.3:
	* doc/FileSystem.3:
	* doc/GetStdChan.3:
	* doc/OpenFileChnl.3:
	* doc/StdChannels.3:
	* doc/TCL_MEM_DEBUG.3:
	* doc/Tcl_Main.3:
	* doc/Utf.3:
	* doc/file.n:
	* doc/tclsh.1:  Several typo and formatting corrections discovered
	during conversion to TMML. Thanks to Joe English. [Patch 490514]
	* unix/mkLinks: 'make mklinks'

2001-12-10  Miguel Sofer  <[email protected]>

	* generic/tclCompCmds.c:
	* generic/tclCompExpr.c:
	* generic/tclCompile.c:
	* generic/tclCompile.h:
	* generic/tclExecute.c:
	* generic/tclProc.c: fixed the calculation of the maximal stack depth
	required by bytecodes. [Bug 483611]

2001-12-07  Miguel Sofer  <[email protected]>

	* generic/tclVar.c:
	* tests/trace.test: restored consistency in refCount accounting by
	array traces [Bug 4484339], submitted by Don Porter.

2001-12-06  Donal K. Fellows  <[email protected]>

	* tests/parseExpr.test, tests/for.test, tests/expr.test:
	* tests/expr-old.test, tests/compile.test, tests/compExpr.test
	* tests/compExpr-old.test: Kept up to date with syntax errors.
	* generic/tclParseExpr.c (ParsePrimaryExpr): Rewrote to give even
	better syntax errors in the fairly common case of an identifier
	without decorations by guessing based on the currently available
	functions. Also made messages consistent between memdebug and ordinary
	builds.

2001-12-05  Miguel Sofer  <[email protected]>

	* generic/tclVar.c:
	* tests/trace.test: new algorithm for [array get], safe when there are
	traces that modify the array. [Bug 449893]

2001-12-04  Donal K. Fellows  <[email protected]>

	* tests/compExpr-old.test, tests/compExpr.test, tests/compile.test:
	* tests/expr-old.test, tests/expr.test, tests/for.test:
	* tests/while.test, tests/if.test: Rewrite to handle more specific
	syntax errors.
	* tests/parseExpr.test: Rewrite to get rid of dup test numbers and
	handle more specific syntax errors.
	* generic/tclParseExpr.c (LogSyntaxError): Added a detail message
	argument to help explain what the syntax error is.
	(Tcl_ParseExpr, ParseCondExpr, ParsePrimaryExpr): Added detail
	messages.
	(UNKNOWN_CHAR): New lexeme for characters that are always illegal in
	expressions outside strings.

2001-12-03  Donal K. Fellows  <[email protected]>

	* doc/expr.n: Various documentation improvements in relation to the
	function calls. Includes fix for [Bug 487704] submitted by Devin Eyre.

2001-12-03  David Gravereaux <[email protected]>

	* win/makefile.vc: Some install target bugs repaired along with
	$(TCLSTUBLIB) added to the dependencies rather than implicit through
	the dde and reg extensions which don't happen to always require it for
	some build types.

2001-11-30  Miguel Sofer  <[email protected]>

	* generic/tclVar.c: Tcl_Preserve'ing VarTrace structures to avoid
	memory corruption. Patch for [Bug 484334] provided by Don Porter

2001-11-29  Miguel Sofer  <[email protected]>

	* tests/namespace.test: modified namespace-41.2, added 41.3
	{knownbug} after discussion with Don Porter and Kevin Kenny.

2001-11-29  Miguel Sofer  <[email protected]>

	* tests/namespace.test: added namespace-41.2, a simpler test for
	[Bug 231259]

2001-11-29  Donal K. Fellows  <[email protected]>

	* generic/tclBinary.c (BINARY_SCAN_MAX_CACHE, Tcl_BinaryObjCmd,
	(ScanNumber): Added caching scheme to reduce number of object
	allocations when doing scans of large repetitive binary strings. See
	comments in file for reasoning behind implementation. Suggested by
	Miguel Sofer in [Patch 429916], but independently implemented.

2001-11-28  Donal K. Fellows  <[email protected]>

	* doc/regsub.n, doc/regexp.n: Converted dangling references to
	METASYNTAX section into references to the re_syntax manual page.

2001-11-27  D. Richard Hipp   <[email protected]>

	* win/tclWinFCmd.c: Fix a coredump in the filename normalizer code for
	Win95/98.

2001-11-27  David Gravereaux <[email protected]>

	* win/makefile.vc: Removed the Tk reference for the 'winhelp' target.
	Converge at install will need to be the solution for Tk and all other
	extensions.

2001-11-27  Donal K. Fellows  <[email protected]>

	* tests/cmdAH.test (cmdAH-24.2): Made test less sensitive to OS
	preemption, but perfection isn't practical. [Bug 463189, reported by
	Don Porter]

	* tests/switch.test (switch-9.*): Added tests to exercise more of the
	argument checking.  (switch-7.2,switch-7.3): Test changed behaviour
	slightly.
	* generic/tclCmdMZ.c (Tcl_SwitchObjCmd): Reworked argument parsing to
	be stricter about what it accepts. This should make uses of the
	[switch] command be more maintainable. [Bug 475397, reported by Don
	Porter]

2001-11-26  Don Porter <[email protected]>

	* generic/tclIntPlatDecls.h: 'make genstubs' after changes in
	2001-11-23 commit from Daniel Steffen.

2001-11-24  Mo DeJong  <[email protected]>

	* unix/Makefile.in: Add comments to better describe TCL_EXE and when
	it should be available.
	* win/Makefile.in: Add TCL_EXE variable to be used by rules like `make
	genstubs`. Don't set TCL_LIBRARY before running `make genstubs` since
	we will be running with a tclsh from the PATH not the one we build.

2001-11-24  Mo DeJong  <[email protected]>

	* win/configure: Regen.
	* win/tcl.m4 (SC_CONFIG_CFLAGS): Add comctl32.lib to wish link libs.
	This change was originally added to Tk on 2001-11-09 but was not
	committed to Tcl.

2001-11-23  Daniel Steffen <[email protected]>

	* unix/Makefile.in:
	* unix/configure.in:
	* unix/install-sh:
	* unix/mkLinks:
	* unix/mkLinks.tcl:
	* unix/tclLoadDyld.c:
	* unix/tclMtherr.c: Mac OSX support: build system, dynamic code loading
	and support for case-insensitive filesystems in mkLinks. [Patch 435258]

2001-11-23  Daniel Steffen <[email protected]>

	Up-port to 8.4 of mac code changes for 8.3.3 & various new changes for
	8.4, some already backported to 8.3.4. [Patch 435658]

	* generic/tclObj.c: added #include to fix missing prototype errors

	* generic/tcl.h: MAC_TCL: addition of ConditionalMacros.h and use of
	DLLIMPORT and DLLEXPORT like on other platforms. ( => no longer need
	the .exp files and can remove use of #pragma export that never worked
	well)
	removed line continuation in #if clause as this breaks the mac
	resource compiler (note that *.r files include tcl.h)

	* mac/tclMacFile.c: fixed bug in permission checking code

	* mac/tclMacLoad.c: corrected utf-8 handling, comparison of package
	names to code fragment names changed to only match on the length of
	package name, this allows for fragment names with version numbers
	appended.

	* mac/tclMacInt.h:
	* generic/tclInt.h:
	* mac/tclMacTime.c:
	* generic/tclIOUtil.c: moved declaration of TclpGetGMTOffset()

	* mac/tclMacShLib.exp:
	* mac/tclMacOSA.exp:
	* mac/tclMacMSLPrefix.h: removed files

	* unix/Makefile.in: removed reference to .exp files

	* mac/MW_TclBuildLibHeader.h:
	* mac/MW_TclBuildLibHeader.pch:
	* mac/MW_TclHeaderCommon.h:
	* mac/MW_TclStaticHeader.h:
	* mac/MW_TclStaticHeader.pch: new precompiled header files

	* mac/MW_TclAppleScriptHeader.pch:
	* mac/MW_TclHeader.pch:
	* mac/MW_TclTestHeader.pch:
	* mac/tclMacCommonPch.h: revised precompiled header handling: now
	include a common header file 'MW_TclHeaderCommon.h' from all .pch
	files, the .pch files themselves now only setup #defines (e.g.
	BUILD_tcl, STATIC_BUILD, TCL_DEBUG, TCL_THREADS) like in makefiles on
	other platforms.

	* mac/tclMac.h:
	* mac/tclMacPort.h:
	* mac/tclMacInt.h: use of BUILD_tcl and TCL_STORAGE_CLASS like on other
	platforms, standardize #include'd files to what's done on other
	platforms, removed use of #pragma export.

	* mac/tcltkMacBuildSupport.sea.hqx: new archive of mac build support
	files & suggested build environment directory hierarchy:
	'Building MacTclTk' & 'CW Pro6 changes' readme's.
	projects for MoreFiles 1.5.2 static & shared libraries.
	project & sources for 'pseudoCarbonSupport', see below.
	included XML versions of the projects for CW Pro5 or Pro7 users.

	* mac/tclMacProjects.sea.hqx: updated mac build project files:
	build support for CodeWarrior Pro6, UnivIntf 3.4 & shared runtime
	libraries: the MSL libraries and MoreFiles are no longer compiled into
	Tcl.shlb, all non-static binaries now use the Pro6 shared runtime
	libraries and MoreFiles.shlb.  These shlbs are merged into the standard
	Wish and TclShell, but 3rd party applications linking with Tcl.shlb or
	Tk.shlb need to setup access to them.  (see the "(sh-ppc)" targets
	for how to do this.)
	included XML versions of the projects for CW Pro5 or Pro7 users.
	use compat/strtod.c instead of MSL's strtod()
	use WASTE versions of MSL for tcl test target to avoid text buffer
	cutoff at 32k.
	Merging the full MSL.shlb and the other shlbs into Wish & TclShell
	makes them a bit larger than before, use unmerged binaries to avoid
	copying the shared code with every application, e.g. when deploying
	numerous Wish based droplets.
	Note that using CW Pro5 to compile extensions is in principle still
	possible, but need to link with Pro6 runtime libraries.
	Tclapplescript now loads and runs on CFM68k.
	Highly experimental "pseudoCarbon" support for Tcl only on OS 8/9:
	binaries in "Build:(Carbon):" link against CarbonLib instead of
	InterfaceLib, however the actual code has not been carbonized! i.e. it
	will not run on OSX and may not even run properly with CarbonLib.
	This should in principle allow you to build & test OS9 CFM Carbon
	binaries that need to link with Tcl.shlb. On OSX you can use the
	native Tcl.framework, but you have to build a MachO binary as there
	is no CFM glue lib for Tcl.framework.
	the library pseudoCarbonSupport.shlb manually loads the symbols from
	InterfaceLib that are not in CarbonLib but are needed by the
	uncarbonized code in Tcl.shlb and TclShell.

	* generic/tclMain.c: MAC_TCL: workaround for broken/non-standard isatty
	on MW Pro6, #include <unistd.h> instead of defining isatty

	* mac/tclMacPort.h: MW Pro6 changes for MSL fcntl.h, stat.h & isatty

	* mac/tclMacAppInit.c: add EXTERN to InstallConsole to enable DLL
	export via the TCL_STORAGE_CLASS mechanism.

	* mac/tclMacFCmd.c: fix for FSpDirectoryCopy API change

	* mac/tclMacLibrary.c: emit compile time error when
	TCL_REGISTER_LIBRARY and USE_TCL_STUBS are both defined at the same
	time in an extension, this use is not currently supported and will
	result in a crash when dynamically loading the extension.

	* mac/tclMacApplication.r:
	* mac/tclMacLibrary.r:
	* mac/tclMacOSA.r:
	* mac/tclMacResource.r: fixed obsolete copyrights/dates in version
	strings; updated version strings to standard usage; added support for
	'(Support Libraries)' subfolder for shared runtime libraries in
	unmerged binaries; commented out demo setting of "Tcl Environment
	Variables"; reorganized resources among these files to avoid multiple
	copies in applications and shared libraries, the script libraries are
	now no longer duplicated in Tclsh but are only included in the
	resources of Tcl.shlb.

	* mac/tclMacChan.c:
	* mac/tclMacSock.c: cast for *BlockMode

	* mac/tclMacUtil.c:
	* mac/tclMacMath.h: removed obsolete hypot() definition

	* generic/tclIntPlatDecls.h:
	* generic/tclInt.decls:
	* generic/tclStubInit.c:
	* mac/tclMacNotify.c:
	* mac/tclMacOSA.c:
	* mac/tclMacUtil.c:
	* generic/tclThreadTest.c: renamed routines conflicting with standard
	Apple or MoreFiles headers (at compile or link time):
	GetGlobalMouse         -> GetGlobalMouseTcl
	FSpGetDirectoryID      -> FSpGetDirectoryIDTcl
	FSpOpenResFileCompat   -> FSpOpenResFileCompatTcl
	FSpCreateResFileCompat -> FSpCreateResFileCompatTcl
	NewThread              -> NewTestThread
	the renamed MoreFiles *Tcl routines are just wrappers calling into the
	MoreFiles DLL.

	* mac/tclMacCommonPch.h:
	* mac/tclMacThrd.c:
	* mac/tclMacPanic.c: removed OLDROUTINENAMES define, renamed obsolete
	apple API names to modern equivalents; UH3.4 support: added #include
	<ControlDefinitions.h>, updated New*Proc() calls to New*UPP().

	* mac/tclMacUnix.c: added missing (Tcl_Obj ***) cast to
	Tcl_ListObjGetElements call

	* mac/tclMacAlloc.c: modernized TclpSysAlloc() to use temporary memory
	instead of system heap memory when available (MacOS >= 7.5 and
	possibly earlier, use of system heap has been discouraged for a long
	time and has many disadvantages, e.g. memory isn't paged out, and
	errors can very easily bring the system down); fixed crashing bug in
	TclpSysRealloc() and CleanUpExitProc() where memory was being accessed
	after having been deallocated; fixed memory leak in (de)allocation
	code (for every block ever allocated with TclpSysAlloc, a Ptr was
	leaked), if temporary memory is available, don't track allocated
	memory, instead use RecoverHandle() to get Handle from Ptr, otherwise
	use doubly linked list to correctly track memory and free all
	allocated memory; added new option for ConfigureMemory:
	MEMORY_DONT_USE_TEMPMEM, disables use of temporary memory even when it
	would be available, only necessary when writing e.g. a driver (using
	tcl??); increased fraction of application heap reserved for OS
	routines to 512K

	* compat/strftime.c:
	* mac/tclMacTime.c:
	* mac/tclMacPort.h:
	* generic/tclInt.decls:
	* generic/tclIntPlatDecls.h:
	* generic/tclStubInit.c: timezone support for mac via TclpGetTZName()
	like on windows, using an inverse timezone table adapted from
	tclDate.c to map gmtoffset in seconds gotten from the MacOS APIs to a
	timezone string, as there is no good way to get this info from MacOS.
	I had to make up some unusual timezones and arbitrarily decide on the
	most standard of the multiple choices available for every timezone.

	* generic/tclExecute.c: workaround for a MSL bug/misfeature: for very
	small floats, MSL can return errno ERANGE but a non-zero value (<
	LDBL_MIN however)

	* mac/tclMacAppInit.c: support for WASTE text library using temporary
	memory, setting has no effect if WASTE is not used.

	* mac/tclMacPanic.c: removed duplicate code from generic/tclPanic.c
	and added that file to projects instead.

	* tests/all.tcl: set tcltest::singleProcess 1 as multiple processes
	are not available on the mac.

	* tests/cmdAH.test: access time not available on the mac, skip the
	atime touch test

	* tests/appendComp.test:
	* tests/cmdMZ.test:
	* tests/compile.test:
	* tests/exec.test:
	* tests/fileName.test:
	* tests/lset.test:
	* tests/namespace.test:
	* tests/tcltest.test: added missing cleanups/tests/catches that caused
	tests to fail on the mac.

	* doc/tclvars.n: doc bug, env(PWD) should be env(HOME) [Bug 463834]

2001-11-21  Don Porter	<[email protected]>

	* tests/trace.test (trace-8.8): Corrected test for Bug 219393.

	* generic/tclBasic.c (Tcl_DeleteCommandFromToken,CallCommandTraces):
	* generic/tclCmdMZ>c (Tcl_UntraceCommand):  Added Tcl_Preserve and
	Tcl_Release calls to prevent deletion of CommandTrace structures until
	all callers are done using them, preventing memory corruption. [Bug
	453805]

2001-11-20  Kevin B. Kenny  <[email protected]>

	* doc/GetTime.3 (Tcl_GetTime):
	* generic/tcl.decls (Tcl_GetTime):
	* generic/tclClock.c (Tcl_ClockObjCmd):
	* generic/tclCompile.c (TclCleanupByteCode, TclInitByteCodeObj):
	* generic/tclCmdMZ.c (Tcl_TimeObjCmd):
	* generic/tclUtil.c (TclpGetTime):
	* generic/tclTest.c (GetTimesCmd):
	* generic/tclTimer.c (Tcl_CreateTimerHandler, TimerSetupProc,
	(TimerCheckProc, TimerHandlerEventProc):
	* mac/tclMacNotify.c (Tcl_SetTimer):
	* mac/tclMacShLib.exp (Tcl_GetTime):
	* mac/tclMacTime.c (Tcl_GetTime):
	* unix/tclUnixChan.c (TclUnixWaitForFile):
	* unix/tclUnixEvent.c (Tcl_Sleep):
	* unix/tclUnixThrd.c (Tcl_ConditionWait):
	* unix/tclUnixTime.c (Tcl_GetTime):
	* win/tclWinNotify.c (Tcl_Sleep):
	* win/tclWinTest.c (TestwinclockCmd):
	* win/tclWinTime.c (TclpGetSeconds, TclpGetClicks, Tcl_GetTime):
	Changed all uses of TclpGetTime to Tcl_GetTime. Added Tcl_GetTime to
	the Stubs table and the library documentation. Added a TclpGetTime in
	tclUtil.c for backward compatibility of extensions. [Patch 483500,
	TIP#73]

	* generic/tclCmdMZ.c (Tcl_TimeObjCmd): Corrected an error in the
	[time] command that caused incorrect results to be returned if the
	total duration of all iterations exceeded 2**31 microseconds. [Bug
	478847]

	* generic/tclInt.decls:
	* generic/tclInt.h:
	* generic/tclStubInit.h: Reran 'make genstubs'

2001-11-20  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c
	* generic/tclCompile.h:
	* generic/tclExecute.c: moving all code relative to bytecodes from
	tclBasic.c to tclExecute.c - the functions RecordTracebackInfo and
	Tcl_ExprObj went to tclExecute.c, and new interface function was
	defined (TclCompEvalObj).
	The final objective of this sequence of moves is to provide a clean,
	clear-cut interface between Tcl's core and the compiler/engine
	subsystem.

2001-11-20  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c
	* generic/tclCompile.h:
	* generic/tclExecute.c: factoring out of common code in tclBasic.c
	(new function TclInterpReady defined: it resets the interp's result,
	then checks that it hasn't been deleted and that the nesting level is
	acceptable). Passed the responsibility of calling it to the *callers*
	of TclEvalObjvInternal.

2001-11-20  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c
	* generic/tclExecute.c: a better variant of the previous-to-last
	commit (restoring numLevels computations). The managing of the levels
	now has to be done by the *callers* of TclEvalObjvInternal

2001-11-20  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c: missing variable declaration under
	TCL_COMPILE_DEBUG.

2001-11-20  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c:
	* generic/tclProc.c: restoring the computations of iPtr->numLevels to
	the original logic (previous to buggy modifs on 2001-11-16).

2001-11-20  Jeff Hobbs  <[email protected]>

	* tools/eolFix.tcl (new-file):
	* unix/Makefile.in: added EOL correction for Windows bat files to
	dist target. [Bug 219409] (davygrvy)

	* unix/tclUnixInit.c (TclpSetInitialEncodings): update of patch from
	2001-11-16 that uses the old Tcl encoding check mechanism as a
	fallback to the original. Also added a TCL_DEFAULT_ENCODING #define
	(defaults to iso8859-1). Tcl will first try setlocale and nl_langinfo,
	and if that fails, guess based on certain LANG|LC_* env vars. [Patch
	418645]

2001-11-19  David Gravereaux <[email protected]>

	* win/buildall.vc.bat:  Added useful comments.

2001-11-19  Miguel Sofer  <[email protected]>

	* tests/compile.test: added a test for bug [Bug 483309]

2001-11-19  Vince Darley  <[email protected]>

	* win/tclWinFile.c:
	* win/tclWinFCmd.c:
	* win/tclWin32Dll.c:
	* doc/file.n:
	* tests/winFCmd.test: improved speed of file normalization for
	Win95/98, and clarified docs on differences in file normalization
	between NT/2000 and the older operating systems. Added test to ensure
	normalization is correct.

2001-11-19  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c:
	* generic/tclParse.c: Code reorganisation. Moved all evaluation
	functions from tclParse.c to tclBasic.c, so that now tclParse.c deals
	exclusively with parsing and all evaluations are done by code in
	tclBasic.c. The functions moved are: TclEvalObjvInternal,
	Tcl_EvalObjv, Tcl_LogCommandInfo, Tcl_EvalTokensStandard,
	Tcl_EvalTokens, Tcl_EvalEx, Tcl_Eval, Tcl_EvalObj and
	Tcl_GlobalEvalObj.

2001-11-19  Donal K. Fellows  <[email protected]>

	* tests/trace.test (trace-8.8): Added adapted version of [Bug 219393]
	as new test; the test won't reliably show up the old problem unless it
	is being run under something like Purify, but something is better than
	nothing...

	* generic/tclVar.c (Tcl_TraceVar2, Tcl_UntraceVar2): Added missing
	mask bits for trace result type and a check for a nonsense flag
	combination.
	* generic/tclCmdMZ.c (TraceVarProc): Added missing test for NULL when
	deleting a trace that doesn't cause an error.

	* doc/TraceVar.3: Added documentation for change due to TIP#68.

	* generic/tclCmdMZ.c (TraceVarInfo): Removed problematic errMsg field
	from structure.
	(TraceVarProc): Removed references to errMsg field and changed
	handling of errors so that they returned a Tcl_Obj* containing the
	error string. This minimizes the number of calls to the memory
	management subsystem.
	(TclTraceCommandObjCmd, TraceCommandProc): Removed references to
	errMsg field which was never used in command traces in any case.
	(Tcl_TraceObjCmd, TclTraceVariableObjCmd): Removed references to
	errMsg field and made variable traces register with
	TCL_TRACE_RESULT_OBJECT bit set.

	* generic/tcl.h (TCL_TRACE_RESULT_DYNAMIC,TCL_TRACE_RESULT_OBJECT):
	New constants to define how to handle the strings returned from trace
	callbacks [TIP#68]
	* generic/tclVar.c (CallTraces, Tcl_GetVar2Ex, TclGetIndexedScalar,
	(TclGetElementOfIndexedArray, Tcl_SetVar2Ex, TclSetIndexedScalar,
	(TclSetElementOfIndexedArray, Tcl_UnsetVar2, Tcl_ArrayObjCmd,
	(TclDeleteVars, TclDeleteCompiledLocalVars, DeleteArray,
	(TclVarTraceExists): Support for those new trace flags.

2001-11-19  Miguel Sofer  <[email protected]>

	* generic/tclCompCmds.c: patch for [Bug 483309] (petasis).

2001-11-16  Kevin B. Kenny  <[email protected]>

	* generic/tclListObj.c: removed a C++-style comment that was
	inadvertently left in the source code.

2001-11-16  Jeff Hobbs  <[email protected]>

	* tests/interp.test:
	* generic/tclInterp.c (SlaveObjCmd): Corrected argument checking for
	'$interp alias|aliases|issafe'. [Patch 479560] (thoyts, hobbs)

	* unix/tclUnixInit.c: added HAVE_LANGINFO code block.
	* unix/configure: regened
	* unix/configure.in: added SC_ENABLE_LANGINFO call
	* unix/tcl.m4: made SHLIB_LD_LIBS='${LIBS}' for FreeBSD* (meyer)
	Added modified version of Wagner patch to make use of nl_langinfo
	where possible to determine Unix platform encoding, instead of the
	inflexible built-in system. This is used by default when possible, and
	can be disabled with --enable-langinfo=no. [Patch 418645] (hobbs,
	wagner)

2001-11-16  Miguel Sofer  <[email protected]>

	* generic/tclCompile.h:
	* generic/tclExecute.c:
	* generic/tclObj.c: moved Tcl_GetCommandFromObj and all defining code
	for tclCmdNameType objects to tclObj.c (from tclExecute.c). This code
	has nothing to do with bytecodes.

2001-11-16  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c:
	* generic/tclCompile.h:
	* generic/tclExecute.c:
	* generic/tclParse.c:
	* generic/tclProc.c:
	* tests/stack.test: consolidation of duplicated code (in
	TclExecuteByteCode and EvalObjv); renaming of EvalObjv to TclEvalObjv
	as it is not static anymore; restored consistency of level counts
	between compiled and directly evaled code. [Bug 480896]

2001-11-12  David Gravereaux <[email protected]>

	* win/makefile.vc:
	* win/rules.vc:  Small bug fixes.

	* win/README: added some docs pointing to the docs in makefile.vc for
	it's use.

2001-10-17  Kevin B. Kenny  <[email protected]>

	* doc/lappend.n:
	* doc/lindex.n:
	* doc/linsert.n:
	* doc/list.n:
	* doc/llength.n:
	* doc/lrange.n:
	* doc/lsearch.n:
	* doc/lset.n (new-file):
	* doc/lsort.n:
	* generic/tclBasic.c (builtInCmds, Tcl_EvalObjEx):
	* generic/tclCmdIL.c (Tcl_LindexObjCmd, Tcl_LindexList):
	(Tcl_LindexFlat, Tcl_LsetObjCmd):
	* generic/tclCompCmds.c (Tcl_CompileLindexCmd, Tcl_CompileLsetCmd):
	* generic/tclCompile.c:
	* generic/tclCompile.h:
	* generic/tclExecute.c (TclExecuteByteCode):
	* generic/tclInt.decls:
	* generic/tclInt.h:
	* generic/tclIntDecls.h:
	* generic/tclListObj.c (TclLsetList, TclLsetFlat, TclSetListElement):
	* generic/tclObj.c (TclInitObjSubsystem):
	* generic/tclStubInit.c:
	* generic/tclTestObj.c (TestobjCmd):
	* generic/tclUtil.c (TclGetIntForIndex, SetEndOffsetFromAny):
	* generic/tclVar.c (Tcl_LappendObjCmd):
	* tests/lindex.test:
	* tests/lset.test (new-file):
	* tests/lsetComp.test (new-file):
	* tests/obj.test:
	* tests/string.test:
	* tests/stringComp.test:
	Reference implementation of TIP's #22, #33 and #45. Adds the ability
	of the [lindex] command to have multiple index arguments, and adds the
	[lset] command. Both commands are byte-code compiled. [Patch 471874]
	(work by Kenny, commited by Hobbs)

2001-11-12  David Gravereaux <[email protected]>

	* win/buildall.vc.bat(new):
	* win/makefile.vc:  Small fix with deriving the "OriginalFilename"
	string in the .rc scripts. Added a quick batchfile for building the
	entire thing.

2001-11-12  Jeff Hobbs  <[email protected]>

	* doc/FileSystem.3:
	* doc/file.n:
	* doc/tcltest.n: converted use of \' to more reasonable format.

2001-11-10  Mo DeJong  <[email protected]>

	* unix/Makefile.in:
	* win/Makefile.in: Add "make gdb" target. This target can run tclsh
	inside either gdb or insight.

2001-11-10  David Gravereaux <[email protected]>

	* win/makefile.vc:  Added a check to make sure one runs the makefile
	from the /win directory only.

	* win/mkd.bat:
	* win/rmd.bat:  Changes from Llyod Lim for better stability.
	[Patch 456759]

2001-11-09  David Gravereaux <[email protected]>

	* win/makefile.vc:
	* win/tcl.dsp:  winhelp target fixes for non-NT systems. It seems
	NMAKE under these remembers changed directories during commands. A new
	tcltest feature from Peter Spjuth <[email protected]> to specify a
	pattern file from the commandline and redirecting output to a file
	when not under NT with it's scrollback console. Then it replays it,
	piped through more. Added 2 new static "configurations" to tcl.dsp.
	I could keep adding more, but I think we should leave it up to the
	user for customizing it.

	Sticky-points left:  'profile' option.

2001-11-09  Jeff Hobbs  <[email protected]>

	* doc/FileSystem.3:
	* doc/StdChannels.3:
	* doc/file.n:
	* doc/tcltest.n:
	* tools/man2help.tcl:
	* tools/man2help2.tcl: fixed winhelp generation problems
	[Patch 480268]

	* unix/configure:
	* unix/tcl.m4: added -lc to AIX libs, fixed path to ldAix

2001-11-09  Don Porter	<[email protected]>

	* tests/var.test:
	* generic/tclVar.c: Corrected bug in [global] when dealing with
	variable names matching :*. [Bug 480176]

2001-11-08  Mo DeJong  <[email protected]>

	Fixup stack size under OSF1. [Patch 474790]

	* unix/configure: Regen.
	* unix/tcl.m4: Add HAVE_PTHREAD_ATTR_SETSTACKSIZE define to
	EXTRA_CFLAGS to adjust initial stack size.

2001-11-08  Mo DeJong  <[email protected]>

	Enable thread support under FreeBSD. [Bug 473708]

	* unix/configure: Regen.
	* unix/tcl.m4 (SC_ENABLE_THREADS): Check for pthread functions in
	libc_r and enable thread support if found.
	* unix/dltest/Makefile.in: Set SHLIB_LD_LIBS and use it in the
	Makefile to properly link a shared library.

2001-11-08  Mo DeJong  <[email protected]>

	* unix/Makefile.in:
	* unix/dltest/Makefile.in: Avoid adding libc to the LIBS variable
	since it is not needed when linking with CC. If required when linking
	with LD it should be done on a case by case basis in tcl.m4.

2001-11-08  David Gravereaux <[email protected]>

	* win/rules.vc:
	* win/makefile.vc:  Fixed install target to adjust for the different
	build types. Added a 'linkexten' option to link the win extensions
	inside the shell when built static. Placed win/tclAppInit.c patch in
	SF patch DB for approval. 'profile' option not hooked in yet.
	Everything else know is done.

	* win/tcl.dsp(new):
	* win/tcl.dsw(new):  Simple MsDev stub project files that calls
	makefile.vc. Will help run Tcl in the debugger easier without
	confusing MsDev for where the .pdb files are.

2001-11-07  Mo DeJong  <[email protected]>

	* unix/Makefile.in:
	* win/Makefile.in: Print a message indicating that the user should run
	"make genstubs" when the generated tclStubInit.c file is out of date.
	We can't regenerate automatically since there may be no tclsh on the
	system and that would cause bootstrap problems. [Bug 465874]

2001-11-07  Mo DeJong  <[email protected]>

	Define TCL_INCLUDE_SPEC in tclConfig.sh. It should be included by
	extensions that need to find Tcl include headers in the install
	location. The user can override the include install dir with
	--includedir so we need to record this information for extensions.
	[Bug 421835]

	* unix/configure: Regen.
	* unix/configure.in: Define TCL_INCLUDE_SPEC.
	* unix/tclConfig.sh.in: Define TCL_INCLUDE_SPEC.
	* win/configure: Regen.
	* win/configure.in: Define TCL_INCLUDE_SPEC.
	* win/tclConfig.sh.in: Define TCL_INCLUDE_SPEC.

2001-11-07  David Gravereaux <[email protected]>

	* win/rules.vc:
	* win/makefile.vc: Dropped the NOMSVCRT macro and put it on the option
	list instead. It makes more sense to me this way as NOMSVCRT=0 would
	only be the valid setting. Fixed the dde and reg extension for
	building static. Improved, but not perfected, the winhelp target.

2001-11-07  Mo DeJong  <[email protected]>

	* win/README: Change minimum VC++ version to 5.X since 4.X is known
	not to work.
	Indicate that Mingw is required and building with Cygwin gcc is not
	supported. Include instructions that indicate how to install Mingw and
	what URLs folks should use to download the supported version of Mingw.
	* win/configure: Regen.
	* win/configure.in: Error out if user tries to compile the Windows
	version of Tcl with Cygwin gcc. Users should compile with Mingw gcc
	instead.

2001-11-06  Andreas Kupries  <[email protected]>

	* generic/tclIO.c (ReadChars): Fixed [Bug 478856] reported by Stuart
	Cassoff <[email protected]>. The bug caused loss of
	fileevents when [read]ing less data from the channel than buffered.
	Due to an empty input buffer the flag CHANNEL_NEED_MORE_DATA was set
	but never reset, causing the I/O system to wait for more data instead
	of using a timer to synthesize fileevents and to flush the pending
	data out of the buffers.

2001-11-06  David Gravereaux <[email protected]>

	* win/rules.vc (new):
	* win/makefile.vc:  Complete over/under rewrite to support numerous
	build options all from the commandline itself without needing to edit
	the makefile. Now requires vcvars32.bat to be run prior to running
	nmake for bootstraping the environment. Fully doc'd usage for it is in
	makefile.vc. Commentary welcome. Sticky points left are:

	1) winhelp target shows errors in the converting script.
	2) .rc scripts aren't getting the right #defines to build the correct
	   "OriginalFilename" strings. (have patch, won't commit yet)
	3) Naming convention with suffixes describing the buildtype are 'tsdx'
	   which will need public acceptance. ie. tclsh84tsx.exe is a (t)
	   threaded shell (s) statically linked to the core and (x) uses
	   msvcrt instead of libcmt.

2001-11-04  Vince Darley  <[email protected]>

	* library/init.tcl: made filesystem fallback proc ::tcl::CopyDirectory
	more robust to vagaries of non-native filesystems.

2001-11-02  Vince Darley  <[email protected]>

	* doc/file.n:
	* generic/tclIOUtil.c: updated documentation and comments to clarify
	behaviour of 'file copy' wrt soft links.

2001-10-29  Vince Darley  <[email protected]>

	* win/tclWinFile.c: fix to '-types {f r}' bug in TclpMatchInDirectory
	(which could cause a UMR, as well as returning wrong results). Also
	improved API for 'stat' to resolve [Bug 219258].
	* win/tclWin32Dll.c
	* win/tclWinInt.h: addition of improved stat API to internal lookup
	table.
	* tests/fileName.test: two new tests for the above bug.
	* generic/tclIOUtil.c: some cleanup of comments and #ifdefs

2001-10-29  Donal K. Fellows  <[email protected]>

	* unix/tclUnixFile.c (TclpMatchInDirectory): Argument to access() was
	entryPtr->d_name instead of nativeEntry which failed when trying to
	check access for files in other than the current directory. [Bug
	475941, reported by Georgios Petasis]

2001-10-25  Donal K. Fellows  <[email protected]>

	* unix/tclUnixChan.c: Added stateUpdated member to struct TtyState.
	(TtyCloseProc,TtySetOptionProc,TtyInit): Use stateUpdated member of
	TtyState to decide whether it is necessary to reset a serial port when
	Tcl closes it. Blindly resetting can cause Tcl to be sent an
	unexpected SIGTSTP when it is executing in the background [Bug 471374,
	reported by Chris Nelson]

2001-10-22  Andreas Kupries  <[email protected]>

	* doc/ObjectType.3: Minor documentation fix, reported by David N.
	Welton <[email protected]> directly to me.

2001-10-22  Vince Darley  <[email protected]>

	* win/tclWinFCmd.c: fix to stop test suite from hanging process under
	some versions of WinNT. [Bug 466102] (Kevin Kenny)

2001-10-18  Jeff Hobbs  <[email protected]>

	* tests/clock.test (clock-8.1):
	* generic/tclDate.c (RelativeMonth):
	* generic/tclGetDate.y (RelativeMonth): corrected off-by-one-day error
	in clock scan with relative months and years during swing hours. [Bug
	413397, Patch 414024] (lavana)

2001-10-18  Vince Darley  <[email protected]>

	* generic/tclIOUtil.c: fix to bug in Tcl_FSChdir shown up by recent
	tclkit builds.

2001-10-17  Jeff Hobbs  <[email protected]>

	* unix/tclUnixPipe.c (PipeInputProc, PipeOutputProc): do immediate
	retry when error is returned with errno == EINTR. [Bug 415131] (leger)

2001-10-16  Jeff Hobbs  <[email protected]>

	* unix/tclLoadAout.c (TclGuessPackageName): removed unused vars and
	fixed warnings. [Bug 446622] (lim)

2001-10-15  Miguel Sofer  <[email protected]>

	* generic/tclProc.c: changing a memcmp to strncmp to avoid a memory
	error detected by purify (thanks Jeff); modify style to agrre with the
	style guide.

2001-10-15  Andreas Kupries  <[email protected]>

	* generic/tclInt.decls (TclExpandCodeArray,TclGetInstructionTable):
	Added to internal stubs table. Tclcompiler (Tclpro project) needs them
	if used as loadable package under Windows. Changed signatures. We
	don't want to describe compiler internal structures in "tclInt.h".

	* generic/tclCompile.h: S.a. Removed function declarations.
	* generic/tclCompile.c: S.a. Adapted to changed signatures.

2001-10-15  Jeff Hobbs  <[email protected]>

	* unix/configure:
	* unix/configure.in:
	* win/configure:
	* win/configure.in:
	* win/tcl.m4: reworked to be a little cleaner in comparison to each
	other, and to AC_SUBST even empty vars for win/tclConfig.sh

	* generic/tclFileName.c: minor code cleanup

	* generic/tcl.h: moved #define of WIN32 to tcl.h where __WIN32__ is
	defined and added #ifndef check.

	* doc/open.n: moved all fconfigure option docs to fconfigure.n
	* doc/fconfigure.n: added serial config options

	* win/tclWinChan.c:
	* win/tclWinPort.h:
	* win/tclWinSerial.c: added TIP #35 Windows enhancements for serial
	configuration. [Patch 438509] (schroedter)

2001-10-15  Vince Darley  <[email protected]>

	* generic/tclFCmd.c: fix to memory leak in TclFileDeleteCmd on
	certain error conditions.
	* doc/FileSystem.3: fix to typo.

2001-10-12  Jeff Hobbs  <[email protected]>

	* library/encoding/ebcdic.enc:
	* tools/encoding/ebcdic.txt: EBCDIC charset mapping.
	[Patch 219323] (nijtmans)

	* library/encoding/tis-620.enc:
	* tools/encoding/tis-620.txt: TIS-620 charset mapping.
	[Patch 467423] (poonlap)

	* tests/http.test: added removeFile for outdata

	* tests/ioCmd.test: added catch around file removal, as Windows file
	locking throws errors.

	* tests/socket.test (socket-7.2): corrected to work on Win2K.

2001-10-12  Miguel Sofer  <[email protected]>

	* tests/compile.test: new tests for [Bug 467523]; they are only
	effective if TCL_MEM_DEBUG was set during compilation.

2001-10-11  Miguel Sofer  <[email protected]>

	* generic/tclLiteral.c (TclReleaseLiteral): insured that
	self-referential bytecodes are properly cleaned up on interpreter
	deletion [Bug 467523] (Ronnie Brunner)

2001-10-10  David Gravereaux  <[email protected]>

	* win/tclWinPort.h:  #include <winsock2.h> needed to get moved to
	after #include <windows.h> or wierd misunderstandings took place when
	-D_WIN32_WINNT=0x0400 is set for outside code that requires knowledge
	of Tcl innards. General header macro magic applied liberally...

2001-10-10  Don Porter	<[email protected]>

	* tests/unixInit.test:	Corrected restore of ::env(LANG).

2001-10-09  Jeff Hobbs	<[email protected]>

	* generic/tclFileName.c (Tcl_SplitPath): corrected mem leak intro'd
	with VFS code where the result obj from Tcl_FSSplitPath was not
	getting freed.

2001-10-09  Miguel Sofer  <[email protected]>

	* generic/tclLiteral.c: (TclReleaseLiteral) reverted previous patch
	for [Bug 467523] - cure is worse than the illness.

2001-10-05  Miguel Sofer  <[email protected]>

	* generic/tclLiteral.c: (TclReleaseLiteral) insured that
	self-referential bytecodes are properly cleaned up on interpreter
	deletion. [Bug 467523] (Ronnie Brunner)

2001-10-04  Jeff Hobbs  <[email protected]>

	* tools/configure:
	* tools/configure.in: noted 8.4 as default Tcl version

	* library/encoding/cp936.enc:
	* library/encoding/cp949.enc:
	* library/encoding/cp950.enc:
	* library/encoding/iso8859-16.enc:
	* library/encoding/macCroatian.enc:
	* library/encoding/macCyrillic.enc:
	* library/encoding/macGreek.enc:
	* library/encoding/macIceland.enc:
	* library/encoding/macRoman.enc:
	* library/encoding/macTurkish.enc:
	* tools/encoding/cp1250.txt:
	* tools/encoding/cp1251.txt:
	* tools/encoding/cp1252.txt:
	* tools/encoding/cp1253.txt:
	* tools/encoding/cp1254.txt:
	* tools/encoding/cp1255.txt:
	* tools/encoding/cp1256.txt:
	* tools/encoding/cp1257.txt:
	* tools/encoding/cp1258.txt:
	* tools/encoding/cp874.txt:
	* tools/encoding/cp932.txt:
	* tools/encoding/cp936.txt:
	* tools/encoding/cp949.txt:
	* tools/encoding/cp950.txt:
	* tools/encoding/iso8859-1.txt:
	* tools/encoding/iso8859-10.txt:
	* tools/encoding/iso8859-13.txt:
	* tools/encoding/iso8859-14.txt:
	* tools/encoding/iso8859-15.txt:
	* tools/encoding/iso8859-16.txt:
	* tools/encoding/iso8859-2.txt:
	* tools/encoding/iso8859-3.txt:
	* tools/encoding/iso8859-4.txt:
	* tools/encoding/iso8859-5.txt:
	* tools/encoding/iso8859-6.txt:
	* tools/encoding/iso8859-7.txt:
	* tools/encoding/iso8859-8.txt:
	* tools/encoding/iso8859-9.txt:
	* tools/encoding/koi8-r.txt:
	* tools/encoding/macCentEuro.txt:
	* tools/encoding/macCroatian.txt:
	* tools/encoding/macCyrillic.txt:
	* tools/encoding/macGreek.txt:
	* tools/encoding/macIceland.txt:
	* tools/encoding/macRoman.txt:
	* tools/encoding/macTurkish.txt:
	Updated encodings with latest mappings from www.unicode.org. This did
	not include some Mac encodings that have special multi-unichar
	translations now (like symbols, dingbats and japanese). Also does not
	include big5, gb or euc* as those have different formats in the latest
	Unicode version that need new conversion tools. Not all related .enc
	files changed as some had been updates separately.

2001-10-03  Jeff Hobbs  <[email protected]>

	* generic/tclEvent.c (Tcl_FinalizeThread): moved freeing of
	tclLibraryPath to before the thread exit handlers are called. Slight
	modification to change on 2001-09-24.

2001-10-01  Jeff Hobbs  <[email protected]>

	* win/configure: regen'ed
	* win/tcl.m4:
	* win/makefile.vc: added Win64 SDK RC1 compilation support
	* win/Makefile.in: added $(LDFLAGS_CONSOLE) to TCLSH, TCLTEST and
	PIPE_DLL_FILE targets to get the link flags

	* win/tclWinInit.c: minor 64bit casts

2001-10-01  Miguel Sofer  <[email protected]>

	* generic/tclCmdIL.c:
	* generic/tclCmdMZ.c:
	* generic/tclParseExpr.c: removed unnecessary inclusion of
	tclCompile.h and made a small modification in (InfoBodyCmd) to improve
	the isolation of the compiler/engine subsystem.

2001-09-29  Vince Darley  <[email protected]>

	* generic/tclIOUtil.c:
	* doc/FileSystem.3: corrected and clarified documentation for
	'Tcl_FSListVolumes(Proc)'. No code changes.

2001-09-28  Miguel Sofer  <[email protected]>

	* doc/FindExec.3: added a comment not to change the working directory
	before calling Tcl_GetNameOfExecutable. [Bug 219215]

2001-09-28  Kevin Kenny   <[email protected]>

	* generic/tclIO.c: added two more '(ClientData)' casts on calls to
	Tcl_Preserve and Tcl_Release -- ones that Vince apparently missed.

2001-09-28  Donal K. Fellows  <[email protected]>

	* doc/lsort.n: Improved doc...
	* generic/tclCmdIL.c (Tcl_LsortObjCmd, SortCompare): Made
	offset-from-end indexing work, and factored out some "magic numbers"
	for easier understanding. [Bug 465674]
	* tests/cmdIL.test (cmdIL-1.26): Added test for offset-from-end
	indexing for lsort.

2001-09-28  Vince Darley  <[email protected]>

	* win/tclWinFCmd.c:
	* unix/tclUnixFCmd.c: fix to performance issue reported by jcw in
	which 'access("")' is called unnecessarily when normalizing any
	absolute path.
	* generic/tclIO.c: added '(ClientData)' cast to calls to
	Tcl_(Preserve|Release) newly introduced, fixing compile error on
	Windows.

2001-09-27  Don Porter  <[email protected]>

	* doc/FileSystem.3 (Tcl_FSLoadFile):
	* generic/tcl.decls (Tcl_FSLoadFile):
	* generic/tcl.h (Tcl_FSLoadFileProc):
	* generic/tclInt.h (TclpLoadFile):
	* generic/tclIOUtil.c (Tcl_FSLoadFile):
	* generic/tclLoadNone.c (TclpLoadFile):
	* generic/tclTest.c (TestReportLoadFile):
	* library/ldAout.tcl:
	* mac/tclMacLoad.c (TclpLoadFile):
	* unix/tclLoadAix.c (TclpLoadFile):
	* unix/tclLoadAout.c (TclpLoadFile):
	* unix/tclLoadDl.c (TclpLoadFile):
	* unix/tclLoadDld.c (TclpLoadFile):
	* unix/tclLoadDyld.c (TclpLoadFile):
	* unix/tclLoadNext.c (TclpLoadFile):
	* unix/tclLoadOSF.c (TclpLoadFile):
	* unix/tclLoadShl.c (TclpLoadFile):
	* win/tclWinLoad.c (TclpLoadFile):
	* win/tclWinFCmd.c (DoRemoveJustDirectory):  More CONST poisoning
	fixes from the 2001-09-24 TIP 27 changes. CONST-ified Tcl_FSLoadFile
	and TclpLoadFile. Report and patch from Kevin Kenny. [Bug 465833]

	* generic/tclIO.c (ChannelTimerProc):  Added Tcl_Preserve() and
	Tcl_Release() to fix segfault introduced by the 2001-09-26 changes.
	[Bug 465494]

	* doc/TCL_MEM_DEBUG.3:  Updated out-of-date reference to #define
	GUARD_SIZE.

	* doc/UpVar.3 (Tcl_UpVar,Tcl_UpVar2):
	* generic/tcl.decls (Tcl_UpVar,Tcl_UpVar2):
	* generic/tclInt.decls (TclFindProc,TclGetFrame):
	* generic/tclInt.h (TclFindProc,TclGetFrame,TclLookupVar,
	(TclPrecTraceProc,TclProcInterpProc}):
	* generic/tclProc.c (TclGetFrame,TclFindProc):
	* generic/tclVar.c (Tcl_UpVar,Tcl_UpVar2,MakeUpvar):  Updated APIs in
	generic/tclProc.c and generic/tclVar.c according to the guidelines of
	TIP 27. [Patch 465442]

	* generic/tclDecls.h:
	* generic/tclIntDecls.h: make genstubs

2001-09-26  Andreas Kupries  <[email protected]>

	* doc/fileevent.n: Accepted [Patch 465279] adding an example to the
	fileevent manpage. Minor modifications to get a better formatting.
	Report and patch by David N. Welton <[email protected]>.

	* The changes below fix [Bug 462317] where Expect tried to read more
	than was in the buffers and then blocked in the OS call as its pty
	channel driver provides no blockmodeproc through which the OS could be
	notified of blocking-behaviour. Because of this the general I/O core
	has to take more care than usual to preserve the semantics of
	non-blocking channels.

	The problem was reported by "Kevin O'Gorman" <[email protected]>.

	* generic/tclIO.c (Tcl_ReadRaw): Do not read from the driver if the
	channel is non-blocking and the fileevent causing the read was
	generated by a timer. We do not know if there is data available from
	the OS. Instead of going to the OS for more and potentially blocking
	we simply signal EWOULDBLOCK to the higher levels to cause the system
	to wait for true fileevents.
	(GetInput): Same as before.
	(ChannelTimerProc): Added set and clear of CHANNEL_TIMER_FEV.

	* generic/tclIO.h (CHANNEL_TIMER_FEV): New flag for channels. Is set
	if a fileevent was generated by a timer, the channel is not blocking
	and the driver did not provide a blockmodeproc. In that case the I/O
	core has to be especially careful about going to the driver for more
	data.

2001-09-26  Don Porter  <[email protected]>

	* doc/SplitPath.3 (Tcl_GetPathType):
	* generic/tcl.decls (Tcl_GetPathType):
	* generic/tclFileName.c (Tcl_GetPathType):
	* win/tclWinFile.c (TclpMatchInDirectory, NativeStat):  Vince Darley
	reports the 2001-09-24 TIP 27 changes left the win directory CONST
	poisoned. These changes should fix that.

	* generic/tclDecls.h: make genstubs

2001-09-25  Don Porter  <[email protected]>

	* doc/GetInt.3:
	* generic/tclInt.h (TclGetLong deleted):
	* generic/tcl.decls:
	* generic/tclInt.decls:
	* generic/tclGet.c:  Updated APIs in generic/tclGet.c according to the
	guidelines of TIP 27. [Patch 464674]

	* generic/tclDecls.h:
	* generic/tclIntDecls.h: make genstubs

2001-09-25  Miguel Sofer  <[email protected]>

	* generic/tclVar.c: removed comments referring to unused flag
	TCL_PARSE_PART1.

2001-09-24  Don Porter  <[email protected]>

	* doc/Concat.3:
	* doc/DString.3:
	* doc/SplitList.3:
	* generic/tclInt.h (TclCheckBadOctal):
	* generic/tcl.decls:
	* generic/tclInt.decls:
	* generic/tclEncoding.c (OpenEncodingFile):
	* generic/tclMain.c (Tcl_Main):
	* generic/tclUtil.c:
	* unix/tclLoadDl.c (TclpLoadFile):  Updated APIs in generic/tclUtil.c
	according to the guidelines of TIP 27. [Patch 464553]

	* generic/tclDecls.h:
	* generic/tclIntDecls.h: make genstubs

2001-09-24  Andreas Kupries  <[email protected]>

	The change below fixes [Bug 464380]. The bug was reported by Ronnie
	Brunner <[email protected]>. He also provided the patch.

	* generic/tclEvent.c (Tcl_Finalize): Moved release of 'tclLibraryPath'
	to Tcl_FinalizeThread.
	(Tcl_FinalizeThread): See above, new place for release of
	'tclLibraryPath'.

2001-09-24  Donal K. Fellows  <[email protected]>

	* tools/encoding/cp1252.txt: File was missing part of the encoding
	[euro, ZCaron and zcaron].

	* doc/OpenFileChnl.3: Add docs for Tcl_OutputBuffered; remove some old
	changebars.

2001-09-21  Jeff Hobbs  <[email protected]>

	* generic/tclExecute.c (TclExecuteByteCode): corrected INST_STR_CMP
	else case for strings to pass true utf char length to Tcl_UtfNCmp.

2001-09-20  Jeff Hobbs  <[email protected]>

	* win/tclWinInit.c: added extra processor definitions. (mstacy)

	* win/tclWinSock.c (SocketThread): corrected pointer cast for _WIN64.

	* win/tclWinNotify.c: removed unnecessary winsock include (it is
	already in from tclWinPort.h).

	* win/tclWinPort.h: changed winsock.h include to winsock2.h. Reverses
	change from 2000-11-16, but is necessary for WIN64. Extensions should
	comply with defined OS words, or use #ifndef.

2001-09-20  Donal K. Fellows  <[email protected]>

	* tests/socket.test: removed dependence on being run from same dir as
	remote.tcl, which only now needs to be in the same dir as this file.
	[Bug 219326]

2001-09-19  Jeff Hobbs  <[email protected]>

	* generic/tclTest.c (TestcmdtokenCmd): corrected pointer
	storage/retrieval for 64bit machines.

	* generic/tclCmdAH.c (Tcl_FormatObjCmd):
	* generic/tclScan.c (Tcl_ScanObjCmd): corrected handling of format and
	scan on 64-bit machines. [Bug 412696] (rmax)

	* unix/configure: regen'ed
	* unix/tcl.m4: added --enable-64bit support for HP-11 with the 64-bit
	kernel.

	* tests/basic.test:
	* tests/cmdInfo.test: improved skip reporting of missing commands

	* tests/winFCmd.test: simplified error check for winFCmd-7.9

	* tests/winPipe.test: removed obsolete cat16 tests

	* generic/tclExecute.c (TclExecuteByteCode): fixed invalid usage of
	valuePtr in TRACE_WITH_OBJ in INST_EVAL_STK case. [Bug 462594] Changed
	INST_STR_CMP instruction to promote to Unicode strings only when one
	of the strings is already of Unicode type.

	* generic/tclExecute.c (TclExecuteByteCode):
	* generic/tclCompile.c (instructionTable):
	* generic/tclCompCmds.c (TclCompileStringCmd): INST_STR_MATCH -
	Updated to Int1 instruction type and added special case to use
	INST_STR_EQ instead when no glob chars are specified in a static
	string.

	* tests/{for.test,foreach.test,if.test,while.test}:
	* generic/tclCompCmds.c (TclCompileForCmd, TclCompileForeachCmd,
	TclCompileIfCmd, TclCompileWhileCmd): Corrected the overaggressive
	compiling of loop bodies enclosed in ""s.  [Bug 219166] (msofer)

2001-09-19  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c: insured that execution stack errors are also
	detected at abnormal returns.

2001-09-19  Donal K. Fellows  <[email protected]>

	* doc/socket.n: Added documentation to mention what happens when a
	server socket is created with port=0. Removed an old change bar, and
	no new change bar because Tcl has always behaved this way as it is
	really a poorly-documented standards-defined OS feature.

	* tests/util.test (util-8.1): Test derived from code to detect the
	problem, but the test always works in the C locale, so beware if you
	are maintaining the code.
	* generic/tclUtil.c (TclNeedSpace): Rewrote to be UTF-8 aware. [Bug
	411825, but not that patch which would have added extra spaces if
	there was a real non-ASCII space involved.]

2001-09-18 Andreas Kupries  <[email protected]>

	* generic/tclIOCmd.c (Tcl_PutsObjCmd): Rewritten to have saner and
	faster argument handling. [Bug 123552], [Patch 402564] (fellows)

2001-09-18  Don Porter  <[email protected]>

	* unix/configure: Regen.
	* unix/tcl.m4 (SC_CONFIG_CFLAGS): On Linux, disable inlining when one
	of the compat/*.c routines is to be linked in. [Patch 440891]

2001-09-17  Jeff Hobbs  <[email protected]>

	* generic/tcl.h: removed forced #define USE_TCLALLOC 1 for Windows.
	This means the native system allocator will be used by default. This
	should be binary and source compatible with extensions, as Tcl_Alloc
	is a properly stubbed function.

2001-09-17  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c: corrected small bug in [Patch 456668] - the
	varFramePtr was not restored in one possible exit.

2001-09-17  Miguel Sofer  <[email protected]>

	* doc/tclvars.n:
	* generic/tclCompile.c:
	* generic/tclCompile.h:
	* generic/tclExecute.c:
	* generic/tclProc.c: disabled all compile and execution tracing
	functionality in standard builds; TCL_COMPILE_DEBUG is now necessary
	to enable it. [Bug 451858]

2001-09-14  Andreas Kupries <[email protected]>

	* doc/gets.n:
	* doc/read.n:
	* doc/puts.n:
	* doc/flush.n:
	* doc/fconfigure.n:
	* doc/flush.n:
	* doc/eof.n:
	* doc/seek.n:
	* doc/tell.n:
	* doc/close.n:
	* doc/fileevent.n: Added references to the Tcl standard channels. Item
	[219250], reported by David LeBlanc <[email protected]>. Thanks to
	Christopher Nelson <[email protected]> for doing editorial work.

2001-09-13  Andreas Kupries  <[email protected]>

	* win/Makefile.in:
	* win/configure.in:
	* win/makefile.bc:
	* win/makefile.vc:
	* library/dde/pkgIndex.tcl: Fixed version numbers from bogus tcl
	versions to independent versions for dde and registry packages.

2001-09-13  Jeff Hobbs  <[email protected]>

	* tests/regexp.test (regexp-20.1):
	* generic/tclCmdMZ.c (Tcl_RegsubObjCmd): had to adjust fix from
	2001-08-06 to actually duplicate the objects in certain cases. This is
	really a place where feather would have been essential. [Bug 461322]

	* generic/tclUtf.c (Tcl_UtfPrev): corrected to return the proper
	location when the middle of a UTF-8 byte was passed in [Tk Bug 450504]

	* ChangeLog.1999:
	* ChangeLog: broke changes from 199x into ChangeLog.1999 to reduce
	size of the main ChangeLog.

2001-09-13  Andreas Kupries <[email protected]>

	* tests/ioCmd.test: Changed the computation of the result for
	iocmd-8.1[123] so that the tests work for single- and multi-process
	execution of the testsuite. Depending on the choice of the user stdout
	is a tty or not and thus reports different channel options. Fixes
	[460993] reported by Don Porter.

2001-09-13  Miguel Sofer  <[email protected]>

	* doc/ParseCmd.3:
	* generic/tcl.decls:
	* generic/tclCmdMZ.c (Tcl_SubstObjCmd):
	* generic/tclDecls.h:
	* generic/tclParse.c:
	* generic/tclStubInit.c:
	* tests/parse.test: Deprecate the use of Tcl_EvalTokens, replaced by
	the new Tcl_EvalTokensStandard. The new function performs the same
	duties but adheres to the standard return convention for Tcl
	evaluations; the deprecated function could only return TCL_OK or
	TCL_ERROR, which caused [Bug 219384] and [Bug 455151]. This patch
	implements [TIP 56].

2001-09-12  Mo DeJong  <[email protected]>

	* unix/configure: Regen.
	* unix/tcl.m4: Invert the logic that checks for $GCC. Instead of
	checking for "$GCC" = "no" we check for "$GCC" != "yes" or simply swap
	the true and false blocks of code in an if statement. That way if GCC
	is set to "" everything will still work. [Bug 460991]

2001-09-12  Don Porter <[email protected]>

	* tests/appendComp.test:
	* tests/lsearch.test:
	* tests/namespace.test:
	* tests/rename.test:
	* tests/split.test:  Corrected tests to better isolate tests in one
	file from influencing tests in other files. [Bug 460591]

2001-09-12  Miguel Sofer  <[email protected]>

	* generic/tcl.decls: reserved stub #481 for the implementation of
	[TIP 56]

2001-09-11  Andreas Kupries <[email protected]>

	* doc/OpenFileChnl.3: Added documentation for Tcl_WriteRaw and
	Tcl_ReadRaw [Bug 414929].

	* doc/CrtChannel.3: Added documentation for Tcl_ChannelBuffered and
	Tcl_GetTopChannel [Bug 414929].

	* The changes below are a fix for [Bug 219253].

	* tests/socket.test: Removed _most_ instances of hardwired port
	numbers for listening sockets. Remaining are the ports in all tests
	with constraint 'doTestsWithRemoteServer'. These seem to be designed
	for a more controlled environment and are usually skipped when running
	the testsuite.

	* tests/io.test: Removed all instances of hardwired port numbers for
	listening sockets.

2001-09-10  Jeff Hobbs  <[email protected]>

	* generic/tclEvent.c (TclInExit): Corrected handling of tsd in late
	stages of finalization. [Bug 419449] (darley)

	* tests/stack.test:
	* generic/tclInterp.c (AliasObjCmd): Check the numLevels to ensure
	that we aren't hitting some alias loop condition. [Bug 443184]

2001-09-10  Mo DeJong  <[email protected]>

	* unix/configure: Regen.
	* unix/tcl.m4 (SC_CONFIG_CFLAGS): Don't include . characters in the
	Tcl library name when building on FreeBSD 3.X and later systems.
	[Patch 450725]

2001-09-10  Andreas Kupries <[email protected]>

	* doc/tclsh.1:
	* doc/Tcl_Main.3:
	* doc/CrtChannel.3:
	* doc/OpenFileChnl.3:
	* doc/GetStdChan.3: Enhanced the manpages with cross-references to
	the new manpage and more explanations how these functions deal with
	the standard channels in various situations.

	* doc/StdChannels.3: New manpage describing handling of the standard
	channels by the Tcl library. [Bug 402725]

2001-09-10  Don Porter <[email protected]>

	* unix/mkLinks (Tcl_FSLink): Updated to reflect 2001-08-23 file system
	changes.

	* unix/tclLoadShl.c:  Added #include of tclInt.h; access to Tcl
	internals, notably TclpUnloadFile(), is required. Thanks to Bob
	Techentin for report and patch. [Bug 459305]

	* generic/tclInitScript.h (initScript):
	* win/tclWinInit.c (TCL_REGISTRY_KEY, TclpSetVariables):  Removed
	vestiges of Tcl's old initialization from registry variables. [Bug
	455645]

2001-09-10  Andreas Kupries <[email protected]>

	* generic/tclInt.decls: Also added 'TclWinFlushDirtyChannels' to the
	  internal platform specific stub table.

	* win/tclWinFile.c (TclpObjStat): Now added the call to
	'TclWinFlushDirtyChannels' to this function. I don't know where my
	head was last thursday (2001-09-06), but the call was actually added
	to 'TclpObjChdir', i.e. the implementation of [cd]. Corrected this
	now. Thanks to Vince Darley for spotting this.

2001-09-10  Miguel Sofer  <[email protected]>

	* generic/tclProc.c:
	* tests/proc.test: made [proc] bytecompile a no-op for procs defined
	with _args_ as single argument and an empty body. [FRQ 451441]

2001-09-09  Mo DeJong  <[email protected]>

	* unix/Makefile.in:
	* win/Makefile.in: Use () around variable name instead of {}. Use
	TCLTEST variable directly instead of depending on the tcltest alias.

2001-09-09  David Gravereaux <[email protected]>

	* generic/tcl.h:
	* generic/tclPlatDecls.h: Reminder from David Cuthbert
	<[email protected]> that I hadn't finished the Borland compatibility
	stuff. [Patch 436116]

2001-09-09  Mo DeJong  <[email protected]>

	* tests/cmdAH.test: Modify cmdAH-20.5 and cmdAH-24.8 to display the
	file atime or mtime results if the test fails.

2001-09-08  David Gravereaux <[email protected]>

	* win/mkd.bat:
	* win/rmd.bat: made these text files, text files again. [Patch 451333]

2001-09-08  Mo DeJong  <[email protected]>

	* win/mkd.bat:
	* win/rmd.bat: Apply binary property (cvs admin -kb) to files and
	convert to CRLF linefeed format to fix the VC++ build. [Bug 219409]

2001-09-08 Vince Darley <[email protected]>

	* generic/tclInt.h:
	* generic/tclFCmd.c:
	* doc/FileSystem.3:
	* generic/tclIOUtil.c: removed Tcl_FSCopyFile fallback to channel
	copying, since the channels will not have access to interpreters and
	the channel copying currently requires an interp. Code which required
	cross-platform copies always has interpreters, so that solves the
	problem. Fixes bug in TclKit.

2001-09-07  David Gravereaux <[email protected]>

	* win/tcl.m4: Added -link50compat option so a VC6 linker makes a VC5
	(pre sp3) compatible import library. [Bug 219257]

2001-09-07  Mo DeJong  <[email protected]>

	* win/tclWinThrd.c (TclpThreadExit): Cast status argument to
	_endthreadex to unsigned instead of DWORD to match the Win32 function
	prototype.

2001-09-06  Andreas Kupries <[email protected]>

	* All the changes below serve to fix bug [219148] which reports a 80x
	performance hit for file I/O on Win* systems. On my system it was
	closer to a 120x hit. Problem report by Uwe Traum <no email address
	available>.

	The fix goes like this: The obstacle is 'FlushFileBuffers', executed
	whenever Tcl writes data to the OS, as Tcl has to wait for the disk to
	complete I/O, and disks are slow. We remove that obstacle. This opens
	another problem, [file size] reports back wrong numbers. So for [file
	size] we add the call back in. As optimization we keep track of the
	channels which were written to and flush only these.

	* win/tclWinFile.c (TclpObjStat): Added a call to
	'TclWinFlushDirtyChannels'. This ensures that [file size] and related
	commands report the correct size of a file even if Tcl has recently
	written to it. Unixoid OS's always report the correct size even for
	files with pending data, but Win* syssystem don't. They only report
	what is actually on disk.

	* win/tclWinInt.h: Added declaration of 'TclWinFlushDirtyChannels',
	making it available to other parts of the tcl core.

	* win/tclWinChan.c (TclWinFlushDirtyChannels): New, internal,
	procedure. Goes through the list of open file channels and forces the
	OS to flush its file buffers for all which were written to since the
	last call of this function. This is an expensive operation as Tcl has
	to wait for the OS to complete actual writes to the disk.

	(FileInfo): Added dirty flag required by the procedure above.

	(FileOutputProc): Removed flushing of file buffers, setting the dirty
	flag instead. This means that the previously incurred delays do not
	happen anymore.

	(TclWinOpenFileChannel): Added initialization of 'dirty' flag.

2001-09-06  Jeff Hobbs  <[email protected]>

	* doc/http.n: noted -binary, charset and coding state keys.
	* tests/http.test:
	* library/http/pkgIndex.tcl:
	* library/http/http.tcl (geturl): correctly get charset parameter
	and convert text according to specified encoding (if known). RFC
	iso8859-1 is used by default. Also recognize Content-encoding to see
	if we should do binary translation. Added a CYA -binary switch for the
	cases that were missed. [Bugs 219211, 219399]

	* tests/ioUtil.test: changed to make better use of constraints and
	remove knownBug constraints that weren't valid.

2001-09-06  Don Porter  <[email protected]>

	* tests/unixInit.test (unixInit-3.2): Updated test to support newer
	HP-UX releases that properly report euc-jp as the system encoding for
	Japanese. Bug report and patch verification by Bob Techentin. [Bug
	453883]

	* doc/http.n:
	* library/http/*.tcl:
	* tools/tcl.wse.in:
	* tools/tclmin.wse:
	* unix/Makefile.in:
	* win/{Mm}akefile.*:  Updated http package to version 2.4, reflecting
	the new features just added.

2001-09-06 Vince Darley <[email protected]>

	* generic/tclTest.c: tests of old-fs hooks no longer cause problems in
	threaded builds. Also removed unused unload proc.
	* generic/tcl.decls:
	* generic/tclIOUtilc: added Tcl_FSMountsChanged so that a vfs can
	inform the filesystem that the filesystem epoch must be changed (since
	cached filesystems may now be incorrect). Fixes problem running tclvfs
	extension.
	* library/tcltest/tcltest.tcl: if tests aren't in a native filesystem,
	then don't use pipes to run them. [Bug 458741]

2001-09-06  Donal K. Fellows  <[email protected]>

	* generic/tcl.decls (479 generic):
	* generic/tclIO.c (Tcl_Seek,Tcl_Tell,Tcl_OutputBuffered): Added public
	function to return the size of the output buffer and reworked other
	channel functions to use this shared functionality and that of
	Tcl_InputBuffered() too. [TIP#49, Rolf Schroedter]

2001-09-05  David Gravereaux <[email protected]>

	* generic/tclPlatDecls.h:  Another small trim finalizing Borland
	support.

	* win/tclWinPipe.c:
	* win/tclWinPort.h:  More Borland compatibility fixes. Changed EDQUOT
	#define from 49 to 69. Borland had a clash as it was already using
	this number. Upon advice from Helmut Giese, EDQUOT has been found in
	other header files #defined as 69. [Patch 436116]

	* win/.cvsignore:  A few more glob patterns added.

	* win/makefile.bc (new):  Borland lives once more! rejoice..
	* generic/tclAlloc.c: Small Borland compatibility fix.
	* win/tclWinTime.c:  More Borland compatibility fixes. [Patch 436116]

2001-09-05 Vince Darley <[email protected]>

	* tests/winFCmd.test: made notWin2000 constraint false if not running
	on Windows at all.

2001-09-04  David Gravereaux <[email protected]>

	* win/tclWinThrd.c:  Revisited _beginthreadex() stuff. Instead of
	assuming a c-runtime implimentation of _beginthreadex normal, I
	reversed the logic to not assume, and use when is by explicitly
	needing to add runtimes that support it such as Borland.

	* generic/tcl.h:
	* generic/tclPlatDecls.h:  Borland compatibility change so ClientData
	was properly typed as a void* and TCHAR would not be defined twice.

	* generic/tcl.h:  Removed a small mistake from before. Changes to the
	EXTERN macro for proper Borland compatibility will have to see a TIP.
	What's this with the MS compiler:

		__declspec(dllexport) int func (int a, int b);

	will have to be this with Borland:

		int __cdecl __export func (int a, int b);

	The order of the attribute needs to be after the return type.

2001-09-04  Don Porter  <[email protected]>

	* compat/strtod.c (strtod):  Fixed failure to handle expressions like
	3eq2 and failure to set errno on overflow. [Bug 440894]

2001-09-04  Miguel Sofer  <[email protected]>

	* generic/tclProc.c:
	* tests/proc.test: made [proc] check that formal args have simple
	names. [Bug 458548]

2001-09-04 Vince Darley <[email protected]>

	Minor bug fixes in filesystem, plus small vfs changes as a result of
	enabling the test filesystem to work properly.
	* tests/fileName.test: ensure new test cleans up after itself
	* doc/filename.n:
	* generic/tclFileName.c: improved Mac path handling and document why
	[Bug 421842] on Windows handling of UNC paths is not valid.
	Documentation and code now much clearer on what is and is not a UNC
	path.
	* doc/FileSystem.3:
	* unix/tclUnixPipe.c:
	* generic/tclFCmd.c:
	* generic/tclIOUtil.c: fixed error message, fixed [Bug 453512] about
	dangerous use of tmpnam, replaced with mkstemp. Documented all the
	changes.
	* generic/tclTest.c: made test vfs fully functional as a 'reporting
	filesystem'.
	* generic/tcl.stubs:
	* generic/tcl.h:
	* generic/tclInt.h:
	* generic/tclIOUtil.c:
	* doc/file.n:
	* various platform-specific 'TclpLoadFile': fixed comments about
	unload behaviour, and completed objectification of loading. Required
	change to Tcl_Filesystem lookup table, so incompatible with 8.4a3, but
	not older versions of Tcl. The change also allows 'link' and
	'reporting' filesystems to function correctly when loading files.
	Implementation of 'file delete -force' copes with case where cwd is
	inside the directory. Moved overlooked Tcl_FSGetPathType from internal
	to external API. Made sure filesystems which are registered and then
	unregistered are only freed when all references to them are gone.
	Documented changes.
	* unix/tclUnixFCmd.c: when deleting directories recursively, make sure
	permissions are ok. Together with the above, this fixes [Bug 219139]
	* tests/winFCmd.test: differentiated test results for win2k versus
	not. This fixes [Bug: 219239]
	* tests/fCmd.test: added tests for 'file delete -force' where the cwd
	is inside, and when permissions are inadequate.

2001-09-04  Miguel Sofer  <[email protected]>

	* generic/tclCompile.c: fixed incorrect operands for INST_LIST [Bug
	458241] (David Cuthbert, [email protected])

2001-09-03  Jeff Hobbs  <[email protected]>

	* generic/tclExecute.c (TclExecuteByteCode): fixed missing comma in
	debug macro.

2001-09-03  Donal K. Fellows  <[email protected]>

	* doc/ExprLongObj.3: Fixed error in documentation of argument type to
	Tcl_ExprObj [Bug 457435]

2001-09-02  David Gravereaux <[email protected]>

	* win/tclWinThrd.c:  Portability fix for Cygwin who's c-runtime,
	not surprisingly, doesn't have the MSVCRT specific _beginthreadex /
	_endthreadex pair. This might have to be revisited for proper Borland,
	lcc32, Watcom and other support as well. [Patch 444255]

	* win/tclWinThrd.c:  Moved FinalizeConditionEvent() proto to within
	the main #ifdef TCL_THREADS block to avoid mingw warning about it
	being there but unused.

	* win/makefile.vc:  Added -Zl (zee el) to tclStubLib.c compile line to
	make sure the tclstub84.lib static library is built without requiring
	a specific C-runtime library at link-time for the end-use developer.
	It has been noted on c.l.t that this trips many first time users
	trying to make extensions. [Patch 403533]

2001-08-31  Jeff Hobbs  <[email protected]>

	* generic/tclInt.h: added TclCompileListCmd header
	* generic/tclBasic.c: added TclCompileListCmd compile proc
	* generic/tclCompCmds.c (TclCompileListCmd): function to compile the
	'list' command at parse time.
	* generic/tclExecute.c (TclExecuteByteCode): definition of INST_LIST
	bytecode.

	* doc/StringObj.3: added words of warning to use Tcl_ResetResult with
	the Tcl_Append* functions.

	* tests/compile.test: added compile-11.* interp result checks
	* generic/tclUtil.c (TclGetIntForIndex): added Tcl_ResetResult before
	Tcl_AppendStringsToObj to prevent shared object crash when called from
	bcc instruction. The Tcl_Append* calls that append to the result
	object that are invoked by bcc insts must remember to call
	Tcl_ResetResult because the bcc doesn't do this for us. [Bug 456892]

2001-08-30  Jeff Hobbs  <[email protected]>

	* generic/tclIndexObj.c: fixed some casting problems that upset Crays.
	[Bug 419528] (andreasen)

2001-08-30  Don Porter  <[email protected]>

	* generic/tcl.h: Silence warning from Sun compiler. [Bug 454374]

2001-08-30  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c: allow cached fully-qualified command names to
	be usable from different namespaces within the same interpreter
	without forcing a new lookup. This speeds up scripts that pass command
	names in variables ("this" in some OO packages). [Patch 456668]

2001-08-30 Vince Darley <[email protected]>

	Further fs updates. After examining the most common Tcl extensions
	(TclX, BLT, Tk, TclPro, Mktclapp), it has been determined that only
	TclpGetCwd and the Access/Stat/Open insert/delete hooks of the
	internal fs functions are ever used. The remaining functions from
	Tcl's internal interfaces have therefore been removed, since Tcl now
	exports a more suitable public API (Tcl_FS...)

	* generic/tclInt.stubs:
	* generic/tclInt.h: updated for removed internal functions. Some new
	internal functions have been put in tclInt.h (and not exported in the
	stub table because good public equivalents exist).
	* generic/tclTest.c: some test functions used the internal private
	APIs. These tests have been retained, but modified to use public APIs.
	Also objectified the internal filesystem tests.
	* win/tclWinFile.c: removed TclpStat, TclpAccess and refactored code
	to use NativeAccess, NativeStat. This should speed up stat, access and
	glob commands.
	* win/tclWinFCmd.c: removed all TclpCopy/Rename/Delete File/Directory
	string-based procedures which aren't used any more. Improved
	efficiency of some other procedures. Ensure that filename conversions
	with a NULL interp do not crash Tcl.
	* mac/tclMacFCmd.c: wrapped long lines and cleaned up
	TclpObjNormalizePath, removed all TclpCopy/Rename/Delete
	File/Directory string-based procedures which aren't used any more.
	* mac/tclMacFile.c: removed obsolete TclpStat, TclpAccess, TclpChdir,
	etc.
	* unix/tclUnixFCmd.c: removed use of TclpAccess, removed all
	TclpCopy/Rename/Delete File/Directory string-based procedures which
	aren't used any more.
	* unix/tclUnixFile.c: removed obsolete TclpStat, TclpAccess,
	TclpChdir, etc.
	* tcl(Unix|Mac|Win)Chan.c: objectified TclpOpenFileChannel.
	* various 'load' implementations all objectified.
	* generic/tclFileName.c: removed redundant code.
	* generic/tclIOUtil.c: removed TclStat, TclAccess, TclpListVolumes.
	Fix to MatchInDirectory at the root of a volume. Also improved some
	documentation, and improved default path joining behaviour for virtual
	filesystems, especially regarding '~'.
	* tests/fileName.test: added tests to check for bugs fixed above.
	* doc/FileName.3: improved documentation

2001-08-30  David Gravereaux <[email protected]>

	* generic/tclAsync.c:
	* generic/tclEvent.c:
	* generic/tclInt.h: Improper cleanup of asyncMutex in tclAsync.c
	repaired. TclFinalizeSynchronization() was trying to remove a
	registered mutex that was dumped earlier when the TSD it was stored in
	was cleared. This was only surfacing on *nix. Windows was being masked
	by mutexes not actually being returned to the system! That was
	repaired in a previous patch. Needed to add a private
	TclFinalizeAsync() to tclAsync.c and called from Tcl_FinalizeThread().
	Pheww.. Is this done yet? [Bug 414419] requested by Rob Ratcliff
	<[email protected]>

2001-08-28  Jeff Hobbs  <[email protected]>

	* generic/tclCompCmds.c (TclPushVarName): noted 'static' defn.
	[Bug 453872]

2001-08-26  Don Porter <[email protected]>

	* library/auto.tcl (tcl_findLibrary):
	* tests/unixInit.test (unixInit-2.{1,9}):
	* unix/tclUnixInit.c (TclpInitLibraryPath):
	* win/tclWinInit.c (TclpInitLibraryPath):  Corrected inconsistency
	between  the search path for script libraries and the directory name
	$DISTNAME into which distributions built by 'make test' unpack. [Bug
	455642]

2001-08-24  Jeff Hobbs  <[email protected]>

	* tests/stringComp.test: added string-1.3
	* generic/tclCompCmds.c (TclCompileStringCmd): changed to return
	TCL_OUT_LINE_COMPILE instead of TCL_ERROR when compiling and an
	unknown string method is called. This is necessary as the string
	command may be never called, or not until 'string' is redefined.

2001-08-24 Vince Darley <[email protected]>

	* doc/glob.n: documented windows-style path issue with glob.
	[Bug 219392]
	* doc/filename.n: documented windows path/file length limitation.
	[Bug 454597]

2001-08-24  Don Porter <[email protected]>

	* tests/unixInit.test (unixInit-2.9): Corrected expected result to
	match Tcl's quirky construction of its init library path.

2001-08-23  Andreas Kupries <[email protected]>

	* win/tclWinPipe.c (BuildCommandLine): Fixed [Bug 432499]. Part of the
	code used the non-absolute path to the executable to determine
	quoting. This failed if the absolute path contained spaces, but the
	application name itself not. This bug caused no trouble on Win NT 5,
	but does for other variants in the Win* family. Report and fix due to
	Ken Poole <[email protected]>.

2001-08-23  Jeff Hobbs  <[email protected]>

	* unix/configure:
	* unix/tcl.m4: added QNX-6 build support. [Bug 219410] (loverso)

	* unix/tclUnixFCmd.c:
	* generic/tclIOUtil.c:
	* generic/tclFileName.c: corrected minor compiler warnings.

2001-08-23 Vince Darley <[email protected]>

	Variety of small filesystem and vfs issues fixed or improved. The new
	fs code allows many new opportunities for efficiency improvements
	through the objectified API. The main changes integrated here are such
	efficiency improvements. Some limitations of the original
	implementation have also now been lifted. Meanwhile a variety of fs
	bugs (some old, some new) have also been fixed.

	* generic/tclFileName.c: Made Tcl_FSSplitPath more efficient, and
	removed some static string-based procedures which are no longer used.
	Much more objectification. Tcl_FSJoinPath is now very efficient and
	more aware of virtual filesystems. Clarified where the Mac-specific
	code attempts to interpret Unix-style paths. Modified TclDoGlob to use
	lstat not access to fix [Bug 434876] (L. Virden)

	* tcl(Win|Unix|Mac)FCmd.c:
	* tcl(Win|Unix|Mac)File.c: replaced TclpListVolumes with
	TclpObjListVolumes with different signature, updated code due to more
	efficient signature of Tcl_FSGetTranslatedPath. Used cached native
	paths where possible to improve efficiency -- this was completed on
	MacOS, but on Unix and Win the traversal functions make the task much
	more complex, so there are still some improvements possible there.
	Removed unused TclpNormalizePath which had been left in tclWinFCmd.c.
	Objectified all 'file attributes' functions. Fixed the new [Bug
	451571, Bruce Stephens] which is most obvious on Unix, but could occur
	on MacOS or Windows. This bug actually existed in Tcl 8.3.x but was
	only made obvious by the recent filesystem overhaul when the code was
	exercised more heavily.
	* tests/fileName.test: Three new tests to exercise the above bug, and
	make sure it is fixed correctly.
	* unix/tclUnixFile.c: avoid panic in glob when a link doesn't point
	anywhere. It would probably be good to define exactly what Tcl should
	do in circumstances like these, and make sure mac/win/unix all behave
	accordingly. [Bug 417111] (Hemang Lavana). Also fixed
	misleading/obsolete comment in the code.
	* generic/tcl.stubs: changed signature of Tcl_FSGetTranslatedPath and
	added Tcl_FSGetTranslatedStringPath.
	These changes allow further optimisations in the FS code.
	* generic/tcl.h: changed signature of Tcl_FSListVolumes so that it
	doesn't require a Tcl interpreter plus result. Renamed Tcl_FSReadLink
	to Tcl_FSLink with additional argument so we can support making links
	in the future. [Patch: 450340]
	* generic/tclInt.h: added declaration for TclpObjListVolumes.
	Objectified internal call signatures for 'file attributes' functions,
	and added an internal objectified get path type function.
	* generic/tclIOUtil.c: added the moved function TclpListVolumes which
	calls platform specific code (needed for backwards compatibility), and
	improved efficiency of parts of the FS (particularly file
	normalization). Much less copying and memory allocation is required
	now. added new GetPathType so that changes in 'file volumes' can
	actually affect files' types, and objectified more code. Made current
	code work with test suite artificially changing current platform.
	Added 'static' keywords where required.
	* generic/tclIO.c:
	* generic/tclTest.c: Added 'static' keywords, fixing [Bug 453872] (Bob
	Techentin)
	* generic/tclCmdAH.c: file command implementation updated for API
	changes, removed unnecessary special-case SplitPath static function,
	since it no longer helps prevent code duplication. Moved setting of
	interpreter result to each individual location that actually required
	it, to avoid very large code separation between reading and setting
	the result.
	* doc/FileSystem.3: updated documentation for the new or changed APIs,
	and clarified some issues.
	* doc/SplitPath.3: added pointer to newer APIs in FileSystem.3
	* doc/filename.n: clarified current implementation of tilde support on
	Mac/Win.  [Bug 453514] (Sergey Kuzmin)
	* doc/glob.n: improved documentation for '-directory' and '-path'
	options.

	There are now many private, obsolete, platform-specific 'Tclp'
	string-based filesystem APIs which could be removed. We should check
	whether any of these are used by extensions and, at least in Tcl 9,
	remove them.

	The above changes signify a ***POTENTIAL INCOMPATIBILITY*** with
	8.4a3, since signatures of two functions in the new API have changed,
	but not with older versions of Tcl.

2001-08-23  Donal K. Fellows  <[email protected]>

	* generic/tclBinary.c (FormatNumber): Extract a long from the object
	and not an int, to stop [binary format] from being unable to format
	some input numbers on architectures where sizeof(int) is less than
	sizeof(long) (particularly Alpha). [tiprender Bug 441861]

	* tests/format.test: Converted conditional execution of tests into a
	test constraint.

2001-08-22  Jeff Hobbs  <[email protected]>

	* win/Makefile.in:
	* win/makefile.vc: updated install target for dde1.2
	* doc/dde.n: fixed dde man page (which was totally incorrect).
	* tests/winDde.test:
	* win/tclWinDde.c (Tcl_DdeObjCmd): added -binary option to dde request
	command to allow for returning binary data. [Bug 227482]
	Updated dde to 1.2

	* tests/tcltest.test: added unixExecs constraint to files that used
	'grep' in the test. [Bug 453143]

	* library/tcltest/tcltest.tcl: fixed stdio constraint test. [Patch
	454050] (stanton)
	Simplified unixExecs constraint test.

2001-08-22  Don Porter <[email protected]>

	* tests/ioUtil.test (ioUtil-3.*): Corrected errors in tests revealed
	by fix of overagressive compiler. [Bug 451200]

2001-08-21  Miguel Sofer  <[email protected]>

	* generic/tclCompCmds.c:
	* tests/compile.test: Fixed overagressive compilation of [catch]: it
	was catching errors at substitution time. [Bug 219184]

2001-08-21  Jeff Hobbs  <[email protected]>

	* tests/tcltest.test (tcltest-12.2): fixed test that would break when
	env vars weren't Tcl list friendly [Patch 454046] (stanton)

2001-08-20  Jeff Hobbs  <[email protected]>

	* library/http/http.tcl (geturl): added port number to Host: header to
	comply with HTTP/1.1 spec (RFC 2068). [Bug 452217]

2001-08-16  David Gravereaux <[email protected]>

	* tools/tcl.wse.in:
	* tools/tcl.hpj.in:
	* win/tcl.hpj.in:  Removed -kb storage in CVS to ensure these text
	files are checked-out in the translation mode CVS is in. Setting these
	as binary as part of an effort to make sure they are always in CRLF,
	no matter what the CVS translation, is bypassing how CVS works and is
	confusing.

	* tools/genStubs.tcl:  Removed LF-only output. Having to reconvert
	back to CRLF before committing to CVS was giving me a headache. [Bug
	451333]

	* win/makefile.vc: replaced $(WINDIR) with $(include32) for the
	.rc.res inference rule. winver.h wasn't getting included. [Bug 445630]

2001-08-14  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c: make the intial maxNestingDepth of an
	interpreter be MAX_NESTING_DEPTH instead of a hardwired value. [Bug
	232564]

2001-08-13  Miguel Sofer  <[email protected]>

	* tests/trace.test: Corrected test numbers. [Bug 449794]

2001-08-12  Mo DeJong  <[email protected]>

	* unix/configure: Regen.
	* unix/configure.in:
	* unix/tcl.m4: Use GCC variable set by AC_PROG_CC instead of defining
	our own using_gcc variable.

2001-08-11  Vince Darley <[email protected]>

	Variety of small issues introduced by the vfs code fixed:
	* generic/tclIOUtil.c: uninitialised read.
	* generic/tclFCmd.c: possible memory leak in file delete with error
	condition.

2001-08-10  Miguel Sofer  <[email protected]>

	* generic/tclVar.c:
	* tests/trace.test: Insure that [array] traces work correctly for
	undefined variables. [Bug 449094]

2001-08-09  Mo DeJong  <[email protected]>

	* unix/Makefile.in: Delete the unused getcwd.o target. [Bug 440942]

2001-08-08  Don Porter <[email protected]>

	* library/dde/pkgIndex.tcl:
	* library/http/http.tcl:
	* library/http/pkgIndex.tcl:
	* library/msgcat/msgcat.tcl:
	* library/msgcat/pkgIndex.tcl:
	* library/opt/optparse.tcl:
	* library/opt/pkgIndex.tcl:
	* library/reg/pkgIndex.tcl:
	* library/tcltest/tcltest.tcl:
	* library/tcltest/pkgIndex.tcl: Added checks for package dependencies.
	Bumped patchlevels of changed packages: http 2.3.2, msgcat 1.2.2,
	opt 0.4.3, tcltest 2.0.1. [Patch 448931]

	* README:
	* generic/tcl.h:
	* tools/tcl.wse.in:
	* unix/configure:
	* unix/configure.in:
	* unix/tcl.spec:
	* win/README.binary:
	* win/configure:
	* win/configure.in: Bumped up patchlevel to 8.4a4 to distinguish CVS
	snapshots from the 8.4a3 release. This does not necessarily mean there
	will be an 8.4a4 release. [Bug 448938]

2001-08-06  Jeff Hobbs  <[email protected]>

	8.4a3 RELEASE

	* changes:
	* README:
	* mac/README:
	* unix/README:
	* win/README.binary: updated for 8.4a3 release

	* generic/tclFileName.c (Tcl_FSSplitPath): update to Tcl style guide.

	* generic/tclFCmd.c (FileCopyRename): fixed mem leak in introduction
	of vfs code where a new Tcl_Obj wasn't freed.

	* generic/tclCmdMZ.c (Tcl_RegexpObjCmd, Tcl_RegsubObjCmd): reordered
	the retrieval of arguments to avoid shimmering bug when the pattern
	and string referenced the same object.

	* unix/configure: regenerated
	* unixE/tcl.m4: added GNU (HURD) configuration target.
	[Patch 442974] (brinkmann)

	* win/README: made note of URL for Windows compilation notes

	* win/tclWinThrd.c (TclpFinalizeMutex, TclpFinalizeCondition): added
	DeleteCriticalSection calls for cleanup [Patch 419683]

	* unix/tclUnixPipe.c (TclpCreateTempFile): fixed use of tmpnam,
	which is dangerous. [Patch 442636] (lim)
	The use of tmpnam in TclpTempFileName must still be changed.

	* tests/http.test (http-4.14): fixed variable error return.
	[Bug 424252]

2001-08-03  Jeff Hobbs  <[email protected]>

	* win/configure: regenerated
	* win/tcl.m4: fixed DLLSUFFIX definition to always be ${DBGX}.dll.
	This is necessary for TEA compliant builds that build shared against a
	static-built Tcl.
	* win/Makefile.in ($(TCLSH)): added $(TCL_STUB_LIB_FILE) to build
	target, otherwise it wouldn't get generated in a static build.

2001-08-06  Andreas Kupries <[email protected]>

	* generic/tclIOCmd.c (Tcl_GetsObjCmd): Applied patch from [Bug 442665]
	to fix the bug reported by it. The function can corrupt a freed object
	if it is called with objc == 3. This is because it retrieves resultPtr
	and does not increment its reference count, but then calls
	Tcl_ObjSetVar2, which causes the retrieved resultPtr object to be
	released.

2001-08-06  Don Porter <[email protected]>

	* doc/tclsh.1: Added note that the tclsh program is frequently
	installed with the Tcl version numer as part of the name. [Patch
	402725]

	* generic/tclPkg.c:
	* tests/pkg.test:  [package forget] now forgets all of the package
	arguments it receives, not stopping when a package is not found. [Bug
	415273]

2001-08-02  Jeff Hobbs  <[email protected]>

	* generic/tclIOUtil.c (Tcl_FSMatchInDirectory): corrected
	uninitialized value.

2001-08-02  Mo DeJong  <[email protected]>

	* generic/tclPlatDecls.h:
	* win/tclWinPort.h: Revert <tchar.h> related changes made to improve
	Cygwin support on 2001-07-18. This change ended up breaking the VC++
	build because of conflicts between Windows APIs and internal Tk APIs.

2001-08-01  Jeff Hobbs  <[email protected]>

	* unix/tclUnixFCmd.c: minor casts to eliminate warnings. (lim)
	[Patch 440218]

	* tests/parseOld.test: changed some tests that required testwordend to
	exist to skip in a proper tcltest manner. [Bug 442663]

	* library/http/http.tcl (http::mapReply): the regsub'ing of \n and \t
	to escape them was unnecessary.

2001-07-31  Vince Darley <[email protected]>

	Changes from TIP#17 "Redo Tcl's filesystem"
	The following files were impacted:
	* doc/Access.3:
	* doc/FileSystem.3:
	* doc/OpenFileChnl.3:
	* doc/file.n:
	* doc/glob.n:
	* generic/tcl.decls:
	* generic/tcl.h:
	* generic/tclCmdAH.c:
	* generic/tclCmdIL.c:
	* generic/tclCmdMZ.c:
	* generic/tclDate.c:
	* generic/tclDecls.h:
	* generic/tclEncoding.c:
	* generic/tclFCmd.c:
	* generic/tclFileName.c:
	* generic/tclGetDate.y:
	* generic/tclIO.c:
	* generic/tclIOCmd.c:
	* generic/tclIOUtil.c:
	* generic/tclInt.decls:
	* generic/tclInt.h:
	* generic/tclIntDecls.h:
	* generic/tclLoad.c:
	* generic/tclStubInit.c:
	* generic/tclTest.c:
	* generic/tclUtil.c:
	* library/init.tcl:
	* mac/tclMacFCmd.c:
	* mac/tclMacFile.c:
	* mac/tclMacInit.c:
	* mac/tclMacPort.h:
	* mac/tclMacResource.c:
	* mac/tclMacTime.c:
	* tests/cmdAH.test:
	* tests/event.test:
	* tests/fCmd.test:
	* tests/fileName.test:
	* tests/io.test:
	* tests/ioCmd.test:
	* tests/proc-old.test:
	* tests/registry.test:
	* tests/unixFCmd.test:
	* tests/winDde.test:
	* tests/winFCmd.test:
	* unix/mkLinks:
	* unix/tclUnixFCmd.c:
	* unix/tclUnixFile.c:
	* unix/tclUnixInit.c:
	* unix/tclUnixPipe.c:
	* win/tclWinFCmd.c:
	* win/tclWinFile.c:
	* win/tclWinInit.c:
	* win/tclWinPipe.c:

2001-07-24  Mo DeJong  <[email protected]>

	* win/tclWinThrd.c (Tcl_CreateThread): Close Windows HANDLE returned
	by _beginthreadex. The MS documentation states that this handle is not
	closed by a later call to _endthreadex.

2001-07-21  Don Porter  <[email protected]>

	* doc/pkgMkindex.n:
	* library/package.tcl:  Corrected documentation and usage message of
	[pkg_mkIndex].

2001-07-18  Mo DeJong  <[email protected]>

	* generic/tclPlatDecls.h: Define TCHAR by including windows.h instead
	of tchar.h since Cygwin does not support the tchar.h header. Include
	CHECK_UNICODE_CALLS logic from tclWinPort.h.
	* win/tclWinPort.h: Remove CHECK_UNICODE_CALLS logic. Remove include
	of windows.h since this now done it tclPlatDecls.h.
	* win/tclWinReg.c: Remove duplicate include of windows.h.

2001-07-18  Andreas Kupries <[email protected]>

	* generic/tclIO.c: Aftermath to [Bug 427196]. Squash empty buffers if
	they are smaller than the requested buffersize, to prevent reusage of
	old buffers and to honor changes in the requested buffersize made by
	the user.

2001-07-17  Mo DeJong  <[email protected]>

	* win/tclWinFile.c (TclpReadlink): Add Cygwin specific definition for
	the TclpReadlink function. This method implements reading of symbolic
	links when build with Cygwin.

2001-07-17  Mo DeJong  <[email protected]>

	* win/tclWinPort.h: Add Cygwin specific defines for environ and
	timezone variables.

2001-07-17  Andreas Kupries <[email protected]>

	* generic/tclIO.c (GetInput): Fixed [Bug 427196]. Memory was
	overwritten because a buffer was used after a change of the requested
	buffersize together with that requested buffersize and not its actual
	size, which was smaller. Note that the continous reuse of the smaller
	buffer negatively impacts performance. The system never allocates a
	buffer with the newly requested bigger buffersize.

2001-07-16  Mo DeJong  <[email protected]>

	* generic/tcl.h: Define __WIN32__ when __CYGWIN__ or __MINGW32__ is
	defined.
	* generic/tclAlloc.c: Define caddr_t when compiling with VC++ or
	mingw. This type is already defined when compiling with Cygwin.

2001-07-16  Mo DeJong  <[email protected]>

	* win/tclWinConsole.c:
	* win/tclWinPipe.c:
	* win/tclWinPort.h:
	* win/tclWinSerial.c:
	* win/tclWinThrd.c:
	Remove unnecessary #includes of dos.h, direct.h, and tchar.h. This
	will help the Cygwin porting effort since these headers do not exist
	under Cygwin.

2001-07-16  Jeff Hobbs  <[email protected]>

	* win/tclWinPipe.c (PipeClose2Proc): constrained the mutex lock to
	just the TerminateThread call and waiting for termination. (jsmith)

	* generic/tclCmdMZ.c: Removed extra copy of the SCAN_* macros
	#defined in generic/tclScan.c. [Bug 441230] (porter)

2001-07-12  Donal K. Fellows  <[email protected]>

	* tests/unixInit.test (unixInit-2.8): Added extra constraint,
	notInstalledInTmp, to stop this test from damaging installations in
	/tmp; not much fun to have to reinstall the Tcl library every time you
	run the test suite!

	* tests/subst.test (subst-10.*): Updated tests to check new behaviour
	for 'break' in command substitutions.
	(subst-1.2,subst-7.1): Error messages changed.
	* doc/SubstObj.3: New file, to document Tcl_SubstObj.
	* doc/subst.n: Improved and updated documentation for 'subst' to help
	support the changed behaviour.
	* generic/tcl.decls (generic-437): Declaration for Tcl_SubstObj
	* generic/tcl.h (TCL_SUBST_*): Added flags for Tcl_SubstObj.
	* generic/tclCmdMZ.c (Tcl_SubstObj,Tcl_SubstObjCmd): Divided into two
	parts to allow people to access the innards of 'subst' and changed the
	behaviour when command substitutions do a 'break' to be different from
	'continue'. Also now works with objects, which allows for some nifty
	optimisations with variable substitutions and a slight improvement
	with command substitutions. [TIP#36]

2001-07-10  Mo DeJong  <[email protected]>

	* unix/Makefile.in: Add AR variable for use in STLIB_LD.
	* unix/configure: Regen.
	* unix/configure.in: Use STLIB_LD when defining MAKE_LIB and
	MAKE_STUB_LIB. Subst RANLIB and AR.
	* unix/tcl.m4 (SC_CONFIG_CFLAGS): Add doc comment about STLIB_LD
	command. Check ${AR} env var when setting STLIB_LD and delay
	evaluation until make time.
	* win/configure: Regen.
	* win/tcl.m4 (SC_CONFIG_CFLAGS): Delay evaluation of ${AR} in STLIB_LD
	and add flags to better match the Unix implementation. Don't bother
	defining AR when using VC++ since it is not used.

2001-07-06  Mo DeJong  <[email protected]>

	* win/configure: Regen.
	* win/tcl.m4 (SC_CONFIG_CFLAGS): Pass -e _WinMain@16 in addition to
	the -mwindows flag to work around a problem with ld when it
	incorrectly use main() as the executable entry point when both
	WinMain() and main() are available.

2001-07-06  Donal K. Fellows  <[email protected]>

	* tests/cmdAH.test: Added leading zero to file modes to work around
	fault in HPUX strtol() which ignores the base parameter. [Bug 438808]

2001-07-05  Mo DeJong  <[email protected]>

	* win/Makefile.in: Subst DEPARG directly instead of relying on a
	variable. This will make Cygwin builds faster since an extra exec will
	be avoided.
	* win/configure: Regen.
	* win/configure.in: Subst DEPARG.
	* win/tcl.m4 (SC_CONFIG_CFLAGS): Move AC_MSG_CHECKING after the
	AC_CHECK_PROG so that status messages do not get mixed together. Set
	DEPARG based on the results of the cygpath check so that we avoid
	using an extra exec when it is not needed. Use ac_cv_cygwin status
	flag instead of looking at the output of gcc -v, which works in the
	case where -mno-cygwin is set in the CFLAGS.

2001-07-04  Jeff Hobbs  <[email protected]>

	* README:
	* mac/README:
	* unix/README:
	* win/README:
	* win/README.binary: updated READMEs with purls

2001-07-03  Mo DeJong  <[email protected]>

	* win/Makefile.in: Remove PATHTYPE variable.
	* win/configure: Regen.
	* win/configure.in: Don't subst PATHTYPE.
	* win/tcl.m4 (SC_CONFIG_CFLAGS): Remove PATHTYPE variable. Set CYGPATH
	to "cygpath -w" if the cygpath executable is found on the path. This
	approach works for native Cygwin builds and cross compiles.

2001-07-03  Jeff Hobbs  <[email protected]>

	* tests/var.test:
	* generic/tclVar.c (Tcl_VariableObjCmd): added patch to check for
	number of args. [Patch 426038]

	* generic/tclVar.c (Tcl_GetVar2Ex): added ability to recognize
	TCL_TRACE_READS flags to cause creation of part1 in TclLookupVar to
	make sure newly created array will get read traces triggered
	appropriately. This is called by Tcl_ObjGetVar2, Tcl_GetVar, and
	Tcl_GetVar2.
	(TclSetIndexedScalar, TclSetElementOfIndexedArray): added read trace
	triggering for lappend case.
	(Tcl_LappendObjCmd): pass TCL_TRACE_READS to Tcl_ObjGetVar2 to trigger
	possible read traces for new arrays.

	* generic/tclExecute.c (TclExecuteByteCode): added TCL_TRACE_READS
	flag to INST_LAPPEND(_ARRAY)_STK case to trigger read traces for newly
	created arrays. Removed unnecessary #ifdef for TCL_COMPILE_DEBUG in
	INST_LOAD_SCALAR1 case.

	* tests/append.test:
	* tests/appendComp.test: added tests for read trace triggering for
	append and lappend.

2001-07-03  Mo DeJong  <[email protected]>

	* tests/clock.test (clock-2.5): Adjust test so that it passes when the
	time slice is 60 msecs, now passes under Windows 98.

2001-07-03  Mo DeJong  <[email protected]>

	* win/tcl.m4 (SC_CONFIG_CFLAGS): Don't pass the v flag to ${AR} when
	using gcc, verbose output is not needed.

2001-07-03  Don Porter  <[email protected]>

	* tests/unixInit.test (unixInit-2.8):  Changed test back to using
	installation layout, adding comments explaining why the test writes to
	the directories it does, and checks to avoid destroying other files in
	/tmp.

2001-07-03  Donal K. Fellows  <[email protected]>

	* tests/unixInit.test (unixInit-1.2): Fixed faults reported in
	[Bug 438070] - well, at least enough to work on Solaris - and added
	comments that should make what is going on in the test clearer.

2001-07-02  Jeff Hobbs  <[email protected]>

	* tests/util.test: added util-4.6
	* generic/tclUtil.c (Tcl_ConcatObj): Corrected walking backwards over
	utf-8 chars. [Bug 227512]

2001-07-02  Don Porter  <[email protected]>

	* tests/unixInit.test (unixInit-2.8):  Corrected test for all absolute
	pathnames in library path when executable is installed near root
	directory to use correct development directory layout. [Bug 438014]

	* tests/unixInit.test (unixInit-2.9):
	* unix/tclUnixInit.c (TclpInitLibraryPath):
	* win/tclWinInit.c (TclpInitLibraryPath):  Corrected buggy
	construction of search path entries relative to executable. Added test
	for bad construction. [Bug 438014]

2001-06-28  Miguel Sofer  <[email protected]>

	* generic/tclNamesp.c: Correction to faulty patch from [Bug 231259]

2001-06-28  Donal K. Fellows  <[email protected]>

	* tests/unixInit.test (unixInit-1.2): Modified so as not to require a
	local echo service, which fails on many systems which have that turned
	off for security reasons...

2001-06-27  Jeff Hobbs  <[email protected]>

	* generic/tclInt.h:
	* generic/tclObj.c:
	* unix/Makefile.in: added a -DPURIFY mode that makes Tcl_Obj's
	allocated and free singularly (instead of in alloc in blocks and never
	free) to allow checkers like Purify to operate better.

	* library/encoding/koi8-u.enc: added koi8-u (Ukranian variant)
	encoding.

	* tests/subst.test:
	* generic/tclUtf.c (Tcl_UtfBackslash): Corrected backslash handling of
	multibyte utf-8 chars. [Bug 217987]

	* generic/tclCmdIL.c (InfoProcsCmd): fixed potential mem leak in info
	procs that created objects without using them.

	* generic/tclCompCmds.c (TclCompileStringCmd): fixed mem leak when
	string command failed to parse the subcommand.

	* doc/interp.n:
	* doc/unknown.n: updated notes about what is in a safe interp. [Bug
	218605]

2001-06-27  Donal K. Fellows  <[email protected]>

	* tests/event.test (event-11.5): Removed hard-coded port number which
	could fail on some systems. [Bug 436727]

2001-06-26  Mo DeJong  <[email protected]>

	* unix/Makefile.in:
	* win/Makefile.in: Add `make shell` target. This target will set the
	proper env vars before invoking tclsh from the build directory.

2001-06-26  Mo DeJong  <[email protected]>

	* win/Makefile.in: Use : to separate VPATH entries. This works for
	both Cygwin builds and cross builds, the VPSEP variable is simply
	unneeded complexity.
	* win/configure: Regen.
	* win/configure.in: Don't subst VPSEP.
	* win/tcl.m4 (SC_CONFIG_CFLAGS): Remove VPSEP variable.

2001-06-26  Mo DeJong  <[email protected]>

	* unix/configure: Regen.
	* unix/configure.in: Fix last checkin by removing export since that
	only works in bash.
	* win/configure: Regen.
	* win/configure.in: Ditto.

2001-06-26  Mo DeJong  <[email protected]>

	* unix/configure: Regen.
	* unix/configure.in: Set CFLAGS to "" if the user did not set CFLAGS
	in the env. This keeps AC_PROG_CC from adding "-g -O2" to the CFLAGS
	by default.
	* win/configure: Regen.
	* win/configure.in: Ditto.

2001-06-25  Mo DeJong  <[email protected]>

	* win/configure: Regen.
	* win/configure.in: Use RC_DEFINE flag from tcl.m4.
	* win/tcl.m4 (SC_CONFIG_CFLAGS): Set RC_DEFINE flag based on the
	compiler in use.

2001-06-25  Mo DeJong  <[email protected]>

	* win/tcl.m4 (SC_CONFIG_CFLAGS): Link to the imm32 library when
	building with mingw gcc.

2001-06-25  Mo DeJong  <[email protected]>

	* win/configure: Regen.
	* win/tcl.m4 (SC_CONFIG_CFLAGS): When building with gcc, don't attempt
	to link with LD or support dllwrap. Simply require a recent version of
	Cygwin gcc or Mingw gcc that supports -shared. When linking, use gcc
	instead of ld since gcc automatically includes libs like -lmsvcrt.

2001-06-22  Mo DeJong  <[email protected]>

	* win/configure: Regen.
	* win/configure.in: Add resource compiler fix from 8.3.3 to fix
	compiling with mingw.

2001-06-22  Mo DeJong  <[email protected]>

	* win/configure: Regen.
	* win/tcl.m4: Fix silly typo in last checkin.

2001-06-22  Mo DeJong  <[email protected]>

	* unix/Makefile.in: Set CFLAGS to @CFLAGS@ and @CFLAGS_DEFAULT@. Set
	LDFLAGS to @LDFLAGS@ and @LDFLAGS_DEFAULT@. Add LDFLAGS_DEBUG and
	LDFLAGS_OPTIMIZE to match the way CFLAGS_DEFAULT works. This will
	support user set CFLAGS or LDFLAGS at configure time.
	* unix/configure: Regen.
	* unix/configure.in: Don't set CFLAGS to CFLAGS_DEFAULT, instead
	subst CFLAGS_DEFAULT into the Makefile. Add AC_SUBST for
	CFLAGS_DEFAULT, LDFLAGS_DEFAULT, LDFLAGS_DEBUG, and LDFLAGS_OPTIMIZE.
	* unix/tcl.m4 (SC_ENABLE_SYMBOLS): Modify LDFLAGS_DEFAULT so that it
	uses a Makefile variable just like CFLAGS_DEFAULT.
	* win/Makefile.in: Set CFLAGS to @CFLAGS@ and @CFLAGS_DEFAULT@. Set
	LDFLAGS to @LDFLAGS@ and @LDFLAGS_DEFAULT@. This will support user set
	CFLAGS or LDFLAGS at configure time.
	* win/configure: Regen.
	* win/configure.in: Don't set CFLAGS or LDFLAGS, instead subst
	CFLAGS_DEFAULT and LDFLAGS_DEFAULT into the Makefile.
	* win/tcl.m4 (SC_ENABLE_SYMBOLS): Modify LDFLAGS_DEFAULT so that it
	uses a Makefile variable just like CFLAGS_DEFAULT.

2001-06-22  Mo DeJong  <[email protected]>

	* win/configure:
	* win/tcl.m4 (SC_CONFIG_CFLAGS): Don't set LDFLAGS_DEBUG to -g or
	LDFLAGS_OPTIMIZE to -O when compiling with gcc. These flags are not
	needed and can cause problems with the Cygwin version of ld.

2001-06-18  Donal K. Fellows  <[email protected]>

	* tests/unixInit.test (unixInit-1.2,unixInit-2.8): Added test for code
	described below, and fixed a couple of errors that caused problems
	during testing; the code to determine the installedTcl constraint was
	wrong, and test unixInit-2.8 assumed that /tmp/lib was free for use
	and could be deleted, which clashed nastily with my installation and
	made other tests fail unnecessarily!

	* unix/tclUnixChan.c (TtyInit,TclpOpenFileChannel,
	(Tcl_MakeFileChannel,TclpGetDefaultStdChannel): Alterations so that
	the standard channels - stdin, stdout and stderr - have the correct
	type and fconfigure options. This required making the initialisation
	of serial lines a little more sophisticated to make the console behave
	correctly in interactive mode... [Bug 219137 and duplicates]

2001-06-16  Don Porter  <[email protected]>

	* generic/tclInt.decls:
	* generic/tclInt.h:
	* generic/tclPanic.c (Tcl_PanicVA):
	* mac/tclMacAppInit.c (main):
	* mac/tclMacPanic.c (TclpPanic):
	* unix/tclUnixPort.h:
	* win/tclWinPort.h: Replaced TclMacSetPanic with TclpPanic for setting
	a platform-specific panic handler. TclpPanic is NULL on Unix and
	Windows. Fixes broken wish on Mac due to earlier patches. [Patch
	415648]

	* generic/tclIntPlatDecls.h:
	* generic/tclStubInit.c: `make gentubs` after above changes.

2001-06-13  Don Porter  <[email protected]>

	* mac/tclMacAppInit.c (main, Macintosh_Init):
	* mac/tclMacBOAAppInit.c (main):
	* mac/tclMacPanic.c: Applied patches from Dan Steffen correcting
	problems on the Macintosh in the 2001-06-08 changes.

2001-06-12  Donal K. Fellows  <[email protected]>

	* tests/regexp.test (regexp-18.12):
	* generic/tclCmdMZ.c (Tcl_RegexpObjCmd): Fixed so that submatches
	that do not match always have index pair {-1 -1} [Bug 219232]

2001-06-08  Don Porter  <[email protected]>

	* generic/tcl.h:
	* generic/tcl.decls:
	* generic/tclPanic.c: Added CONST to Tcl_*Panic* public interfaces.
	[Patch 415648, TIP 27]

	* generic/tclInt.decls:
	* mac/tclMacAppInit.c (main):
	* mac/tclMacBOAAppInit.c (main):
	* mac/tclMacPanic.c: Modified special Mac implementations of
	Tcl_*Panic* to be exact copies of the generic implementations. Added
	TclMacSetPanic. The generic implementations should be used directly,
	rather than copies, but that requires further changes by someone
	familiar with the Mac build systems. [Patch 415648]

	* generic/tclDecls.h:
	* generic/tclIntPlatDecls.h:
	* generic/tclStubInit.c: `make gentubs` after above changes.

	* doc/Panic.3:
	* unix/mkLinks:  New file documenting Tcl_*Panic* public interfaces,
	followed by `make mklinks`. [Patch 415648, Bug 219170, Bug 414936]

2001-06-03  Jeff Hobbs  <[email protected]>

	* generic/tclUtil.c (Tcl_DStringAppendElement): patch to save an
	extra strlen call. [Bug 428572]

2001-05-30  Donal K. Fellows  <[email protected]>

	* generic/tclExecute.c (TclExecuteByteCode): Added two casts to
	INST_STR_CMP implementation to get rid of a couple warnings from the
	SUNWspro C compiler.

	* generic/tclBasic.c (Tcl_GetMathFuncInfo,Tcl_ListMathFuncs):
	* generic/tclCmdIL.c (Tcl_InfoObjCmd,InfoFunctionsCmd):
	* generic/tcl.decls (generic table, positions 435+436):
	* tests/info.test:
	* doc/CrtMathFnc.3:
	* doc/info.n: Changes due to TIP #15 "Functions to List and Detail
	Math Functions"

2001-05-28  Jeff Hobbs  <[email protected]>

	* library/init.tcl (unknown): removed errant " in error message

2001-05-27  Jeff Hobbs  <[email protected]>

	* generic/regc_locale.c: updated character class range data for
	Unicode v3.1.0 compliance.
	* generic/tclUniData.c: regenerated from Unicode v3.1.0 data file (new
	as of 2001-05-16). This brings Tcl to current unicode compliance.

	* tests/utf.test: added tests to check unicode 3 compliance

	* unix/Makefile.in (tclUtf.o): added tclUniData.c dependency.

	* tools/uniClass.tcl: added comments to output format and the script
	for clarification.

	* tools/uniParse.tcl: corrected filename output and GetDelta macro to
	use 'info' as param (was 'infO')

2001-05-26  Donal K. Fellows  <[email protected]>

	* generic/tclVar.c (tclArraySearchType,SetArraySearchObj,
	(ParseSearchId): Added code to speed up array searching by reducing
	the amount of parsing needed for searchIds.

	* generic/tclObj.c (TclInitObjSubsystem):
	* generic/tclIndexObj.c (Tcl_GetIndexFromObjStruct):
	* generic/tclNamesp.c (TclInitNamespaceSubsystem):
	* generic/tclInt.h: Moved some Tcl_ObjType initialisation to
	TclInitObjSubsystem to be with the bulk of the rest. [Patch 424851]
	Committed by Miguel Sofer <[email protected]>

2001-05-23  Jeff Hobbs  <[email protected]>

	* tests/io.test: changed io-52.[9-11] to not be platform sensitive
	with EOL translation.

	* library/encoding/cp1250.enc:
	* library/encoding/cp1251.enc:
	* library/encoding/cp1252.enc:
	* library/encoding/cp1253.enc:
	* library/encoding/cp1254.enc:
	* library/encoding/cp1255.enc:
	* library/encoding/cp1256.enc:
	* library/encoding/cp1257.enc:
	* library/encoding/cp1258.enc:
	* library/encoding/cp874.enc:
	* library/encoding/iso8859-6.enc:
	* library/encoding/iso8859-7.enc:
	* library/encoding/iso8859-8.enc:
	* library/encoding/iso8859-10.enc (new):
	* library/encoding/iso8859-13.enc (new):
	* library/encoding/iso8859-14.enc (new): updated encoding tables based
	on http://www.unicode.org/Public/MAPPINGS/. (kuhn)

2001-05-23  Mo DeJong  <[email protected]>

	* unix/tcl.m4 (SC_PATH_TCLCONFIG): Fix comments, and typo in cached
	variable name.

2001-05-23  Mo DeJong  <[email protected]>

	* unix/tcl.m4 (SC_LOAD_TKCONFIG): Remove use of undefined TCLCONFIG
	variable and call AC_MSG_RESULT to print the checking result.
	* win/tcl.m4: Ditto.

2001-05-22  Jeff Hobbs  <[email protected]>

	* generic/tclObj.c (TclAllocateFreeObjects): simplified
	objSizePlusPadding to use sizeof(Tcl_Obj) (max) Corrected use of
	tclObjsAlloced/Freed/Shared in TCL_MEM_DEBUG compile.

2001-05-22  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c: removed Tcl_DuplicateObj in INST_DUP

2001-05-21  Jeff Hobbs  <[email protected]>

	* tests/tcltest.test (tcltest-19.1): fixed failing test that was
	getting affected by Windows env handling of empty valued elements.

	* unix/tcl.m4: added more common install directories in which to
	search for *Config.sh. [Bug 419812]

	* tests/cmdMZ.test (cmdMZ-1.4): added notLinux constraint to test to
	prevent failure message on Linux due to OS caching bug.

	* tests/httpd (httpdRespond): added response to timeout value in query
	string.

	* tests/http.test: removed unused notLinux constraint setting

	* generic/tclRegexp.c (Tcl_RegExpExecObj): added use of
	Tcl_GetUnicodeFromObj.

2001-05-19  Andreas Kupries <[email protected]>

	* Note that "tclbench" (see project "tcllib") was extended with
	performance benchmarks for [fcopy] too.

	* doc/fcopy.n: Updated to reflect the extended behaviour of 'fcopy'.

	* tests/io.test: Added tests 'io-52.9', 'io-52.10' and 'io-52.11' to
	test the handling of encodings by 'fcopy' / 'TclCopychannel'. [Bug
	209210]

	* generic/tclIO.c: Split of both 'Tcl_ReadChars' and 'Tcl_WriteChars'
	into a public error checking and an internal working part. The public
	functions now use the new internal ones. The new functions are
	'DoReadChars' and 'DoWriteChars'. Extended 'CopyData' to use the new
	functions 'DoXChars' when required by the encodings on the input and
	output channels. [Bug 209210]

2001-05-16  Jeff Hobbs  <[email protected]>

	* library/history.tcl (tcl::HistAdd): prevent empty calls from being
	added to the history (arndt)

	* tests/error.test: updated error-1.3 message to account for string
	index being compiled at toplevel.
	* tests/appendComp.test:
	* tests/stringComp.test: new files for extended bytecode testing

	* generic/tclBasic.c: added new CompileProc invocations to basic
	command initialization.
	* generic/tclCompCmds.c: added new compile commands for append,
	lappend, lindex and llength. Refactored set and incr compile commands
	to use new TclPushVarName function for handling the varname component
	during compilation (also used by append and lappend). Changed string
	compile command to compile toplevel code as well (when possible).
	* generic/tclCompile.c: added new instruction enums
	* generic/tclCompile.h: added debug info for new instructions
	* generic/tclExecute.c (TclExecuteByteCode): moved elemPtr to toplevel
	var (oft-used). Added definitions for new bytecode instructions
	INST_LIST_INDEX, INST_LIST_LENGTH, INST_APPEND_SCALAR1,
	INST_APPEND_SCALAR4, INST_APPEND_ARRAY1, INST_APPEND_ARRAY4,
	INST_APPEND_ARRAY_STK, INST_APPEND_STK, INST_LAPPEND_SCALAR1,
	INST_LAPPEND_SCALAR4, INST_LAPPEND_ARRAY1, INST_LAPPEND_ARRAY4,
	INST_LAPPEND_ARRAY_STK, INST_LAPPEND_STK.
	Refactored repititious code for reuse with INST_LOAD_STK (same as
	INST_LOAD_SCALAR_STK), INST_STORE_STK (same as INST_STORE_SCALAR_STK).
	Updated INST_STR_CMP with style of fix of 2001-04-06 Fellows
	[Bug 219201] as that fix only affected the runtime eval'ed "string"
	(string compare is normally byte-compiled now). We may want to back
	these out for speed in the future, noting the problems with \x00
	comparisons in the docs.
	* generic/tclInt.h: declarations for new compile commands.
	* generic/tclVar.c: change TclGetIndexedScalar,
	TclGetElementOfIndexedArray, TclSetElementOfIndexedArray and
	TclSetIndexedScalar to use flags. The Set functions now support
	TCL_APPEND_ELEMENT and TCL_LIST_ELEMENT as well.
	* generic/tclInt.decls:
	* generic/tclIntDecls.h: minor signature changes for above.

	* generic/tclCmdMZ.c: made use of new Tcl_GetUnicodeFromObj.

2001-05-16  Donal K. Fellows  <[email protected]>

	* doc/console.n: Deleted. Put it in the wrong source tree! D'oh!

2001-05-15  Jeff Hobbs  <[email protected]>

	* generic/tcl.decls:
	* generic/tclDecls.h:
	* generic/tclStubInit.c:
	* generic/tclStringObj.c (Tcl_GetUnicodeFromObj): new function to
	parallel Tcl_GetStringFromObj (fix of an API oversight).

	* unix/tclUnixPipe.c: updated pipeChannelType to TCL_CHANNEL_VERSION_2
	type specification.

	* tests/fileName.test: corrected tests not to fail on win when a
	C:/test dir exists.

	* generic/tclFileName.c (ExtractWinRoot): corrected ABR error

2001-05-15  Miguel Sofer  <[email protected]>

	* tests/lindex.test: added test for nested braces [Patch 423617]

2001-05-15  Miguel Sofer  <[email protected]>

	* generic/tclInt.h:
	* generic/tclNamesp.c: invalidate all bytecodes in a namespace if a
	new command shadows a bytecoded command.
	* tests/namespace.test:
	Patched from [Bug 231259]

2001-05-15  Donal K. Fellows  <[email protected]>

	* doc/console.n: Created. It seems very odd to me that the console
	implementation is part of the Tcl distribution and not part of Tk, but
	given the location of the source, the documentation must obviously
	match up...

2001-05-14  Donal K. Fellows  <[email protected]>

	* generic/tclCmdMZ.c (Tcl_StringObjCmd):
	* tests/string.test (string-4.14): Negative string indices should not
	be added as offsets to the result of [string first] but instead be
	treated as referring to the start of the string. [Bug 423581]

2001-05-11  Mo DeJong  <[email protected]>

	* unix/Makefile.in: Add a LDFLAGS variable to the Makefile instead of
	directly substing @LDFLAGS@.
	* unix/configure: Regen.
	* unix/tcl.m4: Fix CFLAGS_DEFAULT so that the name of a Makefile
	variable is passed as @CFLAGS@.
	* win/Makefile.in: Move the setting of CFLAGS higher up in the
	Makefile.
	* win/configure: Regen.
	* win/configure.in: Use dnl to comment out macros so that they are not
	accidently expanded.
	* win/tcl.m4: Fix CFLAGS_DEFAULT so that the name of a Makefile
	variable is passed as @CFLAGS@.

2001-05-07  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c: insure different rand() seeds in different
	threads. [Bug 416643]

2001-05-03  Jeff Hobbs  <[email protected]>

	* tests/tcltest.test: removed extraneous 'c' (doh!) [Bug: 414031]

	* tools/tcltk-man2html.tcl: removed use of 'exec' for portability and
	fixed up code.

2001-05-03  Don Porter  <[email protected]>

	* doc/library.n:
	* library/init.tcl:
	* tests/autoMkindex.t*: Modified [auto_import] to apply pattern
	matching in the [namespace import] style. [Bug 420186]
	***POTENTIAL INCOMPATIBILITY*** for any callers of [auto_import] from
	outside Tcl that expect the pattern matching to be like that of
	[string match].

2001-05-03  Miguel Sofer  <[email protected]>

	* generic/tclParse.c:
	* tests/namespace.test: Insure consistent behaviour of the [unknown]
	command: when a command is unknown, it is always processed by
	[::unknown], ignoring any namespace proc which happens to be called
	"unknown" [Patch 421166, Bug 420507]

2001-05-02  Don Porter  <[email protected]>

	* tools/genStubs.tcl: Add a package require of Tcl 8 at the beginning
	of the script so that the script will print a descriptive error
	message when run in an old Tcl 7 shell.

2001-04-27  Kevin Kenny	<[email protected]>

	* generic/tclInt.decls:
	* generic/tclInt.h:
	* generic/tclCmdIL.c:
	* generic/tclProc.c:
	* generic/tclVar.c: Added another collection of missing CONSTs related
	to TclGetNamespaceForQualName.
	* generic/tclIntDecls.h: Regenerated.

2001-04-25  Mo DeJong  <[email protected]>

	* unix/configure: Regen.
	* unix/tcl.m4: Subst TCL_THREADS into tclConfig.sh.
	* unix/tclConfig.sh.in: Add TCL_THREADS variable.
	* win/configure: Regen.
	* win/tcl.m4: Subst TCL_THREADS into tclConfig.sh.
	* win/tclConfig.sh.in: Add TCL_THREADS variable.

2001-04-25  Mo DeJong  <[email protected]>

	* unix/configure: Regen.
	* unix/configure.in: Use $@ in MAKE_LIB and MAKE_STUB_LIB commands
	instead of using a delayed subst variable. Replace instances of
	STUB_LIB_FILE with TCL_STUB_LIB_FILE.

2001-04-25  Mo DeJong  <[email protected]>

	* unix/Makefile.in: Use TCL_STUB_LIB_FILE instead of STUB_LIB_FILE.
	* unix/configure: Regen.
	* unix/configure.in: Don't subst STUB_LIB_FILE, use TCL_STUB_LIB_FILE
	instead.

2001-04-25  Donal K. Fellows  <[email protected]>

	* tools/encoding/iso8859-15.txt:
	* library/encoding/iso8859-15.enc: Oops! Got the full encoding wrong.
	Should be fixed now...

	* tools/encoding/iso8859-15.txt:
	* library/encoding/iso8859-15.enc:
	* tools/tcl.wse.in: Added ISO 8859-15 (a.k.a. Latin-1 + Euro currency
	symbol) support.

	* generic/tclNamesp.c:
	* generic/tclBasic.c (TclRenameCommand): Missing CONST from several
	declarations relating to use of TclGetNamespaceForQualName

2001-04-24  Kevin B. Kenny    <[email protected]>

	* doc/AssocData.3:
	* doc/CrtCommand.3:
	* doc/CrtMathFnc.3:
	* doc/CrtObjCmd.3:
	* doc/ExprLong.3:
	* generic/tclBasic.c:
	* generic/tclCmdMZ.c:
	* doc/CrtSlave.3:
	* generic/tclNamesp.c:
	* generic/tcl.decls:
	* generic/tcl.h:
	* generic/tclInt.decls:
	* generic/tclInt.h: (TIP #27) Another round of CONST changes, this
	time adding CONST to the API's exported from tclBasic.c. [Patch
	415179]
	***POTENTIAL INCOMPATIBILITY*** from 8.4a2, in which Vince Darley's
	changes to command tracing were added. A const has been added to the
	type signature of one of the parameters to Tcl_CommandTraceProc.

2001-04-10  Kevin B. Kenny    <[email protected]>

	* unix/tclUnixTime.c: Altered code to use memcpy instead of
	structure assigments in an effort to achieve better K&R
	compatibility.

2001-04-10  Kevin B. Kenny    <[email protected]>

	* unix/tclUnixTime.c: Fixed silly typo in calls to 'gmtime' and
	'localtime' that broke the Linux build.

2001-04-09  Kevin B. Kenny    <[email protected]>

	* unix/tclLoadShl.c: Added DYNAMIC_PATH to the load flags so that the
	SHLIB_PATH will be searched for other libraries. [Bug 219140]

2001-04-09  Kevin B. Kenny    <[email protected]>

	* unix/tcl.m4: Added _REENTRANT to Solaris build so that thread safe
	library routines are included.
	* unix/configure: Re-ran 'autoconf' with changed tcl.m4
	* tclUnixTime.c: Modified for thread safety of 'gmtime' and
	'localtime' system calls. [Bugs 219136 and 232558]

2001-04-09  Donal K. Fellows  <[email protected]>

	* tests/expr.test (expr-21.*): Tests to check below fix.
	* generic/tclParseExpr.c (GetLexeme): Now recognises the
	non-numeric boolean literals for what they are. It no longer makes
	sense for anyone to create functions with the same name as one of
	them, but this was true in 7.* as well [Bug 217777; finally!]

2001-04-07  Miguel Sofer <[email protected]>

	* generic/tclExecute.c: Avoid panic when there are extra items in the
	tcl stack. [Bug 406709, Patch 414470]
	* tests/foreach.test: test to exercise the patch

2001-04-07  Miguel Sofer <[email protected]>

	* doc/namespace.n: document correct functionality
	* generic/tclNamesp.c: corrected behaviour of [namespace code]
	[Bug 219385, Patch 403530]
	* library/init.tcl:
	* tests/namespace-old.test: test correct functionality
	* tests/namespace.test: test correct functionality

2001-04-07  Andreas Kupries  <[email protected]>

	* unix/Makefile.in (checkdoc): New target, checking the definitions as
	found in the compiled library against the manpages to find
	undocumented public functionality.

	* unix/mkLinks: Updated to include the new manpage.

	* doc/UniCharIsAlpha.3: New manpage documenting the Unicode
	character classification APIs. [Bug 218720]

2001-04-07  Andreas Kupries  <[email protected]>

	* unix/mkLinks: Updated to incorporate the changes below.

	* doc/StringObj.3: Added 'Tcl_AttemptSetObjLength' to the NAME
	section. [Bug 414435]

	* doc/Alloc.3: Added both 'Tcl_AttemptAlloc' and 'Tcl_AttemptRealloc'
	to the NAME section. [Bug 414435]

	* doc/Utf.3: Added both 'Tcl_UniCharCaseMatch' and
	'Tcl_UniCharNcasecmp' to the NAME section. [Bug 414435]

2001-04-06  Don Porter  <[email protected]>

	* library/init.tcl:
	* tests/init.test:  Modified processing of $::errorInfo by [unknown]
	when the auto-loaded command throws an error to better cover the
	tracks of auto-loading. [Bug 219280, Patch 403551]

2001-04-06  Donal K. Fellows  <[email protected]>

	* doc/read.n: Added section on "USE WITH SERIAL PORTS" to resolve
	[Bug 219402]

	* tests/string.test (string-2.30): Test for this case
	* generic/tclCmdMZ.c (Tcl_StringObjCmd, STR_COMPARE branch): Fixed
	problem caused by Utf-rep of \x00 being more than Utf-rep of \x01
	fooling memcmp by forcing everything through Utf-based comparisons.
	Added optimizations for case where objects have a string/unicode-rep
	or a bytearray-rep (i.e. where we can perform comparisons on
	fixed-size units). [Bug 219201]
	* generic/tclUtf.c (Tcl_UtfNcmp): Corrected seriously erroneous
	comment.

2001-04-05  Andreas Kupries  <[email protected]>

	* doc/Macintosh.3: Removed duplicates from .SH line. [Bug 413983]

2001-04-05  Donal K. Fellows  <[email protected]>

	* generic/tclCmdMZ.c (Tcl_StringObjCmd): Fixed so will compile
	with K&R compilers. [Patch 413844, Bug 413847]

2001-04-04  Don Porter  <[email protected]>

	* generic/tclMain.c:  Patch from Kevin Kenny to restore support of
	pre-ANSI compilers. [Bug 413846, Patch 413842]

2001-04-04  Andreas Kupries  <[email protected]>

	* unix/mkLinks: Updated to contain the new manpage.

	* doc/Environment.3: New manpage, describes Tcl_PutEnv. [Bug 219171]

	* doc/Macintosh.3: New manpage describing the macintosh specific parts
	of the public API. [Bug 219169]

2001-04-04  Jeff Hobbs  <[email protected]>

	* unix/configure:
	* unix/tcl.m4: extended test of termios vs. termio vs. sgtty to
	better detect result on Linux and when certain configure
	redirections are being used. [Patch 402923; Bug 227412, 219194] (max)

2001-04-04  Andreas Kupries  <[email protected]>

	* generic/tclTest.c:
	* tests/io.tests: TIP #10 followup correcting a problem with the
	original patch because of the lack of 'testthread id' for a
	non-threaded compilation.

2001-04-04  Kevin Kenny <[email protected]>

	* doc/ByteArrObj.3:
	* doc/DumpActiveMemory.3:
	* doc/InitStubs.3:
	* doc/PkgRequire.3:
	* doc/StringObj.3:
	* generic/tcl.decls:
	* generic/tcl.h:
	* generic/tclBinary.c:
	* generic/tclCkalloc.c:
	* generic/tclDecls.h:
	* generic/tclListObj.c:
	* generic/tclObj.c:
	* generic/tclPkg.c:
	* generic/tclStringObj.c:
	* generic/tclStubLib.c: (TIP#27) Changed a number of Tcl API's to
	accept "CONST char*" in place of simple "char*". (kennykb) [Patch
	404026]

2001-04-04  Jeff Hobbs  <[email protected]>

	* generic/tclListObj.c (Tcl_SetListObj): set objPtr->length = 0 in
	empty object case to maintain sanctity of Tcl_Obj bytes/length
	pairing. [Patch 405998] (porter)

2001-04-03  Andreas Kupries  <[email protected]>

	* unix/mkLinks: Added 'Signal.3', 'Tcl_WaitPid'.

	* doc/DetachPids.3: Added description of 'Tcl_WaitPid' [Bug 219173].

	* doc/Signal.3: New man page describing the public API procedures
	'Tcl_SignalId' and 'Tcl_SignalMsg'. [Bug 219172]

2001-04-02  Jeff Hobbs  <[email protected]>

	* README:
	* win/README:
	* win/README.binary: further notes corrections.

	* win/configure:
	* win/tcl.m4 (SHLIB_LD):  added -incremental:no. [Bug 219381]

2001-04-01  Jeff Hobbs  <[email protected]>

	* README:
	* mac/README:
	* win/README:
	* win/README.binary:
	* unix/README: updated patchlevel information to 8.4a3 and updated
	links and notes.

	* generic/tcl.h:
	* tools/tcl.wse.in:
	* win/configure.in (VER):
	* win/configure:
	* unix/configure:
	* unix/configure.in (VER):
	* unix/tcl.spec: updated patchlevel information to 8.4a3

2001-03-30  Jeff Hobbs  <[email protected]>

	* generic/tclCkalloc.c (TclFinalizeMemorySubsystem): set curTagPtr
	to NULL to allow for reuse.
	* generic/tclEvent.c (Tcl_Finalize): moved the tsdPtr initialization
	inside the subsystemsInitialized check to prevent it potentially
	getting called twice during finalization.
	[Patch 403532, Bug 219391] (wu)

	* generic/tclThreadTest.c (Tcl_ThreadObjCmd): cast fixes
	* generic/tclTest.c (TestChannelCmd): added cast to mollify Windows
	debug build.

	* win/tclWinSock.c (SocketEventProc): Fixed race condition in
	readability of socket on Windows. [Patch 410674, Bug 219205, 219333]

	* win/tcl.m4: added imm32.lib to LIBS_GUI for Tk IME support.

	* win/Makefile.in (install-libraries): removed extra \s that broke
	the target.
	(install-doc): improved install-* targets to use their base build
	dependency.

2001-03-30  Andreas Kupries  <[email protected]>

	* All of the changes below belong to TIP #10 [Tcl I/O Enhancement:
	Thread-Aware Channels]. See also [Patch 403358] at SF.

	* generic/tclIO.h (struct ChannelState, line 236f): Extended the
	structure with a new field of type 'Tcl_ThreadId' to hold the id of
	the thread currently managing all channels with this state.

	Note: This structure is shared by all channels in a stack of
	transformations.

	* generic/tclIO.c (Tcl_CreateChannel, lines 1058-1065): Modified to
	store the Id of the current thread in the 'ChannelState' of the new
	channel.

	* generic/tclIO.c (Tcl_SpliceChannel, lines 2265-2270): Modified in
	the same manner as 'Tcl_CreateChannel' as the channel will be managed
	by the current thread afterward.

	* generic/tclIO.c   (Tcl_GetChannelThread, lines 1478-1503):
	* generic/tcl.decls (Tcl_GetChannelThread, lines 1504-1506): New API
	function to retrieve the Id of the managing thread from a channel.
	Implementation and declaration.

	* generic/tclTest.c (TestChannelCmd, lines 4520-4532): Added
	subcommand 'mthread' to query a channel about its managing thread.

2001-03-29  Mo DeJong  <[email protected]>

	* tests/interp.test: Print out warning when testinterpdelete command
	is not defined. Add tests that checks to make sure a child interp
	inherits the parent's cwd.

2001-03-29  Jeff Hobbs  <[email protected]>

	* doc/tcltest.n: corrected incorrect macro usage.

	* doc/lsort.n: corrected unbalanced nroff macros.

	* unix/tclUnixPipe.c (TclpCreateTempFile): prevent potential race
	condition and security leak in tmp filename creation.
	[Patch 402924] (max)

	* unix/configure:
	* unix/tcl.m4: corrected IRIX-5.x config to not use -n32.
	[Patch 403626] (english)

	* unix/tclUnixThrd.c (Tcl_ConditionWait): fixed handling of timeout
	for threads (corrects excessive CPU usage issue for Tk on Unix in
	threaded Tcl environment). [Bug 411603] (ruppert)

2001-03-29  Donal K. Fellows  <[email protected]>

	* doc/lsort.n: Added some notes that clarify the behaviour of
	[lsort] as well as a whole bunch of examples.  [Bug 219202]

2001-03-27  Jeff Hobbs  <[email protected]>

	* doc/Alloc.3: corrected docs to note that Tcl_Attempt* return char
	*'s, not ints. [Bug 411388]

	* tests/regexp.test (regexp-19.1):
	* generic/tclCmdMZ.c (Tcl_RegsubObjCmd): fixed handling of nulls in
	subspec value.

2001-03-26  Don Porter  <[email protected]>

	* generic/tclDecls.h (Tcl_InitCustomHashTable):  Correction to patch
	from 2001-01-18;  tclDecls.h was not generated using 'make genstubs'.

2001-03-26  Donal K. Fellows  <[email protected]>

	* win/tclWinInt.h (tclWinTCharEncoding): Removed as now a static
	variable in win/tclWin32Dll.c instead.

2001-03-23  Jeff Hobbs  <[email protected]>

	* generic/tclVar.c (Tcl_ArrayObjCmd): Corrected retrieval of resultPtr
	to prevent possible corruption.

	* generic/tclNamesp.c (Tcl_Import): Correctly freed a DString.
	[Patch 403755] (lavana)

2001-03-15  Donal K. Fellows  <[email protected]>

	* tests/set-old.test (set-old-7.2): Changed error behaviour of
	[unset] to agree with documentation, so must change test as well.

2001-03-14  Don Porter  <[email protected]>

	* library/package.tcl (pkg_mkIndex):  Added patch from Vince Darley to
	make [pkg_mkIndex -verbose] even more verbose. [Bug 219349, Patch
	403529]

2001-03-13  Donal K. Fellows  <[email protected]>

	* doc/info.n: Improved documentation for [info hostname]. [Bug 403840]

	* generic/tclVar.c (Tcl_UnsetObjCmd): Made command behave as
	documented [issue remaining from Bug 405769]

	* generic/tclCmdMZ.c (Tcl_StringObjCmd): A missing {return TCL_OK;}
	was causing memory corruption. [Bug 408002]

	* generic/tclExecute.c (TclDeleteExecEnv, GrowEvaluationStack,
	(TclExecuteByteCode): Added some casts to ClientData that are
	apparently needed on some architectures.

2001-03-12  Donal K. Fellows  <[email protected]>

	* tests/string.test: Fixed some test numberings and added a test.
	[Patch 403229]

2001-03-06  Donal K. Fellows  <[email protected]>

	* generic/tclVar.c (Tcl_UnsetObjCmd): Rewrote argument parser to avoid
	a read off the end of the argument array that could occur when
	executing something like [unset -nocomplain] was executed. Improved
	the error message given when not enough arguments are given (-nocomplain
	should obviously be *before* --, not after it) and also modified the
	test suite to take account of that and the documentation to use the
	same improvement. [Bug 405769]

2001-03-02  Donal K. Fellows  <[email protected]>

	* generic/tclExecute.c (TclExecuteByteCode): Fixed bug that could pass
	pointers to freed memory to command implementations, which most
	obviously caused some weird behaviour with [info level], but could
	have caused problems with user code and command traces too. [Bug
	404865, Patch 405436]

2001-02-23  msofer  <[email protected]>

	* no changes; fixing up the missing comment in the previous one.
	Sorry.

2001-02-23  msofer  <[email protected]>

	* /cvsroot/tcl/tcl/tests/execute.test: added test for evaluation of an
	expression in a variable; evals once by compiling, second time using
	the previous compilation

2001-02-18  Kevin B. Kenny  <[email protected]>

	* doc/clock.n: Updated documentation to reflect the addition of
	compat/strftime.c, including the correct formatting of ISO-8601:1988
	fiscal week number (%V).

2001-02-15  Donal K. Fellows  <[email protected]>

	* generic/tclCmdMZ.c (Tcl_SplitObjCmd): Improved efficiency of
	splitting strings into individual characters by adding hash so that
	only one Tcl_Obj per character is created. Improves performance of
	splitting of short strings and makes a huge difference to splitting of
	long strings, such as is done in the mime package in tcllib. [Bug
	131523]

2001-01-31  Don Porter  <[email protected]>

	* win/makefile.vc (install-libraries):  Corrected misdirected install
	directory for the msgcat 1.2 package.

2001-01-30  Don Porter  <[email protected]>

	* generic/tclIO.c (CopyData): Moved code that updates the count of how
	many bytes are left to copy. Corrects bug that when writing occurs in
	the background, the copy loop could be escaped without updating the
	count, causing CopyData() to try to copy more bytes than the toRead
	value originally passed to TclCopyChannel(), leading to hangs and
	misreporting of number of bytes copied. [Bug 118203, Patch 103432]

2001-01-18  Andreas Kupries  <[email protected]>

	Everything below belongs together, it fixes [Bug 123153]

	* generic/tcl.h (line 342): A bit more explanation about the default
	value for TCL_PRESERVE_BINARY_COMPATABILITY.

	* generic/tcl.h (line 1208): Define the macro 'Tcl_InitHashTable' only
	when TCL_PRESERVE_BINARY_COMPATIBILITY is not set as it kills binary
	compatibility to 8.3 and earlier versions. This is the main part of
	the patch/change.

	* generic/tcl.decls (line 1469):
	* generic/tclHash.c (Tcl_InitHashTable):
	* generic/tclHash.c (Tcl_InitHashTableEx):
	* generic/tclObj.c (Tcl_InitObjHashTable): Changed
	'Tcl_InitHashTableEx' to 'Tcl_InitCustomHashTable'. This change is
	more of an estethical nature, replacing the ubiquitous 'Ex' suffix
	with a more meaningful name. The introduced binary incompatibility is
	deemed acceptable as it is between alpha versions.  Updated callers.

	* doc/Hash.3:
	* unix/mkLinks: Changed 'Tcl_InitHashTableEx' to
	'Tcl_InitCustomHashTable'.

2001-01-10  Donal K. Fellows  <[email protected]>

	* tests/winPipe.test (winpipe-1.20):
	* tests/winDde.test (createChildProcess):
	* tests/pkgMkIndex.test (pkgtest::createIndex): Removed assumption
	that paths contain no spaces which causes problems with both [eval]
	and [open |...] due to the well-known differences between lists and
	strings. Fixes [Bug 119406]

2001-01-04  Don Porter  <[email protected]>

	* tests/unixInit.test:
	* unix/tclUnixInit.c (TclpInitLibraryPath):
	* win/tclWinInit.c (TclpInitLibraryPath):  Several entries in the
	library path ($tcl_libPath) are determined relative to the absolute
	path of the executable. When the executable is installed in or near
	the root directory of the file system, relative pathnames were being
	incorrectly generated, and in the worst case, memory access violations
	were crashing the program. [Bug 119416, Patch 102972]

	******************************************************************
	*** CHANGELOG ENTRIES FOR 2000 IN "ChangeLog.2000"             ***
	*** CHANGELOG ENTRIES FOR 1999 AND EARLIER IN "ChangeLog.1999" ***
	******************************************************************
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<


























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































Deleted ChangeLog.2002.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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
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
2002-12-18  David Gravereaux  <[email protected]>

	* win/makefile.vc: some uses of xcopy swapped to the @$(CPY) macro.
	Reported by Joe Mistachkin <[email protected]>.

2002-12-17  Jeff Hobbs  <[email protected]>

	* generic/tclNotify.c (TclFinalizeNotifier, Tcl_SetServiceMode):
	(Tcl_ThreadAlert): Check that the stub functions are non-NULL before
	calling them. They could be set to NULL by Tcl_SetNotifier.

2002-12-16  David Gravereaux  <[email protected]>

	* generic/tclPipe.c (TclCleanupChildren):
	* tests/winPipe.test:
	* win/tclWinPipe.c (Tcl_WaitPid):
	* win/tclWinTest.c:  Gave Tcl_WaitPid the ability to return a Win32
	exception code translated into a posix style SIG*. This allows [close]
	to report "CHILDKILLED" without the meaning getting lost in a
	truncated exit code. In TclCleanupChildren(), TclpGetPid() had to get
	moved to before Tcl_WaitPid() as the the handle is removed from the
	list taking away the ability to get the process id after the wait is
	done. This shouldn't effect the unix implimentaion unless waitpid is
	called with a pid of zero, meaning "any". I don't think it is..

2002-12-13  Don Porter  <[email protected]>

	* unix/configure.in:	Updated configure of CVS snapshots to reflect
	* win/configure.in:	the 8.4.1.1 patchlevel.

	* unix/configure:	autoconf
	* win/configure		autoconf

2002-12-11  Don Porter  <[email protected]>

	* generic/tclProc.c (ProcessProcResultCode): Fix failure to propagate
	negative return codes up the call stack. [Bug 647307]
	* tests/proc.test (proc-6.1): Test for Bug 647307

	* generic/tclParseExpr.c (TclParseInteger):  Return 1 for the string
	"0x" (recognize leading "0" as an integer). [Bug 648441]
	* tests/parseExpr.test (parseExpr-19.1): Test for Bug 648441.

2002-12-09  Jeff Hobbs  <[email protected]>

	* win/tclWinThrd.c (TclpMasterUnlock):
	* generic/tclThread.c (TclFinalizeThreadData): TclpMasterUnlock must
	exist and be called unconditional of TCL_THREADS. [Bug 651139]

2002-12-08  David Gravereaux  <[email protected]>

	* win/tclWinSock.c (SocketThreadExitHandler, InitSockets):  Check
	that the tsdPtr is valid before dereferencing as we call it from the
	exit handler, too [Bug 650353]. Another WSAStartup() loaded version
	comparison byte swap issue fixed. Although 0x0101 byte swapped is
	still 0x0101, properly claiming which is major/minor is more correct.

2002-12-06  Jeff Hobbs  <[email protected]>

	* generic/tclStubInit.c: regen
	* generic/tclIntPlatDecls.h: regen
	* generic/tclInt.decls: added TclWinResetInterface

	* win/tclWin32Dll.c (TclWinResetInterfaces):
	* win/tclWinInit.c (TclpSetInitialEncodings, WinEncodingsCleanup):
	add exit handler that resets the encoding information to a state where
	we can reuse Tcl. Following these changes, it is possible to reuse Tcl
	(following Tcl_FindExecutable or Tcl_CreateInterp) following a
	Tcl_Finalize.

	* generic/tclIOUtil.c (TclFinalizeFilesystem): reset statics to their
	original values on finalize to allow reuse of the library.

2002-12-04  David Gravereaux  <[email protected]>

	* win/tclWinPipe.c: reverted back to -r1.27 due to numerous test
	failures that need to be resolved first. The idea was good, but the
	details aren't.

2002-12-04  David Gravereaux  <[email protected]>

	* win/tclWinPipe.c (Tcl_WaitPid):  When a process exits with an
	exception, pass this notice on to the caller with a SIG* code rather
	than truncating the exit code and missing the meaning. This allows
	TclCleanupChildren() to report "CHILDKILLED".

	This has a different behavior than unix in that closing the read pipe
	to a process sends the SIGPIPE signal which is returned as a SIGPIPE
	exit status. On windows, we send the process a CTRL_BREAK_EVENT and
	get back a CONTROL_C_EXIT which is documented to mean a SIGINT which
	seems wrong as a system, but is the correct exit status.

2002-12-04  Vince Darley  <[email protected]>

	* generic/tclIOUtil.c: fix to redirected 'load' in virtual filesystem
	for some Unix systems.

	* generic/tclEvent.c: the filesystem must be cleaned up before the
	encoding subsystem because it needs access to encodings. Fixes crash
	on exit observed in embedded applications.

	* generic/tclTestObj.c: patch omitted from previous change of
	2002-11-13

2002-12-03  Jeff Hobbs  <[email protected]>

	* generic/tclStubLib.c (Tcl_InitStubs): prevent the cached check of
	tclStubsPtr to allow for repeated load/unload of the Tcl dll by
	hosting apps. [Bug 615304]

2002-12-03  David Gravereaux  <[email protected]>

	* win/tclAppInit.c (sigHandler): Protect from trying to close a NULL
	handle.

	* win/tclWinPipe.c (PipeClose2Proc, TclpCreateProcess): Send a real
	Win32 signal (CTRL_C_EVENT) when the read channel is brought down to
	alert the child to close on its side. Start the process with
	CREATE_NEW_PROCESS_GROUP to allow the ability to send these signals.
	The following test case now brings down the child without the use of
	an external [kill] command.

	% set p [open "|[info name]" w+]
	file8d5380
	% pid $p
	2876
	% close $p     <- now doesn't block in Tcl_WaitPid()
	%

	* win/tclWinPipe.c (PipeClose2Proc): Changed CTRL_C_EVENT to
	CTRL_BREAK_EVENT as it can't be ignored by the child and proved to
	work on [open "|netstat 1" w+] where CTRL_C_EVENT didn't.

2002-11-27  David Gravereaux  <[email protected]>

	* win/tclWinPort.h: Don't turn off winsock prototypes!  TclX didn't
	like it. Even though the core doesn't use the prototypes, do offer
	them.

	* win/tclWinSock.c: Removed shutdown() from the function table as it
	wasn't referenced anywhere and cleaned-up some casting that that
	wasn't needed.

	* win/tclWinSock.c: WSAStartup() loaded version comparison error which
	resulted in 2.0 looking less than 1.1.

	* win/tclWinChan.c (Tcl_MakeFileChannel): return of DuplicateHandle()
	incorrectly used. [Bug 618852]

2002-11-26  Jeff Hobbs  <[email protected]>

	* generic/tclEncoding.c (TclFinalizeEncodingSubsystem): properly
	cleanup all encodings by using Tcl_FirstHashEntry in the while loop.

	* unix/Makefile.in (valgrind): add simple valgrind target

	* tests/exec.test: unset path var to allow singleproc testing

	* generic/tclInterp.c (AliasCreate): preserve/release interps to
	prevent possible FMR error in bad alias cases.

2002-11-26  David Gravereaux  <[email protected]>

	* win/tclWinPort.h:
	* win/tclWinSock.c:  This patch does two things:

	1) Cleans-up the winsock typedefs by using the typedefs provided by
	winsock2.h. This has no effect on how winsock is initialized; just
	makes the source code easier to read. [Patch 561305 561301]

	2) Revamps how the socket message handler thread is brought up and
	down to allow for cleaner exits without the use of TerminateThread().
	TerminateThread is evil. No attempt has been made to resolve [Bug
	593810] which may need a new channel driver version for adding a
	registering function within the transfered thread to init the handler
	thread. IOW, initialization of the TSD structure is getting bypassed
	through the thread extension's [thread::transfer] command.

2002-11-26  David Gravereaux  <[email protected]>

	* win/tclWinConsole.c:
	* win/tclWinPipe.c:
	* win/tclWinSerial.c:
	* win/tclWinSock.c:
	* win/tclWinThrd.c:
	* win/tclWinTime.c:  General cleanup of all worker threads used by the
	channel drivers. Eliminates the normal case where the worker thread is
	terminated ('cept the winsock one). Instead, use kernel events to
	signal a clean exit. Only when the worker thread is blocked on an I/O
	call is the thread terminated. Essentially, this makes all other
	channel worker threads behave like the PipeReaderThread() function for
	it's cleaner exit behavior. This appears to fix [Bug 597924] but needs
	3rd party confirmation to close the issue.

2002-11-26  Mo DeJong  <[email protected]>

	* win/README: Update msys build env URL. This release #4 build both
	tcl and tk without problems.

2002-11-22  Jeff Hobbs  <[email protected]>

	* library/init.tcl:         code cleanup to reduce use of
	* library/opt/optparse.tcl: string compare

	* tests/interp.test: interp-14.4
	* generic/tclInterp.c (TclPreventAliasLoop): prevent seg fault when
	creating an alias command over the interp name. [Bug 641195]

2002-11-18  Jeff Hobbs  <[email protected]>

	* generic/tclUtil.c (SetEndOffsetFromAny): handle integer offset
	after the "end-" prefix.

	* generic/get.test:
	* generic/string.test:
	* generic/tclObj.c (SetIntFromAny, SetWideIntFromAny):
	* generic/tclGet.c (TclGetLong, Tcl_GetInt): simplify sign handling
	before calling strtoul(l). [Bug 634856]

2002-11-18  David Gravereaux  <[email protected]>

	* win/tclWinThrd.c (Tcl_CreateThread/TclpThreadExit): Fixed improper
	compiler macros that missed the VC++ compiler. This resulted in VC++
	builds using CreateThread()/ExitThread() in place of the proper
	_beginthreadex()/_endthreadex(). This was a large error and am
	surprised I missed seeing it earlier.

2002-11-13  Jeff Hobbs  <[email protected]>

	* generic/regexpComp.test: added tests 22.*
	* generic/tclCompCmds.c (TclCompileRegexpCmd): add left and right
	anchoring (^ and $) recognition and check starting or ending .* to
	extend the number of REs that can be compiled to string match or
	string equal.

2002-11-13  Vince Darley  <[email protected]>

	* generic/tclCmdMZ.c:
	* tests/trace.test: applied patch from Hemang Levana to fix [Bug
	615043] in execution traces with 'return -code error'.

	* generic/tclTestObj.c:
	* tests/stringObj.test: added 'knownBug' test for [Bug 635200]
	* generic/tclStringObj.c: corrected typos in comments

	* generic/tclFileName.c:
	* tests/fileName.test: applied patch for bug reported against tclvfs
	concerning handling of Windows serial ports like 'com1', 'lpt3' by the
	virtual filesystem code.

	* doc/RegExp.3: clarification of the 'extendMatch' return values.

2002-11-11  Jeff Hobbs  <[email protected]>

	* generic/tclUtil.c (Tcl_Backslash): use TclUtfToUniChar.
	(Tcl_StringCaseMatch): use TclUtfToUniChar and add further
	optimizations for the one-byte/char case.

	* generic/tclUtf.c: make use of TclUtfToUniChar macro throughout the
	functions, and add extra optimization to Tcl_NumUtfChars for
	one-byte/char case.

	* generic/tclVar.c (DisposeTraceResult, CallVarTraces): add proper
	static declarations.

	* generic/tclStringObj.c (Tcl_GetCharLength): optimize for the ascii
	char case.
	(Tcl_GetUniChar): remove unnecessary use of Tcl_UtfToUniChar.
	(FillUnicodeRep): Use TclUtfToUniChar.

	* generic/tclHash.c (HashStringKey): move string++ lower to save an
	instruction.

	* generic/tclExecute.c (TclExecuteByteCode): improve INST_STR_CMP to
	use memcmp in the one-byte/char case, also use direct index for
	INST_STR_INDEX in that case.

	* generic/tclEncoding.c (UtfToUtfProc, UtfToUnicodeProc):
	(TableFromUtfProc, EscapeFromUtfProc): Use TclUtfToUniChar.
	(UnicodeToUtfProc, TableToUtfProc): add 1-byte char optimizations for
	Tcl_UniCharToUtf call. These improve encoded channel conversion speeds
	by up to 20%.

	* tests/split.test: added 1-char string split tests
	* generic/tclCmdMZ.c (Tcl_SplitObjCmd): Use TclUtfToUniChar. Also
	added a special case for single-ascii-char splits.
	(Tcl_StringObjCmd): Use TclUtfToUniChar. For STR_RANGE, support
	getting ranges of ByteArrays (reverts change from 2000-05-26).
	(TraceExecutionProc) add proper static declaration.

	* generic/tclInt.h: add macro version of Tcl_UtfToUniChar
	(TclUtfToUniChar) that does the one-byte utf-char check without
	calling Tcl_UtfToUniChar, for use by the core. This brings notable
	speedups for primarily ascii string handling.

	* generic/tcl.h (TCL_PATCH_LEVEL): bump to 8.4.1.1 for patchlevel
	only. This interim number will only be reflected by [info patchlevel].

2002-11-11  Kevin Kenny  <[email protected]>

	* doc/Tcl.n: Corrected indentation of the new language. Oops.

2002-11-10  Kevin Kenny <[email protected]>

	* doc/Tcl.n: Added language to the Endekalogue to make it clear that
	substitutions always take place from left to right. [Bug 635644]

2002-11-06  Mo DeJong  <[email protected]>

	* changes: Note TclInExit TclInThreadExit changes.
	* generic/tclEvent.c (TclInExit, TclInThreadExit): Split out
	functionality of TclInExit to make it clear which one should be called
	in each situation.
	* generic/tclInt.decls: Declare TclInThreadExit.
	* generic/tclIntDecls.h: Regen.
	* generic/tclStubInit.c: Regen.
	* mac/tclMacChan.c (StdIOClose):
	* unix/tclUnixChan.c (FileCloseProc):
	* win/tclWinChan.c (FileCloseProc):
	* win/tclWinConsole.c (ConsoleCloseProc):
	* win/tclWinPipe.c (TclpCloseFile):
	* win/tclWinSerial.c (SerialCloseProc): Invoke the new TclInThreadExit
	method instead of TclInExit.

2002-11-06  Mo DeJong  <[email protected]>

	* unix/configure: Regen.
	* unix/tcl.m4 (SC_CONFIG_CFLAGS): Generate a fatal configure error if
	no ar program can be found on the path. [Bug 582039]
	* win/configure: Regen.
	* win/configure.in: Check that AR, RANLIB, and RC are found on the
	path when building with gcc.

2002-11-03  David Gravereaux <[email protected]>

	* win/tclAppInit.c:  Calls Registry_Init() and Dde_Init() when
	STATIC_BUILD and TCL_USE_STATIC_PACKAGES macros are set.

	* win/makefile.vc:
	* win/rules.vc:  linkexten option now sets the TCL_USE_STATIC_PACKAGES
	macro which also adds the registry and dde object files to the link
	of the shell. [Patch 479697] Also factored some additional macros that
	will be helpful for extension authors. Version grepping of tcl.h will
	need to be added to complete this.

	* win/buildall.vc.bat: Added more descriptive commentary.

2002-11-01  David Gravereaux <[email protected]>

	* win/tclWinReg.c:  Changed the Tcl_PkgProvide() line to declare the
	registry extension at version 1.1 from 1.0.

2002-10-31  Andreas Kupries  <[email protected]>

	* library/word.tcl: Changed $tcl_platform to $::tcl_platform to avoid
	possible scope trouble.

2002-10-29  Vince Darley  <[email protected]>

	* win/tclWinInt.h:
	* win/tclWin32Dll.c: added comments about certain NULL function
	pointers which will be filled in when Tcl_FindExecutable is called, so
	that users don't report invalid bugs on this topic. (No code changes
	at all).

2002-10-29  Daniel Steffen  <[email protected]>

	* unix/tclLoadDyld.c (TclpFindSymbol): pass all dyld error messages
	upstream [Bug 627546].

2002-10-28  Andreas Kupries  <[email protected]>

	* library/dde/pkgIndex.tcl:
	* library/reg/pkgIndex.tcl: Changed the hardwired debug suffix (d) to
	the correct suffix (g).

2002-10-28  Don Porter  <[email protected]>

	* library/auto.tcl:	Converted the Mac-specific [package unknown]
	* library/init.tcl:	behavior to use a chaining mechanism to extend
	* library/package.tcl:	the default [tclPkgUnknown]. [Bug 627660]
	* library/tclIndex:	[Patch 624509] (steffen)

2002-10-26  David Gravereaux <[email protected]>

	* win/makefile.vc: xcopy on NT 4.0 doesn't support the /Y switch
	(overwrite). Added logic to handle this. [Bug 618019]

2002-10-23  Donal K. Fellows  <[email protected]>

	* generic/tclInt.h: Removed definitions of obsolete HistoryEvent and
	HistoryRev structures (the history mechanism has been written in Tcl
	for some time now.)

2002-10-22  Jeff Hobbs  <[email protected]>

	*** 8.4.1 TAGGED FOR RELEASE ***

	* changes: updated for 8.4.1 release

	* win/Makefile.in: removed @MEM_DEBUG_FLAGS@ subst.
	* win/configure: regen
	* win/configure.in: removed SC_ENABLE_MEMDEBUG call
	* win/tcl.m4: replaced SC_ENABLE_MEMDEBUG with a more intelligent
	SC_ENABLE_SYMBOLS that takes yes|no|mem|compile|all as options now.

2002-10-22  Daniel Steffen  <[email protected]>

	* library/auto.tcl (tcl_findLibrary):
	* library/package.tcl (tclPkgUnknown): on macosx, search inside the
	Resources/Scripts subdirectory of any potential package directory.
	* macosx/Tcl.pbproj/project.pbxproj: add standard Frameworks dirs to
	TCL_PACKAGE_PATH make argument.
	* unix/tclUnixInit.c (TclpSetVariables): on macosx, add embedded
	framework dirs to tcl_pkgPath: @executable_path/../Frameworks and
	@executable_path/../PrivateFrameworks (if they exist), as well as the
	dirs in DYLD_FRAMEWORK_PATH (if set). [Patch 624509]
	use standard MAXPATHLEN instead of literal 1024

2002-10-22  Donal K. Fellows  <[email protected]>

	* doc/StringObj.3, doc/Object.3: Documented that Tcl_Obj's standard
	string form is a modified UTF-8; apparently, this was not mentioned
	anywhere in the main docs, and lead to [Bug 624919].

2002-10-21  Daniel Steffen  <[email protected]>

	* macosx/Tcl.pbproj/project.pbxproj: bumped version to 8.4.1
	* generic/tcl.h: Added reminder comment to edit
	macosx/Tcl.pbproj/project.pbxproj when version number changes.

2002-10-18  Jeff Hobbs  <[email protected]>

	* library/reg/pkgIndex.tcl:
	* win/configure:
	* win/configure.in:
	* win/Makefile.in:
	* win/makefile.vc:
	* win/makefile.bc:    Updated to reg1.1

	* doc/registry.n:      Added support for broadcasting changes to the
	* tests/registry.test: registry Environment. Noted proper code in the
	* win/tclWinReg.c:     docs. [Patch 625453]

	* unix/Makefile.in (dist): add any mac/tcl*.sea.hqx files

2002-10-17  Don Porter  <[email protected]>

	* generic/tclVar.c:	Fixed code that check for proper # of args to
	* tests/var.test:	[array names]. Added test. [Bug 624755]

2002-10-16  Jeff Hobbs  <[email protected]>

	* win/configure:                 add workaround for cygwin windres
	* win/tcl.m4 (SC_CONFIG_CFLAGS): problem. [Patch 624010] (howell)

2002-10-15  Jeff Hobbs  <[email protected]>

	* README: added archives.tcl.tk note

	* unix/configure:
	* unix/tcl.m4: Correct AIX-5 ppc build flags. Correct HP 11 64-bit gcc
	building. [Patch 601051] (martin)

2002-10-15  Vince Darley  <[email protected]>

	* generic/tclCmdMZ.c:
	* tests/trace.test: applied patch from Hemang Levana to fix [Bug
	615043] in execution traces with idle tasks firing.

2002-10-14  Jeff Hobbs  <[email protected]>

	* generic/tclEnv.c (Tcl_PutEnv): correct possible mem leak. [Patch
	623269] (brouwers)

2002-10-11  Donal K. Fellows  <[email protected]>

	* generic/tcl.h: Need a different strategy through the maze of
	#defines to let people building with Cygwin build correctly. Also made
	some comments less misleading...

2002-10-10  Jeff Hobbs  <[email protected]>

	* README: fixed minor nits [Bug 607776] (virden)

	* win/configure:
	* win/tcl.m4: enable USE_THREAD_ALLOC (new threaded allocator) by
	default in cygwin configure on Windows.

2002-10-10  Don Porter  <[email protected]>

	* doc/Tcl.n:	Clarified that namespace separators are legal in the
			variable names during $-subtitution. [Bug 615139]

	* doc/regexp.n:	Typo correction. Thanks Ronnie Brunner. [Bug 606826]

2002-10-10  Vince Darley  <[email protected]>

	* unix/tclLoadAout.c
	* unix/tclLoadDl.c
	* unix/tclLoadDld.c
	* unix/tclLoadDyld.c
	* unix/tclLoadNext.c
	* unix/tclLoadOSF.c
	* unix/tclLoadShl.c
	* win/tclWinLoad.c: allow either full paths or simply dll names to be
	specified when loading files (the latter will be looked up by the OS
	on your PATH/LD_LIBRARY_PATH as appropriate). Fixes [Bug 611108]

2002-10-09  Jeff Hobbs  <[email protected]>

	* unix/README: doc'ed --enable-symbols options.
	* unix/Makefile.in: removed @MEM_DEBUG_FLAGS@ subst.
	* unix/configure: regen
	* unix/configure.in: removed SC_ENABLE_MEMDEBUG call
	* unix/tcl.m4: replaced SC_ENABLE_MEMDEBUG with a more intelligent
	SC_ENABLE_SYMBOLS that takes yes|no|mem|compile|all as options now.

2002-10-09  Kevin B. Kenny  <[email protected]>

	* win/tclWinTime.c: Added code to set an exit handler that terminates
	the thread that calibrates the performance counter, so that the thread
	won't outlive unloading the Tcl DLL. [Bug 620735]

2002-10-09  Donal K. Fellows  <[email protected]>

	* doc/binary.n: More clarification of [binary scan]'s behaviour.

2002-10-09  Daniel Steffen  <[email protected]>

	* generic/tclIntDecls.h: fixed botched regen.

2002-10-09  Daniel Steffen  <[email protected]>

	* generic/tclInt.decls: made TclSetPreInitScript() declaration
	generic as it is used on mac & aqua as well.
	* generic/tclIntDecls.h:
	* generic/tclStubInit.c: regen.
	* generic/tclCompile.h: added prototype for TclCompileVariableCmd.

	* mac/tclMacPort.h: removed incorrect <fcntl.h> definitions and
	obsolete <stat.h> definitions.
	* mac/tclMacChan.c: removed obsolete GetOpenMode() and replaced
	associated constants with the <fcntl.h> analogues (they existing defs
	were inconsistent with <fcntl.h> which was causing havoc when
	Tcl_GetOpenMode was used instead of private GetOpenMode).

	* mac/tclMacFCmd.c: removed GenerateUniqueName(), use equivalent (and
	identically named) routine from MoreFiles instead.

	* mac/tclMacLoad.c: CONSTification, fixes to Vince's last changes.

	* mac/tclMacFile.c:
	* mac/tclMacTest.c:
	* mac/tclMacUnix.c: CONSTification.

	* mac/tclMacOSA.c: CONSTification, sprintf fixes, UH 3.4.x changes;
	fix for missing autoname token from TclOSACompileCmd. (bdesgraupes)
	* mac/AppleScript.html(AppleScript delete): doc fix. (bdesgraupes)

	* mac/tcltkMacBuildSupport.sea.hqx: updated MoreFiles to 1.5.3,
	updated build instructions for 8.4.
	* mac/tclMacProjects.sea.hqx: rebuilt archive.

2002-10-09  Donal K. Fellows  <[email protected]>

	* doc/Alloc.3: Added a note to mention that attempting to allocate a
	zero-length block can return NULL. [Tk Bug 619544]

2002-10-04  Donal K. Fellows  <[email protected]>

	* doc/binary.n: Doc improvements [Patch 616480]

	* tests/fCmd.test, tests/winFCmd.test:
	* tools/eolFix.tcl, tools/genStubs.tcl: [file exist] -> [file exists]
	Thanks to David Welton.

2002-10-03  Don Porter  <[email protected]>

	* doc/tcltest.n: fixed typo [Bug 618018]. Thanks to "JJM".

2002-10-03  Donal K. Fellows  <[email protected]>

	* tools/man2help2.tcl:
	* tests/http.test, tests/httpd, tests/httpold.test:
	* tests/env.test, tests/binary.test, tests/autoMkindex.test:
	* library/init.tcl, library/http/http.tcl: [info exist] should really
	be [info exists]. [Bug 602566]

	* doc/lsearch.n: Better specification of what happens when -sorted is
	mixed with other options. [Bug 617816]

2002-10-01  Jeff Hobbs  <[email protected]>

	* generic/tclProc.c (TclCreateProc): mask out VAR_UNDEFINED for
	precompiled locals to support 8.3 precompiled code.
	(Tcl_ProcObjCmd): correct 2002-09-26 fix to look for tclProcBodyType.

2002-10-01  Donal K. Fellows  <[email protected]>

	* doc/socket.n: Mentioned that ports may be specified as serivce names
	as well as integers. [Bug 616843]

2002-09-30  Jeff Hobbs  <[email protected]>

	* generic/tclCompCmds.c (TclCompileRegexpCmd): correct the checking
	for bad re's that didn't terminate the re string. Resultant compiles
	were correct, but much slower than necessary.

2002-09-29  David Gravereaux <[email protected]>

	* win/tclAppInit.c: Added proper exiting conditions using Win32
	console signals. This handles the existing lack of a Ctrl+C exit to
	call exit handlers when built for thread support. Also, properly
	handles exits from other conditions such as CTRL_CLOSE_EVENT,
	CTRL_LOGOFF_EVENT, and CTRL_SHUTDOWN_EVENT signals. In all cases,
	exit handlers will be called. [Bug 219355]

	* win/makefile.vc: Added missing tclThreadAlloc.c to the build rules
	and defines USE_THREAD_ALLOC when TCL_THREADS is defined to get the
	new behavior by default.

2002-09-27  Don Porter  <[email protected]>

	* README:		Bumped to version 8.4.1 to avoid confusion of
	* generic/tcl.h:	CVS snapshots with the actual 8.4.0 release.
	* tools/tcl.wse.in:
	* unix/configure.in:
	* unix/tcl.spec:
	* win/configure.in:

	* unix/configure:	autoconf
	* win/configure:

2002-09-26  Jeff Hobbs  <[email protected]>

	* unix/configure: regen.
	* unix/tcl.m4: improve AIX-4/5 64bit compilation support.

	* generic/tclProc.c (Tcl_ProcObjCmd): correct overeager optimization
	of noop proc to handle the precompiled case. (sofer)

	* unix/ldAix (nmopts): add -X32_64 to make it work for 32 or 64bit
	mode compilation.

	* library/encoding/koi8-u.enc: removed extraneous spaces that confused
	encoding reader. [Bug 615115]

	* unix/Makefile.in: generate source dists with -src designator and do
	not generate .Z anymore (just .gz and .zip).

2002-09-18  Mumit Khan <[email protected]>

	Added basic Cygwin support.

	* win/tcl.m4 (SC_PATH_TCLCONFIG): Support one-tree build.
	(SC_PATH_TKCONFIG): Likewise.
	(SC_PROG_TCLSH): Likewise.
	(SC_CONFIG_CFLAGS): Assume real Cygwin port and remove -mno-cygwin
	flags. Add -mwin32 to extra_cflags and extra_ldflags. Remove ``-e
	_WinMain@16'' from LDFLAGS_WINDOW.
	* win/configure.in: Allow Cygwin build.
	(SEH test): Define to be 1 instead of empty value.
	(EXCEPTION_DISPOSITION): Add test.
	* win/configure: Regenerate.

	* generic/tcl.h: Don't explicitly define __WIN32__ for Cygwin, let the
	user decide whether to use Windows or POSIX personality.
	(TCL_WIDE_INT_TYPE, TCL_LL_MODIFIER, struct Tcl_StatBuf): Define for
	Cygwin.
	* generic/tclEnv.c (Tcl_CygwinPutenv): putenv replacement for Cygwin.
	* generic/tclFileName.c (Tcl_TranslateFileName): Convert POSIX to
	native format.
	(TclDoGlob): Likewise.
	* generic/tclPlatDecls.h (TCHAR): Define for Cygwin.
	* win/tclWinPort.h (putenv, TclpSysAlloc, TclpSysFree,
	(TclpSysRealloc): Define for Cygwin.

2002-09-26  Daniel Steffen  <[email protected]>

	* macosx/Makefile: preserve environment value of INSTALL_ROOT. When
	embedding only use deployment build. Force relink before embedded
	build to ensure new linker flags are picked up.

	* macosx/Tcl.pbproj/project.pbxproj: add symbolic links to debug lib,
	stub libs and tclConfig.sh in framework toplevel. Configure target
	dependency fix. Fix to 'clean' action. Added private tcl headers to
	framework. Install tclsh symbolic link. Html doc build works when no
	installed tclsh available. Made html doc structure in framework more
	like in Apple frameworks.

2002-09-24  Donal K. Fellows  <[email protected]>

	* unix/tcl.m4 (SC_TCL_64BIT_FLAGS): Yet more robust 64-bit value
	detection to close [Bug 613117] on more systems.

	* generic/tclCompile.c (TclPrintSource): More CONSTifying.
	* generic/tclExecute.c (EvalStatsCmd): Object-ify to reduce warnings.
	Thanks to 'CoderX2' on the chat for bringing this to my attention...

	* unix/tcl.m4: Forgot to define TCL_WIDE_INT_IS_LONG at the
	appropriate moment. I believe this is the cause of [Bug 613117]

	* doc/lset.n: Changed 'list' to 'varName' for consistency with lappend
	documentation. Thanks to Glenn Jackman [Bug 611719]

2002-09-22  Don Porter  <[email protected]>

	* library/tcltest/tcltest.tcl:  Corrected [puts -nonewline] within
	test bodies. Thanks to Harald Kirsch. [Bug 612786, Patch 612788] Also
	corrected reporting of body return code. Thanks to David Taback [Bug
	611922]
	* library/tcltest/pkgIndex.tcl: Bump to version 2.2.1.
	* tests/tcltest.test: added tests for these bugs.

2002-09-15  Mo DeJong  <[email protected]>

	* unix/configure: Regen.
	* unix/tcl.m4 (SC_CONFIG_CFLAGS): Add PEEK_XCLOSEIM define under
	Linux. This is used by Tk to double check that an X input context is
	cleaned up before it is closed.

2002-09-12  David Gravereaux <[email protected]>

	* win/coffbase.txt: Added BLT to the virtual base address listings
	table should BLT's build tools decide to use it.

2002-09-12  Daniel Steffen  <[email protected]>

	* generic/tcl.h:
	* mac/tclMacApplication.r:
	* mac/tclMacLibrary.r:
	* mac/tclMacResource.r: unified use of the two equivalent resource
	compiler header inclusion defines RC_INVOKED and RESOURCE_INCLUDED,
	now use RC_INVOKED throughout.

2002-09-10  Mo DeJong  <[email protected]>

	* unix/README: Add note about building extensions with the same
	compiler Tcl was built with. [Tk Bug 592096]

2002-09-10  Daniel Steffen  <[email protected]>

	* macosx/Tcl.pbproj/project.pbxproj: disabled building html
	documentation during embedded build.

2002-09-10  Daniel Steffen  <[email protected]>

	* unix/Makefile.in: added DYLIB_INSTALL_DIR variable for macosx and
	set it to default value ${LIB_RUNTIME_DIR}
	* unix/tcl.m4 (Darwin): use DYLIB_INSTALL_DIR instead of
	LIB_RUNTIME_DIR in the -install_name argument to ld.
	* unix/configure: regen.

	* macosx/Tcl.pbproj/project.pbxproj:
	* macosx/Makefile: added support for building Tcl as an embedded
	framework, i.e. using an dyld install_name containing
	@executable_path/../Frameworks via the new DYLIB_INSTALL_DIR
	unix/Makefile variable.

2002-09-10  Jeff Hobbs  <[email protected]>

	*** 8.4.0 TAGGED FOR RELEASE ***

2002-09-06  Don Porter  <[email protected]>

	* doc/file.n:  Format correction, and clarified [file normalize]
	returns an absolute path.

	* doc/tcltest.n:  Added examples section, as long promised.

2002-09-06  Reinhard Max  <[email protected]>

	* tests/tcltest.test: Added nonRoot flag to tests 8.3, 8.4, and 8.12.

2002-09-05  Don Porter  <[email protected]>

	* doc/tcltest.n:  Clarified phrasing.

	* generic/tclBasic.c (TclRenameCommand,CallCommandTraces):
	* tests/trace.test (trace-27.1): Corrected memory leak when a rename
	trace deleted the command being traced. Test added. Thanks to Hemang
	Lavana for the fix. [Bug 604609]

	* generic/tclVar.c (TclDeleteVars):  Corrected logic for setting the
	TCL_INTERP_DESTROYED flag when calling variable traces. [Tk Bug 605121]

2002-09-04  Miguel Sofer  <[email protected]>

	* generic/tclVar.c (DeleteArray): leak plug [Bug 604239]. Thanks to
	dkf and dgp for the long and difficult discussion in the chat.

2002-09-03  Jeff Hobbs  <[email protected]>

	* generic/tclVar.c (Tcl_UpVar2): code cleanup to not use goto

	* unix/configure: remove -pthread from LIBS on FreeBSD in thread
	* unix/tcl.m4:    enabled build. [Bug 602849]

2002-09-03  Miguel Sofer  <[email protected]>

	* generic/tclInterp.c (AliasCreate): a Tcl_Obj was leaked on error
	return from TclPreventAliasLoop.

2002-09-03  Daniel Steffen  <[email protected]>

	* macosx/Tcl.pbproj/project.pbxproj: Bumped version number to 8.4.0
	and updated copyright info.

2002-09-03  Miguel Sofer  <[email protected]>

	* generic/tclVar.c (Tcl_UpVar2): a Tcl_Obj was being leaked on error
	return from TclGetFrame.

2002-09-03  Don Porter  <[email protected]>

	* changes:  Updated changes for 8.4.0 release.

2002-09-02  Jeff Hobbs  <[email protected]>

	* unix/tclUnixFile.c (TclpObjLink): removed unnecessary/unfreed extra
	native char*.

	* unix/tclUnixChan.c (Tcl_MakeTcpClientChannel): make sure to init
	flags field of TcpState ptr to 0.

	* unix/configure:
	* unix/tcl.m4: added 64-bit gcc compilation support on HP-11.
	[Patch 601051] (martin)

	* README:		Bumped version number to 8.4.0
	* generic/tcl.h:
	* tools/tcl.wse.in:
	* unix/configure:
	* unix/configure.in:
	* unix/tcl.spec:
	* win/README.binary:
	* win/configure:
	* win/configure.in:

	* generic/tclInterp.c (SlaveCreate): make sure that the memory and
	checkmem commands are initialized in non-safe slave interpreters when
	TCL_MEM_DEBUG is used. [Bug 583445]

	* win/tclWinConsole.c (ConsoleCloseProc): only wait on writable pipe
	if there was something to write. This may prevent infinite wait on
	exit.

	* tests/exec.test: marked exec-18.1 unixOnly until the Windows
	incompatibility (in the test, not the core) can be resolved.

	* tests/http.test (http-3.11): added close $fp that was causing an
	error on Windows because the file was not closed before deleting.

	* unix/tclUnixInit.c (Tcl_MacOSXGetLibraryPath): made this static
	function only appear when HAVE_CFBUNDLE is defined.

2002-08-31  Daniel Steffen  <[email protected]>

	* unix/tcl.m4: added TK_SHLIB_LD_EXTRAS analogue of existing
	TCL_SHLIB_LD_EXTRAS for linker settings only used when linking Tk.

	* unix/configure: regen

2002-08-31  Daniel Steffen  <[email protected]>

	*** macosx-8-4-branch merged into the mainline [Patch 602770] ***

	* generic/tcl.decls: added new macosx specific entry to stubs table.

	* tools/genStubs.tcl: added generation of platform guards for
	macosx. This is a little more complex than it seems, because MacOS X
	IS "unix" plus a little bit, for the purposes of Tcl. BUT
	unfortunately, Tk uses "unix" to mean X11. So added platform keys for
	macosx (the little added to "unix"), "aqua" and "x11" to distinguish
	these for Tk.

	* generic/tcl.h: added a #ifnded RESOURCE_INCLUDED so that tcl.h can
	be passed to the resource compiler.

	* generic/tcl.h:
	* generic/tclNotify.c: added a few Notifier procs, to be able to
	modify more bits of the Tcl notifier dynamically. Required to get Mac
	OS X Tk to live on top of the Tcl Unix threaded notifier. Changes the
	size of the Tcl_NotifierProcs structure, but doesn't move any elements
	around.

	* unix/tclUnixNotfy.c: moved the call to Tcl_ConditionNotify till
	AFTER we are done mucking with the pointer swap. Fixes cases where the
	thread waiting on the condition wakes & accesses the waitingListPtr
	before it gets reset, causing a hang.

	* library/auto.tcl (tcl_findLibrary): added checking the directories
	in the tcl_pkgPath for library files on macosx to enable support of
	the standard Mac OSX library locations.

	* unix/Makefile.in:
	* unix/configure.in:
	* unix/tcl.m4: added MAC_OSX_DIR. Added PLAT_OBJS to the OBJS: there
	are some MacOS X specific files now for Tcl, and when I get the
	resource & applescript stuff ported over, and restore support for
	FindFiles, etc, there will be a few more. Added LD_LIBRARY_PATH_VAR
	configure variable to avoid having to set all possible LD_LIBRARY_PATH
	analogues on all platforms. LD_LIBRARY_PATH_VAR is "LD_LIBRARY_PATH"
	by default, "LIBPATH" on AIX, "SHLIB_PATH" on HPUX and
	"DYLD_LIBRARY_PATH" on Mac OSX. Added configure option to package Tcl
	as a framework on Mac OSX.

	* macosx/tclMacOSXBundle.c (new): support for finding Tcl extension
	packaged as 'bundles' in the standard Mac OSX library locations.

	* unix/tclUnixInit.c: added support for findig the tcl script library
	inside Tcl packaged as a framework on Mac OSX.

	* macosx/Tcl.pbproj/jingham.pbxuser (new):
	* macosx/Tcl.pbproj/project.pbxproj (new): project for Apple's
	ProjectBuilder IDE.

	* macosx/Makefile (new): simple makefile for building the project from
	the command line via the ProjectBuilder tool 'pbxbuild'.

	* unix/configure:
	* generic/tclStubInit.c:
	* generic/tclPlatDecls.h: regen

2002-08-29  Andreas Kupries  <[email protected]>

	* win/tclWinThrd.c (TclpFinalizeThreadData, TclWinFreeAllocCache):
	Applied patch for [Bug 599428], provided by Miguel Sofer
	<[email protected]>.

2002-08-28  David Gravereaux <[email protected]>

	* generic/tclEnv.c:
	* unix/configure.in:
	* win/tclWinPort.h:  putenv() on some systems copies the buffer rather
	than taking reference to it. This causes memory leaks and is know to
	effect mswindows (msvcrt) and NetBSD 1.5.2 . This patch tests for this
	behavior and turns on -DHAVE_PUTENV_THAT_COPIES=1 when approriate.
	Thanks to David Welton for assistance. [Bug 414910]

	* unix/configure: regen'd

2002-08-28  Donal K. Fellows  <[email protected]>

	* doc/eval.n: Added mention of list command and corrected "SEE ALSO".

	* unix/configure.in: Cache handling of ac_cv_type_socklen_t was wrong.
	[Bug 600931] reported by John Ellson. Fixed by putting the brackets
	where they belong.

2002-08-26  Miguel Sofer  <[email protected]>

	* generic/tclCompCmds.c: fix for [Bug 599788] (error in element name
	causing segfault), reported by Tom Wilkason. Fixed by copying the
	tokens instead of the source string.

2002-08-26  Miguel Sofer  <[email protected]>

	* generic/tclThreadAlloc.c: small optimisation, reducing the new
	allocator's overhead.

2002-08-23  Miguel Sofer  <[email protected]>

	* generic/tclObj.c (USE_THREAD_ALLOC): fixed leak [Bug 597936]. Thanks
	to Zoran Vasiljevic.

2002-08-23  Miguel Sofer  <[email protected]>

	* generic/tclThreadAlloc.c (USE_THREAD_ALLOC): moving objects between
	caches as a block, instead of one-by-one.

2002-08-22  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c:
	* generic/tclCmdMZ.c: fix for freed memory r/w in delete traces [Bug
	589863], patch by Hemang Lavana.

2002-08-20  Andreas Kupries  <[email protected]>

	* win/Makefile.in (CFLAGS):
	* unix/Makefile.in (MEM_DEBUG_FLAGS): Added usage of @MEM_DEBUG_FLAGS@.
	* win/configure.in:
	* unix/configure.in: Added usage of SC_ENABLE_MEMDEBUG.
	* win/tcl.m4:
	* unix/tcl.m4: Added macro SC_ENABLE_MEMDEBUG. Allows a user of
	configure to (de)activate memory validation and debugging
	(TCL_MEM_DEBUG). No need to modify the makefile anymore.

2002-08-20  Don Porter  <[email protected]>

	* generic/tclCkalloc.c:	CONSTified MemoryCmd and CheckmemCmd.

	* README:		Bumped version number to 8.4b3 to distinguish
	* generic/tcl.h:	HEAD from the 8.4b2 release.
	* tools/tcl.wse.in:
	* unix/configure.in:
	* unix/tcl.spec:
	* win/README.binary:
	* win/configure.in:

	* unix/configure:	autoconf
	* win/configure:

	* library/http/http.tcl:	Corrected installation directory of
	* library/msgcat/msgcat.tcl:	the package tcltest 2.2. Added
	* library/opt/optparse.tcl:	comments in other packages to remind
	* library/tcltest/tcltest.tcl:	that installation directories need
	* unix/Makefile.in:		updates to match increasing version
	* win/Makefile.in:		numbers. [Bug 597450]
	* win/makefile.bc:
	* win/makefile.vc:

2002-08-19  Andreas Kupries  <[email protected]>

	* unix/tclUnixTest.c (TestfilehandlerCmd): Changed readable/writable
	to the more common readable|writable. Fixes [Bug 596034] reported by
	Larry Virden <[email protected]>.

2002-08-16  Donal K. Fellows  <[email protected]>

	* tests/fCmd.test: Added test to make sure that the cause of the
	problem is detectable with an unpatched Tcl.
	* doc/ObjectType.3: Added note on the root cause of this problem to
	the documentation, since it is possible for user code to trigger this
	sort of behaviour too.
	* generic/tclIOUtil.c (SetFsPathFromAny): Objects should only have
	their old representation deleted when we know that we are about to
	install a new one. This stops a weird TclX bug under Linux with
	certain kinds of memory debugging enabled which essentally came down
	to a double-free of a string.

2002-08-14  Miguel Sofer  <[email protected]>

	* generic/tclInt.h:
	* generic/tclObj.c: (code cleanup) factored the parts in the macros
	TclNewObj() / TclDecrRefCount() into a common part for all
	memory allocators and two new macros TclAllocObjStorage() /
	TclFreeObjStorage() that are specific to each allocator and fully
	describe the differences. Removed allocator-specific code from
	tclObj.c by using the macros.

2002-08-12  Miguel Sofer  <[email protected]>

	* generic/tclCmdMZ.c: fixing UMR in delete traces, [Bug 589863].

2002-08-08  David Gravereaux <[email protected]>

	* tools/man2help.tcl: Fixed $argv handling bug where if -bitmap wasn't
	specified $argc was off by one.

2002-08-08  Miguel Sofer  <[email protected]>

	* tests/uplevel.test: added 6.1 to test [uplevel] with shadowed
	commands [Bug 524383]

	* tests/subst.test: added 5.8-10 as further tests for [Bug 495207]

2002-08-08  Don Porter  <[email protected]>

	* tests/README: Noted removal of defs.tcl.

2002-08-08  Jeff Hobbs  <[email protected]>

	* doc/lsearch.n: corrected lsearch docs to use -inline in examples.

	*** 8.4b2 TAGGED FOR RELEASE ***

	* tests/fCmd.test:
	* tests/unixFCmd.test: updated tests for new link copy behavior.
	* generic/tclFCmd.c (CopyRenameOneFile): changed the behavior to
	follow links to endpoints and copy that file/directory instead of just
	copying the surface link. This means that trying to copy a link that
	has no endpoint (danling link) is an error. [Patch 591647] (darley)
	(CopyRenameOneFile): this is currently disabled by default until
	further issues with such behavior (like relative links) can be
	handled correctly.

	* tests/README: slight wording improvements

2002-08-07  Miguel Sofer  <[email protected]>

	* docs/BoolObj.3: added description of valid string reps for a
	boolean object. [Bug 584794]
	* generic/tclObj.c: optimised Tcl_GetBooleanFromObj and
	SetBooleanFromAny to avoid parsing the string rep when it can be
	avoided. [Bugs 584650, 472576]

2002-08-07  Miguel Sofer  <[email protected]>

	* generic/tclCompile.h:
	* generic/tclObj.c: making tclCmdNameType static ([Bug 584567], Don
	Porter).

2002-08-07  Miguel Sofer  <[email protected]>

	* generic/tclObj.c (Tcl_NewObj): added conditional code for
	USE_THREAD_ALLOC; objects allocated through Tcl_NewObj() were
	otherwise being leaked. [Bug 587488] reported by Sven Sass.

2002-08-06  Daniel Steffen  <[email protected]>

	* generic/tclInt.decls:
	* unix/tclUnixThrd.c: Added stubs and implementations for
	non-threaded build for the tclUnixThrd.c procs TclpReaddir,
	TclpLocaltime, TclpGmtime and TclpInetNtoa. Fixes link errors in
	stubbed & threaded extensions that include tclUnixPort.h and use any
	of the procs readdir, localtime, gmtime or inet_ntoa (e.g. TclX 8.4)
	[Bug 589526]
	* generic/tclIntPlatDecls.h:
	* generic/tclStubInit.c: Regen.

2002-08-05  Don Porter  <[email protected]>

	* library/tcltest/tcltest.tcl:	The setup and cleanup scripts are now
	* library/tcltest/pkgIndex.tcl:	skipped when a test is skipped, fixing
	* tests/tcltest.test:		[Bug 589859]. Test for bug added, and
	corrected tcltest package bumped to version 2.2.

	* generic/tcl.decls:	Restored Tcl_Concat to return (char *). Like
	* generic/tclDecls.h:	Tcl_Merge, it transfers ownership of a dynamic
	* generic/tclUtil.c:	allocated string to the caller.

2002-08-04  Don Porter  <[email protected]>

	* doc/CmdCmplt.3:	Applied Patch 585105 to fully CONST-ify all
	* doc/Concat.3:		remaining public interfaces of Tcl. Notably,
	* doc/CrtCommand.3:	the parser no longer writes on the string it
	* doc/CrtSlave.3:	is parsing, so it is no longer necessary for
	* doc/CrtTrace.3:	Tcl_Eval() to be given a writable string. Also
	* doc/Eval.3:		the refactoring of the Tcl_*Var* routines by
	* doc/ExprLong.3:	by Miguel Sofer is included, so that the
	* doc/LinkVar.3:	"part1" argument for them no longer needs to
	* doc/ParseCmd.3:	be writable either.
	* doc/SetVar.3:
	* doc/TraceVar.3:
	* doc/UpVar.3:		Compatibility support has been enhanced so
	* generic/tcl.decls:	that a #define of USE_NON_CONST will remove
	* generic/tcl.h:	all possible source incompatibilities with the
	* generic/tclBasic.c:	8.3 version of the header file(s). The new
	* generic/tclCmdMZ.c:	#define of USE_COMPAT_CONST now does what
	* generic/tclCompCmds.c:USE_NON_CONST used to do -- disable only those
	* generic/tclCompExpr.c:new CONST's that introduce irreconcilable
	* generic/tclCompile.c:	incompatibilities.
	* generic/tclCompile.h:
	* generic/tclDecls.h:	Several bugs are also fixed by this patch.
	* generic/tclEnv.c:	[Bugs 584051,580433] [Patches 585105,582429]
	* generic/tclEvent.c:
	* generic/tclInt.decls:
	* generic/tclInt.h:
	* generic/tclIntDecls.h:
	* generic/tclInterp.c:
	* generic/tclLink.c:
	* generic/tclObj.c:
	* generic/tclParse.c:
	* generic/tclParseExpr.c:
	* generic/tclProc.c:
	* generic/tclTest.c:
	* generic/tclUtf.c:
	* generic/tclUtil.c:
	* generic/tclVar.c:
	* mac/tclMacTest.c:
	* tests/expr-old.test:
	* tests/parseExpr.test:
	* unix/tclUnixTest.c:
	* unix/tclXtTest.c:
	* win/tclWinTest.c:

2002-08-01  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c: bugfix (reading freed memory). Testsuite
	passed on linux/i386, compile-13.1 hung on linux/alpha.

2002-08-01  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c: added a reference count for the complete
	execution stack, instead of Tcl_Preserve/Tcl_Release.

2002-08-01  Mo DeJong  <[email protected]>

	* generic/tclCkalloc.c (TclFinalizeMemorySubsystem): Don't lock the
	ckalloc mutex before invoking the Tcl_DumpActiveMemory function since
	it also locks the same mutex. This code is only executed when "memory
	onexit filename" has been executed and Tcl is compiled with
	-DTCL_MEM_DEBUG.

2002-08-01  Reinhard Max  <[email protected]>

	* win/tclWinPort.h: The windows headers don't provide socklen_t, so we
	have to do it.

2002-07-31  Miguel Sofer  <[email protected]>

	* generic/tclInt.h (USE_THREAD_ALLOC): for unshared objects,
	TclDecrRefCount now frees the internal rep before the string rep -
	just like the non-macro Tcl_DecrRefCount/TclFreeObj [Bug 524802]. For
	the other allocators the fix was done on 2002-03-06.

2002-07-31  Miguel Sofer  <[email protected]>

	* generic/tclInterp.c: signed/unsigned comparison warning fixed
	(Vince Darley).

2002-07-31  Donal K. Fellows  <[email protected]>

	* unix/tcl.m4 (SC_BUGGY_STRTOD): Enabled caching of test results.

	* unix/tcl.m4 (SC_BUGGY_STRTOD): Solaris 2.8 still has a buggy
	strtod() implementation; make sure we detect it.

	* tests/expr.test (expr-22.*): Marked as non-portable because it seems
	that these tests have an annoying tendency to fail in unexpected ways.
	[Bugs 584825, 584950, 585986]

2002-07-30  Andreas Kupries  <[email protected]>

	* tests/io.test:
	* generic/tclIO.c (WriteChars): Added flag to break out of loop if
	nothing of the input is consumed at all, to prevent infinite looping
	of called with a non-UTF-8 string. Fixes Bug 584603 (partially). Added
	new test "io-60.1". Might need additional changes to Tcl_Main so that
	unprintable results are printed as binary data.

2002-07-29  Mo DeJong  <[email protected]>

	* unix/Makefile.in: Use CC_SEARCH_FLAGS instead of LD_SEARCH_FLAGS
	when linking with ${CC}.
	* unix/configure: Regen.
	* unix/configure.in: Don't subst CC_SEARCH_FLAGS or LD_SEARCH_FLAGS
	since this is now done in tcl.m4.
	* unix/tcl.m4 (SC_CONFIG_CFLAGS): Document and set CC_SEARCH_FLAGS
	whenever LD_SEARCH_FLAGS is set. [Patch 588290]

2002-07-29  Reinhard Max  <[email protected]>

	* unix/tcl.m4 (SC_SERIAL_PORT): Fixed detection for cases when
                                        configure's stdin is not a tty.

	* unix/tclUnixPort.h:
	* generic/tclIOSock.c:          Changed size_t to socklen_t in
                                        socket-related function calls.

	* unix/configure.in:            Added test and fallback definition
                                        for socklen_t.

	* unix/configure:               generated.

2002-07-29  Miguel Sofer  <[email protected]>

	* generic/tclObj.c: fixed a comment

	* generic/tcl.h:
	* generic/tclBasic.c:
	* generic/tclInterp.c: added the new flag TCL_EVAL_INVOKE to the
	interface of the Tcl_Eval* functions, removing the
	TCL_EVAL_NO_TRACEBACK added yesterday: alias invocations not only
	require no tracebacks, but also look up the command name in the global
	scope - see new test interp-9.4
	* tests/interp.test: added 9.3 to test for safety of aliases to hidden
	commands, 9.4 to test for correct command lookup scope.

2002-07-29  Donal K. Fellows  <[email protected]>

	* generic/regc_locale.c (cclass): [[:xdigit:]] is only a defined
	concept on western characters, so should not allow any unicode digit,
	and hence number of ranges in [[:xdigit:]] is fixed.
	* tests/reg.test: Added test to detect the bug.
	* generic/regc_cvec.c (newcvec): Corrected initial size value in
	character vector structure. [Bug 578363] Many thanks to
	[email protected] for tracking this down.

2002-07-28  Miguel Sofer  <[email protected]>

	* generic/tcl.h:
	* generic/tclBasic.c: added the new flag TCL_EVAL_NO_TRACEBACK to the
	interface of the Tcl_Eval* functions. Modified the error message for
	too many nested evaluations.
	* generic/tclInterp.h: changed the Alias struct to be of variable
	length and store the prefix arguments directly (instead of a pointer
	to a Tcl_Obj list). Made AliasObjCmd call Tcl_EvalObjv instead of
	TclObjInvoke - thus making aliases trigger execution traces [Bug
	582522].
	* tests/interp.test:
	* tests/stack.test: adapted to the new error message.
	* tests/trace.test: added tests for aliases firing the exec traces.

2002-07-27  Mo DeJong  <[email protected]>

	* unix/Makefile.in: Revert fix for Tcl bug 529801 since it was
	incorrect and broke the build on other systems. Fix [Bug 587299]. Add
	MAJOR_VERSION, MINOR_VERSION, PATCH_LEVEL, SHLIB_LD_FLAGS,
	SHLIB_LD_LIBS, CC_SEARCH_FLAGS, LD_SEARCH_FLAGS, and LIB_FILE
	variables to support more generic library build/install rules.
	* unix/configure: Regen.
	* unix/configure.in: Move AC_PROG_RANLIB into tcl.m4. Move shared
	build test and setting of MAKE_LIB and MAKE_STUB_LIB into tcl.m4. Move
	subst of a number of variables into tcl.m4 where they are defined.
	* unix/tcl.m4 (SC_ENABLE_SYMBOLS, SC_CONFIG_CFLAGS): Subst vars where
	they are defined. Add MAKE_LIB, MAKE_STUB_LIB, INSTALL_LIB, and
	INSTALL_STUB_LIB rules to deal with the ugly details of running ranlib
	on static libs at build and install time. Replace TCL_SHLIB_LD_EXTRAS
	with SHLIB_LD_FLAGS and use it when building a shared library.
	* unix/tclConfig.sh.in: Add TCL_CC_SEARCH_FLAGS.

2002-07-26  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c: fixed Tcl_Obj leak in code corresponding to
	the macro NEXT_INST_V(x, 0, 1) [Bug 587495].

2002-07-26  Miguel Sofer  <[email protected]>

	* generic/tclVar.c (TclObjLookupVar): leak fix and improved comments.

2002-07-26  Jeff Hobbs  <[email protected]>

	* generic/tclVar.c (TclLookupVar): removed early returns that
	prevented the parens from being restored. Also removed goto label as
	it was not necessary.

2002-07-24  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c:
	* tests/expr-old.test: fix for erroneous error messages in [expr],
	[Bug 587140] reported by Martin Lemburg.

2002-07-25  Joe English  <[email protected]>

	* generic/tclProc.c: fix for [Tk Bug 219218] "error handling with
	bgerror in Tk"

2002-07-24  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c: restoring full TCL_COMPILE_DEBUG
	functionality.

2002-07-24  Don Porter  <[email protected]>

	* tests/unixInit.test: relaxed unixInit-3.1 to accept iso8859-15 as a
	valid C encoding. [Bug 575336]

2002-07-24  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c: restoring the tcl_traceCompile functionality
	while I repair tcl_traceExec. The core now compiles and runs also
	under TCL_COMPILE_DEBUG, but execution in the bytecode engine can
	still not be traced.

2002-07-24  Daniel Steffen  <[email protected]>

	* unix/Makefile.in:
	* unix/configure.in: corrected fix for [Bug 529801]: ranlib only
	needed for static builds on Mac OS X.
	* unix/configure: Regen.
	* unix/tclLoadDyld.c: fixed small bugs introduced by Vince,
	implemented library unloading correctly (needs OS X 10.2).

2002-07-23  Joe English  <[email protected]>

	* doc/OpenFileChnl.3: (Updates from Larry Virden)
	* doc/open.n:
	* doc/tclsh.1: Fix section numbers in Unix man page references.
	* doc/lset.n:  In EXAMPLES section, include command to set the initial
	value used in subsequent examples.
	* doc/http.n: Package version updated to 2.4.

2002-07-23  Mo DeJong  <[email protected]>

	* unix/configure: Regen.
	* unix/tcl.m4 (SC_CONFIG_CFLAGS): Enable 64 bit compilation when using
	the native compiler on a 64 bit version of IRIX. [Bug 219220]

2002-07-23  Mo DeJong  <[email protected]>

	* unix/Makefile.in: Combine ranlib tests and avoid printing unless
	ranlib is actually run.

2002-07-23  Mo DeJong  <[email protected]>

	* unix/tcl.m4 (SC_PATH_X): Set XINCLUDES to "" instead of "# no
	special path needed" or "# no include files found" when x headers
	cannot be located.

2002-07-22  Vince Darley  <[email protected]>

	* generic/tclIOUtil.c: made tclNativeFilesystem static (since 07-19
	changes removed its usage elsewhere), and added comments about its
	usage.
	* generic/tclLoad.c:
	* generic/tcl.h:
	* generic/tcl.decls:
	* doc/FileSystem.3: converted last load-related ClientData parameter
	to Tcl_LoadHandle opaque structure, removing a couple of casts in the
	process.

	* generic/tclInt.h: removed tclNativeFilesystem declaration since it
	is now static again.

2002-07-22  Donal K. Fellows  <[email protected]>

	* tests/expr.test (expr-22.*): Added tests to help detect the
	corrected handling.
	* generic/tclExecute.c (IllegalExprOperandType): Improved error
	message generated when attempting to manipulate Inf and NaN values.
	* generic/tclParseExpr.c (GetLexeme): Allowed parser to recognise
	'Inf' as a floating-point number. [Bug 218000]

2002-07-21  Don Porter  <[email protected]>

	* tclIOUtil.c: Silence compiler warning. [Bug 584408].

2002-07-19  Vince Darley  <[email protected]>

	* generic/tclIOUtil.c: fix to GetFilesystemRecord
	* win/tclWinFile.c:
	* unix/tclUnixFile.c: fix to subtle problem with links shown up by
	latest tclkit builds.

2002-07-19  Mo DeJong  <[email protected]>

	* unix/configure:
	* unix/configure.in:
	* win/configure:
	* win/configure.in: Add AC_PREREQ(2.13) in an attempt to make it more
	clear that the configure scripts must be generated with autoconf
	version 2.13. [Bug 583573]

2002-07-19  Vince Darley  <[email protected]>

	* unix/Makefile.in: fix to build on MacOS X [Bug 529801], bug report
	and fix from jcw.

2002-07-19  Donal K. Fellows  <[email protected]>

	* win/tclWinSerial.c (no_timeout): Made this variable static.

	* generic/tclExecute.c, generic/tclCompile.c, generic/tclBasic.c:
	* generic/tclCompile.h (builtinFuncTable, instructionTable): Added
	prefix to these symbols because they are visible outside the Tcl
	library.

	* generic/tclCompExpr.c (operatorTable):
	* unix/tclUnixTime.c (tmKey):
	* generic/tclIOUtil.c (theFilesystemEpoch, filesystemWantToModify,
	filesystemIteratorsInProgress, filesystemOkToModify): Made these
	variables static.

	* unix/tclUnixFile.c:		Renamed nativeFilesystem to
	* win/tclWinFile.c:		tclNativeFilesystem and declared
	* generic/tclIOUtil.c:		it properly in tclInt.h
	* generic/tclInt.h:

	* generic/tclUtf.c (totalBytes): Made this array static and const.

	* generic/tclParse.c (typeTable): Made this array static and const.
	(Tcl_ParseBraces): Simplified error handling case so that scans are
	only performed when needed, and flags are simpler too.

	* license.terms: Added AS to list of copyright holders; it's only
	fair for the current gatekeepers to be listed here!

	* tests/cmdMZ.test: Renamed constraint for clarity. [Bug 583427]
	Added tests for the [time] command, which was previously only
	indirectly tested!

2002-07-18  Vince Darley  <[email protected]>

	* generic/tclInt.h:
	* generic/tcl.h:
	* */*Load*.c: added comments on changes of 07/17 and replaced
	clientData with Tcl_LoadHandle in all locations.

	* generic/tclFCmd.c:
	* tests/fileSystem.test: fixed a 'knownBug' with 'file attributes ""'
	* tests/winFCmd.test:
	* tests/winPipe.test:
	* tests/fCmd.test:
	* tessts/winFile.test: added 'pcOnly' constraint to some tests to make
	for more useful 'tests skipped' log from running all tests on
	non-Windows platforms.

2002-07-17  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c (CallCommandTraces): delete traces now receive
	the FQ old name of the command. [Bug 582532] (Don Porter)

2002-07-18  Vince Darley  <[email protected]>

	* tests/ioUtil.test: added constraints to 1.4,2.4 so they don't run
	outside of tcltest. [Bugs 583276, 583277]

2002-07-17  Miguel Sofer  <[email protected]>

	* generic/tclVar.c (DupParsedVarName): nasty bug fixed, reported by
	Vince Darley.

2002-07-17  Miguel Sofer  <[email protected]>

	* generic/tclVar.c (TclPtrIncrVar): missing CONST in declarations,
	inconsistent with tclInt.h. Thanks to Vince Darley for reporting, boo
	to gcc for not complaining.

2002-07-17  Vince Darley  <[email protected]>

	* generic/tclInt.h:
	* generic/tclIOUtil.c:
	* generic/tclLoadNone.c:
	* unix/tclLoadAout.c:
	* unix/tclLoadDl.c:
	* unix/tclLoadDld.c:
	* unix/tclLoadDyld.c:
	* unix/tclLoadNext.c:
	* unix/tclLoadOSF.c:
	* unix/tclLoadShl.c:
	* mac/tclMacLoad.c:
	* win/tclWinLoad.c: modified to move more functionality to the generic
	code and avoid duplication. Partial replacement of internal uses of
	clientData with opaque Tcl_LoadHandle. A little further work still
	needed, but significant changes are done.

2002-07-17  D. Richard Hipp    <[email protected]>

	* library/msgcat/msgcat.tcl: fix a comment that was causing problems
	for programs (ex: mktclapp) that embed the initialization scripts in
	strings.

2002-07-17  Miguel Sofer  <[email protected]>

	* generic/tclInt.decls:
	* generic/tclIntDecls.h:
	* generic/tclStubInit.c:
	* generic/tclVar.c: removing the now redundant functions to access
	indexed variables: Tcl(Get|Set|Incr)IndexedScalar() and
	Tcl(Get|Set|Incr)ElementOfIndexedArray().

2002-07-17  Donal K. Fellows  <[email protected]>

	* generic/tclExecute.c (TclExecuteByteCode): Minor fixes to make this
	file compile with SunPro CC...

2002-07-17  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c: modified to do variable lookup explicitly, and
	then either inlining the variable access or else calling the new
	TclPtr(Set|Get|Incr)Var functions in tclVar.c
	* generic/tclInt.h: declare some functions previously local to
	tclVar.c for usage by TEBC.
	* generic/tclVar.c: removed local declarations; moved all special
	accessor functions for indexed variables to the end of the file -
	they are unused and ready for removal, but left there for the time
	being as they are in the internal stubs table.

	** WARNING FOR BYTECODE MAINTAINERS **
	TCL_COMPILE_DEBUG is currently not functional; will be fixed ASAP.

2002-07-16  Mo DeJong  <[email protected]>

	* unix/Makefile.in:
	* win/Makefile.in: Add a more descriptive warning in the event `make
	genstubs` needs to be rerun.

2002-07-16  Mo DeJong  <[email protected]>

	* unix/Makefile.in: Use dltest.marker file to keep track of when the
	dltest package is up to date. This fixes [Bug 575768] since tcltest is
	no longer linked every time.
	* unix/dltest/Makefile.in: Create ../dltest.marker after a successful
	`make all` run in dltest.

2002-07-16  Mo DeJong  <[email protected]>

	* unix/configure: Regen.
	* unix/configure.in: Remove useless subst of TCL_BIN_DIR.

2002-07-15  Miguel Sofer  <[email protected]>

	* generic/tclVar.c: inaccurate comment fixed

2002-07-15  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c (Tcl_AddObjErrorInfo):
	* generic/tclExecute.c (TclUpdateReturnInfo):
	* generic/tclInt.h:
	* generic/tclProc.c:
	Added two Tcl_Obj to the ExecEnv structure to hold the fully qualified
	names "::errorInfo" and "::errorCode" to cache the addresses of the
	corresponding variables. The two most frequent setters of these
	variables now profit from the new variable name caching.

2002-07-15  Miguel Sofer  <[email protected]>

	* generic/tclVar.c: refactorisation to reuse already looked-up Var
	pointers; definition of three new Tcl_Obj types to cache variable name
	parsing and lookup for later reuse; modification of internal functions
	to profit from the caching.

	* generic/tclInt.decls:
	* generic/tclInt.h:
	* generic/tclIntDecls.h:
	* generic/tclNamesp.c: adding CONST qualifiers to variable names
	passed to Tcl_FindNamespaceVar and to variable resolvers; adding CONST
	qualifier to the 'msg' argument to TclLookupVar. Needed to avoid code
	duplication in the new tclVar.c code.

	* tests/set-old.test:
	* tests/var.test: slight modification of error messages due to the
	modifications in the tclVar.c code.

2002-07-15  Don Porter  <[email protected]>

	* tests/unixInit.test:	Improved constraints to protect /tmp. [Bug
	581403]

2002-07-15  Vince Darley  <[email protected]>

	* tests/winFCmd.test: renamed 'win2000' and 'notWin2000' to more
	appropriate constraint names.
	* win/tclWinFile.c: updated comments to reflect 07-11 changes.
	* win/tclWinFCmd.c: made ConvertFileNameFormat static again, since no
	longer used in tclWinFile.c
	* mac/tclMacFile.c: completed TclpObjLink implementation which was
	previously lacking.
	* generic/tclIOUtil.c: comment cleanup and code speedup.

2002-07-14  Don Porter  <[email protected]>

	* generic/tclInt.h:	Removed declarations that duplicated entries
	in the (internal) stub table.

	* library/tcltest/tcltest.tcl:  Corrected errors in handling of
	configuration options -constraints and -limitconstraints.

	* README:		Bumped HEAD to version 8.4b2 so we can
	* generic/tcl.h:	distinguish it from the 8.4b1 release.
	* tools/tcl.wse.in:
	* unix/configure*:
	* unix/tcl.spec:
	* win/README.binary:
	* win/configure*:

2002-07-11  Vince Darley  <[email protected]>

	* doc/file.n:
	* win/tclWinFile.c: on Win 95/98/ME the long form of the path is used
	as a normalized form. This is required because short forms are not a
	robust representation. The file normalization function has been sped
	up, but more performance gains might be possible, if speed is still an
	issue on these platforms.

2002-07-11  Don Porter  <[email protected]>

	* library/tcltest/tcltest.tcl: Corrected reaction to existing but
	false ::tcl_interactive.

	* doc/Hash.3: Overlooked CONST documentation update.

2002-07-11  Donal K. Fellows  <[email protected]>

	* generic/tclCkalloc.c: ckalloc() and friends take the block size as
	an unsigned, so we should use %ud when reporting it in fprintf() and
	panic().

2002-07-11  Miguel Sofer  <[email protected]>

	* generic/tclCompile.c: now setting local vars undefined at compile
	time, instead of waiting until the proc is initialized.
	* generic/tclProc.c: use macro TclSetVarUndefined instead of directly
	setting the flag.

2002-07-11  Donal K. Fellows  <[email protected]>

	* tests/cmdAH.test: [file attr -perm] is Unix-only, so add [catch]
	when not inside a suitably-protected test.

2002-07-10  Donal K. Fellows  <[email protected]>

	* tests/unixFCmd.test, tests/fileName.test:
	* tests/fCmd.test: Removed [exec] of Unix utilities that have
	equivalents in standard Tcl. [Bug 579268] Also simplified some of
	unixFCmd.test while I was at it.

2002-07-10  Don Porter  <[email protected]>

	* tests/tcltest.test:  Greatly reduced the number of [exec]s, using
	slave interps instead.
	* library/tcltest/tcltest.tcl:  Fixed bug uncovered in the conversion
	where a message was written to stdout instead of [outputChannel].

	* tests/basic.test:	Cleaned up, constrained, and reduced the
	* tests/compile.test:	amount of [exec] usage in the test suite.
	* tests/encoding.test:
	* tests/env.test:
	* tests/event.test:
	* tests/exec.test:
	* tests/io.test:
	* tests/ioCmd.test:
	* tests/regexp.test:
	* tests/regexpComp.test:
	* tests/socket.test:
	* tests/tcltest.test:
	* tests/unixInit.test:
	* tests/winDde.test:
	* tests/winPipe.test:

2002-07-10  Donal K. Fellows  <[email protected]>

	* tests/cmdAH.test: Removed [exec] of Unix utilities. [Bug 579211]

	* tests/expr.test: Added tests to make sure that this works.
	* generic/tclExecute.c (ExprCallMathFunc): Functions should also be
	able to return wide-ints. [Bug 579284]

2002-07-08  Andreas Kupries  <[email protected]>

	* tests/socket.test: Fixed [Bug 578164]. The original reason for the
	was a DNS outage while running the testsuite. Changed [info hostname]
	to 127.0.0.1 to bypass DNS, knowing that we operate on the local host.

2002-07-08  Don Porter  <[email protected]>

	* doc/tcltest.n:		Fixed incompatibility in [viewFile].
	* library/tcltest/tcltest.tcl:	Corrected docs. Bumped to 2.2.1.
	* library/tcltest/pkgIndex.tcl: [Bug 578163]

2002-07-08  Vince Darley  <[email protected]>

	* tests/cmdAH.test:
	* tests/fCmd.test:
	* tests/fileName.test: tests which rely on 'file link' need a
	constraint so they don't run on older Windows OS. [Bug 578158]
	* generic/tclIOUtil.c:
	* generic/tcl.h:
	* generic/tclInt.h:
	* generic/tclTest.c:
	* mac/tclMacChan.c:
	* unix/tclUnixChan.c:
	* win/tclWinChan.c:
	* doc/FileSystem.3: cleaned up internal handling of
	Tcl_FSOpenFileChannel to remove duplicate code, and make writing
	external vfs's clearer and easier. No functionality change. Also
	clarify that objects with refCount zero should not be passed in to the
	Tcl_FS API, and prevent segfaults from occuring on such user errors.
	[Bug 578617]

2002-07-06  Don Porter  <[email protected]>

	* tests/pkgMkIndex.test:  Constrained tests of [load] package indexing
	to those platforms where the testing shared libraries have been built.
	[Bug 578166]

2002-07-05  Don Porter  <[email protected]>

	* changes: added recent changes

2002-07-05  Reinhard Max  <[email protected]>

	* generic/tclClock.c (FormatClock): Convert the format string to utf-8
	before calling TclpStrftime, so that non-ASCII characters don't get
	mangled when the result string is being converted back.
	* tests/clock.test: Added a test for that.

2002-07-05  Donal K. Fellows  <[email protected]>

	* unix/Makefile.in (ro-test,ddd,GDB,DDD): Created new targets to
	allow running the test suite with a read-only current directory,
	running under ddd instead of gdb, and factored out some executable
	names for broken sites (like mine) where gdb and ddd are installed
	with non-standard names...

	* tests/httpold.test: Altered test names to httpold-* to avoid clashes
	with http.test, and stopped tests from failing when the current
	directory is not writable...

	* tests/event.test:		Stop these tests from failing when the
	* tests/ioUtil.test:		current directory is not writable...
	* tests/regexp.test:
	* tests/regexpComp.test:
	* tests/source.test:
	* tests/unixFile.test:
	* tests/unixNotfy.test:

	* tests/unixFCmd.test:		Trying to make these test-files not
	* tests/macFCmd.test:		bomb out with an error when the
	* tests/http.test:		current directory is not writable...
	* tests/fileName.test:
	* tests/env.test:

2002-07-05  Jeff Hobbs  <[email protected]>

	*** 8.4b1 TAGGED FOR RELEASE ***

2002-07-04  Donal K. Fellows  <[email protected]>

	* tests/cmdMZ.test (cmdMZ-1.4):
	* tests/cmdAH.test: More fixing of writable-current-dir assumption.
	[Bug 575824]

2002-07-04  Miguel Sofer  <[email protected]>

	* tests/basic.test: Same issue as below; fixed [Bug 575817]

2002-07-04  Andreas Kupries  <[email protected]>

	* tests/socket.test:
	* tests/winPipe.test:
	* tests/pid.test: Fixed [Bug 575848]. See below for a description the
	general problem.

	* All the bugs below are instances of the same problem: The testsuite
	assumes [pwd] = [temporaryDirectory] and writable.

	* tests/iogt.test: Fixed [Bug 575860].
	* tests/io.test:   Fixed [Bug 575862].
	* tests/exec.test:
	* tests/ioCmd.test: Fixed [Bug 575836].

2002-07-03  Don Porter  <[email protected]>

	* tests/pkg1/direct1.tcl: removed
	* tests/pkg1/pkgIndex.tcl: removed
	* tests/pkgMkIndex.test:  Imported auxilliary files from tests/pkg1
	into the test file pkgMkIndex.test itself. Formatting fixes.

	* unix/Makefile.in: removed tests/pkg/* from `make dist`

	* tests/pkg/circ1.tcl: removed
	* tests/pkg/circ2.tcl: removed
	* tests/pkg/circ3.tcl: removed
	* tests/pkg/global.tcl: removed
	* tests/pkg/import.tcl: removed
	* tests/pkg/pkg1.tcl: removed
	* tests/pkg/pkg2_a.tcl: removed
	* tests/pkg/pkg2_b.tcl: removed
	* tests/pkg/pkg3.tcl: removed
	* tests/pkg/pkg4.tcl: removed
	* tests/pkg/pkg5.tcl: removed
	* tests/pkg/pkga.tcl: removed
	* tests/pkg/samename.tcl: removed
	* tests/pkg/simple.tcl: removed
	* tests/pkg/spacename.tcl: removed
	* tests/pkg/std.tcl: removed
	* tests/pkgMkIndex.test: Fixed [Bug 575857] where this test file
	expected to be able to write to [file join [testsDirectory] pkg]. Part
	of the fix was to import several auxilliary files into the test file
	itself.

	* tests/main.test:	Cheap fix for [Bugs 575851, 575858]. Avoid
	* tests/tcltest.test:	non-writable . by [cd [temporaryDirectory]].

	* library/auto.tcl: Fix [tcl_findLibrary] to be sure it sets $varName
	only if a successful library script is found. [Bug 577033]

2002-07-03  Miguel Sofer  <[email protected]>

	* generic/tclCompCmds.c (TclCompileCatchCmd): return
	TCL_OUT_LINE_COMPILE instead of TCL_ERROR: let the failure happen at
	runtime so that it can be caught [Bug 577015].

2002-07-02  Joe English  <[email protected]>

	* doc/tcltest.n: Markup fixes, spellcheck.

2002-07-02  Don Porter  <[email protected]>

	* doc/tcltest.n: more refinements of the documentation.

	* library/tcltest/tcltest.tcl: Added trace to be sure the stdio
	constraint is updated whenever the [interpreter] changes.

	* doc/tcltest.n:		Reverted [makeFile] and [viewFile] to
	* library/tcltest/tcltest.tcl:	their former behavior, and documented
	* tests/cmdAH.test:		it. Corrected misspelling of hook
	* tests/event.test:		procedure. Restored tests.
	* tests/http.test:
	* tests/io.test:

	* library/tcltest/tcltest.tcl: Simplified logic of [GetMatchingFiles]
	and [GetMatchingDirectories], removing special case processing.

	* doc/tcltest.n: More documentation updates. Reference sections are
	complete. Only examples need adding.

2002-07-02  Vince Darley  <[email protected]>

	* tests/fCmd.test:
	* generic/tclCmdAH.c: clearer error msgs for 'file link', as per the
	man page.

2002-07-01  Joe English  <[email protected]>

	* doc/Access.3:
	* doc/AddErrInfo.3:
	* doc/Alloc.3:
	* doc/Backslash.3:
	* doc/CrtChannel.3:
	* doc/CrtSlave.3:
	* doc/Encoding.3:
	* doc/Eval.3:
	* doc/FileSystem.3:
	* doc/Notifier.3:
	* doc/OpenFileChnl.3:
	* doc/ParseCmd.3:
	* doc/RegExp.3:
	* doc/Tcl_Main.3:
	* doc/Thread.3:
	* doc/TraceCmd.3:
	* doc/Utf.3:
	* doc/WrongNumArgs.3:
	* doc/binary.n:
	* doc/clock.n:
	* doc/expr.n:
	* doc/fconfigure.n:
	* doc/glob.n:
	* doc/http.n:
	* doc/interp.n:
	* doc/lsearch.n:
	* doc/lset.n:
	* doc/msgcat.n:
	* doc/packagens.n:
	* doc/pkgMkIndex.n:
	* doc/registry.n:
	* doc/resource.n:
	* doc/safe.n:
	* doc/scan.n:
	* doc/tclvars.n:  Spell-check, fixed typos (Updates from Larry Virden).

2002-07-01  Donal K. Fellows  <[email protected]>

	* unix/tcl.m4 (SC_CONFIG_CFLAGS): Made Solaris use gcc for linking
	when building with gcc to resolve problems with undefined symbols
	being present when tcl library used with non-gcc linker at later
	stage. Symbols were compiler-generated, so it is the compiler's
	business to define them. [Bug 541181]

2002-07-01  Don Porter  <[email protected]>

	* doc/tcltest.n: more work in progress updating tcltest docs.

	* library/tcltest/tcltest.tcl: Change [configure -match] to stop
	treating an empty list as a list of the single pattern "*". Changed
	the default value to [list *] so default operation remains the same.

	* tests/pkg/samename.tcl: restored. needed by pkgMkIndex.test.

	* library/tcltest/tcltest.tcl: restored writeability testing of
	-tmpdir, augmented by a special exception for the deafault value.

2002-07-01  Donal K. Fellows  <[email protected]>

	* doc/concat.n: Documented the *real* behaviour of [concat]!

2002-06-30  Don Porter  <[email protected]>

	* doc/tcltest.n: more work in progress updating tcltest docs.

	* tests/README:		Updated the instructions on running and
	* tests/cmdMZ.test:	adding to the test suite. Also updated
	* tests/encoding.test:	several tests, mostly to correctly create
	* tests/fCmd.test:	and destroy any temporary files in the
	* tests/info.test:	[temporaryDirectory] of tcltest.
	* tests/interp.test:

	* library/tcltest/tcltest.tcl:	Stopped checking for writeability of
	-tmpdir value because no default directory can be guaranteed to be
	writeable.

	* tests/autoMkindex.tcl: removed.
	* tests/pkg/samename.tcl: removed.
	* tests/pkg/magicchar.tcl: removed.
	* tests/pkg/magicchar2.tcl: removed.
	* tests/autoMkindex.test: Updated auto_mkIndex tests to use [makeFile]
	and [removeFile] so tests are done in [temporaryDirecotry] where write
	access is guaranteed.

	* library/tcltest/tcltest.tcl:	Fixed [makeFile] and [viewFile] to
	* tests/cmdAH.test:		accurately reflect a file's contents.
	* tests/event.test:		Updated tests that depended on buggy
	* tests/http.test:		behavior. Also added warning messages
	* tests/io.test:		to "-debug 1" operations to debug test
	* tests/iogt.test:		calls to (make|remove)(File|Directory)

	* unix/mkLinks: `make mklinks` on 6-27 commits.

2002-06-28  Miguel Sofer  <[email protected]>

	* generic/tclCompile.h: modified the macro TclEmitPush to not call its
	first argument repeatedly or pass it to other macros, [Bug 575194]
	reported by Peter Spjuth.

2002-06-28  Don Porter  <[email protected]>

	* docs/tcltest.n:	Doc revisions in progress.
	* library/tcltest/tcltest.tcl: Corrected -testdir default value. Was
	not reliable, and disagreed with docs! Thanks to Hemang Lavana. [Bug
	575150]

2002-06-28  Donal K. Fellows  <[email protected]>

	* unix/tclUnixThrd.c:	Renamed the Tcl_Platform* #defines to TclOS*
	* unix/tclUnixPipe.c:	because they are only used internally. Also
	* unix/tclUnixFile.c:	stopped double-#def of TclOSlstat [Bug 566099,
	* unix/tclUnixFCmd.c:	post-rename]
	* unix/tclUnixChan.c:
	* unix/tclUnixPort.h:

	* doc/string.n: Improved documentation for [string last] along lines
	described in [Bug 574799] so it indicates that the supplied index
	marks the end of the search space.

2002-06-27  Don Porter  <[email protected]>

	* doc/dde.n:		Work in progress updating the documentation
	* doc/http.n:		of the packages that come bundled with
	* doc/msgcat.n:		the Tcl source distribution, notably tcltest.
	* doc/registry.n:
	* doc/tcltest.n:

	* library/tcltest/tcltest.tcl:  Made sure that the TCLTEST_OPTIONS
	environment variablle configures tcltest at package load time.

2002-06-26  Vince Darley  <[email protected]>

	* tests/fileSystem.test:
	* generic/tclIOUtil.c: fix to handling of empty paths "" which are not
	claimed by any filesystem [Bug 573758]. Ensure good error messages
	are given in all cases.
	* tests/cmdAH.test:
	* unix/tclUnixFCmd.c: fix to bug reported as part of [Patch 566669].
	Thanks to Taguchi, Takeshi for the report.

2002-06-26  Reinhard Max  <[email protected]>

	* unix/tclUnixTime.c: Make [clock format] respect locale settings.
	* tests/clock.test:   [Bug 565880]. ***POTENTIAL INCOMPATIBILITY***

2002-06-26  Miguel Sofer  <[email protected]>

	* doc/CrtInterp.3:
	* doc/StringObj.3: clarifications by Don Porter, [Bug 493995] and [Bug
	500930].

2002-06-24  Don Porter  <[email protected]>

	* library/tcltest/tcltest.tcl:	Corrected suppression of -verbose skip
	* tests/tcltest.test:		and start by [test -output]. Also
	corrected test suite errors exposed by corrected code. [Bug 564656]

2002-06-25  Reinhard Max  <[email protected]>

	* unix/tcl.m4:       New macro SC_CONFIG_MANPAGES.
	* unix/configure.in: Added support for symlinks and compression when
	* unix/Makefile.in:  installing the manpages. [Patch 518052]
	* unix/mkLinks.tcl:  Default is still hardlinks and no compression.

	* unix/mkLinks:      generated
	* unix/configure:

	* unix/README:       Added documentation for the new features.

	* unix/tcl.m4 (SC_PATH_TCLCONFIG): Replaced ${exec_prefix}/lib by
	${libdir}.

2002-06-25  Donal K. Fellows  <[email protected]>

	* generic/tclUtil.c (TclGetIntForIndex): Fix of critical [Bug 533364]
	generated when the index is bad and the result is a shared object. The
	T_ASTO(T_GOR, ...) idiom likely exists elsewhere though. Also removed
	some cruft that just complicated things to no advantage.
	(SetEndOffsetFromAny): Same fix, though this wasn't on the path
	excited by the bug.

2002-06-24  Don Porter  <[email protected]>

	* library/tcltest/tcltest.tcl:	Implementation of TIP 101. Adds abd
	* tests/parseOld.test:		exports a [configure] command from
	* tests/tcltest.test:		tcltest.

2002-06-22  Don Porter  <[email protected]>

	* changes: updated changes file for 8.4b1 release.

	* library/tcltest/tcltest.tcl:	Corrections to tcltest and the Tcl
	* tests/basic.test:		test suite so that a test with options
	* tests/cmdInfo.test:		-constraints knownBug
	* tests/compile.test:		-limitConstraints 1 only tests the
	* tests/encoding.test:		knownBug tests. Mostly involves
	* tests/env.test:		replacing direct access to the
	* tests/event.test:		testConstraints array with calls to
	* tests/exec.test:		the testConstraint command (which
	* tests/execute.test:		requires tcltest version 2)
	* tests/fCmd.test:
	* tests/format.test:
	* tests/http.test:
	* tests/httpold.test:
	* tests/ioUtil.test:
	* tests/link.test:
	* tests/load.test:
	* tests/namespace.test:
	* tests/pkgMkIndex.test:
	* tests/reg.test:
	* tests/result.test:
	* tests/scan.test:
	* tests/stack.test:

2002-06-22  Donal K. Fellows  <[email protected]>

	* tools/tcl.wse.in (Disk Label), unix/tcl.spec (version):
	* win/README.binary, README, win/configure.in, unix/configure.in:
	* generic/tcl.h (TCL_RELEASE_*, TCL_PATCH_LEVEL): Bump to beta1.

2002-06-21  Joe English  <[email protected]>

	* generic/tclCompExpr.c:
	* generic/tclParseExpr.c: LogSyntaxError() should reset the
	interpreter result [Bug 550142 "Tcl_ExprObj -> abort"]

2002-06-21  Don Porter  <[email protected]>

	* unix/Makefile.in:	Updated all package install directories
	* win/Makefile.in:	to match current Major.minor versions
	* win/makefile.bc:	of the packages. Added tcltest package
	* win/makefile.vc:	to installation on Windows.

	* library/init.tcl:  Corrected comments and namespace style issues.
	Thanks to Bruce Stephens. [Bug 572025]

2002-06-21  Vince Darley  <[email protected]>

	* tests/cmdAH.test:          Added TIP#99 implementation of 'file
	* tests/fCmd.test:           link'. Supports creation of symbolic and
	* tests/fileName.test:       hard links in the native filesystems and
	* tests/fileSystem.test:     in vfs's, when the individual filesystem
	* generic/tclTest.c:         supports the concept.
	* generic/tclCmdAH.c:
	* generic/tclIOUtil.c:
	* generic/tcl.h:
	* generic/tcl.decls:
	* doc/FileSystem.3:
	* doc/file.n:
	* mac/tclMacFile.c:
	* unix/tclUnixFile.c:
	* win/tclWinFile.c: Also enhanced speed of 'file normalize' on
	Windows.

2002-06-20  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c (TclEvalObjvInternal): fix for [Bug 571385] in
	the implementation of TIP#62 (command tracing). Vince Darley, Hemang
	Lavana & Don Porter: thanks.

2002-06-20  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c (TclCompEvalObj): clarified and simplified the
	logic for compilation/recompilation.

2002-06-19  Joe English  <[email protected]>

	* doc/file.n: Fixed indentation. No substantive changes.

2002-06-19  Jeff Hobbs  <[email protected]>

	* generic/tclCmdMZ.c (Tcl_RegexpObjCmd): get the resultPtr again as
	the Tcl_ObjSetVar2 may cause the result to change. [Patch 558324]
	(watson)

2002-06-19  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c (TEBC): removing unused "for(;;)" loop;
	improved comments; re-indentation.

2002-06-18  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c (TEBC):
	- elimination of duplicated code in the non-immediate INST_INCR
	  instructions.
	- elimination of 103 (!) TclDecrRefCount macros. The different
	  instructions now jump back to a common "DecrRefCount zone" at the
	  top of the loop. The macro "ADJUST_PC" was replaced by two macros
	  "NEXT_INST_F" and "NEXT_INST_V" that take three params
	  (pcAdjustment, # of stack objects to discard, resultObjPtr handling
	  flag). The only instructions that retain a TclDecrRefCount are
	  INST_POP (for speed), the common code for the non-immediate
	  INST_INCR, INST_FOREACH_STEP and the two INST_LSET.

	The object size of tclExecute.o was reduced by approx 20% since the
	start of the consolidation drive, while making room for some peep-hole
	optimisation at runtime.

2002-06-18  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c (TEBC, INST_DONE): small bug in the panic code
	for tcl-stack corruption.

2002-06-17  David Gravereaux <[email protected]>

	Trims to support the removal of RESOURCE_INCLUDED from rc scripts from
	[FRQ 565088].

	* generic/tcl.h: moved the #ifndef RC_INVOKED start block up in the
	file. rc scripts don't need to know thread mutexes.

	* win/tcl.rc:
	* win/tclsh.rc: removed the #define RESOURCE_INCLUDED to let the
	built-in -DRC_INVOKED to the work.

2002-06-17  Jeff Hobbs  <[email protected]>

	* doc/CrtTrace.3:        Added TIP#62 implementation of command
	* doc/trace.n:           execution tracing [FRQ 462580] (lavana).
	* generic/tcl.h:         This includes enter/leave tracing as well
	* generic/tclBasic.c:    as inter-procedure stepping.
	* generic/tclCmdMZ.c:
	* generic/tclCompile.c:
	* generic/tclExecute.c:
	* generic/tclInt.decls:
	* generic/tclInt.h:
	* generic/tclIntDecls.h:
	* generic/tclStubInit.c:
	* generic/tclVar.c:
	* tests/trace.test:

2002-06-17  Andreas Kupries  <[email protected]>

	* win/tclWinPipe.c (BuildCommandLine): Fixed [Bug 554068] ([exec] on
	windows did not treat { in filenames well.). Bug reported by Vince
	Darley <[email protected]>, patch provided by Vince
	too.

2002-06-17  Joe English  <[email protected]>

	* generic/tcl.h: #ifdef logic for K&R C backwards compatibility
	changed to assume modern C by default. See [FRQ 565088] for full
	details.

2002-06-17  Don Porter  <[email protected]>

	* doc/msgcat.n: Corrected en_UK references to en_GB. UK is not a
	country designation recognized in ISO 3166.

	* library/msgcat/msgcat.tcl:  More Windows Registry locale codes from
	Bruno Haible.

	* doc/msgcat.n:
	* library/msgcat/msgcat.tcl:
	* library/msgcat/pkgIndex.tcl:
	* tests/msgcat.test:  Revised locale initialization to interpret
	environment variable locale values according to XPG4, and to recognize
	the LC_ALL and LC_MESSAGES values over that of LANG. Also added many
	Windows Registry locale values to those recognized by msgcat. Revised
	tests and docs. Bumped to version 1.3. Thanks to Bruno Haible for the
	report and assistance crafting the solution. [Bug 525522, 525525]

2002-06-16  Miguel Sofer  <[email protected]>

	* generic/tclCompile.c (TclCompileTokens): a better algorithm for the
	previous bug fix.

2002-06-16  Miguel Sofer  <[email protected]>

	* generic/tclCompile.c (TclCompileTokens):
	* tests/compile.test: [Bug 569438] in the processing of dollar
	variables; report by Georgios Petasis.

2002-06-16  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c: bug in the consolidation of the INCR_..._STK
	instructions; the bug could not be exercised as the (faulty)
	instruction INST_INCR_ARRAY_STK was never compiled-in (related to [Bug
	569438]).

2002-06-14  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c (TclExecuteByteCode): runtime peep-hole
	optimisation of variables (INST_STORE, INST_INCR) and commands
	(INST_INVOKE); faster check for the existence of a catch.
	(TclExecuteByteCode): runtime peep-hole optimisation of comparisons.
	(TclExecuteByteCode): runtime peep-hole optimisation of INST_FOREACH -
	relies on peculiarities of the code produced by the bytecode compiler.

2002-06-14  David Gravereaux <[email protected]>

	* win/rules.vc: The test for compiler optimizations was in error.
	Thanks goes to Roy Terry <[email protected]> for his assistance
	with this.

2002-06-14  Donal K. Fellows  <[email protected]>

	* doc/trace.n, tests/trace.test:
	* generic/tclCmdMZ.c (Tcl_TraceObjCmd,TclTraceCommandObjCmd)
	(TclTraceVariableObjCmd): Changed references to "trace list" to
	"trace info" as mandated by TIP#102.

2002-06-13  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c (TclExecuteByteCode): consolidated code for the
	conditional branch instructions.

2002-06-13  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c (TclExecuteByteCode): fixed the previous patch;
	wouldn't compile with TCL_COMPILE_DEBUG set.

2002-06-13  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c (TclExecuteByteCode): consolidated the handling
	of exception returns to INST_INVOKE and INST_EVAL, as well as most of
	the code for INST_CONTINUE and INST_BREAK, in the new jump target
	"processExceptionReturn".

2002-06-13  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c (TclExecuteByteCode): consolidated variable
	handling opcodes, replaced redundant code with some 'goto'. All
	store/append/lappend opcodes on the same data type now share the main
	code; same with incr opcodes.
	* generic/tclVar.c: added the bit TCL_TRACE_READS to the possible
	flags to Tcl_SetVar2Ex - it causes read traces to be fired prior to
	setting the variable. This is used in the core for [lappend].

	***NOTE*** the usage of TCL_TRACE_READS in Tcl_(Obj)?GetVar.* is not
	documented; there, it causes the call to create the variable if it
	does not exist. The new usage in Tcl_(Obj)?SetVar.* remains
	undocumented too ...

2002-06-13  Vince Darley  <[email protected]>

	* tests/fCmd.test:
	* tests/winFile.test:
	* tests/fileSystem.test:
	* generic/tclTest.c:
	* generic/tclCmdAH.c:
	* generic/tclIOUtil.c:
	* doc/FileSystem.3:
	* mac/tclMacFile.c:
	* unix/tclUnixFile.c:
	* win/tclWinFile.c: fixed up further so both compiles and actually
	works with VC++ 5 or 6.
	* win/tclWinInt.h:
	* win/tclWin32Dll.c: cleaned up code and vfs tests and added tests for
	the internal changes of 2002-06-12, to see whether WinTcl on NTFS can
	coexist peacefully with links in the filesystem. Added new test
	command 'testfilelink' to enable the newer code to be tested.
	* tests/fCmd.test: (made certain tests of 'testfilelink' not run on
	unix).

2002-06-12  Miguel Sofer  <[email protected]>

	* tclBasic.c (Tcl_DeleteTrace): fixed [Bug 568123] (thanks to Hemang
	Lavana)

2002-06-12  Jeff Hobbs  <[email protected]>

	* win/tclWinFile.c: corrected the symbolic link handling code to allow
	it to compile. Added real definition of REPARSE_DATA_BUFFER (found in
	winnt.h). Most of the added definitions appear to have correct,
	cross-Win-version equivalents in winnt.h and should be removed, but
	just making things "work" for now.

2002-06-12  Vince Darley  <[email protected]>

	* generic/tclIOUtil.c:
	* generic/tcl.decls:
	* generic/tclDecls.h: made code for Tcl_FSNewNativePath agree with man
	pages.

	* doc/FileSystem.3: clarified the circumstances under which certain
	functions are called in the presence of symlinks.

	* win/tclWinFile.c:
	* win/tclWinPort.h:
	* win/tclWinInt.h:
	* win/tclWinFCmd.c:  Fix for Windows to allow 'file lstat', 'file
	type', 'glob -type l', 'file copy', 'file delete', 'file normalize',
	and all VFS code to work correctly in the presence of symlinks
	(previously Tcl's behaviour was not very well defined). This also
	fixes possible serious problems in all versions of WinTcl where 'file
	delete' on a NTFS symlink could delete the original, not the symlink.
	Note: symlinks cannot yet be created in pure Tcl.

2002-06-11  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c:
	* generic/tclCompCmds.c:
	* generic/tclInt.h: reverted the new compilation functions; replaced
	by a more general approach described below.

	* generic/tclCompCmds.c:
	* generic/tclCompile.c: made *all* compiled variable access attempts
	create an indexed variable - even get or incr without previous set.
	This allows indexed access to local variables that are created and set
	at runtime, for example by [global], [upvar], [variable], [regexp],
	[regsub].

2002-06-11  Miguel Sofer  <[email protected]>

	* doc/global.n:
	* doc/info.n:
	* test/info.test:
	* generic/tclCmdIL.c: fix for [Bug 567386], [info locals] was
	reporting some linked variables.

	* generic/tclBasic.c:
	* generic/tclCompCmds.c:
	* generic/tclInt.h: added compile functions for [global], [variable]
	and [upvar]. They just declare the new local variables, the commands
	themselves are not compiled-in. This gives a notably faster read
	access to these linked variables.

2002-06-11  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c: optimised algorithm for exception range
	lookup; part of [Patch 453709].

2002-06-10  Vince Darley  <[email protected]>

	* unix/tclUnixFCmd.c: fixed [Bug 566669]
	* generic/tclIOUtil.c: improved and sped up handling of native paths
	(duplication and conversion to normalized paths), particularly on
	Windows.
	* modified part of above commit, due to problems on Linux. Will
	re-examine bug report and evaluate more closely.

2002-06-07  Don Porter  <[email protected]>

	* tests/tcltest.test:  More corrections to test suite so that tests of
	failing [test]s don't show up themselves as failing tests.

2002-06-07  Donal K. Fellows  <[email protected]>

	* generic/tclExecute.c: Tidied up headers in relation to float.h to
	cut the cruft and ensure DBL_MAX is defined since doubles seem to be
	the same size everywhere; if the assumption isn't true, the variant
	platforms had better have run configure...

	* unix/tclUnixPort.h (EOVERFLOW): Added code to define it if it
	wasn't previously defined. Also some other general tidying and adding
	of comments. [Bugs 563122, 564595]
	* compat/tclErrno.h: Added definition for EOVERFLOW copied from
	Solaris headers; I've been unable to find any uses of EFTYPE, which
	was the error code previously occupying the slot, in Tcl, or any
	definition of it in the Solaris headers.

2002-06-06  Mo DeJong  <[email protected]>

	* unix/dltest/Makefile.in: Remove hard coded CFLAGS=-g and add
	CFLAGS_DEBUG, CFLAGS_OPTIMIZE, and CFLAGS_DEFAULT varaibles. [Bug
	565488]

2002-06-06  Don Porter  <[email protected]>

	* tests/tcltest.test:  Corrections to test suite so that tests of
	failing [test]s don't show up themselves as failing tests.

	* tests/io.test: Fixed up namespace variable resolution issues
	revealed by running test suite with "-singleproc 1".

	* doc/tcltest.n:
	* library/tcltest/tcltest.tcl:
	* tests/tcltest.test: Several updates to tcltest.
	  1) changed to lazy initialization of test constraints
	  2) deprecated [initConstraintsHook]
	  3) repaired badly broken [limitConstraints].
	  4) deprecated [threadReap] and [mainThread]
	[Patch 512214, Bug 558742, Bug 461000, Bug 534903]

2002-06-06  Daniel Steffen  <[email protected]>

	* unix/tclUnixThrd.c (TclpReaddir, TclpLocaltime, TclpGmtime): added
	mutex wrapped calls to readdir, localtime & gmtime in case their
	thread-safe *_r counterparts are not available.
	* unix/tcl.m4: added configure check for readdir_r
	* unix/tcl.m4 (Darwin): set TCL_DEFAULT_ENCODING to utf-8 on MacOSX
	(where posix file apis expect utf-8, not iso8859-1).
	* unix/configure: regen
	* unix/Makefile.in: set DYLD_LIBRARY_PATH in parallel to
	LD_LIBRARY_PATH for MacOSX dynamic linker.
	* generic/tclEnv.c (TclSetEnv): fix env var setting on MacOSX (adapted
	from [Patch 524352] by jkbonfield).

2002-06-05  Don Porter  <[email protected]>

	* doc/Tcl_Main.3: Documented $tcl_rcFileName and added more
	clarifications about the intended use of Tcl_Main(). [Bug 505651]

2002-06-05  Daniel Steffen  <[email protected]>

	* generic/tclFileName.c (TclGlob): mac specific fix to recent changes
	in 'glob -tails' handling.
	* mac/tclMacPort.h:
	* mac/tclMacChan.c: fixed TIP#91 bustage.
	* mac/tclMacResource.c (Tcl_MacConvertTextResource): added utf
	conversion of text resource contents.
	* tests/macFCmd.test (macFCmd-1.2): allow CWIE creator.

2002-06-04  Don Porter  <[email protected]>

	* library/tcltest/tcltest.tcl:
	* tests/init.test:
	* tests/tcltest.test:	Added more TIP 85 tests from Arjen Markus.
	Converted tcltest.test to use a private namespace. Fixed bugs in
	[tcltest::Eval] revealed by calling [tcltest::test] from a non-global
	namespace, and namespace errors in init.test.

2002-06-04  Mo DeJong  <[email protected]>

	* win/README: Update msys+mingw URL.

2002-06-03  Don Porter  <[email protected]>

	* doc/tcltest.n:
	* library/tcltest/tcltest.tcl:
	* library/tcltest/pkgIndex.tcl:
	* tests/tcltest.test:  Implementation of TIP 85. Allows tcltest users
	to add new legal values of the -match option to [test], associating
	each with a Tcl command that does the matching of expected results
	with actual results of tests. Thanks to Arjen Markus. => tcltest 2.1
	[Patch 521362]

2002-06-03  Miguel Sofer  <[email protected]>

	* doc/namespace.n: added description of [namepace forget] behaviour
	for unqualified patterns. [Bug 559268]

2002-06-03  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c: reverting an accidental modification in the
	last commit.

2002-06-03  Miguel Sofer  <[email protected]>

	* doc/Tcl.n: clarify the empty variable name issue ([Bug 549285]
	reported by Tom Krehbiel, patch by Don Porter).

2002-05-31  Don Porter  <[email protected]>

	* library/package.tcl:  Fixed leak of slave interp in [pkg_mkIndex].
	Thanks to Helmut for report. [Bug 550534]

	* tests/io.test:
	* tests/main.test:  Use the "stdio" constraint to control whether an
	[open "|[interpreter]"] is attempted.

	* generic/tclExecute.c (TclMathInProgress,TclExecuteByteCode
	(ExprCallMathFunc):
	* generic/tclInt.h (TclMathInProgress):
	* unix/Makefile.in (tclMtherr.*):
	* unix/configure.in (NEED_MATHERR):
	* unix/tclAppInit.c (matherr):
	* unix/tclMtherr.c (removed file):
	* win/tclWinMtherr.c (_matherr): Removed internal routine
	TclMathInProgress and Unix implementation of matherr(). These are now
	obsolete, dealing with very old versions of the C math library.
	Windows version is retained in case Borland compilers require it, but
	it is inactive. Thanks to Joe English. [Bug 474335, Patch 555635]

	* unix/configure: regen

2002-05-30  Miguel Sofer  <[email protected]>

	* generic/tclCompExpr.c:
	* generic/tclCompile.c:
	* generic/tclCompile.h: removed exprIsJustVarRef and
	exprIsComparison from the ExprInfo and CompileEnv structs. These
	were set, but not used since dec 1999 [Bug 562383].

2002-05-30  Vince Darley  <[email protected]>

	* generic/tclFileName.c (TclGlob): fix to longstanding 'knownBug' in
	fileName tests 15.2-15.4, and fix to a new Tcl 8.4 bug in certain uses
	of 'glob -tails'.
	* tests/fileName.test: removed 'knownBug' flag from some tests, added
	some new tests for above bugs.

2002-05-29  Jeff Hobbs  <[email protected]>

	* unix/configure: regen'ed
	* unix/configure.in: replaced bigendian check with autoconf standard
	AC_C_BIG_ENDIAN, which defined WORDS_BIGENDIAN on bigendian systems.
	* generic/tclUtf.c (Tcl_UniCharNcmp):
	* generic/tclInt.h (TclUniCharNcmp): use WORDS_BIGENDIAN instead of
	TCL_OPTIMIZE_UNICODE_COMPARE to enable memcmp alternative.

	* generic/tclExecute.c (TclExecuteByteCode INST_STR_CMP):
	* generic/tclCmdMZ.c (Tcl_StringObjCmd): changed the case for choosing
	the Tcl_UniCharNcmp compare to when both objs are of StringType, as
	benchmarks show that is the optimal check (both bigendian and
	littleendian systems).

2002-05-29  Don Porter  <[email protected]>

	* generic/tclMain.c: Removed "dummy" reference to Tcl_LinkVar. It is
	no longer needed since Tcl_Main() now actually calls Tcl_LinkVar().
	Thanks to Joe English for pointing that out.

2002-05-29  Donal K. Fellows  <[email protected]>

	* generic/tclExecute.c (TclExecuteByteCode):
	* generic/tclCmdMZ.c (Tcl_StringObjCmd): Use the macro version.
	* generic/tclInt.h (TclUniCharNcmp): Optimised still further with a
	macro for use in sensitive places like tclExecute.c

	* generic/tclUtf.c (Tcl_UniCharNcmp): Use new flag to figure out when
	we can use an optimal comparison scheme, and default to the old scheme
	in other cases which is at least safe.
	* unix/configure.in (TCL_OPTIMIZE_UNICODE_COMPARE): New optional flag
	that indicates when we can use memcmp() to compare Unicode strings
	(i.e. when the high-byte of a Tcl_UniChar precedes the low-byte.)

2002-05-29  Jeff Hobbs  <[email protected]>

	* generic/tclInt.decls:
	* generic/tclIntDecls.h:
	* generic/tclStubInit.c:
	* generic/tclUtf.c: added TclpUtfNcmp2 private command that
	mirrors Tcl_UtfNcmp, but takes n in bytes, not utf-8 chars. This
	provides a faster alternative for comparing utf strings	internally.
	(Tcl_UniCharNcmp, Tcl_UniCharNcasecmp): removed the explicit end of
	string check as it wasn't correct for the function (by doc and logic).

	* generic/tclCmdMZ.c (Tcl_StringObjCmd): reworked the string equal
	comparison code to use TclpUtfNcmp2 as well as short-circuit for
	equal objects or unequal length strings in the equal case.
	Removed the use of goto and streamlined the other parts.

	* generic/tclExecute.c (TclExecuteByteCode): added check for object
	equality in the comparison instructions. Added short-circuit for !=
	length strings in INST_EQ, INST_NEQ and INST_STR_CMP. Reworked
	INST_STR_CMP to use TclpUtfNcmp2 where appropriate, and only use
	Tcl_UniCharNcmp when at least one of the objects is a Unicode obj with
	no utf bytes.

	* generic/tclCompCmds.c (TclCompileStringCmd): removed error creation
	in code that no longer throws an error.

	* tests/string.test:
	* tests/stringComp.test: added more string comparison checks.

	* tests/clock.test: better qualified 9.1 constraint check for %s.

2002-05-28  Jeff Hobbs  <[email protected]>

	* generic/tclThreadAlloc.c (TclpRealloc, TclpFree): protect
	against the case when NULL is based.

	* tests/clock.test: added clock-9.1
	* compat/strftime.c:
	* generic/tclClock.c:
	* generic/tclInt.decls:
	* generic/tclIntDecls.h:
	* unix/tclUnixTime.c: fix for Windows msvcrt mem leak caused by using
	an env(TZ) setting trick for in clock format -gmt 1. This also makes
	%s seem to work correctly with -gmt 1 as well as making it a lot
	faster by avoid the env(TZ) hack. TclpStrftime now takes useGMT as an
	arg. [Bug 559376]

2002-05-28  Vince Darley  <[email protected]>

	* generic/tclIOUtil.c: fixes to Tcl_FSLoadFile when called on a file
	inside a vfs. This should avoid leaving temporary files sitting
	around on exit. [Bug 545579]

2002-05-27  Donal K. Fellows  <[email protected]>

	* win/tclWinError.c: Added comment on conversion of
	ERROR_NEGATIVE_SEEK because that is a mapping that really belongs,
	and not a catch-all case.
	* win/tclWinPort.h (EOVERFLOW): Should be either EFBIG or EINVAL
	* generic/tclPosixStr.c (Tcl_ErrnoId, Tcl_ErrnoMsg): EOVERFLOW can
	potentially be a synonym for EINVAL.

2002-05-24  Donal K. Fellows  <[email protected]>

	=== Changes due to TIP#91 ===

	* win/tclWinPort.h: Added declaration of EOVERFLOW.
	* doc/CrtChannel.3: Added documentation of wideSeekProc.
	* generic/tclIOGT.c (TransformSeekProc, TransformWideSeekProc):
	Adapted to use the new channel mechanism.
	* unix/tclUnixChan.c (FileSeekProc, FileWideSeekProc): Renamed
	FileSeekProc to FileWideSeekProc and created new FileSeekProc which
	has the old-style interface and which errors out with EOVERFLOW when
	the returned file position can't fit into the return type (int for
	historical reasons).
	* win/tclWinChan.c (FileSeekProc, FileWideSeekProc): Renamed
	FileSeekProc to FileWideSeekProc and created new FileSeekProc which
	has the old-style interface and which errors out with EOVERFLOW when
	the returned file position can't fit into the return type (int for
	historical reasons).
	* mac/tclMacChan.c (FileSeek): Reverted to old interface; Macs lack
	large-file support because I can't see how to add it.
	* generic/tclIO.c (Tcl_Seek, Tcl_Tell): Given these functions
	knowledge of the new arrangement of channel types.
	(Tcl_ChannelVersion): Added recognition of new version code.
	(HaveVersion): New function to do version checking.
	(Tcl_ChannelBlockModeProc, Tcl_ChannelFlushProc)
	(Tcl_ChannelHandlerProc): Made these functions use HaveVersion for
	ease of future maintainability.
	(Tcl_ChannelBlockModeProc): Obvious lookup function.
	* generic/tcl.h (Tcl_ChannelType): New wideSeekProc field, and
	seekProc type restored to old interpretation.
	(TCL_CHANNEL_VERSION_3): New channel version.

2002-05-24  Andreas Kupries  <[email protected]>

	* tests/winPipe.test: Applied patch for [Bug 549617]. Patch and bug
	report by Kevin Kenny <[email protected]>.

	* win/tclWinSock.c (TcpWatchProc): Fixed [Bug 557878]. We are not
	allowed to mess with the watch mask if the socket is a server socket.
	I believe that the original reporter is George Peter Staplin.

2002-05-21  Mo DeJong  <[email protected]>

	* unix/configure: Regen.
	* unix/configure.in: Invoke SC_ENABLE_SHARED before calling
	SC_CONFIG_CFLAGS so that the SHARED_BUILD variable can be checked
	inside SC_CONFIG_CFLAGS.
	* unix/tcl.m4 (SC_CONFIG_CFLAGS): Pass -non_shared instead of -shared
	to ld when configured with --disable-shared under OSF. [Bug 540390]

2002-05-20  Daniel Steffen  <[email protected]>

	* generic/tclInt.h: added prototype for TclpFilesystemPathType().
	* mac/tclMacChan.c: use MSL provided creator type if available instead
	of the default 'MPW '.

2002-05-16  Joe English  <[email protected]>

	* doc/CrtObjCmd.3: Added Tcl_GetCommandFromObj, Tcl_GetCommandFullName
	[Bugs 547987, 414921]

2002-05-14  Donal K. Fellows  <[email protected]>

	* unix/tclUnixChan.c (TtyOutputProc): #if/#endif-ed this function out
	to stop compiler warnings. Also much general tidying of comments in
	this file and removal of whitespace from blank lines.

2002-05-13  Donal K. Fellows  <[email protected]>

	* unix/tclUnixChan.c (SETBREAK): Solaris thinks ioctl() takes a signed
	second argument, and Linux thinks ioctl() takes an unsigned second
	argument. So need a longer definition of this macro to get neither to
	spew warnings...

2002-05-13  Vince Darley  <[email protected]>

	* generic/tclEvent.c:
	* generic/tclIOUtil.c:
	* generic/tclInt.h: clean up all memory allocated by the filesystem,
	via introduction of 'TclFinalizeFilesystem'.
	Move TclFinalizeLoad into TclFinalizeFilesystem so we can be sure it
	is called at just the right time.
	Fix bad comment also. [Bug 555078 and 'fs' part of 543549]
	* win/tclWinChan.c: fix comment referring to wrong function.

2002-05-10  Don Porter  <[email protected]>

	* tests/load.test:
	* tests/safe.test:
	* tests/tcltest.test: Corrected some list-quoting issues and other
	matters that cause tests to fail when the patch includes special
	characters. Report from Vince Darley. [Bug 554068]

2002-05-08    David Gravereaux <[email protected]>

	* doc/file.n:
	* tools/man2tcl.c:
	* tools/man2help2.tcl:  Thanks to Peter Spjuth
	<[email protected]>, again. My prior fix for single-quote macro
	mis-understanding was wrong. Reverted to reimpliment the 'macro2' proc
	which handles single-quote macros and restored file.n text arrangement
	to avoid single-quotes on the first line. Sorry for all the confusion.

2002-05-08  David Gravereaux <[email protected]>

	* tools/man2tcl.c:
	* tools/man2help2.tcl: Proper source of macro error misunderstanding
	single-quote as the leading macro command found and repaired.

	* doc/file.n: Reverted to prior state before I messed with it.

2002-05-08  Don Porter  <[email protected]>

	* library/tcltest/tcltest.tcl: Corrected [uplevel] quoting when
	[source]-ing test script in subdirectories.
	* tests/fileName.test:
	* tests/load.test:
	* tests/main.test:
	* tests/tcltest.test:
	* tests/unixInit.test: Fixes to test suite when there's a space in the
	working path. Thanks to Kevin Kenny.

2002-05-07  David Gravereaux <[email protected]>

	-- Changes from Peter Spjuth <[email protected]>
	* tools/man2tcl.c: Increased line buffer size and a bail-out if that
	should ever be over-run.
	* tools/man2help.tcl: Include Courier New font in rtf header.
	* tools/man2help2.tcl: Improved handling of CS/CE fields. Use Courier
	New for code samples and indent better.

	* doc/file.n:
	* doc/TraceCmd.3:  winhelp conversion tools where understanding
	a ' as the first character on a line to be an unknown macro.
	Not knowing how to repair tools/man2tcl.c, I decided to rearrange
	the text in the docs instead.

2002-05-07  Vince Darley  <[email protected]>

	* generic/tclFileName.c: fix to similar segfault when using 'glob
	-types nonsense -dir dirname -join * *'. [Bug 553320]

	* doc/FileSystem.3: further documentation on vfs.
	* tests/cmdAH.test:
	* tests/fileSystem.test:
	* tests/pkgMkindex.test: Fix to testsuite bugs when running out of
	directory whose name contains '{' or '['.

2002-05-07  Miguel Sofer  <[email protected]>

	* tests/basic.test: Fix for [Bug 549607]
	* tests/encoding.test: Fix for [Bug 549610]
	These are testsuite bugs that caused failures when the filename
	contained spaces. Report & fix by Kevin Kenny.

2002-05-02  Vince Darley  <[email protected]>

	* generic/tclFileName.c: fix to freeing a bad object (i.e. segfault)
	when using 'glob -types nonsense -dir dirname'.
	* generic/tclWinFile.c: fix to [Bug 551306], also wrapped some long
	lines.
	* tests/fileName.test: added several tests for the above bugs.
	* doc/FileSystem.3: clarified documentation on refCount requirements
	of the object returned by the path type function.
	* generic/tclIOUtil.c:
	* win/tclWinFile.c:
	* unix/tclUnixFile.c:
	* mac/tclMacFile.c: moved TclpFilesystemPathType to the platform-
	specific directories, so we can add missing platform-specific
	implementations. On Windows, 'file system' now returns useful results
	like "native NTFS", "native FAT" for that system. Unix and MacOS still
	only return "native".
	* doc/file.n: clarified documentation.
	* tests/winFile.test: test for 'file system' returning correct values.
	* tests/fileSystem.test: test for 'file system' returning correct
	values. Clean up after failed previous test run.

2002-04-26  Jeff Hobbs  <[email protected]>

	* unix/configure:
	* unix/tcl.m4: change HP-11 SHLIB_LD_LIBS from "" to ${LIBS} so that
	the .sl knows its dependent libs.

2002-04-26  Donal K. Fellows  <[email protected]>

	* tests/obj.test (obj-11.[56]): Test conversion to boolean more
	thoroughly.
	* generic/tclObj.c (SetBooleanFromAny): Was not calling an integer
	parsing function on native 64-bit platforms! [Bug 548686]

2002-04-24  Jeff Hobbs  <[email protected]>

	* generic/tclInt.h: corrected TclRememberJoinableThread decl to use
	VOID instead of void.
	* generic/tclThreadJoin.c: noted that this code isn't needed on Unix.

2002-04-23  Jeff Hobbs  <[email protected]>

	* doc/exec.n:
	* doc/tclvars.n: doc updates [Patch 509426] (gravereaux)

2002-04-24  Daniel Steffen  <[email protected]>

	* mac/tclMacResource.r: added check of TCLTK_NO_LIBRARY_TEXT_RESOURCES
	#define to allow disabling the inclusion of the tcl library code in
	the resource fork of Tcl executables and shared libraries.

2002-04-23  Donal K. Fellows  <[email protected]>

	* doc/TraceCmd.3: New file that documents Tcl_CommandTraceInfo,
	Tcl_TraceCommand and Tcl_UntraceCommand [Bug 414927]

2002-04-22  Jeff Hobbs  <[email protected]>

	* generic/tclAlloc.c:
	* generic/tclInt.h:
	* generic/tclThreadAlloc.c (new):
	* unix/Makefile.in:
	* unix/tclUnixThrd.c:
	* win/Makefile.in:
	* win/tclWinInt.h:
	* win/tclWinThrd.c: added new threaded allocator contributed by AOL
	that significantly reduces lock contention when multiple threads are
	in use. Only Windows and Unix implementations are ready, and the
	Windows one may need work. It is only used by default on Unix for now,
	and requires that USE_THREAD_ALLOC be defined (--enable-threads on
	Unix will define this).

	* generic/tclIOUtil.c (Tcl_FSRegister, Tcl_FSUnregister): corrected
	calling of Tcl_ConditionWait to ensure that there would be a condition
	to wait upon.

	* generic/tclCmdAH.c (Tcl_FileObjCmd): added cast in FILE_SIZE.

	* win/tclWinFCmd.c (DoDeleteFile): check return of setattr API calls
	in file deletion for correct Win32 API handling.

	* win/Makefile.in: correct dependencies for shell, gdb, runtest
	targets.

	* doc/clock.n:
	* compat/strftime.c (_fmt): change strftime to correctly handle
	localized %c, %x and %X on Windows. Added some notes about how the
	other values could be further localized.

2002-04-19  Don Porter  <[email protected]>

	* generic/tclMain.c (Tcl_Main):  Free the memory allocated for the
	startup script path. [Bug 543549]

	* library/msgcat/msgcat.tcl:  [mcmax] wasn't using the caller's
	namespace when determining the max translated length. Also made
	revisions for better use of namespace variables and more efficient
	[uplevel]s.

	* doc/msgcat.n:
	* library/msgcat/msgcat.tcl:
	* library/msgcat/pkgIndex.tcl:  Added [mcload] to the export list of
	msgcat; bumped to 1.2.3. [Bug 544727]

2002-04-20  Daniel Steffen  <[email protected]>

	* generic/tclInt.decls:
	* generic/tclIntPlatDecls.h:
	* generic/tclStubInit.c:
	* mac/tclMacFCmd.c:
	* mac/tclMacFile.c:
	* mac/tclMacUtil.c: Modified TclpObjNormalizePath to be alias file
	aware, and replaced various calls to FSpLocationFrom*Path by calls to
	new alias file aware versions FSpLLocationFrom*Path. The alias file
	aware routines don't resolve the last component of a path if it is an
	alias. This allows [file copy/delete] etc. to act correctly on alias
	files. (c.f. discussion in [Bug 511666])

2002-04-19  Donal K. Fellows  <[email protected]>

	* tests/lindex.test (lindex-3.7):
	* generic/tclUtil.c (TclGetIntForIndex): Stopped indexes from hitting
	wide ints. [Bug 526717]

2002-04-18  Miguel Sofer  <[email protected]>

	* generic/tclNamesp.c:
	* tests/info.test: [Bug 545325] info level didn't report namespace
	eval, bug report by Richard Suchenwirth.

2002-04-18  Don Porter  <[email protected]>

	* doc/subst.n:  Clarified documentation on handling unusual return
	codes during substitution, and on variable substitutions implied by
	command substitution, and vice versa. [Bug 536838]

2002-04-18  Donal K. Fellows  <[email protected]>

	* generic/tclCmdIL.c (InfoBodyCmd):
	* tests/info.test (info-2.6): Proc bodies without string reps would
	report as empty. [Bug 545644]

	* generic/tclCmdMZ.c (Tcl_SubstObj): More clarification for comment on
	behaviour when substitutions are not well-formed, prompted by [Bug
	536831]; alas, removing the ill-defined behaviour is a lot of work.

2002-04-18  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c:
	* tests/expr-old.test: fix for [Bug 542588] (Phil Ehrens), where "too
	large integers" were reported as "floating-point value" in [expr]
	error messages.

2002-04-17  Jeff Hobbs  <[email protected]>

	* generic/tclEncoding.c (EscapeFromUtfProc):
	* generic/tclIO.c (WriteChars, Tcl_Close): corrected the handling of
	outputting end escapes for escape-based encodings.
	[Bug 526524] (yamamoto)

2002-04-17  Don Porter  <[email protected]>

	* doc/tcltest.n:  Removed [saveState] and [restoreState] from tcltest
	2 documentation, effectively deprecating them. [Bug 495660]
	* library/tcltest/tcltest.tcl: Made separate export for commands kept
	only for tcltest 1 compatibility.

	* tests/iogt.test: Revised to run tests in a namespace, rather than
	use the useless and buggy [saveState] and [restoreState] commands of
	tcltest. Updated to use tcltest 2 as well. [Patch 544911]

2002-04-16  Don Porter  <[email protected]>

	* tests/io.test: Revised to run tests in a namespace, rather than use
	the useless and buggy [saveState] and [restoreState] commands of
	tcltest. Updated to use tcltest 2 as well. [Patch 544546]

2002-04-15  Miguel Sofer  <[email protected]>

	* generic/tclProc.c:
	* tests/proc-old.test: Improved stack trace for TCL_BREAK and
	TCL_CONTINUE returns from procs. Patch by Don Porter [Bug 536955].

	* generic/tclExecute.c:
	* tests/compile.test: made bytecodes check for a catch before
	returning; the compiled [return] is otherwise non-catchable. [Bug
	542142] reported by Andreas Kupries.

2002-04-15  Don Porter  <[email protected]>

	* tests/socket.test:  Increased timeout values so that tests have
	time to successfully complete even on slow/busy machines. [Bug 523470]

	* doc/tcltest.n:
	* library/tcltest/tcltest.tcl:
	* tests/tcltest.test:  Revised [tcltest::test] to return errors when
	called with invalid syntax and to accept exactly two arguments as
	documented. Improved error messages. [Bug 497446, Patch 513983]
	***POTENTIAL INCOMPATIBILITY***: Incompatible with previous tcltest
	2.* releases, found only in alpha releases of Tcl 8.4.

2002-04-11  Jeff Hobbs  <[email protected]>

	* generic/tclNotify.c (TclFinalizeNotifier): remove remaining
	unserviced events on finalization.

	* win/tcl.m4: Enabled COFF as well as CV style debug info with
	--enable-symbols to allow Dr. Watson users to see function info. More
	info on debugging levels can be obtained at:
	http://msdn.microsoft.com/library/en-us/dnvc60/html/gendepdebug.asp

	* tests/ioCmd.test: fixed iocmd-8.15 to have mac and unixPc variants.

	* generic/tclParse.c (Tcl_ParseVar): conditionally incr obj refcount
	to prevent possible mem leak.

2002-04-08  Daniel Steffen  <[email protected]>

	* generic/tcl.h: no <sys/types.h> on mac.
	* mac/tclMacFile.c: minor fixes to Vince's changes from 03-24.
	* mac/tclMacOSA.c:
	* mac/tclMacResource.c: added missing Tcl_UtfToExternalDString
	conversions of resource file names.
	* mac/tclMacSock.c (TcpGetOptionProc): fixed bug introduced by Andreas
	on 02-25; changed strcmp's to strncmp's so that option comparison
	behaves like on other platforms.
	* mac/tcltkMacBuildSupport.sea.hqx (CW Pro6 changes): added support to
	allow Tk to hookup C library stderr/stdout to TkConsole.
	* tests/basic.test:
	* tests/cmdAH.test:
	* tests/encoding.test:
	* tests/fileSystem.test:
	* tests/ioCmd.test: fixed tests failing on mac: check for existence of
	[exec], changed some result strings.

2002-04-06  Jeff Hobbs  <[email protected]>

	* unix/tclUnixFCmd.c (Realpath): added a little extra code to
	initialize a realpath arg when compiling in PURIFY mode in order to
	prevent spurious purify warnings. We should really create our own
	realpath implementation, but this will at least quiet purify for now.

2002-04-05  Don Porter  <[email protected]>

	* generic/tclCmdMZ.c (Tcl_SubstObj):
	* tests/subst.test:  Corrected [subst] so that return codes TCL_BREAK
	and TCL_CONTINUE returned by variable substitution have the same
	effect as when those codes are returned by command substitution. [Bug
	536879]

2002-04-03  Jeff Hobbs  <[email protected]>

	* library/tcltest/tcltest.tcl: added getMatchingFiles back (alias to
	GetMatchingFiles), which was a public function in tcltest 1.0.

2002-04-01  Vince Darley  <[email protected]>

	* generic/tclEnv.c:
	* generic/tclIOUtil.c: invalidate filesystem cache when the user
	changes env(HOME). Fixes [Bug 535621]. Also cleaned up some of the
	documentation.
	* tests/fileSystem.test: added test for bug just fixed.

2002-04-01  Kevin Kenny  <[email protected]>

	* win/tclWinTime.c (Tcl_GetTime): made the checks of clock frequency
	more permissive to cope with the fact that Win98SE is observed to
	return 1.19318 in place of 1.193182 for the performance counter
	frequency.

2002-03-29  Jeff Hobbs  <[email protected]>

	* generic/tclCmdMZ.c (Tcl_TraceObjCmd, TraceVarProc)
	(TraceCommandProc, TclTraceCommandObjCmd):  corrected potential
	double-free of traces on variables by flagging in Trace*Proc that it
	will free the var in case the eval wants to delete the var trace as
	well. [Bug 536937] Also converted Tcl_UntraceVar -> Tcl_UntraceVar2
	and Tcl_Eval to Tcl_EvalEx in Trace*Proc for slight efficiency
	improvement.

2002-03-29  Don Porter  <[email protected]>

	* doc/AllowExc.3:
	* generic/tclBasic.c (Tcl_EvalObjv,Tcl_EvalEx,Tcl_EvalObjEx):
	* generic/tclCompile.h (TclCompEvalObj):
	* generic/tclExecute.c (TclCompEvalObj,TclExecuteByteCode):
	* tests/basic.test: Corrected problems with Tcl_AllowExceptions having
	influence over the wrong scope of Tcl_*Eval* calls. Patch from Miguel
	Sofer. Report from Jean-Claude Wippler. [Bug 219181]

2002-03-28  Don Porter  <[email protected]>

	* generic/tclVar.c: Refactored CallTraces to collect repeated handling
	of its returned value into CallTraces itself.

2002-03-28  David Gravereaux <[email protected]>

	* tools/feather.bmp:
	* tools/man2help.tcl:
	* tools/man2help2.tcl:
	* win/makefile.vc: More winhelp target fixups. Added a feather bitmap
	to the non-scrollable area and changed the color to be yellow from a
	plain white. The colors can be whatever we want them to be, but
	thought I would start with something bold. [Bug 527941]

	* doc/SetVar.3:
	* doc/TraceVar.3:
	* doc/UpVar.3:  .AP macro syntax repair.

2002-03-27  David Gravereaux <[email protected]>

	* tools/man2help.tcl:
	* win/makefile.vc:  winhelp target now copies all needed files from
	tools/ to a workarea under $(OUT_DIR) and builds it from there. No
	build cruft is left in tools/ anymore. All paths used in man2help.tcl
	are now relative to where the script is. [Bug 527941]

2002-03-27  David Gravereaux <[email protected]>

	* win/.cvsignore:
	* win/buildall.vc.bat:
	* win/coffbase.txt:
	* win/makefile.vc:
	* win/nmakehlp.c (new):
	* win/rules.vc:  First draft fix for [Bug 527941]. More changes need
	to done to the makehelp target to get to stop leaving build files in
	the tools/ directory. This does not address the syntax errors in the
	man files. Having the contents of tcl.hpj(.in) inside makefile.vc
	allows for version numbers to be replaced with macros.

	The new nmakehlp.c is built by rules.vc in preprocessing and removes
	the need to use tricky shell syntax that wasn't compatible on Win9x
	systems. Clean targets made Win9x complient. This is a first draft
	repair for [Bug 533862].

2002-03-28  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c (Tcl_EvalEx): passing the correct commandSize to
	TclEvalObjvInternal. [Bug 219362], fix by David Knoll.

2002-03-28  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c (Tcl_EvalEx):
	* tests/basic.test: avoid exceptional returns at level 0. [Bug 219181]

2002-03-27  Don Porter  <[email protected]>

	* doc/tcltest.n ([mainThread]):
	* library/tcltest/tcltest.tcl:
	* tests/tcltest.test:  Major code cleanup to deal with whitespace,
	coding conventions, and namespace issues, with several minor bugs
	fixed in the process.

	* tests/main.test: Added missing [after cancel]s.

2002-03-25  Don Porter  <[email protected]>

	* tests/main.test: Removed workarounds for Bug 495977.

	* library/tcltest/tcltest.tcl:  Keep the value of $::auto_path
	unchanged, so that the tcltest package can test code that depends on
	auto-loading. If a testing application needs $::auto_path pruned, it
	should do that itself. [Bug 495726]
	Improve the processing of the -constraints option to [test] so that
	constraint lists can have arbitrary whitespace, and non-lists don't
	blow things up. [Bug 495977]
	Corrected faulty variable initialization. [Bug 534845]

2002-03-25  Miguel Sofer  <[email protected]>

	* doc/CrtTrace.3: small doc correction
	* generic/tclBasic.c (Tcl_DeleteTrace): Allow NULL callback on trace
	deletions. [Bug 534728] (Hemang Lavana)

2002-03-24  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c (Tcl_EvalObjv): replaced obscure, incorrect code
	as described in [Bug 533907] (Don Porter).

2002-03-24  Don Porter  <[email protected]>

	* library/tcltest/tcltest.tcl:  Use [interpreter] to set/query the
	executable currently running the tcltest package. [Bug 454050]

	* library/tcltest/tcltest.tcl:  Allow non-proc commands to be used as
	the customization hooks. [Bug 495662]

2002-03-24  Vince Darley  <[email protected]>

	* generic/tclFilename.c:
	* generic/tclFCmd.c:
	* generic/tclTest.c:
	* generic/tcl.h:
	* generic/tclIOUtil.c:
	* win/tclWinFile.c:
	* win/tclWinFCmd.c:
	* win/tclWinPipe.c:
	* unix/tclUnixFile.c:
	* unix/tclUnixFCmd.c:
	* mac/tclMacFile.c:
	* doc/FileSystem.3:
	* doc/file.n:
	* tests/cmdAH.test:
	* tests/fileName.test:
	* tests/fileSystem.test: (new file)
	* tests/winFCmd.test: fix [Bug 511666] and [Bug 511658], and improved
	documentation of some aspects of the filesystem, particularly
	'Tcl_FSMatchInDirectory' which now might match a single file/directory
	only, and 'file normalize' which wasn't very clear before. Removed
	inconsistency betweens docs and the Tcl_Filesystem structure. Also
	fixed [Bug 523217] and corrected file normalization on Unix so that
	it expands symbolic links. Added some new tests of the filesystem
	code (in the new file 'fileSystem.test'), and some extra tests for
	correct handling of symbolic links. Fix to [Bug 530960] which shows up
	on Win98. Made comparison with ".com" case insensitive in tclWinPipe.c

	***POTENTIAL INCOMPATIBILITY***: But only between alpha releases
	(users of the new Tcl_Filesystem lookup table in Tcl 8.4a4 need to
	handle the new way in which Tcl may call Tcl_FSMatchInDirectory, and
	'file normalize' on unix now behaves correctly). Only known impact is
	with the 'tclvfs' extension.

2002-03-22  Miguel Sofer  <[email protected]>

	* tests/basic.test (basic-46.1): adding test for [Bug 533758], fixed
	earlier today.

2002-03-22  Jeff Hobbs  <[email protected]>

	* win/tclWinInt.h: moved undef of TCL_STORAGE_CLASS. [Bug 478579]

2002-03-22  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c (Tcl_EvalObjEx):
	* generic/tclExecute.c (TclCompEvalObj): fixed the errorInfo for
	return codes other than (TCL_OK, TCL_ERROR) to runLevel 0.[Bug 533758]
	Removed the static RecordTracebackInfo(), as its functionality is
	easily replicated by Tcl_LogCommandInfo. Bug and redundancy noted by
	Don Porter.

2002-03-21  Donal K. Fellows  <[email protected]>

	* doc/expr.n: Improved documentation for ceil and floor. [Bug 530535]

2002-03-20  Don Porter  <[email protected]>

	* doc/SetVar.3:
	* doc/TraceVar.3:
	* doc/UpVar.3:
	* generic/tcl.h (Tcl_VarTraceProc):
	* generic/tcl.decls (Tcl_GetVar2, Tcl_SetVar2, Tcl_TraceVar2,
	(Tcl_UnsetVar2, Tcl_UntraceVar2, Tcl_UpVar2, Tcl_VarTraceInfo2,
	(Tcl_GetVar2Ex, TclSetVar2Ex):
	* generic/tclCmdMZ.c (TraceVarProc):
	* generic/tclEnv.c (EnvTraceProc):
	* generic/tclEvent.c (VwaitVarProc):
	* generic/tclInt.decls (TclLookupVar,TclPrecTraceProc):
	* generic/tclLink.c (LinkTraceProc):
	* generic/tclUtil.c (TclPrecTraceProc):
	* generic/tclVar.c (CallTraces, MakeUpvar, VarErrMsg, TclLookupVar,
	(Tcl_GetVar2, Tcl_SetVar2, Tcl_TraceVar2, Tcl_UnsetVar2,
	(Tcl_UntraceVar2, Tcl_UpVar2, Tcl_VarTraceInfo2, Tcl_GetVar2Ex,
	(TclSetVar2Ex): Updated interfaces of generic/tclVar.c according to
	TIP 27. In particular, the "part2" arguments were CONSTified. [Patch
	532642]
	* generic/tclDecls.h:
	* generic/tclIntDecls.h: make genstubs

2002-03-15  Donal K. Fellows  <[email protected]>

	* tests/compile.test (compile-12.3): Test to detect bug 530320.
	* generic/tclCompile.c (TclCompileTokens): Fixed buffer overrun
	reported in bug 530320.

2002-03-14  Mo DeJong  <[email protected]>

	* win/configure: Regen.
	* win/configure.in: Add configure time test for SEH support in the
	compiler.
	* win/tclWin32Dll.c (ESP, EBP, TclpCheckStackSpace,
	(_except_checkstackspace_handler):
	* win/tclWinChan.c (ESP, EBP, Tcl_MakeFileChannel,
	(_except_makefilechannel_handler):
	* win/tclWinFCmd.c (ESP, EBP, DoRenameFile, DoCopyFile,
	(_except_dorenamefile_handler, _except_docopyfile_handler):
	Implement SEH support under gcc using inline asm. Tcl and Tk should
	now compile with Mingw 1.1. [Patch 525746]

2002-03-14  Mo DeJong  <[email protected]>

	* win/tclWinFCmd.c (DoRenameFile, DoCopyFile): Handle an SEH exception
	with EXCEPTION_EXECUTE_HANDLER instead of restarting the faulting
	instruction with EXCEPTION_CONTINUE_EXECUTION. [Bug 466102] provides
	an example of how restarting could send Tcl into an infinite loop.
	[Patch 525746]

2002-03-11  Mo DeJong  <[email protected]>

	* win/tclWinFCmd.c (DoRenameFile, DoCopyFile, DoDeleteFile,
	(DoRemoveJustDirectory): Make sure we don't pass NULL or "" as a path
	name to Win32 API functions since this was crashing under Windows 98.

2002-03-11  Don Porter  <[email protected]>

	* library/tcltest/tcltest.tcl:
	* library/tcltest/pkgIndex.tcl: Bumped tcltest package to 2.0.2.

2002-03-11  Mo DeJong  <[email protected]>

	* library/tcltest/tcltest.tcl (getMatchingFiles): Pass a proper list
	to foreach to avoid munging a Windows patch like D:\Foo\Bar into
	D:FooBar before the glob.

2002-03-11  Mo DeJong  <[email protected]>

	* generic/tclEncoding.c: Fix typo in comment.
	* generic/tclIO.c (DoReadChars, ReadBytes, ReadChars): Use NULL value
	instead of pointer set to NULL to make things more clear. Reorder
	arguments so that they match the function signatures. Cleanup little
	typos and add more descriptive comment.

2002-03-08  Mo DeJong  <[email protected]>

	* win/README: Update to indicate that Mingw 1.1 is required to build
	Tcl. Add section describing new msys based build process. Update
	Cygwin build instructions so users know where to find Mingw 1.1.

2002-03-08  Jeff Hobbs  <[email protected]>

	* win/tclWinFCmd.c (DoCopyFile): correctly set retval to TCL_OK.

2002-03-07  Mo DeJong  <[email protected]>

	* win/tclWin32Dll.c (TclpCheckStackSpace):
	* win/tclWinFCmd.c (DoRenameFile, DoCopyFile): Replace hard coded
	constants with Win32 symbolic names. Move control flow statements out
	of __try blocks since the documentation indicates it is frowned upon.

2002-03-07  Don Porter  <[email protected]>

	* doc/interp.n:
	* generic/tclInterp.c (Tcl_InterpObjCmd, SlaveObjCmd,
	(SlaveRecursionLimit):
	* generic/tclTest.c:
	* tests/interp.test: Added the [interp recursionlimit] command to
	set/query the recursion limit of an interpreter. Proposal and
	implementation from Stephen Trier. [TIP 87, Patch 522849]

2002-03-06  Donal K. Fellows  <[email protected]>

	* generic/tcl.h, tools/tcl.wse.in, unix/configure.in,
	* unix/tcl.spec, win/README.binary, win/configure.in, README:
	Bumped patchlevel; this might need to change in the future, but it
	will help us distinguish between the CVS version and the most recent
	released version.

2002-03-06  Miguel Sofer  <[email protected]>

	* generic/tclInt.h: for unshared objects, TclDecrRefCount now frees
	the internal rep before the string rep - just like the non-macro
	Tcl_DecrRefCount/TclFreeObj. [Bug 524802]

2002-03-06  Donal K. Fellows  <[email protected]>

	* doc/lsearch.n: Documentation of new features, plus examples.
	* tests/lsearch.test: Tests of new features.
	* generic/tclCmdIL.c (Tcl_LsearchObjCmd): TIP#80 support. See
	http://purl.org/tcl/tip/80 for details.

2002-03-05  Jeff Hobbs  <[email protected]>

	*** 8.4a4 TAGGED FOR RELEASE ***

	* unix/tclUnixChan.c: initial remedy for [Bug 525783] flush problem
	introduced by TIP #35. This may not satisfy true serial channels, but
	it restores the correct flushing of std* channels on exit.

	* unix/README: added --enable-langinfo doc.

	* unix/tcl.spec:
	* tools/tcl.wse.in: fixed URL refs to use www.tcl.tk or SF.

2002-03-04  Jeff Hobbs  <[email protected]>

	* README:
	* mac/README:
	* unix/Makefile.in:
	* unix/README:
	* win/README:
	* win/README.binary: updated to use www.tcl.tk URL.

	* unix/Makefile.in: added older ChangeLogs to dist target.

	* tests/io.test:
	* tests/encoding.test: corrected iso2022 encoding results.
	added encoding-24.*
	* generic/tclEncoding.c (EscapeFromUtfProc): corrected output of
	escape codes as per RFC 1468. [Patch 474358] (taguchi)
	(TclFinalizeEncodingSubsystem): corrected potential double-free
	when encodings were finalized on exit. [Bugs 219314, 524674]

2002-03-01  Jeff Hobbs  <[email protected]>

	* library/encoding/iso2022-jp.enc:
	* library/encoding/iso2022.enc:
	* tools/encoding/iso2022-jp.esc:
	* tools/encoding/iso2022.esc: gave <ESC>$B precedence over <ESC>$@,
	based on comments (point 1) in [Bug 219283] (rfc 1468)

	* tests/encoding.test: added encoding-23.* tests
	* generic/tclIO.c (FilterInputBytes): reset the TCL_ENCODING_START
	flags in the ChannelState when using 'gets'. [Bug 523988]
	Also reduced the value of ENCODING_LINESIZE from 30 to 20 as this
	seems to improve the performance of 'gets' according to tclbench.

2002-02-28  Jeff Hobbs  <[email protected]>

	* generic/tclCmdMZ.c (TraceCommandProc): ensure that TraceCommandInfo
	structure was also deleted when a command was deleted to prevent a
	mem leak.

	* generic/tclBasic.c (Tcl_CreateObjTrace): set tracePtr->flags
	correctly.

	* generic/tclTimer.c (TimerExitProc): remove remaining events in
	tls on thread exit.

2002-02-28  Miguel Sofer  <[email protected]>

	* generic/tclNamesp.c: allow cached fully-qualified namespace names to
	be usable from different namespaces within the same interpreter
	without forcing a new lookup [Patch 458872].

2002-02-28  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c: Replaced a few direct stack accesses with the
	POP_OBJECT() macro [Bug 507181] (Don Porter).

2002-02-27  Don Porter  <[email protected]>

	* doc/GetIndex.3:
	* generic/tcl.decls (Tcl_GetIndexFromObjStruct):
	* generic/tclIndexObj.c (Tcl_GetIndexFromObjStruct):  Revised the
	prototype of the Tcl_GetIndexFromObjStruct to take its struct table as
	a (CONST VOID *) argument, better describing what it is, maintaining
	source compatibility, and adding CONST correctness according to TIP
	27. Thanks to Joe English for an elegant solution. [Bug 520304]

	* generic/tclDecls.h: make genstubs

	* generic/tclMain.c (Tcl_Main,StdinProc):  Corrected some reference
	count management errors on the interactive command Tcl_Obj found by
	Purify. Thanks to Jeff Hobbs for the report and assistance.

2002-02-27  Jeff Hobbs  <[email protected]>

	* generic/tclBasic.c (Tcl_EvalTokensStandard): corrected mem leak in
	error case.

	* generic/tclTest.c (TestStatProc[123]): correct harmless UMRs.

	* generic/tclLink.c (Tcl_LinkVar): correct mem leak in error case.

2002-02-27  Andreas Kupries  <[email protected]>

	* tests/socket.test (2.7): Accepted and applied patch for [Bug 523470]
	provided by Don Porter <[email protected]> to avoid timing
	problems in that test.

	* unix/tclUnixChan.c (TclpOpenFileChannel): Added code to regonize
	"/dev/tty" (by name) and to not handle it as tty / serial line. This
	is the controlling terminal and is special. Setting it into raw mode
	as is done for other tty's is a bad idea. This is a hackish fix for
	expect [Bug 520624]. The fix has limitation: Tcl_MakeFileChannel
	handles tty's specially too, but is unable to recognize /dev/tty as it
	only gets a file descriptor, and no name for it.

2002-02-26  Jeff Hobbs  <[email protected]>

	* generic/tclCmdAH.c (StoreStatData): corrected mem leak.

	* generic/tclCmdMZ.c (Tcl_RegsubObjCmd): prevent obj leak in
	remedial regsub case.

	* generic/tclFileName.c (Tcl_TranslateFileName): decr refcount for
	error case to prevent mem leak.

	* generic/tclVar.c (Tcl_ArrayObjCmd): removed extra obj allocation.

	* unix/tclUnixSock.c (Tcl_GetHostName): added an extra
	gethostbyname check to guard against failure with truncated
	names returned by uname.

	* unix/configure:
	* unix/tcl.m4 (SC_SERIAL_PORT): added sys/modem.h check and defined
	_XOPEN_SOURCE_EXTENDED for HP-11 to get updated header decls.

	* unix/tclUnixChan.c: added Unix implementation of TIP #35, serial
	port support. [Patch 438509] (schroedter)

2002-02-26  Miguel Sofer  <[email protected]>

	* generic/tclCmpCmds.c: (bugfix to the bugfix, hopefully the last)
	Bugfix to the new [for] compiling code: was setting a exceptArray
	parameter using another param which wasn't yet initialised, thus
	filling it with noise.

2002-02-25  Andreas Kupries  <[email protected]>

	* mac/tclMacSock.c (TcpGetOptionProc): Changed to recognize the option
	"-error". Essentially ignores the option, always returning an empty
	string.

2002-02-25  Jeff Hobbs  <[email protected]>

	* doc/Alloc.3:
	* doc/LinkVar.3:
	* doc/ObjectType.3:
	* doc/PkgRequire.3:
	* doc/Preserve.3:
	* doc/TCL_MEM_DEBUG.3: Updated documentation to describe the ckalloc,
	ckfree, ckrealloc, attemptckalloc, and attemptckrealloc macros, and
	to accurately describe when and how they are used. [Bug 497459] (dgp)

	* generic/tclHash.c (AllocArrayEntry, AllocStringEntry):
	Before invoking ckalloc when creating a Tcl_HashEntry,
	check that the amount of memory being allocated is
	at least as large as sizeof(Tcl_HashEntry). The previous
	code was allocating memory regions that were one
	or two bytes short. [Bug 521950] (dejong)

2002-02-25  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c (Tcl_EvalEx): avoiding a buffer overrun
	reported by Joe English, and restoring tcl7.6 behaviour for
	[subst]: badly terminated nested scripts will raise an error
	and not be evaluated. [Bug 495207]

2002-02-25  Don Porter  <[email protected]>

	* unix/tclUnixPort.h: corrected strtoll prototype mismatch on Tru64.
	* compat/strtod.c (strtod): simplified #includes
	* compat/strtol.c (strtol): gather result in a long before returning
	as a long: necessary on platforms where sizeof(int) != sizeof(long).

2002-02-25  Daniel Steffen  <[email protected]>

	* unix/tclLoadDyld.c: updated to use Mac OS X 10.1 dyld APIs that
	have more libdl-like semantics. [Bug 514392]

2002-02-25  Miguel Sofer  <[email protected]>

	* generic/tclCompCmds: fixing a bug in patch dated 2002-02-22, in the
	code for [for] and [while]. Under certain conditions, for long bodies,
	the exception range parameters were badly computed. Tests forthcoming:
	I still can't reproduce the conditions in the testsuite (!), although
	the bug (with assorted segfault or panic!)  can be triggered from the
	console or with the new parse.bench in tclbench.

2002-02-25  Donal K. Fellows  <[email protected]>

	* compat/strtoul.c, compat/strtol.c, compat/strtod.c: Added UCHAR,
	CONST and #includes to clean up GCC output.

2002-02-23  Don Porter  <[email protected]>

	* compat/strtoull.c (strtoull):
	* compat/strtoll.c (strtoll):
	* compat/strtoul.c (strtoul): Fixed failure to handle leading
	sign symbols '+' and '-' and '0X' and raise overflow errors.
	[Bug 440916]  Also corrects prototype and errno problems.

2002-02-23  Mo DeJong  <[email protected]>

	* configure: Regen.
	* unix/tcl.m4 (SC_CONFIG_CFLAGS): Link with -n32 instead of -32 when
	building on IRIX64-6.* system. [Bug 521707]

2002-02-22  Don Porter <[email protected]>

	* generic/tclInt.h:
	* generic/tclObj.c: renamed global variable emptyString ->
	tclEmptyString because it is no longer static.
	* generic/tclPkg.c: Fix for panic when library is loaded on a
	platform without backlinking without proper use of stubs. [Bug 476537]

2002-02-22  Jeff Hobbs  <[email protected]>

	* tests/regexpComp.test: updated regexp-11.[1-4] to match changes in
	regexp.test for new regsub syntax

	* unix/configure:
	* unix/tcl.m4: added --enable-64bit support for AIX-4 (using -q64
	flag) when using IBM's xlc compiler.

	* tests/safe.test: updated safe-8.5 and safe-8.7
	* library/safe.tcl (CheckFileName): removed the limit on
	sourceable file names (was only *.tcl or tclIndex files with no more
	than one dot and 14 chars). There is enough internal protection in a
	safe interpreter already. [Tk Bug 521560]

2002-02-22  Miguel Sofer  <[email protected]>

	* generic/tclCompCmds: [FR 465811]. Optimising [if], [for] and [while]
	for constant conditions; in addition, [for] and [while] are now
	compiled with the "loop rotation" optimisation (thanks to Kevin
	Kenny).

2002-02-22  Donal K. Fellows  <[email protected]>

	--- TIP#76 CHANGES ---
	* generic/tclCmdMZ.c (Tcl_RegsubObjCmd): Final-argument-less
	[regsub] returns the modified string.
	* doc/regsub.n: Updated docs.
	* tests/regexp.test: Updated and added tests.

	* compat/strtoll.c (strtoll):
	* compat/strtoull.c (strtoull):
	* unix/tclUnixPort.h:
	* win/tclWinPort.h: Const-ing 64-bit compatibility declarations. Note
	that the return pointer is non-const because it is entirely legal for
	the functions to be called from somewhere that owns the string being
	passed. Fixes problem reported by Larry Virden.

2002-02-21  David Gravereaux <[email protected]>

	* win/mkd.bat (removed):
	* win/coffbase.txt (new):
	* win/makefile.bc:
	* win/makefile.vc:  Changed the 'setup' target to stop using the
	mkd.bat file and just make the directory right in the rule. Same
	change to makefile.bc. Neither configure.in nor Makefile.in use it.

	coffbase.txt will be the master list for our "prefered base addresses"
	set by the linker. This should improve load-time (NT only) by avoiding
	relocations. Submissions to the list by extension authors are
	encouraged.

	Added a 'tidy' target to compliment 'clean' and 'hose' to remove just
	the outputs. Also removed the $(winlibs) macro as it wasn't being
	used.

	Stuff left to do:
	1) get the winhelp target to stop building in the tools/ directory.
	2) stop using rmd.bat
	3) add more dependacy rules.

	* win/tclAppInit.c:  Reverted back to -r1.6, as the header file change
	to tclPort.h won't allow for easy embedded support outside of the
	source dist. Thanks to Don Porter for pointing this out to me.

2002-02-21  David Gravereaux <[email protected]>

	* win/makefile.vc:
	* win/rules.vc:  Added a new "loimpact" option that sets the
	-ws:aggressive linker option. Off by default. It's said to keep the
	heap use low at the expense of alloc speed.

	* win/tclAppInit.c: Changed #include "tcl.h" to be tclPort.h to remove
	the raw windows.h include. tclPort.h brings in windows.h already and
	lessens the pre-compiled-header mush and the randomly useless #pragma
	comment (lib,...) references throughout the big windows.h tree (as
	observed at high linker warning levels).

2002-02-21  Donal K. Fellows  <[email protected]>

	* generic/tcl.h: Better guessing of LP64/ILP32 architecture, but now
	sensitive to presence of (suitable) <limits.h>

2002-02-20  Don Porter <[email protected]>

	* generic/tcl.decls (Tcl_RegExpRange,Tcl_GetIndexFromObjStruct):
	Overlooked a few source incompatibilities. Now using CONST84.
	* generic/tclDecls.h: make genstubs
	* generic/tcl.h (Tcl_CmdObjTraceProc): silence warning from Sun
	Workshop compiler.

2002-02-20  David Gravereaux <[email protected]>

	* win/buildall.vc.bat:
	* win/makefile.vc:
	* win/rules.vc: General clean-ups. Added compiler and linker tests for
	a) the pentium 0x0F errata, b) optimizing (not all have this), and c)
	linker v6 section alignment confusion. All these are tested first to
	make sure any D4002 or LNK1117 warnings aren't displayed. The pentium
	0x0F errata is a recommended switch. The v5 linker's section alignment
	default is 512, but the v6 linker was changed to 4096 in an attempt to
	speed loading on Win98. I changed the default to always be 512 across
	both linkers, unless linking statically, then 4096 is used for the
	claimed speed effect. Using a 512 alignment saves 12k bytes of dead
	space in the DLL.

	Added IA64 B-stepping errata switch when the compiler supports it.

	Added profiling to $(lflags) when requested and also removed the
	explict -entry option as the default works fine as is.

	Removed win/tclWinInit.c from the special case section to let it use
	the common implicit rule as the $(EXTFLAGS) macro it had was never
	referenced anywhere.

2002-02-20  Donal K. Fellows  <[email protected]>

	* generic/tcl.h: Added code to guess the correct settings for
	TCL_WIDE_INT_IS_LONG and TCL_WIDE_INT_TYPE when configure doesn't tell
	us them, as can happen with extensions.

2002-02-19  Donal K. Fellows  <[email protected]>

	* doc/format.n: Updated docs to list the specification.
	* generic/tclCmdAH.c (Tcl_FormatObjCmd): Made behaviour on 64-bit
	platforms correctly meet the specification, that %d works with the
	native word-sized integer, instead of trying to guess (wrongly)
	from the value being passed.

2002-02-19  Don Porter <[email protected]>

	* changes: First draft of updated changes for 8.4a4 release.

2002-02-15  Jeff Hobbs  <[email protected]>

	* unix/tclUnixPort.h: add strtoll/strtoull declarations for
	platforms that do not define them.

	* generic/tclIndexObj.c (STRING_AT): removed ptrdiff_t cast and
	use of VOID* in default case (GNU-ism).

2002-02-15  Kevin Kenny  <[email protected]>

	* compat/strtoll.c:
	* compat/strtoul.c:
	* compat/strtoull.c:
	* generic/tclIOUtil.c:
	* generic/tclPosixStr.c:
	* generic/tclTest.c:
	* generic/tclTestObj.c:
	* tests/get.test:
	* win/Makefile.vc: Further tweaks to the TIP 72 patch to make it
	compile under VC++.

2002-02-15  Andreas Kupries  <[email protected]>

	* tclExecute.c:
	* tclIOGT.c:
	* tclIndexObj.c: Touchups to the TIP 72 patch to make it compileable
	under Windows again. The changes are not complete, there is one nasty
	regarding _stati64

2002-02-15  Donal K. Fellows  <[email protected]>

	+----------------------+
	| TIP #72 IMPLEMENTED. |
	+----------------------+

	There are a lot of changes from this TIP, so please see
	http://purl.org/tcl/tip/72.html for discussion of
	backward-compatibility issues, but the main ones modifications are in:

	* generic/tcl.h: New types.
	* generic/tcl.decls: New public functions.
	* generic/tclExecute.c: 64-bit aware bytecode engine.
	* generic/tclBinary.c: 64-bit handling in [binary] command.
	* generic/tclScan.c: 64-bit handling in [scan] command.
	* generic/tclCmdAH.c: 64-bit handling in [file] and [format]
	commands.
	* generic/tclBasic.c: New "wordSize" entry in ::tcl_platform.
	* generic/tclFCmd.c: Large-file support (with many consequences.)
	* generic/tclIO.c: Large-file support (with many consequences.)
	* compat/strtoll.c, compat/strtoull.c: New support functions.
	* unix/tcl.m4, unix/configure: 64-bit support and greatly enhanced
	cacheing.

	Most other changes, including all those in doc/* and test/* as well as
	the majority in the platform directories, follow on from these.

	Also coming out of the woodwork:
	* generic/tclIndex.c: Better support for Cray PVP.
	* win/tclWinMtherr.c: Better Borland support.

	Note that, in a number of places through the Unix part of the platform
	support, there are Tcl_Platform* references. These are expanded into
	the correct way to call that particular underlying function, i.e. with
	or without a '64' suffix, and should be used by people working on the
	core in preference to the API functions they overlay so that the code
	remains portable depending on the presence or absence of 64-bit
	support on the underlying platform.

	***POTENTIAL INCOMPATIBILITY***: Extracted from the TIP

	SUMMARY OF INCOMPATIBILITIES AND FIXES
	======================================

	The behaviour of expressions containing constants that appear positive
	but which have a negative internal representation will change, as
	these will now usually be interpreted as wide integers. This is always
	fixable by replacing the constant with int(constant).

	Extensions creating new channel types will need to be altered as
	different types are now in use in those areas. The change to the
	declaration of Tcl_FSStat and Tcl_FSLstat (which are the new preferred
	API in any case) are less serious as no non-alpha releases have been
	made yet with those API functions.

	Scripts that are lax about the use of the l modifier in format and
	scan will probably need to be rewritten. This should be very uncommon
	though as previously it had absolutely no effect.

	Extensions that create new math functions that take more than one
	argument will need to be recompiled (the size of Tcl_Value changes),
	and functions that accept arguments of any type (TCL_EITHER) will need
	to be rewritten to handle wide integer values. (I do not expect this
	to affect many extensions at all.)

2002-02-14  Andreas Kupries  <[email protected]>

	* generic/tclIOCmd.c (Tcl_GetsObjCmd): Trivial fix for [Bug 517503], a
	memory leak reported by Miguel Sofer <[email protected]>. The leak
	happens if an error occurs for "set var [gets $chan]" and leak one
	empty object.

2002-02-12  David Gravereaux <[email protected]>

	* djgpp/ (new directory)
	* djgpp/Makefile (new):
	* unix/tclAppInit.c:
	* unix/tclMtherr.c:
	* unix/tclUnixFCmd.c:
	* unix/tclUnixFile.c:
	* unix/tclUnixInit.c:
	* unix/tclUnixPort.h:  Early stage of DJGPP support for building Tcl
	on DOS. Dynamic loading isn't working, yet. Requires watt32 for the
	TCP/IP stack. No autoconf, yet. Barely tested, but makes a working exe
	that runs Tcl in protected-mode, flat memory. [exec] and pipes will
	need the most work as multi-tasking on DOS has to be carefully.

2002-02-10  Kevin Kenny  <[email protected]>

	* doc/CrtObjCmd.3:
	* doc/CrtTrace.3:
	* generic/tcl.decls:
	* generic/tcl.h:
	* generic/tclBasic.c:
	* generic/tclInt.h:
	* generic/tclTest.c:
	* tests/basic.test: Added Tcl_CreateObjTrace,
	Tcl_GetCommandInfoFromToken and Tcl_SetCommandInfoFromToken.
	(TIPs #32 and #79.)

	* generic/tclDecls.h:
	* generic/tclStubInit.c: Regenerated Stubs tables.

2002-02-08  Jeff Hobbs  <[email protected]>

	* unix/configure:
	* unix/tcl.m4: added -pthread for FreeBSD to EXTRA_CFLAGS and
	LDFLAGS. Also triggered nodots only for FreeBSD-3. Added
	AC_DEFINE(_POSIX_PTHREAD_SEMANTICS) for Solaris.

	* unix/tclUnixPort.h:
	* unix/tclUnixThrd.c: added thread-safe versions of readdir,
	localtime, gmtime and inet_ntoa for threaded build. (jgdavidson)

	* generic/tclScan.c (Tcl_ScanObjCmd): prevented ckfree being called on
	a pointer to NULL.

2002-02-07  Don Porter <[email protected]>

	* doc/DString.3:
	* doc/Encoding.3:
	* doc/GetCwd.3:
	* doc/SplitPath.3:
	* doc/Translate.3:
	* doc/Utf.3:
	* generic/tcl.decls:
	* generic/tcl.h:
	* generic/tclEncoding.c:
	* generic/tclEnv.c:
	* generic/tclFileName.c:
	* generic/tclIOUtil.c:
	* generic/tclUtf.c:
	* generic/tclUtil.c:
	* mac/tclMacInit.c:
	* unix/tclUnixFile.c:
	* unix/tclUnixInit.c:
	* unix/tclUnixPipe.c:
	* win/tclWin32Dll.c:
	* win/tclWinFCmd.c:
	* win/tclWinFile.c:
	* win/tclWinInit.c: Partial TIP 27 rollback. Following routines
	restored to return (char *): Tcl_DStringAppend,
	Tcl_DStringAppendElement, Tcl_JoinPath, Tcl_TranslateFileName,
	Tcl_ExternalToUtfDString, Tcl_UtfToExternalDString,
	Tcl_UniCharToUtfDString, Tcl_GetCwd, Tcl_WinTCharToUtf. Also restored
	Tcl_WinUtfToTChar to return (TCHAR *) and Tcl_UtfToUniCharDString to
	return (Tcl_UniChar *). Modified some callers. This change recognizes
	that Tcl_DStrings are de-facto white-box objects.

	* generic/tclDecls.h:
	* generic/tclPlatDecls.h: make genstubs

	* generic/tclCmdMZ.c: corrected use of C++-style comment.

2002-02-06  Jeff Hobbs  <[email protected]>

	* tests/scan.test:
	* generic/tclScan.c (Tcl_ScanObjCmd): corrected scan 0x... %x handling
	that didn't accept the 0x as a prelude to a base 16 number. [Bug
	495213]

	* generic/tclCompCmds.c (TclCompileRegexpCmd): made early check for
	bad RE to stop checking further.

	* generic/tclCmdMZ.c (Tcl_RegsubObjCmd): added special case to search
	for simple 'string map' style regsub calls. Delayed creation of
	resultPtr object until an initial match is made, as the input string
	object can then be reused for no matches.
	(Tcl_StringObjCmd): optimization improvements to the STR_MAP
	algorithm for zero-length and nocase cases.

	* tests/regexp.test:
	* tests/regexpComp.test: extra code coverage tests.

	* tests/string.test: added 10.18 and 10.19 extra tests.

	* generic/regc_locale.c (casecmp): slight performance improvement.

2002-02-05  Don Porter <[email protected]>

	* library/http/http.tcl:
	* library/http/pkgIndex.tcl:  Corrected use of http::error when
	::error was intended. Bump to http 2.4.2.

2002-02-04  Andreas Kupries  <[email protected]>

	* unix/tclUnixChan.c (FileOutputProc): Fixed [bug 465765] reported by
	Dale Talcott <[email protected]>. Avoid writing
	nothing into a file as STREAM based implementations will consider this
	a EOF (if the file is a pipe). Not done in the generic layer as this
	type of writing is actually useful to check the state of a socket.

	* doc/open.n: Fixed [Bug 511540], added cross-reference to 'pid' as
	the command to use to retrieve the pid of a command pipeline created
	via 'open'.

2002-02-01  Jeff Hobbs  <[email protected]>

	* generic/tclCmdMZ.c (Tcl_RegexpObjCmd): handle quirky about case
	earlier to avoid shimmering problem.

2002-02-01  Andreas Kupries  <[email protected]>

	* tests/io.test: io-39.22 split into two tests, one platform
	dependent, the other not. -eofchar is not empty on the windows
	platform.

2002-02-01  Vince Darley <[email protected]>

	* generic/tclTest.c: fix to picky windows compiler problem with the
	'MainLoop' function declaration.

2002-01-31  Andreas Kupries  <[email protected]>

	* win/tclWinFCmd.c: TIP 27: Applied patch fixing CONST warnings on
	behalf of Don Porter <[email protected]>.

2002-01-30  Don Porter <[email protected]>

	* generic/tcl.decls:
	* generic/tcl.h:
	* generic/tclInt.h: For each interface identified in the TIP 27
	changes below as a POTENTIAL INCOMPATIBILITY, the source of the
	incompatibility has been parameterized so that it can be removed. When
	compiling extension code against the Tcl header files, use the
	compiler flag -DUSE_NON_CONST to remove the irresolvable source
	incompatibilities introduced by the TIP 27 changes. Resolvable changes
	are left for extension authors to resolve.
	* generic/tclDecls.h: make genstubs

2002-01-30  Vince Darley <[email protected]>

	* doc/FileSystem.3: added documentation for 3 public functions which
	had been overlooked. [Bug 507701]
	* unix/mkLinks: make mklinks

2002-01-29  Jeff Hobbs  <[email protected]>

	* tests/regexpComp.test:
	* generic/tclCompCmds.c (TclCompileRegexpCmd): enhanced to support
	-nocase and -- options.

2002-01-28  Mo DeJong  <[email protected]>

	* unix/tcl.m4 (SC_LOAD_TCLCONFIG):
	* win/tcl.m4 (SC_LOAD_TCLCONFIG): Set TCL_LIB_SPEC, TCL_STUB_LIB_SPEC,
	and TCL_STUB_LIB_PATH to the values of TCL_BUILD_LIB_SPEC,
	TCL_BUILD_STUB_LIB_SPEC, and TCL_BUILD_STUB_LIB_PATH when tclConfig.sh
	is loaded from the build directory. A Tcl extension should make use of
	the non-build versions of these variables since they will work in both
	cases. This modification was described in TIP 34.

2002-01-28  Jeff Hobbs  <[email protected]>

	* win/tclWinReg.c (regConnectRegistryProc,RecursiveDeleteKey)
	(DeleteKey,GetKeyNames,GetType,GetValue,OpenSubKey,SetValue):
	redid the CONSTification as previous changes caused failing tests.

	* tests/regexpComp.test (new):
	* generic/tclInt.h:
	* generic/tclBasic.c: added TclCompileRegexpCmd entry
	* generic/tclCompCmds.c (TclCompileStringCmd): corrected to return
	TCL_OUT_LINE_COMPILE instead of TCL_ERROR for parsing errors, so
	it only throws the error for runtime compile, in case the user
	modifies 'string'.
	(TclCompileRegexpCmd): first try at a byte-compiled regexp command. It
	handles static strings and ^$ bounded static strings.
	(TclCompileAppendCmd): made TclPushVarName call always use
	TCL_CREATE_VAR as numWords is always > 2 at that point.

	* generic/tclExecute.c (TclExecuteByteCode:INST_LIST): correct
	possibly dangerous decr in macro call.

	* win/tclWinInit.c (TclpFindVariable): CONSTification touch-up

	* win/tclWinReg.c (OpenSubKey): corrected bug introduced in
	CONSTification that dropped pointer reference.

	* ChangeLog.2000 (new file):
	* ChangeLog: broke changes from 2000 into ChangeLog.2000 to reduce
	size of the main ChangeLog.

2002-01-28  David Gravereaux <[email protected]>

	* generic/tclPlatDecls.h:  Added preprocessor logic to force a
	typedef of TCHAR when __STDC__ is defined when using the uncommon
	-Za compiler switch with the microsoft compiler.

2002-01-27  Don Porter <[email protected]>

	* doc/package.n: Documented global namespace context for script
	evaluation by [package require].

2002-01-27  Daniel Steffen  <[email protected]>

	* generic/tclInt.decls:
	* generic/tclIntPlatDecls.h:
	* mac/tclMacChan.c:
	* mac/tclMacFCmd.c:
	* mac/tclMacFile.c:
	* mac/tclMacInit.c:
	* mac/tclMacLoad.c:
	* mac/tclMacResource.c:
	* mac/tclMacSock.c: TIP 27 CONSTification induced changes

	* tests/event.test:
	* tests/main.test: added catches/constraints to test that
	use features that don't exist on the mac.

2002-01-25  Mo DeJong  <[email protected]>

	Make -eofchar and -translation options read only for server sockets.
	[Bug 496733]

	* generic/tclIO.c (Tcl_GetChannelOption, Tcl_SetChannelOption):
	Instead of returning nothing for the -translation option on a server
	socket, always return "auto". Return the empty string enclosed in
	quotes for the -eofchar option on a server socket. Fixup -eofchar
	usage message so that it matches the implementation.
	* tests/io.test: Add -eofchar tests and -translation tests to ensure
	options are read only on server sockets.
	* tests/socket.test: Update tests to account for -eofchar and
	-translation option changes.

2002-01-25  Don Porter <[email protected]>

	* compat/strstr.c (strstr):
	* generic/tclCmdAH.c (Tcl_FormatObjCmd):
	* generic/tclCmdIL.c (InfoNameOfExecutableCmd):
	* generic/tclEnv.c (ReplaceString):
	* generic/tclFileName.c (ExtractWinRoot):
	* generic/tclIO.c (FlushChannel,Tcl_BadChannelOption):
	* generic/tclStringObj.c (AppendUnicodeToUtfRep):
	* generic/tclThreadTest.c (TclCreateThread):
	* generic/tclUtf.c (Tcl_UtfPrev):
	* mac/tclMacFCmd.c (TclpObjListVolumes):
	* mac/tclMacResource.c (TclMacRegisterResourceFork,
	(BuildResourceForkList):
	* win/tclWinInit.c (AppendEnvironment):  Sought out and eliminated
	instances of CONST-casting that are no longer needed after the
	TIP 27 effort.

	* Following is [Patch 501006]
	* generic/tclInt.decls (Tcl_AddInterpResolvers, Tcl_Export,
	(Tcl_FindNamespace, Tcl_GetInterpResolvers, Tcl_ForgetImport,
	(Tcl_Import, Tcl_RemoveInterpResolvers):
	* generic/tclNamesp.c (Tcl_Export, Tcl_Import, Tcl_ForgetImport,
	(Tcl_FindNamespace):
	* generic/tclResolve.c (Tcl_AddInterpResolvers,Tcl_GetInterpResolvers,
	(Tcl_RemoveInterpResolvers): Updated APIs in generic/tclResolve.c and
	generic/tclNamesp.c according to the guidelines of TIP 27.
	* generic/tclIntDecls.h: make genstubs

	* Following is [Patch 505630]
	* doc/AddErrorInfo.3:
	* generic/tcl.decls (Tcl_LogCommandInfo):
	* generic/tclBasic.c (Tcl_LogCommandInfo): Updated interfaces
	of generic/tclBasic.cc according to TIP 27.
	* generic/tclDecls.h: make genstubs

	* Following is [Patch 506818]
	* doc/Hash.3:
	* generic/tcl.decls (Tcl_HashStats):
	* generic/tclHash.c (Tcl_HashStats):  Updated APIs of generic/tclHash.c
	according to guidelines of TIP 27.
	* generic/tclDecls.h: make genstubs
	* generic/tclVar.c (Tcl_ArrayObjCmd): Updated callers.

	* Following is [Patch 506807]
	* doc/ObjectType.3:
	* generic/tcl.decls (Tcl_GetObjType):
	* generic/tclObj.c (Tcl_GetObjType): Updated APIs of generic/tclObj.c
	according to guidelines of TIP 27.
	* generic/tclDecls.h: make genstubs

	* Following is [Patch 507304]
	* doc/Encoding.3:
	* generic/tcl.decls (Tcl_WinUtfToTChar,Tcl_WinTCharToUtf):
	* win/tclWin32Dll.c (Tcl_WinUtfToTChar,Tcl_WinTCharToUtf):
	Updated interfaces in win/tclWin32Dll.c according to TIP 27.
	* generic/tclPlatDecls.h: make genstubs
	* generic/tclIOUtil.c (TclpNativeToNormalized):
	* win/tclWinFCmd.c (TclpObjNormalizePath):
	* win/tclWinFile.c (TclpFindExecutable,TclpMatchInDirectory,
	(NativeIsExec,NativeStat):
	* win/tclWinLoad.c (TclpLoadFile):
	* win/tclWinPipe.c (TclpOpenFile,ApplicationType):
	* win/tclWinReg.c (regConnectRegistryProc,RecursiveDeleteKey,DeleteKey,
	(GetKeyNames,GetType,GetValue,OpenSubKey,SetValue):
	* win/tclWinSerial.c (SerialSetOptionProc): Update callers.

	* Following is [Patch 505072]
	* doc/Concat.3:
	* doc/Encoding.3:
	* doc/Filesystem.3:
	* doc/Macintosh.3:
	* doc/OpenFileChnl.3
	* doc/SetResult.3:
	* doc/SetVar.3:
	* doc/SplitList.3:
	* doc/SplitPath.3:
	* doc/Translate.3:
	* generic/tcl.h (Tcl_FSMatchInDirectoryProc):
	* generic/tclInt.h (TclpMatchInDirectory):
	* generic/tcl.decls (Tcl_Concat,Tcl_GetStringResult,Tcl_GetVar,
	(Tcl_GetVar2,Tcl_JoinPath,Tcl_Merge,Tcl_OpenCommandChannel,Tcl_SetVar,
	(Tcl_SetVar2,Tcl_SplitList,Tcl_SplitPath,Tcl_TranslateFileName,
	(Tcl_ExternalToUtfDString,Tcl_GetEncodingName,Tcl_UtfToExternalDString,
	(Tcl_GetDefaultEncodingDir,Tcl_SetDefaultEncodingDir,
	(Tcl_FSMatchInDirectory,Tcl_MacEvalResource,Tcl_MacFindResource):
	* generic/tclInt.decls (TclCreatePipeline,TclGetEnv,TclpGetCwd,
	(TclpCreateProcess):
	* mac/tclMacFile.c (TclpGetCwd):
	* generic/tclEncoding.c (Tcl_GetDefaultEncodingDir,
	(Tcl_SetDefaultEncodingDir,Tcl_GetEncodingName,
	(Tcl_ExternalToUtfDString,Tcl_UtfToExternalDString, OpenEncodingFile,
	(LoadEscapeEncoding):
	* generic/tclFileName.c (DoTildeSubst,Tcl_JoinPath,Tcl_SplitPath,
	(Tcl_TranslateFileName):
	* generic/tclIOUtil.c (Tcl_FSMatchInDirectory):
	* generic/tclPipe.c (FileForRedirect,TclCreatePipeline,
	(Tcl_OpenCommandChannel):
	* generic/tclResult.c (Tcl_GetStringResult):
	* generic/tclUtil.c (Tcl_Concat,Tcl_SplitList,Tcl_Merge):
	* generic/tclVar.c (Tcl_GetVar,Tcl_GetVar2,Tcl_SetVar,Tcl_SetVar2):
	* mac/tclMacResource.c (Tcl_MacEvalResource,Tcl_MacFindResource):
	Updated interfaces of generic/tclEncoding, generic/tclFilename.c,
	generic/tclIOUtil.c, generic/tclPipe.c, generic/tclResult.c,
	generic/tclUtil.c, generic/tclVar.c and mac/tclMacResource.c according
	to TIP 27. Tcl_TranslateFileName rewritten as wrapper around VFS-aware
	version.
	***POTENTIAL INCOMPATIBILITY***
	Includes source incompatibilities: argv arguments of Tcl_Concat,
	Tcl_JoinPath, Tcl_OpenCommandChannel, Tcl_Merge; argvPtr arguments of
	Tcl_SplitList and Tcl_SplitPath.
	* generic/tclDecls.h:
	* generic/tclIntDecls.h: make genstubs

	* generic/tclCkalloc.c (MemoryCmd):
	* generic/tclClock.c (FormatClock):
	* generic/tclCmdAH.c (Tcl_CaseObjCmd,Tcl_EncodingObjCmd,Tcl_FileObjCmd):
	* generic/tclCmdIL.c (InfoLibraryCmd,InfoPatchLevelCmd,
	(InfoTclVersionCmd):
	* generic/tclCompCmds.c (TclCompileForeachCmd):
	* generic/tclCompCmds.h (TclCompileForeachCmd):
	* generic/tclCompile.c (TclFindCompiledLocal):
	* generic/tclEnv.c (TclSetupEnv,TclSetEnv,Tcl_PutEnv,TclGetEnv,
	(EnvTraceProc):
	* generic/tclEvent.c (Tcl_BackgroundError):
	* generic/tclIO.c (Tcl_BadChannelOption,Tcl_SetChannelOption):
	* generic/tclIOCmd.c (Tcl_ExecObjCmd,Tcl_OpenObjCmd):
	* generic/tclIOSock.c (TclSockGetPort):
	* generic/tclIOUtil.c (SetFsPathFromAny):
	* generic/tclLink.c (LinkTraceProc):
	* generic/tclMain.c (Tcl_Main):
	* generic/tclNamesp.c (TclTeardownNamespace):
	* generic/tclProc.c (TclCreateProc):
	* generic/tclTest.c (TestregexpObjCmd,TesttranslatefilenameCmd,
	(TestchmodCmd,GetTimesCmd,TestsetCmd,TestOpenFileChannelProc1,
	(TestOpenFileChannelProc2,TestOpenFileChannelProc3,AsyncHandlerProc,
	(TestpanicCmd):
	* generic/tclThreadTest.c (ThreadErrorProc,ThreadEventProc):
	* generic/tclUtil.c (TclPrecTraceProc):
	* mac/tclMacFCmd.c (GetFileSpecs):
	* mac/tclMacFile.c (TclpMatchInDirectory):
	* mac/tclMacInit.c (TclpInitLibraryPath,Tcl_SourceRCFile):
	* mac/tclMacOSA.c (tclOSAStore,tclOSALoad):
	* mac/tclMacResource.c (Tcl_MacEvalResource):
	* unix/tclUnixFCmd.c (TclpObjNormalizePath):
	* unix/tclUnixFile.c (TclpMatchInDirectory,TclpGetUserHome,TclpGetCwd,
	(TclpReadLink):
	* unix/tclUnixInit.c (TclpInitLibraryPath,TclpSetVariables,
	(Tcl_SourceRCFile):
	* unix/tclUnixPipe.c (TclpOpenFile,TclpCreateTempFile,
	(TclpCreateProcess):
	* win/tclWinFile.c (TclpGetCwd,TclpMatchInDirectory):
	* win/tclWinInit.c (TclpInitLibraryPath,Tcl_SourceRCFile,
	(TclpSetVariables):
	* win/tclWinPipe.c (TclpCreateProcess): Updated callers.

2002-01-24  Don Porter <[email protected]>

	* generic/tclIOUtil.c (SetFsPathFromAny):  Corrected tilde-substitution
	of pathnames where > 1 separator follows the ~. [Bug 504950]

2002-01-24  Jeff Hobbs  <[email protected]>

	* library/http/pkgIndex.tcl:
	* library/http/http.tcl: don't add port in default case to handle
	broken servers. http bumped to 2.4.1  [Bug 504508]

2002-01-23  Andreas Kupries  <[email protected]>

	* unix/mkLinks: Regenerated.
	* doc/CrtChannel.3:
	* doc/ChnlStack.3: Moved documentation for 'Tcl_GetTopChannel' from
	'CrtChannel' to 'ChnlStack'. Added documentation of
	'Tcl_GetStackedChannel'. [Bug 506147] reported by Mark Patton
	<[email protected]>.

2002-01-23  Don Porter <[email protected]>

	* win/tclWinFile.c (NativeAccess,NativeStat,NativeIsExec,
	(TclpGetUserHome):
	* win/tclWinPort.h (TclWinSerialReopen):
	* win/tclWinSerial.c (TclWinSerialReopen):
	* win/tclWinSock.c (Tcl_OpenTcpServer):  Corrections to earlier TIP 27
	changes. Thanks to Andreas Kupries for the feedback.
	* generic/tclPlatDecls.h: make genstubs

	* doc/GetHostName.3:
	* doc/GetOpnFl.3:
	* doc/OpenTcp.3:
	* tcl.decls (Tcl_GetHostName,Tcl_GetOpenFile,Tcl_OpenTcpClient,
	(Tcl_OpenTclServer):
	* mac/tclMacSock.c (CreateSocket,Tcl_OpenTcpClient,Tcl_OpenTcpServer,
	(Tcl_GetHostName,GetHostFromString):
	* unix/tclUnixChan.c (CreateSocket,CreateSocketAddress,
	(Tcl_OpenTcpClient,Tcl_OpenTcpServer,Tcl_GetOpenFile):
	* unix/tclUnixSock.c (Tcl_GetHostName):
	* win/tclWinSock.c (CreateSocket,CreateSocketAddress,
	(Tcl_OpenTcpClient,Tcl_OpenTcpServer,Tcl_GetHostName):
	Updated socket interfaces according to TIP 27.
	* generic/tclCmdIL.c (InfoHostnameCmd): Updated callers.
	* generic/tclDecls.h: make genstubs

2002-01-21  David Gravereaux <[email protected]>

	* generic/tclLoadNone.c: TclpLoadFile() didn't match proto of typedef
	Tcl_FSLoadFileProc. OK'd by vincentdarley. [Patch 502488]

2002-01-21  Andreas Kupries  <[email protected]>

	* generic/tclIO.c (WriteChars): Fix for [Bug 506297], reported by
	Martin Forssen <[email protected]>. The encoding chosen in
	the script exposing the bug writes out three intro characters when
	TCL_ENCODING_START is set, but does not consume any input as
	TCL_ENCODING_END is cleared. As some output was generated the
	enclosing loop calls UtfToExternal again, again with START set. Three
	more characters in the out and still no use of input ... To break this
	infinite loop we remove TCL_ENCODING_START from the set of flags after
	the first call (no condition is required, the later calls remove an
	unset flag, which is a no-op). This causes the subsequent calls to
	UtfToExternal to consume and convert the actual input.

2002-01-21  Don Porter <[email protected]>

	* generic/tclTest.c: Converted declarations of TestReport file system
	to more portable form. [Bug 501417]

	* generic/tcl.decls (Tcl_TraceCommand,Tcl_UntraceCommand,
	(Tcl_CommandTraceInfo):
	* generic/tclCmdMZ.c (Tcl_TraceCommand,Tcl_UntraceCommand,
	(Tcl_CommandTraceInfo): Updated APIs in generic/tclCmdMZ.c according
	to the guidelines of TIP 27.
	* generic/tclDecls.h: make genstubs

2002-01-18  Don Porter <[email protected]>

	* win/tclWinChan.c:
	* win/tclWinFCmd.c:
	* win/tclWinFile.c: Overlooked callers of Tcl_FSGetNativePath

	* win/tclWinDde.c:
	* win/tclWinReg.c: Overlooked callers of Tcl_GetIndexFromObj

2002-01-18  Daniel Steffen  <[email protected]>

	* generic/tclThreadTest.c:
	* mac/tclMacChan.c:
	* mac/tclMacFCmd.c:
	* mac/tclMacFile.c:
	* mac/tclMacLoad.c:
	* mac/tclMacResource.c: TIP 27 CONSTification broke the mac build in a
	number of places.

2002-01-17  Andreas Kupries  <[email protected]>

	* generic/tclIOCmd.c (Tcl_GetsObjCmd): Fixed [Bug 504642] as reported
	by Brian Griffin <[email protected]>, using his
	patch. Before the patch the generic I/O layer held an unannounced
	reference to the interp result to store the read line into. This
	unfortunately has disastrous results if the channel driver executes a
	tcl script to perform its operation, this freeing the interp
	result. In that case we are dereferencing essentially a dangling
	reference. It is not truly dangling because the object is in the free
	list, but this only causes us to smash the free list and have the
	error occur later somewhere else. The patch simply creates a new
	object for the line and later sets it into the interp result when we
	are done with reading.

2002-01-16  Mo DeJong  <[email protected]>

	* unix/tcl.m4 (SC_LOAD_TCLCONFIG):
	* win/tcl.m4 (SC_LOAD_TCLCONFIG): Subst TCL_DBGX into
	TCL_STUB_LIB_FILE and TCL_STUB_LIB_FLAG variables so that an extension
	does not need to subst TCL_DBGX into its makefile. [Tk Bug 504356]

2002-01-16  Don Porter <[email protected]>

	* doc/FileSystem.3:
	* doc/GetCwd.3:
	* doc/GetIndex.3:
	* generic/tcl.decls (Tcl_GetIndexFromObj, Tcl_GetIndexFromObjStruct,
	(Tcl_GetCwd, Tcl_FSFileAttrStrings, Tcl_FSGetNativePath,
	(Tcl_FSGetTranslatedStringPath):
	* generic/tcl.h (Tcl_FSFileAttrStringsProc):
	* generic/tclFCmd.c (TclFileAttrsCmd):
	* generic/tclIOUtil.c (Tcl_GetCwd,NativeFileAttrStrings,
	(Tcl_FSFileAttrStrings,Tcl_FSGetTranslatedStringPath,
	(Tcl_FSGetNativePath):
	* generic/tclIndexObj.c (Tcl_GetIndexFromObj,
	(Tcl_GetIndexFromObjStruct):
	More TIP 27 updates in tclIOUtil.c and tclIndexObj.c that were
	overlooked before. [Patch 504671]
	***POTENTIAL INCOMPATIBILITY***
	Includes a source incompatibility in the tablePtr arguments of the
	Tcl_GetIndexFromObj* routines.
	* generic/tclDecls.h: make genstubs

	* generic/tclBinary.c (Tcl_BinaryObjCmd):
	* generic/tclClock.c (Tcl_ClockObjCmd):
	* generic/tclCmdAH.c (Tcl_EncodingObjCmd, Tcl_FileObjCmd):
	* generic/tclCmdIL.c (Tcl_InfoObjCmd,Tcl_LsearchObjCmd,Tcl_LsortObjCmd):
	* generic/tclCmdMZ.c (Tcl_TraceObjCmd,Tcl_RegexpObjCmd,Tcl_RegsubObjCmd,
	(Tcl_StringObjCmd,Tcl_SubstObjCmd,Tcl_SwitchObjCmd,
	(TclTraceCommandObjCmd,TclTraceVariableObjCmd):
	* generic/tclCompCmds.c (TclCompileStringCmd):
	* generic/tclEvent.c (Tcl_UpdateObjCmd):
	* generic/tclFileName.c (Tcl_GlobObjCmd):
	* generic/tclIO.c (Tcl_FileEventObjCmd):
	* generic/tclIOCmd.c (Tcl_SeekObjCmd,Tcl_ExecObjCmd,Tcl_SocketObjCmd,
	(Tcl_FcopyObjCmd):
	* generic/tclInterp.c (Tcl_InterpObjCmd,SlaveObjCmd):
	* generic/tclNamesp.c (Tcl_NamespaceObjCmd):
	* generic/tclPkg.c (Tcl_PackageObjCmd):
	* generic/tclTest.c (Tcltest_Init,TestencodingObjCmd,TestgetplatformCmd,
	(TestlocaleCmd,TestregexpObjCmd,TestsaveresultCmd,
	(TestGetIndexFromObjStructObjCmd,TestReportFileAttrStrings):
	* generic/tclTestObj.c (TestindexObjCmd,TeststringObjCmd):
	* generic/tclTimer.c (Tcl_AfterObjCmd):
	* generic/tclVar.c (Tcl_ArrayObjCmd):
	* mac/tclMacFCmd.c (SetFileFinderAttributes):
	* unix/tclUnixChan.c (TclpOpenFileChannel):
	* unix/tclUnixFCmd.c (tclpFileAttrStrings):
	* unix/tclUnixFile.c (TclpObjAccess,TclpObjChdir,TclpObjStat,
	(TclpObjLstat):
	* win/tclWinFCmd.c (tclpFileAttrStrings): Updated callers.

	* doc/RegExp.3:
	* doc/Utf.3:
	* generic/tcl.decls:
	* generic/tclInt.decls:
	* generic/tclRegexp.c:
	* generic/tclUtf.c:  Updated APIs in generic/tclUtf.c and
	generic/tclRegexp.c according to the guidelines of TIP 27.
	[Patch 471509]

	* generic/regc_locale.c (element,cclass):
	* generic/tclCmdMZ.c (Tcl_StringObjCmd):
	* generic/tclFileName.c (TclpGetNativePathType,SplitMacPath):
	* generic/tclIO.c (ReadChars):
	* mac/tclMacLoad.c (TclpLoadFile):
	* win/tclWinFile.c (TclpGetUserHome): Updated callers.

	* generic/tclDecls.h:
	* generic/tclIntDecls.h: make genstubs

	* doc/ParseCmd.3 (Tcl_ParseVar):
	* generic/tcl.decls (Tcl_ParseVar):
	* generic/tclParse.c (Tcl_ParseVar):
	* generic/tclTest.c (TestparsevarObjCmd): Updated APIs in
	generic/tclParse.c according to the guidelines of TIP 27. Updated
	callers. [Patch 501046]
	* generic/tclDecls.h: make genstubs

	* generic/tcl.decls (Tcl_RecordAndEval):
	* generic/tclDecls.h: make genstubs
	* generic/tclHistory.c (Tcl_RecordAndEval): Updated APIs in
	generic/tclHistory.c according to the guidelines of TIP 27.
	[Patch 504091]

	* doc/CrtSlave.3:
	* generic/tcl.decls (Tcl_CreateAlias, Tcl_CreateAliasObj,
	(Tcl_CreateSlave, Tcl_GetAlias, Tcl_GetAliasObj, Tcl_GetSlave):
	* generic/tclInterp.c (Tcl_CreateAlias, Tcl_CreateAliasObj,
	(Tcl_CreateSlave, Tcl_GetAlias, Tcl_GetAliasObj, Tcl_GetSlave):
	Updated APIs in the file generic/tclInterp.c according to the
	guidelines of TIP 27. [Patch 501371]
	***POTENTIAL INCOMPATIBILITY***
	Includes a source incompatibility in the targetCmdPtr arguments of the
	Tcl_GetAlias* routines.

	* generic/tclDecls.h: make genstubs

2002-01-15  Don Porter <[email protected]>

	* doc/SetErrno.3 (Tcl_ErrnoMsg): Corrected documentation for
	Tcl_ErrnoMsg; it takes an integer argument. Thanks to Georgios
	Petasis. [Bug 468183]

	* doc/AddErrInfo.3 (Tcl_PosixError):
	* doc/Eval.3 (Tcl_EvalFile):
	* doc/FileSystem.c (Tcl_FSOpenFileChannel,Tcl_FSOpenFileChannelProc):
	* doc/OpenFileChnl.3 (Tcl_OpenFileChannel):
	* doc/SetErrno.3 (Tcl_ErrnoId,Tcl_ErrnoMsg):
	* doc/Signal.3 (Tcl_SignalId,Tcl_SignalMsg):
	* generic/tcl.decls (Tcl_ErrnoId,TclErrnoMsg,Tcl_EvalFile,
	(Tcl_OpenFileChannel,Tcl_PosixError,Tcl_SignalId,Tcl_SignalMsg,
	(Tcl_FSOpenFileChannel):
	* generic/tcl.h (Tcl_FSOpenFileChannelProc):
	* generic/tclIO.c (FlushChannel):
	* generic/tclIOUtil.c (Tcl_OpenFileChannel,Tcl_EvalFile,TclGetOpenMode,
	(Tcl_PosixError,Tcl_FSOpenFileChannel):
	* generic/tclInt.decls (TclGetOpenMode):
	* generic/tclInt.h (TclOpenFileChannelProc_,TclGetOpenMode,
	(TclpOpenFileChannel):
	* generic/tclPipe.c (TclCleanupChildren):
	* generic/tclPosixStr.c (Tcl_ErrnoId,Tcl_ErrnoMsg,Tcl_SignalId,
	(Tcl_SignalMsg):
	* generic.tclTest.c (PretendTclpOpenFileChannel,
	(TestOpenFileChannelProc1,TestOpenFileChannelProc2,
	(TestOpenFileChannelProc3,TestReportOpenFileChannel):
	* mac/tclMacChan.c (TclpOpenFileChannel):
	* unix/tclUnixChan.c (TclpOpenFileChannel):
	* win/tclWinChan.c (TclpOpenFileChannel): Updated APIs in
	generic/tclIOUtil.c and generic/tclPosixStr.c according to the
	guidelines of TIP 27. Updated callers. [Patch 499196]

	* generic/tclDecls.h:
	* generic/tclIntDecls.h: make genstubs

	* doc/CrtChannel.3:
	* doc/OpenFileChnl.3:
	* generic/tcl.decls:
	* generic/tclIO.h:
	* generic/tclIO.c (DoWrite, Tcl_RegisterChannel, Tcl_GetChannel,
	(Tcl_CreateChannel, Tcl_GetChannelName, CloseChannel, Tcl_Write,
	(Tcl_WriteRaw, Tcl_Ungets, Tcl_BadChannelOption, Tcl_GetChannelOption,
	(Tcl_SetChannelOption, Tcl_GetChannelNamesEx, Tcl_ChannelName):
	Updated APIs in the file generic/tclIO.c according to the guidelines
	of TIP 27. Several minor documentation corrections as well.
	[Patch 503565]
	* generic/tclDecls.h: make genstubs

	* generic/tcl.h (Tcl_DriverOutputProc, Tcl_DriverGetOptionProc,
	(Tcl_DriverSetOptionProc):
	* generic/tclIOGT.c (TransformOutputProc, TransformGetOptionProc,
	(TransformSetOptionProc):
	* mac/tclMacChan.c (FileOutput, StdIOOutput):
	* man/tclMacSock.c (TcpGetOptionProc, TcpOutput):
	* unix/tclUnixChan.c (FileOutputProc, TcpGetOptionProc, TcpOutputProc,
	(TtyGetOptionProc, TtySetOptionProc):
	* unix/tclUnixPipe.c (PipeOuputProc):
	* win/tclWinChan.c (FileOutputProc):
	* win/tclWinConsole.c (ConsleOutputProc):
	* win/tclWinPipe.c (PipeOuputProc):
	* win/tclWinSerial.c (SerialOutputProc, SerialGetOptionProc,
	(SerialSetOptionProc):
	* win/tclWinSock.c (TcpGetOptionProc, TcpOutput): Updated channel
	driver interface according to the guidelines of TIP 27. See also
	[Bug 500348].

	* doc/CrtChannel.3:
	* generic/tcl.h:
	* generic/tclIO.c:
	* generic/tclIO.h:
	* generic/tclInt.h:
	* tools/checkLibraryDoc.tcl:
	Moved Tcl_EolTranslation enum declaration from generic/tcl.h to
	generic/tclInt.h (renamed to TclEolTranslation). It is not used
	anywhere in Tcl's public interface.

2002-01-14  Don Porter <[email protected]>

	* doc/GetIndex.3:
	* doc/WrongNumArgs.3:
	* generic/tcl.decls (Tcl_GetIndexFromObj, Tcl_GetIndexFromObjStruct,
	(Tcl_WrongNumArgs):
	* generic/tclIndexObj.c (Tcl_GetIndexFromObj,Tcl_GetIndexFromObjStruct,
	(Tcl_WrongNumArgs): Updated APIs in the file generic/tclIndexObj.c
	according to the guidelines of TIP 27. [Patch 501491]
	* generic/tclDecls.h: make genstubs

2002-01-11  Mo DeJong  <[email protected]>

	* unix/configure: Regen.
	* unix/configure.in:
	* win/configure: Regen.
	* win/configure.in: Use ${libdir} instead of ${exec_prefix}/lib
	to properly support the --libdir option to configure. [Bug 489370]

2002-01-11  Andreas Kupries  <[email protected]>

	* win/tclWinSerial.c (SerialSetOptionProc): Applied patch for [Bug
	500348] supplied by Rolf Schroedter <[email protected]>. The
	function modified the contents of the the 'value' string and now does
	not do this anymore. This is a followup to the change made on
	2001-12-17.

2002-01-11  David Gravereaux <[email protected]>

	* win/makefile.vc: Removed -GD compiler option. It was intended for
	future use, but MS is again changing the future at their whim. The
	D4002 warning was harmless though, but someone using VC .NET logged it
	as a concern. [Bug 501565]

2002-01-11  Mo DeJong  <[email protected]>

	* unix/Makefile.in: Burn Tcl build directory into tcltest executable
	to avoid crashes caused by ld loading a previously installed version
	of the tcl shared library. [Bug 218110]

2002-01-10  Don Porter <[email protected]>,
	Kevin Kenny <[email protected]>

	* unix/tclLoadDld.c (TclpLoadFile):  syntax error: unbalanced parens.
	Kevin notes that it's far from clear that this file is ever included
	in an actual build; Linux without dlopen appears to be a nonexistent
	configuration.

2002-01-08  Don Porter <[email protected]>,
	Kevin Kenny <[email protected]>

	* doc/StaticPkg.3 (Tcl_StaticPackage):
	* generic/tcl.decls (Tcl_StaticPackage):
	* generic/tclDecls.h (Tcl_StaticPackage):
	* generic/tclInt.decls (TclGuessPackageName):
	* generic/tclInt.h (TclGuessPackageName):
	* generic/tclLoad.c (Tcl_StaticPackage):
	* generic/tclLoadNone.c (TclGuessPackageName):
	* mac/tclMacLoad.c (TclGuessPackageName):
	* unix/tclLoadAout.c (TclGuessPackageName):
	* unix/tclLoadDl.c (TclGuessPackageName):
	* unix/tclLoadDld.c (TclGuessPackageName):
	* unix/tclLoadDyld.c (TclGuessPackageName):
	* unix/tclLoadNext.c (TclGuessPackageName):
	* unix/tclLoadOSF.c (TclGuessPackageName):
	* unix/tclLoadShl.c (TclGuessPackageName):
	* win/tclWinLoad.c (TclGuessPackageName):  Updated APIs in the files
	*/tcl*Load*.c according to the guidelines of TIP 27. [Patch 501096]

2002-01-09  Don Porter <[email protected]>

	* generic/tclTest.c (MainLoop):
	* tests/main.test (Tcl_Main-1.{3,4,5,6}):  Corrected some non-portable
	tests from the new Tcl_Main changes. Thanks to Kevin Kenny.

2002-01-07  Don Porter <[email protected]>

	* generic/tclEvent.c (TclInExit):
	* generic/tclIOUtil.c (SetFsPathFromAbsoluteNormalized,
	(SetFsPathFromAny,Tcl_FSNewNativePath,DupFsPathInternalRep):
	* generic/tclListObj.c (TclLsetList,TclLsetFlat):  Added some type
	casts to satisfy picky compilers.

	* generic/tclMain.c:  Bug fix: neglected the NULL case in
	TclGetStartupScriptFileName(). Broke Tk/wish.

2002-01-05  Don Porter <[email protected]>

	* doc/Tcl_Main.3:
	* generic/tclMain.c:  Substantial rewrite and expanded documentation
	of Tcl_Main to correct a number of bugs and flaws:

	  - Interactive Tcl_Main can now enter a main loop, exit that loop and
	    continue interactive operations. The loop may even exit in the
	    midst of interactive command typing without loss of the partial
	    command. [Bugs 486453, 474131]
	  - Tcl_Main now gracefully handles deletion of its master
	    interpreter.
	  - Interactive Tcl_Main can now operate with non-blocking stdin
	  - Interactive Tcl_Main can now detect EOF on stdin even in
	    mid-command. [Bug 491341]
	  - Added VFS-aware internal routines for managing the startup script
	    selection.
	  - Tcl variable 'tcl_interactive' is now linked to C variable 'tty'
	    so that one can disable/enable interactive prompts at the script
	    level when there is no startup script. This is meant for use by
	    the test suite.
	  - Consistent use of the Tcl libraries standard channels as returned
	    by Tcl_GetStdChannel(); as opposed to the channels named 'stdin',
	    'stdout', and 'stderr' in the master interp, which can be
	    different or unavailable.
	  - Tcl_Main now calls Tcl_Exit() if evaluation of [exit] in the
	    master interpreter returns, assuring Tcl_Main does not return.
	  - Documented Tcl_Main's absence from public stub table
	  - Documented that Tcl_Main does not return.
	  - Documented Tcl variables set by Tcl_Main.
	  - All prompts are done from a single procedure, Prompt.
	  - Use of Tcl_Obj-enabled interfaces everywhere.

	* generic/tclInt.decls (TclGetStartupScriptPath,
	(TclSetStartupScriptPath): New internal VFS-aware routines for
	managing the startup script of Tcl_Main.
	* generic/tclIntDecls.h:
	* generic/tclStubInit.c: make genstubs

	* generic/tclTest.c (TestsetmainloopCmd,TestexitmainloopCmd,
	(Tcltest_Init,TestinterpdeleteCmd):
	* tests/main.test (new):  Added new file to test suite that thoroughly
	tests generic/tclMain.c; added some new test commands for testing
	Tcl_SetMainLoop().

2002-01-04  Don Porter <[email protected]>

	* doc/Alloc.3:
	* doc/Concat.3:
	* doc/CrtMathFnc.3:
	* doc/Hash.3:
	* doc/Interp.3:
	* doc/LinkVar.3:
	* doc/ObjectType.3:
	* doc/PkgRequire.3:
	* doc/Preserve.3:
	* doc/SetResult.3:
	* doc/SplitList.3:
	* doc/SplitPath.3:
	* doc/TCL_MEM_DEBUG.3: Updated documentation to describe the ckalloc,
	ckfree, ckrealloc, attemptckalloc, and attemptckrealloc macros, and
	to accurately describe when and how they are used. [Bug 497459]

	* generic/tclThreadJoin.c (TclRememberJoinableThread,TclJoinThread):
	Replaced Tcl_Alloc and Tcl_Free calls with ckalloc and ckfree so that
	memory debugging is supported.

2002-01-04  Daniel Steffen <[email protected]>

	* mac/tclMacTime.c (TclpGetTZName): fix for daylight savings TZName bug

2002-01-03  Don Porter <[email protected]>

	* doc/FileSystem.3:
	* generic/tclIOUtil.c: Updated some old uses of "fileName" to
	new VFS terminology, "pathPtr".

2002-01-03  Donal K. Fellows  <[email protected]>

	* tests/basic.test (basic-39.4): Greatly simplified test while
	still leaving it so that it crashes when run without the fix to
	the [foreach] implementation.
	* generic/tclCmdAH.c (Tcl_ForeachObjCmd): Stopped [Bug 494348] from
	happening by not trying to be so clever with cacheing; if nothing
	untoward is happening anyway, the less efficient technique will
	only add a few instruction cycles (one function call and a few
	derefs/assigns per list per iteration, with no change in the
	number of tests) and if something odd *is* going on, the code is
	now far more robust.

	* tests/basic.test (basic-39.4): Reproducable script from [Bug 494348]

2002-01-02  Donal K. Fellows  <[email protected]>

	* tests/util.test (Wrapper_Tcl_StringMatch,util-5.*): Rewrote so the
	test is performed with the right internal function since [string
	match] no longer uses Tcl_StringCaseMatch internally.

	* tests/string.test (string-11.51):
	* generic/tclUtf.c (Tcl_UniCharCaseMatch):
	* generic/tclUtil.c (Tcl_StringCaseMatch): Fault with matching
	case-insensitive non-ASCII patterns containing upper case characters.
	[Bug 233257]

	******************************************************************
	*** CHANGELOG ENTRIES FOR 2001 IN "ChangeLog.2001"             ***
	*** CHANGELOG ENTRIES FOR 2000 IN "ChangeLog.2000"             ***
	*** CHANGELOG ENTRIES FOR 1999 AND EARLIER IN "ChangeLog.1999" ***
	******************************************************************
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<










































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































Deleted ChangeLog.2003.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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
2003-12-25  Mo DeJong  <[email protected]>

	* win/tclWin32Dll.c (DllMain): Add HAVE_NO_SEH blocks in place of
	__try and __except statements to support gcc builds. This is needed
	after David's changes on 2003-12-21. [Patch 858493]

2003-12-23  David Gravereaux <[email protected]>

	* generic/tclAlloc.c:	All uses of 'panic' (the macro) changed to
	* generic/tclBasic.c:	'Tcl_Panic' (the function). The #define of
	* generic/tclBinary.c:	panic in tcl.h clearly states it is deprecated
	* generic/tclCkalloc.c:	in the comments. [Patch 865264]
	* generic/tclCmdAH.c:
	* generic/tclCmdIL.c:
	* generic/tclCmdMZ.c:
	* generic/tclCompCmds.c:
	* generic/tclCompExpr.c:
	* generic/tclCompile.c:
	* generic/tclConfig.c:
	* generic/tclDictObj.c:
	* generic/tclEncoding.c:
	* generic/tclEvent.c:
	* generic/tclExecute.c:
	* generic/tclHash.c:
	* generic/tclInterp.c:
	* generic/tclIO.c:
	* generic/tclIOCmd.c:
	* generic/tclIOUtil.c:
	* generic/tclListObj.c:
	* generic/tclLiteral.c:
	* generic/tclNamesp.c:
	* generic/tclObj.c:
	* generic/tclParse.c:
	* generic/tclPathObj.c:
	* generic/tclPkg.c:
	* generic/tclPreserve.c:
	* generic/tclProc.c:
	* generic/tclStringObj.c:
	* generic/tclTest.c:
	* generic/tclThreadAlloc.c:
	* generic/tclTimer.c:
	* generic/tclTrace.c:
	* generic/tclVar.c:
	* mac/tclMacChan.c:
	* mac/tclMacOSA.c:
	* mac/tclMacResource.c:
	* mac/tclMacSock.c
	* mac/tclMacThrd.c:
	* unix/tclUnixChan.c:
	* unix/tclUnixNotfy.c:
	* unix/tclUnixThrd.c:
	* unix/tclXtNotify.c:
	* win/tclWin32Dll.c:
	* win/tclWinChan.c:
	* win/tclWinFCmd.c:
	* win/tclWinNotify.c:
	* win/tclWinPipe.c:
	* win/tclWinSock.c:
	* win/tclWinThrd.c:

	* generic/tclInt.h:  Deprecated use of Tcl_Ckalloc changed to
	Tcl_Alloc in the TclAllocObjStorage macro.

2003-12-22  David Gravereaux <[email protected]>

	* win/nmakehlp.c:
	* win/rules.vc:  New feature for extensions that use rules.vc. Now
	reads header files for version strings. No more hard coding
	TCL_VERSION = 8.5 and having to edit it when you swap cores.

	* win/makefile.vc: VERSION macro now set by reading tcl.h for it.

	* generic/tcl.h: Removed note that makefile.vc needs to have a version
	number changed.

2003-12-21  David Gravereaux <[email protected]>

	* win/tclWin32Dll.c: Structured Exception Handling added around
	Tcl_Finalize called from DllMain's DLL_PROCESS_DETACH. We can't be
	100% assured that Tcl is being unloaded by the OS in a stable
	condition and we need to protect the exit handlers should the stack be
	in a hosed state. AT&T style assembly for SEH under MinGW has not been
	added yet. This is a first part change for [Patch 858493]

2003-12-17  Daniel Steffen  <[email protected]>

	* generic/tclBinary.c (DeleteScanNumberCache): fixed crashing bug when
	numeric scan-value cache contains NULL value.

2003-12-17  Vince Darley  <[email protected]>

	* generic/tclCmdAH.c:
	* unix/tclUnixFile.c:
	* win/tclWinFCmd.c:
	* tests/fCmd.test:
	* tests/fileSystem.test:
	* doc/file.n: final fix to support for relative links and its
	implications on normalization and other parts of the filesystem code.
	Fixes [Bug 859251] and some Windows problems with recursive file
	delete/copy and symbolic links.

2003-12-17  Vince Darley  <[email protected]>

	* generic/tclPathObj.c:
	* tests/fileSystem.test: fix and tests for [Bug 860402] in new file
	normalization code.

2003-12-17  Zoran Vasiljevic  <[email protected]>

	* generic/tclIOUtil.c: fixed 2 memory (object) leaks. [Bug 839519]

	* generic/tclPathObj.c: fixed Tcl_FSGetTranslatedPath to always return
	properly refcounted path object. [Bug 861515]

2003-12-16  Vince Darley  <[email protected]>

	* tests/fCmd.test: marking fCmd-9.14.2, as nonPortable, since on
	Solaris one can change the name of the current directory with 'file
	rename'.
	* doc/FileSystem.3: clarified documentation on ownership of return
	objects/strings of some Tcl_FS* calls.

2003-12-16  Donal K. Fellows  <[email protected]>

	* generic/tclThreadAlloc.c (binfo): Made variable file-local.

2003-12-15  David Gravereaux <[email protected]>

	* win/tcl.rc:
	* win/tclsh.rc: Slight modification to the STRINGIFY macro to support
	Borland's rc tool.

	* win/tclWinFile.c (TclpUtime) : utimbuf struct not a problem with
	Borland.

	* win/tclWinTime.c (TclpGetDate) : Borland's localtime() has a slight
	behavioral difference.

	From Helmut Giese <[email protected]> [Patch 758097].

2003-12-14  David Gravereaux <[email protected]>

	* generic/tclInt.decls: commented-out entry for TclpCheckStackSpace,
	removing it from the Stubs table. It's already declared in tclInt.h
	and labeled as a function that is not to be exported. Regened tables.

2003-12-14  Donal K. Fellows  <[email protected]>

	* generic/tclCmdMZ.c (Tcl_SwitchObjCmd): TIP#75 Implementation
	* tests/switch.test:	Can now get submatch information when using
	* doc/switch.n:		-regexp matching in [switch].

2003-12-14  Vince Darley  <[email protected]>

	* generic/tclPathObj.c: complete rewrite of generic file normalization
	code to cope with links followed by '..'. [Bug 849514], and parts of
	[Bug 859251]

2003-12-12  David Gravereaux <[email protected]>

	* win/tclWinChan.c: Win32's SetFilePointer() takes LONGs not DWORDs (a
	signed/unsigned mismatch). Redid local vars to avoid all casting
	except where truly required.

2003-12-12  Vince Darley  <[email protected]>

	* generic/tclCmdAH.c: fix to normalization of non-existent user name
	('file normalize ~nobody') [Bug 858937]
	* doc/file.n: clarify behaviour of 'file link' when the target is not
	an absolute path.
	* doc/filename.n: correct documentation to say that Windows Tcl does
	handle '~user', for recent Windows releases, and clarified distinction
	between MacOS 'classic' and MacOS X.
	* doc/glob.n: clarification of glob's behaviour when returning
	filenames starting with a '~'.

	* tests/fileSystem.test:
	* tests/fileName.test: new tests added for the normalization problem
	above and other recentlt reported issues.

	* win/tclWinFile.c: corrected unclear comments

	* unix/tclUnixFile.c: allow creation of relative links. [Bug 833713]

2003-12-11  David Gravereaux <[email protected]>

	* win/tclWinSock.c (SocketThreadExitHandler) : added a TerminateThread
	fallback just in case the socket handler thread is really in a paused
	state. This can happen when Tcl is being unloaded by the OS from an
	exception handler. See MSDN docs on DllMain, it states this behavior.

2003-12-09  Jeff Hobbs  <[email protected]>

	* unix/configure:
	* unix/tcl.m4: updated OpenBSD build configuration based on
	[Patch #775246] (cassoff)

2003-12-09  Donal K. Fellows  <[email protected]>

	* unix/tclUnixPort.h:	#ifdef'd out declarations of errno which are
	* tools/man2tcl.c:	known to cause problems with recent glibc.
				[Bug 852369]

2003-12-09  Vince Darley  <[email protected]>

	* win/tclWinFile.c: fix to NT file permissions code [Bug 855923]
	* tests/winFile.test: added tests for NT file permissions - patch and
	test scripts supplied by Benny.

	* tests/winFCmd.test: fixed one test for when not running in C:/

2003-12-02  Donal K. Fellows  <[email protected]>

	* generic/tclBinary.c (DeleteScanNumberCache, ScanNumber): Made the
	numeric scan-value cache have proper references to the objects within
	it so strange patterns of writes won't cause references to freed
	objects. Thanks to Paul Obermeir for the report. [Bug 851747]

2003-12-01  Miguel Sofer <[email protected]>

	* doc/lset.n: fix typo [Bug 852224]

2003-11-24  Don Porter	<[email protected]>

	* generic/tclParse.c:	Corrected faulty check for trailing white
	space in {expand} parsing. Thanks Andreas Leitgeb. [Bug 848262]
	* tests/parse.test: 	New tests for the bug.

2003-11-24  Vince Darley  <[email protected]>

	* generic/tclPathObj.c: fix to [Bug 845778] - Infinite recursion on
	[cd] (Windows only bug), for which new tests have just been added.

2003-11-21  Don Porter	<[email protected]>

	* tests/winFCmd.test (winFCmd-16.10,11): Merged new tests from
	core-8-4-branch.

2003-11-20  Miguel Sofer <[email protected]>

	* generic/tclVar.c: fix flag bit collision between LOOKUP_FOR_UPVAR
	and TCL_PARSE_PART1 (deprecated) [Bug 835020]

2003-11-19  Don Porter	<[email protected]>

	* tests/compile.test (compile-16.22.0):	Improved test for the recent
	fix for Bug 845412.

2003-11-19  Donal K. Fellows  <[email protected]>

	* generic/tclCompile.c (TclCompileScript): Added a guard for the
	expansion code so that long non-expanding commands don't get expansion
	infrastructure inserted in them, especially when that infrastructure
	isn't initialised. [Bug 845412]

2003-11-18  David Gravereaux <[email protected]>

	* contrib/djgpp/Makefile:		Changes from Victor Wagner
	* contrib/djgpp/langinfo.c (new):	<[email protected]> for better
	* contrib/djgpp/langinfo.h (new):	DJGPP support.
	* unix/tclUnixInit.c:			.
	* unix/tclUnixChan.c:			.
	* unix/tclUnixFCmd.c:			.

2003-11-17  Don Porter	<[email protected]>

	* tests/reg.test: Added tests for [Bugs 230589, 504785, 505048, 840258]
	recently fixed by 2003-11-15 commit to regcomp.c by Pavel Goran. His
	notes on the fix: This bug results from an error in code that splits
	states into "progress" and "no-progress" ones. This error causes an
	interesting situation with the pre-collected single-linked list of
	states to be splitted: many items were added to the list, but only
	several of them are accessible from the list beginning, since the
	"tmp" member of struct state (which is used here to hold a pointer to
	the next list item) gets overwritten, which results in a "looped"
	chain. As a result, not all of states are splitted, and one state is
	splitted two times, causing incorrect "no-progress" flag values.

2003-11-16  Donal K. Fellows  <[email protected]>

	* generic/tclExecute.c (TclExecuteByteCode): Make sure that
	Tcl_AsyncInvoke is called regularly when processing bytecodes.
	* generic/tclTest.c (AsyncThreadProc, TestasyncCmd): Extended testing
	harness to send an asynchronous marking without relying on UNIX
	signals.
	* tests/async.test (async-4.*): Tests to check that async events are
	handled by the bytecode core. [Bug 746722]

2003-11-15  Donal K. Fellows  <[email protected]>

	* generic/tclTest.c (TestHashSystemHashCmd): Removed 'const' modifier
	from hash type structure; it should be const and the hash code assumes
	it behaves like const, but that's not how the API is defined. Like
	this, we are following in the same footsteps as Tcl_RegisterObjType()
	which has the same conditions on its argument. Stops VC++5.2 warning.
	[Bug 842511]

2003-11-14  Donal K. Fellows  <[email protected]>

	* generic/tclHash.c (Tcl_DeleteHashTable,Tcl_HashStats,RebuildTable):
	* generic/tclTest.c (TestHashSystemHashCmd): TIP#138 implementation,
	* tests/misc.test:	plus a new chunk of stuff to test the hash
				functions more thoroughly in the test suite.
				[Patch 731356, modified]

	* doc/Tcl.n: Updated Tcl version number and changebars.

2003-11-14  Don Porter	<[email protected]>

	* doc/ParseCmd.3:	Implementation of TIP 157.  Adds recognition
	* doc/Tcl.n:		of the new leading {expand} syntax on words.
	* generic/tcl.h:	Parses such words as the new Tcl_Token type
	* generic/tclBasic.c:	TCL_TOKEN_EXPAND_WORD. Updated Tcl_EvalEx and
	* generic/tclCompile.c: the bytecode compiler/execution engine to
	* generic/tclCompile.h:	recognize the new token type. New opcodes
	* generic/tclExecute.c:	INST_LIST_VERIFY and INST_INVOKE_EXP and a new
	* generic/tclParse.c:	operand type OPERAND_ULIST1 are defined. Docs
	* generic/tclTest.c:	and tests are included.
	* tests/basic.test:
	* tests/compile.test:
	* tests/parse.test:

	* library/auto.tcl:	Replaced several [eval]s used to perform
	* library/package.tcl:	argument expansion with the new syntax. In the
	* library/safe.tcl:	test files lindex.test and lset.test, replaced
	* tests/cmdInfo.test:	use of [eval] to force direct string
	* tests/encoding.test:	evaluation with use of [testevalex] which more
	* tests/execute.test:	directly and robustly serves the same purpose.
	* tests/fCmd.test:
	* tests/http.test:
	* tests/init.test:
	* tests/interp.test:
	* tests/io.test:
	* tests/ioUtil.test:
	* tests/iogt.test:
	* tests/lindex.test:
	* tests/lset.test:
	* tests/namespace-old.test:
	* tests/namespace.test:
	* tests/pkg.test:
	* tests/pkgMkIndex.test:
	* tests/proc.test:
	* tests/reg.test:
	* tests/trace.test:
	* tests/upvar.test:
	* tests/winConsole.test:
	* tests/winFCmd.test:

2003-11-12  Jeff Hobbs  <[email protected]>

	* tests/cmdMZ.test (cmdMZ-1.4): change to nonPortable as more systems
	are using permissions caching, and this isn't really a Tcl controlled
	issue.

2003-11-11  Jeff Hobbs  <[email protected]>

	* unix/configure:
	* unix/tcl.m4: improve AIX --enable-64bit handling
	remove -D__NO_STRING_INLINES -D__NO_MATH_INLINES from CFLAGS_OPTIMIZE
	on Linux. Make default opt -O2 (was -O).

2003-11-11  David Gravereaux <[email protected]>

	* contrib/djgpp/Makefile:  Suggested changes from [email protected]
	(Victor Wagner)

	* unix/tclUnixPort.h:  added socklen_t typedef for DJGPP

2003-11-10  Don Porter	<[email protected]>

	* unix/tclUnixInit.c (TclpInitLibraryPath):
	* win/tclWinInit.c (TclpInitLibraryPath):	Fix for [Bug 832657]
	that should not run afoul of startup constraints.

	* library/dde/pkgIndex.tcl:	Added safeguards so that registry and
	* library/reg/pkgIndex.tcl:	dde packages are not offered on
	* win/tclWinDde.c:		non-Windows platforms. Bumped to
	* win/tclWinReg.c:		registry 1.1.3 and dde 1.3.
	* win/Makefile.in:
	* win/configure.in:
	* win/makefile.bc:
	* win/makefile.vc:

	* win/configure:	autoconf (2.57)

2003-11-10  Donal K. Fellows  <[email protected]>

	* tests/cmdIL.test: Stopped cmdIL-5.5 from stomping over the test
	command, and updated the tests to use some tcltest2 features in
	relation to cleanup. [Bug 838384]

2003-11-10  Vince Darley  <[email protected]>

	* generic/tclCmdAH.c:
	* tests/fCmd.test: fix to misleading error message in 'file link'.
	[Bug 836208]

2003-11-07  Vince Darley  <[email protected]>

	* generic/tclIOUtil.c: fix to compiler warning/error with some
	compilers. [Bug 835918]

2003-11-07  Daniel Steffen  <[email protected]>

	* macosx/Makefile: optimized builds define NDEBUG to turn off
	ThreadAlloc range checking.

2003-11-05  Don Porter	<[email protected]>

	* tests/unixInit.test (unixInit-2.10):  New test to expose [Bug 832657]
	failure of TclpInitLibraryPath() to properly handle .. in the path
	of the executable.

2003-11-04  Daniel Steffen  <[email protected]>

	* macosx/Makefile: added 'test' target.

2003-11-03  Vince Darley  <[email protected]>

	* generic/tclIOUtil.c
	* generic/tclInt.h: added comments and re-arranged code to clarify
	distinction between Tcl_LoadHandle, ClientData for 'load'ed code, and
	point out limitations of the design introduced with Tcl 8.4.

	* unix/tclUnixFile.c: fix to memory leak

	* generic/tclCmdIL.c: removed warning on Windows.

2003-11-01  Donal K. Fellows  <[email protected]>

	* generic/tclCmdIL.c (Tcl_LrepeatObjCmd): Check for sensible list
	lengths and allow for soft failure of the memory subsystem in the
	[lconcat] command [Bug 829027]. Uses direct list creation to avoid
	extra copies when working near the limit of available memory. Also
	reorganized to encourage optimizing compilers to optimize heavily.
	* generic/tclListObj.c (TclNewListObjDirect): New list constructor
	that does not copy the array of objects. Useful for creating
	potentially very large lists or where you are about to throw away the
	array argument which is being used in its entirety.

2003-10-28  Miguel Sofer <[email protected]>

	* generic/tclExecute.c (NEXT_INST macros): replaced macro variable
	"result" by "resultHandling" to avoid confusion.

2003-10-23  Andreas Kupries  <[email protected]>

	* unix/tclUnixChan.c (Tcl_MakeFileChannel): Applied [Patch 813606]
	fixing [Bug 813087]. Detection of sockets was off for Mac OS X which
	implements pipes as local sockets. The new code ensures that only IP
	sockets are detected as such.

	* win/tclWinSock.c (TcpWatchProc): Watch for FD_CLOSE too when asked
	for writable events by the generic layer.
	(SocketEventProc): Generate a writable event too when a close is
	detected.

	  Together the changes fix [Bug 599468].

2003-10-23  Vince Darley  <[email protected]>

	* tests/resource.test:
	* mac/tclMacResource.c: fix to resource freeing problem in 'resource'
	command reported by Bernard Desgraupes.

	* doc/FileSystem.3: updated documentation for 'glob' fix on 2003-10-13
	below

2003-10-22  Donal K. Fellows  <[email protected]>

	* generic/tclCmdAH.c (Tcl_FileObjCmd): Changed FILE_ prefix to FCMD_
	to stop symbol/#def clashes on Cygwin/Mingw32 on NT. [Bug 822528]

2003-10-21   Daniel Steffen  <[email protected]>

	* tools/tcltk-man2html.tcl: fixed incorrect html generated for
	.IP/.TP lists, now use <DL><DT>...<DD>...<P><DT>...<DD>...</DL>
	instead of illegal  <DL><P><DT>...<DD>...<P><DT>...<DD>...</DL>.
	Added skipping of directives directly after .TP to avoid them being
	used as item descriptions, e.g. .TP\n.VS in clock.n.

2003-10-21  Andreas Kupries  <[email protected]>

	* win/tclWinPipe.c (BuildCommandLine): Applied the patch coming with
	[Bug 805605] to the code, fixing the incorrect use of ispace noted by
	Ronald Dauster <[email protected]>.

2003-10-20  Kevin B. Kenny  <[email protected]>

	* doc/msgcat.n:
	* library/msgcat/msgcat.tcl (mclocale,mcload):
	* tools/tcl.wse.in:
	* unix/Makefile.in:     Implementation of TIP#156, add a "root locale"
	* win/makefile.bc:      to the 'msgcat' package. Advanced msgcat
	* win/Makefile.in:      version number to 1.4
	* win/Makefile.vc:

2003-10-15  Donal K. Fellows  <[email protected]>

	* generic/tclCmdIL.c (SortInfo,etc): Reorganized so that SortInfo
	carries an array of integer indices instead of a Tcl list. This nips
	shimmering problems in the bud and simplifies SelectObjFromSublist at
	the cost of making setup slightly more complex. [Bug 823768]

2003-10-14  David Gravereaux <[email protected]>

	* win/tclAppInit.c (sigHandler): Punt gracefully if exitToken has
	already been destroyed.

2003-10-14  Vince Darley  <[email protected]>

	* generic/tclCmdMZ.c:
	* tests/regexp.test: fix to [Bug 823524] in regsub; added three new
	tests.

2003-10-14  Don Porter	<[email protected]>

	* generic/tclBasic.c (TclAppendObjToErrorInfo):	New internal routine
	that appends a Tcl_Obj to the errorInfo, saving the caller the trouble
	of extracting the string rep.

	* generic/tclStringObj.c (TclAppendLimitedToObj):	New internal
	routine that supports truncated appends with optional ellipsis marking.
	This single routine supports UTF-8-safe truncated appends needed in
	several places throughout the Tcl source code, mostly for error and
	stack messages. Clean fix for [Bug 760872].

	* generic/tclInt.h:	Declarations for new internal routines.

	* generic/tclCmdMZ.c:	Updated callers to use the new routines.
	* generic/tclCompExpr.c:
	* generic/tclCompile.c:
	* generic/tclExecute.c:
	* generic/tclIOUtil.c:
	* generic/tclNamesp.c:
	* generic/tclObj.c:
	* generic/tclParseExpr.c:
	* generic/tclProc.c:
	* generic/tclStringObj.c:
	* mac/tclMacResource.c:

	* library/init.tcl:	Updated ::errorInfo cleanup in [unknown] to
	reflect slight modifications to Tcl_LogCommandInfo(). Corrects failing
	init-4.* tests.

2003-10-14  Donal K. Fellows  <[email protected]>

	TIP#127 IMPLEMENTATION FROM JOE MICHAEL SCHLENKER

	* generic/tclCmdIL.c (SelectObjFromSublist): Element selection engine.
	* generic/tclCmdIL.c (Tcl_LsearchObjCmd, Tcl_LsortObjCmd):
	* tests/lsearch.test:	Set up and use of element selection engine,
	* tests/cmdIL.test:	plus tests and documentation.
	* doc/lsearch.n:	Based on [Patch 693836]
	* doc/lsort.n:

2003-10-13  Vince Darley  <[email protected]>

	* generic/tcl.h:
	* generic/tclFileName.c:
	* generic/tclIOUtil.c:
	* generic/tclPathObj.c:
	* generic/tclTest.c:
	* mac/tclMacFile.c:
	* tests/fileName.test: better tests for [Bug 813273]
	* unix/tclUnixFCmd.c:
	* unix/tclUnixFile.c:
	* win/tclWin32Dll.c:
	* win/tclWinFCmd.c:
	* win/tclWinFile.c:
	* win/tclFileInt.h:

	Fixed [Bug 800106] in which 'glob' was incapable of merging the
	results of a directory listing (real or virtual) and any virtual
	filesystem mountpoints in that directory (the latter were ignored).
	This meant boundaries between different filesystems were not seamless
	(e.g. 'glob */*' across a filesystem boundary was wrong). Added new
	entry to Tcl_GlobTypeData in a totally backwards compatible way. To
	allow listing of mounts, registered filesystems must support the
	'TCL_GLOB_TYPE_MOUNT' flag. If this is not supported (e.g. in tclvfs
	1.2) then mounts will simply not be listed for that filesystem.

	Fixed [Bug 749876] 'file writable/readable/etc' (NativeAccess) using
	correct permission checking code for Windows NT/2000/XP where more
	complex user-based security/access priveleges are available,
	particularly on shared volumes. The performance impact of this extra
	checking will need further investigation. Note: Win 95,98,ME have no
	support for this.

	Also made better use of normalized rather than translated paths in the
	platform specific code.

2003-10-12  Jeff Hobbs  <[email protected]>

	* unix/tclUnixTest.c (TestalarmCmd): don't bother checking return
	value of alarm. [Bug #664755] (english)

2003-10-09  Pat Thoyts  <[email protected]>

	* win/makefile.vc:  Applied patches for bug #801467 by Joe Mistachkin
	* win/tclAppInit.c: to fix incompatible TCL_MEM_DEBUG handling in
	* generic/tclObj.c: Win32 VC builds.

2003-10-08  Don Porter	<[email protected]>

	* generic/tclBasic.c:	Save and restore the iPtr->flag bits that
	control the state of errorCode and errorInfo management when calling
	"leave" execution traces, so that all error information of the traced
	command is still available whether traced or not. [Bug 760947]
	Thanks to Yahalom Emet.

2003-10-08  Donal K. Fellows  <[email protected]>

	* generic/tclTest.c (TestNumUtfCharsCmd): Command to allow finer
	access to Tcl_NumUtfChars for testing.
	* generic/tclUtf.c (Tcl_NumUtfChars): Corrected string length
	determining when the length parameter is negative; the terminator is a
	zero byte, not (necessarily) a \u0000 character. [Bug 769812]

2003-10-07  Don Porter	<[email protected]>

	* tests/cmdAH.test:
	* tests/exec.test:		Corrected temporary file management
	* tests/fileSystem.test:	issues uncovered by -debug 1 test
	* tests/io.test:		operations. Also backported some
	* tests/ioCmd.test:		other fixes from the HEAD.
	* tests/main.test:
	* tests/pid.test:		[Bugs 675605, 675655, 675659]
	* tests/socket.test:
	* tests/source.test:

	* tests/fCmd.test:	Run tests with the [temporaryDirectory] as the
	current directory, so that tests can depend on ability to write files.
	[Bug 575837]

	* doc/OpenFileChnl.3:	Updated Tcl_Tell and Tcl_Seek documentation to
	reflect that they now return Tcl_WideInt (TIP 72). [Bug 787537]

	* tests/io.test:	Corrected several tests that failed when paths
	* tests/ioCmd.test:	included regexp-special chars. [Bug 775394]

2003-10-06  Jeff Hobbs	<[email protected]>

	* win/configure:
	* win/tcl.m4: removed incorrect checks for existence of optimization.
	TCL_CFG_OPTIMIZED is now defined whenever the user does not build with
	--enable-symbols.

2003-10-06  Don Porter	<[email protected]>

	* tests/regexp.test:		Matched [makeFile] with [removeFile].
	* tests/regexpComp.test:	[Bug 675652]

	* tests/fCmd.test (fCmd-8.2):	Test only that tilde-substitution
	happens, not for any particular result. [Bug 685991]

	* unix/tcl.m4 (SC_PATH_TCLCONFIG):	Corrected search path so that
	alpha and beta releases of Tcl are not favored. [Bug 608698]

	* tests/reg.test:	Corrected duplicate test names.
	* tests/resource.test:	[Bugs 710370, 710358]
	* tests/dict.test:

	* tests/dict.test:	Updated [package require tcltest] lines to
	* tests/fileSystem.test:	indiciate that these test files
	* tests/lrepeat.test:	use features of tcltest 2.  [Bug 706114]
	* tests/notify.test:
	* tests/parseExpr.test:
	* tests/unixNotfy.test:
	* tests/winDde.test:

2003-10-04  Miguel Sofer <[email protected]>

	* generic/tclExecute.c (TEBC):
	* tests/execute.test (execute-8.2): fix for [Bug 816641] - faulty
	execution and catch stack management.

2003-10-03  Don Porter	<[email protected]>

	* generic/tclBasic.c:	Fixed error in ref count management of command
	* generic/tclCmdMZ.c:	and execution traces that caused access to
	freed memory in trace-32.1. [Bug 811483]

2003-10-02  Don Porter  <[email protected]>

	* generic/tclTrace.c: Corrected comingling of introspection results of
	[trace info command] and [trace info execution]. [Bug 807243]
	Thanks to Mark Saye.

2003-10-01  Daniel Steffen  <[email protected]>

	* macosx/Makefile: fixed redo prebinding bug when DESTDIR="".
	* mac/tclMacResource.c: fixed possible NULL dereference (bdesgraupes).

2003-09-29  Vince Darley  <[email protected]>

	* generic/tclPathObj.c:
	* tests/fileName.test: fix to inconsistent handling of backslash
	path separators on Windows in 'file join' [Bug 813273]

2003-09-29  Donal K. Fellows  <[email protected]>

	* generic/tclPathObj.c (TclNativePathInFilesystem,TclFSGetPathType):
	* generic/tclIOUtil.c (TclNativeDupInternalRep,TclGetPathType): Rename
	to make sure function names won't interfere with other non-Tcl code
	(reported by George Staplin)

	TIP#121 IMPLEMENTATION FROM JOE MISTACHKIN

	* generic/tclEvent.c (Tcl_SetExitProc,Tcl_Exit): Implementation of
	application exit handler scheme.
	* generic/tcl.decls (Tcl_SetExitProc): Public declaration.
	* doc/Exit.3: Documentation of new API function.

	TIP#112 IMPLEMENTATION

	* generic/tclNamesp.c: Core of implementation.
	* generic/tclInt.h (Namespace,TclInvalidateNsCmdLookup): Add command
	list epoch counter and list of ensembles to namespace structure, and
	define a macro to ease update of the epoch counter.
	* generic/tclBasic.c (Tcl_CreateObjCommand,etc.): Update epoch counter
	when list of commands in a namespace changes.
	* generic/tclObj.c (TclInitObjSubsystem): Register ensemble subcommand
	type.
	* tests/namespace.test (42.1-47.6): Tests.
	* doc/namespace.n: Documentation.

	* library/http/http.tcl (geturl): Correctly check the type of
	boolean-valued options. [Bug 811170]

	* unix/tcl.m4 (SC_ENABLE_FRAMEWORK): Added note to make it clearer
	that this is an OSX feature, not a general Unix feature. [Bug 619440]

2003-09-28  David Gravereaux <[email protected]>

	* win/tclWinPipe.c: The windows port of expect can call
	TclWinAddProcess before any of the other pipe functions. Added a
	missing PipeInit() call to make sure the initialization happens.

2003-09-25  Daniel Steffen  <[email protected]>

	* macosx/Makefile: ensure SYMROOT exists if OBJROOT is overridden on
	command line. Replaced explict use of /usr/bin by ${BINDIR}.

2003-09-24  Vince Darley  <[email protected]>

	* library/package.tcl (tcl::MacPkgUnknown, tcl::MacOSXPkgUnknown):
	Minor performance tweaks to reduce the number of [file] invocations.
	Meant to improve startup times, at least a little bit. (The generic
	equivalent patch was applied on 2003-02-21).

2003-09-24  Vince Darley  <[email protected]>

	* trace.test: removed 'knownBug' from a test which doesn't illustrate
	a bug, just a bad test.

2003-09-23  Miguel Sofer <[email protected]>

	* generic/tclExecute.c:
	* generic/tclInt.h: changed the evaluation-stack addressing mode, from
	array-style to pointer-style; the catch stack and evaluation stack are
	now contiguous in memory. [Patch 457449]

2003-09-23  Don Porter  <[email protected]>

	* tests/trace.test (trace-31,32-*):  Added tests for [Bug 807243] and
	[Bug 811483].

	* library/init.tcl (auto_load, auto_import):  Expanded Eric Melski's
	2000-01-28 fix for [Bug 218871] to all potentially troubled uses of
	[info commands] on input data, where glob-special characters could
	cause problems.

2003-09-20  Donal K. Fellows  <[email protected]>

	* tests/expr.test (expr-23.4): Prevented accidental wrapping round of
	exponential operation; it isn't portable, and not what I intended to
	test either. [Bug 808244]

2003-09-19  Miguel Sofer <[email protected]>

	* generic/tclExecute.c: adding (DE)CACHE_STACK_INFO() pairs to protect
	all calls that may cause traces on ::errorInfo or ::errorCode to
	corrupt the stack. [Bug 804681]

2003-09-17  Vince Darley  <[email protected]>

	* tclPathObj.c: fix to test-suite problem introduced by the bug fix
	below. No problem in ordinary code, just test suite code which
	manually adjusts tclPlatform. [Bug 808247]

2003-09-16  Vince Darley  <[email protected]>

	* doc/filename.n: documentation of Windows-specific feature as
        discussed in [Bug 541989]
	* generic/tclPathObj.c: fix for normalization of volume-relative paths
	[Bug 767834]
        * tests/winFCmd.test: new tests for both of the above.
	* tests/cmdAH.test: fix for AFS problem in test suite [Bug 748960]

2003-09-13  Donal K. Fellows  <[email protected]>

	TIP#123 IMPLEMENTATION BASED ON WORK BY ARJEN MARKUS

	* generic/tclCompile.h (INST_EXPON):		Implementation of
	* generic/tclCompile.c (tclInstructionTable):	exponential operator.
	* generic/tclCompExpr.c (operatorTable):
	* generic/tclParseExpr.c (ParseExponentialExpr, GetLexeme):
	* generic/tclExecute.c (TclExecuteByteCode, ExponWide, ExponLong):
	(IllegalExprOperandType):
	* tests/expr.test:
	* tests/compExpr-old.test:
	* doc/expr.n:

2003-09-10  Don Porter  <[email protected]>

	* library/opt/optparse.tcl:	Latest revisions caused [OptGuessType]
	to guess "int" instead of "string" for empty strings. Missed the
	required "-strict" option to [string is]. Thanks to Revar Desmera.
	[Bug 803968]

2003-09-08  David Gravereaux <[email protected]>

	* win/tclWinLoad.c (TclpDlopen): Changed the error message for
	ERROR_PROC_NOT_FOUND to be a bit more helpful in giving us clues.
	"can't find specified procedure" means a function in the import table,
	for implicit loading, couldn't be resolved and that's why the load
	failed.

2003-09-04  Don Porter  <[email protected]>

	* doc/Tcl_Main.3:
	* doc/FileSystem.3:				Implementation of
	* doc/source.n:					TIPs 137/151. Adds a
	* doc/tclsh.1:					-encoding option to
	* generic/tcl.decls:				the [source] command
	* generic/tclCmdMZ.c (Tcl_SourceObjCmd):	and a new C routine,
	* generic/tclIOUtil.c (Tcl_FSEvalFileEx):	Tcl_FSEvalFileEx(),
	* generic/tclMain.c (Tcl_Main):			that provides C access
	* mac/tclMacResource.c (Tcl_MacSourceObjCmd):	to the same function.
	* tests/cmdMZ.test:				Also adds command line
	* tests/main.test:	option handling in Tcl_Main() so that tclsh
	* tests/source.test:	and other apps built on Tcl_Main() respect a
	-encoding command line option before a script filename. Docs and tests
	updated as well. [Patch 742683]
	This is a ***POTENTIAL INCOMPATIBILITY*** only for those C programs
	that embed Tcl, build on Tcl_Main(), and make use of Tcl_Main's former
	ability to pass a leading "-encoding" option to interactive shell
	operations.

	* generic/tclInt.decls:				Added internal stub
	* generic/tclMain.c (Tcl*StartupScript*):	table entries for two
	new functions Tcl_SetStartupScript() and Tcl_GetStartupScript() that
	set/get the path and encoding for the startup script to be evaluated
	by either Tcl_Main() or Tk_Main(). Given public names in anticipation
	of their exposure by a followup TIP.

	* generic/tclDecls.h:		make genstubs
	* generic/tclIntDecls.h:
	* generic/tclStubInit.c:

2003-09-04  Don Porter  <[email protected]>

	* doc/SplitList.3:	Implementation of TIP 148.  Fixes [Bug 489537].
	* generic/tcl.h:	Updated Tcl_ConvertCountedElement() to quote
	* generic/tclUtil.c:	the leading "#" character of all list elements
	unless the TCL_DONT_QUOTE_HASH flag is passed in.

	* generic/tclDictObj.c:	Updated Tcl_ConvertCountedElement() callers
	* generic/tclListObj.c:	to pass in the TCL_DONT_QUOTE_HASH flags
	* generic/tclResult.c:	when appropriate.

2003-08-31  Don Porter  <[email protected]>

	* doc/return.n:	Updated [return] docs to cover new TIP 90 features.

	* doc/break.n:		Added SEE ALSO references to return.n
	* doc/continue.n:

2003-09-01  Donal K. Fellows  <[email protected]>

	* doc/Namespace.3: Basic documentation for the TIP#139 functions. This
	will need improving, but the basic bits are there at least.

2003-08-31  Don Porter  <[email protected]>

	* doc/catch.n:	Updated [catch] docs to cover new TIP 90 features.

2003-08-29  Don Porter  <[email protected]>

	* generic/tclCmdAH.c:	Corrected bug in TIP 90 implementation where
	* tests/cmdMZ.test:	the default -errorcode NONE value was not
	copied into the return options dictionary. This correction modified
	one test result.

2003-08-27  David Gravereaux <[email protected]>

	* compat/strftime.c (_fmt): Removed syst array intializer that
	couldn't take variables within it under the watcom compiler:
	'Initializers must be constant'. I believe Borland has this strictness
	as well. VC++ must be non-standard about this.

	Changed Win32 platform #ifdef from 'WIN32' to '__WIN32__' as this is
	the correct one to use across the Tcl sources. Even though we do force
	it in tcl.h, the true parent one is __WIN32__.

	Added missing CONST'ification usage to match prototype listed in
	tclInt.decls.

	* win/tclWinPort.h:  Added a block for OpenWatcom adjustments that
	fixes 1) the same issue Mo did for MinGW lack of missing LPFN_*
	typedefs in their WINE derived <winsock2.h> and 2) The need to be
	strict about how the char type needs to be signed by default.

	* win/tclWinSock.c:  Added OpenWatcom to the commentary about the
	#ifdef HAVE_NO_LPFN_DECLS block.

	* win/tclWinTime.c:  Changed use of '_timezone' to 'timezone' as this
	difference is already adjusted for in tclWinPort.h. Removed
	unreferenced posixEpoch file-scope global.

	* win/tclWinFile.c (WinReadLinkDirectory): Fix for 'Initializers must
	be constant' with the driveSpec array using OpenWatcom.

2003-08-27  Don Porter  <[email protected]>

	* generic/tclUtil.c:	Corrected [Bug 411825] and other bugs in
	TclNeedSpace() where non-breaking space (\u00A0) and backslash-escaped
	spaces were handled incorrectly.
	* tests/util.test:	Added new tests util-8.[2-6].

2003-08-26  David Gravereaux <[email protected]>

	* generic/tcl.h: Added some support for the LCC-Win32 compiler.
	Unfortunetly, this compiler has a bug in its preprocessor and can't
	build Tcl even with this minor patch. Also added some support for the
	OpenWatcom compiler. A new win/makefile.wc to follow soon.

2003-08-25  Donal K. Fellows  <[email protected]>

	* tools/genStubs.tcl (genStubs::makeDecl): A more subtle way of
	generating stubbed declarations allows us to have declarations of a
	function in multiple interfaces simultaneously.

	* generic/tcl.decls: Duplicated some namespace declarations from
	tclInt.decls here, as mandated by TIP #139. This is OK since the
	declarations match and will end up using the declarations in the
	public code from now on because of #include ordering. Keeping the old
	declarations in tclInt.decls; there's no need to gratuitously break
	compatibility for those extensions which are already clients of the
	namespace code.

2003-08-23  Zoran Vasiljevic  <[email protected]>

	* generic/tclIOUtil.c: merged fixes for thread-unsafe handling of
	filesystem records [Bug 753315]. This also fixed the [Bug 788780]
	* generic/tclPathObj.c: merged fixes for thread-unsafe handling of
	filesystem records. [Bug 753315]

	* generic/tclFileSystem.h: merged fixes for thread-unsafe handling of
	filesystem records. [Bug 753315]

2003-08-19  Pat Thoyts  <[email protected]>

	* win/tclWinSerial.c (SerialErrorStr): Fixed a syntax error created in
	the previous code cleanup.

2003-08-19  Donal K. Fellows  <[email protected]>

	* win/tclWinSerial.c: Adjusted commenting and spacing usage to follow
	the principles of the Style Guide better.

2003-08-18  Mo DeJong  <[email protected]>

	* win/configure: Regen.
	* win/tcl.m4 (SC_ENABLE_SYMBOLS): Use test instead of -eq, which does
	not work. [Bug 781109]

2003-08-13  Chengye Mao <[email protected]>

	* win/tclWinPipe.c: fixed a bug in BuildCommandLine. This bug built a
	command line with a missing space between tclpipe.dll and the
	following arguments. It caused error in Windows 98 when exec
	command.com (e.g. dir). [Bug 789040]

2003-08-11  Donal K. Fellows  <[email protected]>

	TIP #136 IMPLEMENTATION from Simon Geard <[email protected]>
	* generic/tclCmdIL.c (Tcl_LrepeatObjCmd): Adapted version of Simon's
	* doc/lrepeat.n:			  patch, updated to the HEAD
	* tests/lrepeat.test:			  and matching the core style.
	* generic/tclBasic.c (buildIntCmds):	Splice into core.
	* generic/tclInt.h:
	* doc/list.n:				Cross-reference.

2003-08-06  Jeff Hobbs  <[email protected]>

	* win/tclWinInit.c: recognize amd64 and ia32_on_win64 cpus.

2003-08-06  Don Porter  <[email protected]>

	* library/msgcat/msgcat.tcl:	Added escape so that non-Windows
	* library/msgcat/pkgIndex.tcl:	platforms do not try to use the
	registry package. This can save a costly and pointless package search.
	Bumped to 1.3.1. Thanks to Dave Bodenstab. [Bug 781609]

2003-08-05  Miguel Sofer <[email protected]>

	* generic/tclExecute.c (INST_INVOKE, INST_EVAL, INST_PUSH_RESULT):
	added a Tcl_ResetResult(interp) at each point where the interp's
	result is pushed onto the stack, to avoid keeping an extra reference
	that may cause costly Tcl_Obj duplication. Detected by Franco Violi,
	analyzed by Peter Spjuth and Donal Fellows. [Bug 781585]

2003-07-28  Vince Darley  <[email protected]>

	* doc/FileSystem.3:
	* doc/Translate.3: better documentation of Tcl_TranslateFileName and
	related functions. [Bug 775220]

2003-07-24  Mo DeJong  <[email protected]>

	* generic/tcl.h: Revert change made on 2003-07-21 since it made the
	sizeof(Tcl_Obj) different for regular vs mem debug builds.
	* generic/tclInt.h: Define TclDecrRefCount in terms of
	Tcl_DbDecrRefCount which removes one layer of inderection.
	* generic/tclObj.c (TclDbInitNewObj, Tcl_DbIncrRefCount,
	(Tcl_DbDecrRefCount, Tcl_DbIsShared): Define ThreadSpecificData that
	contains a hashtable. The table is used to ensure that a Tcl_Obj is
	only acted upon in the thread that allocated it. This checking code is
	enabled only when mem debug and threads are enabled.

2003-07-24  Don Porter  <[email protected]>

	* tests/async.test:	Added several tests that demonstrate [Bug
	* tests/basic.test:	489537], Tcl's longstanding failure to
	* tests/dict.test:	properly quote any leading '#' character when
	* tests/dstring.test:	generating the string rep of a list so that
	* tests/list.test:	the comment-power of that character is hidden
	* tests/parse.test:	from any [eval], in order to satisfy the
	* tests/util.test:	documentation that [list] does [eval]-safe
				quoting.

2003-07-24  Reinhard Max  <[email protected]>

	* library/package.tcl: Fixed a typo that broke pkg_mkIndex -verbose.
	* tests/pkgMkIndex.test: Added a test for [pkg_mkIndex -verbose].

	* ChangeLog.2002 (new file):
	* ChangeLog: broke changes from 2002 into ChangeLog.2002 to reduce
	size of the main ChangeLog.

2003-07-23  Daniel Steffen  <[email protected]>

	* unix/Makefile.in: changes to html-tcl & html-tk targets for
	compatibility with non-gnu makes.

	* unix/Makefile.in: added macosx/README to dist target.

2003-07-23  Pat Thoyts  <[email protected]>

	* win/tclWinReg.c (OpenSubKey): Fixed bug 775976 which causes the
	registry set command to fail when built with VC7.
	* library/reg/pkgIndex.tcl: Incremented the version to 1.1.2.

2003-07-21  Mo DeJong  <[email protected]>

	Check that the thread incrementing or decrementing the ref count of a
	Tcl_Obj is the thread that originally allocated the thread. This fail
	fast behavior will catch programming errors that allow a single
	Tcl_Obj to be accessed from multiple threads.

	* generic/tcl.h (Tcl_Obj): Add allocThread member to Tcl_Obj. This
	member records the thread id the Tcl_Obj was allocated. It is used to
	check that any future ref count incr or decr is done from the same
	thread that allocated the Tcl_Obj. This member is defined only when
	threads and mem debug are enabled.
	* generic/tclInt.h (TclNewObj, TclDbNewObj, TclDecrRefCount):
	Define TclNewObj and TclDbNewObj using TclDbInitNewObj when mem debug
	is enabled. This fixes a problem where TclNewObj calls did not work
	the same as TclDbNewObj when mem debug was enabled.
	* generic/tclObj.c (TclDbInitNewObj, Tcl_DbIncrRefCount,
	(Tcl_DbDecrRefCount): Add new helper to init Tcl_Obj members when mem
	debug is enabled. Init the allocThread member in TclDbInitNewObj and
	check it in Tcl_DbIncrRefCount and Tcl_DbDecrRefCount to make sure a
	Tcl_Obj allocated in one thread is not being acted upon in another
	thread.

2003-07-21  Vince Darley  <[email protected]>

	* test/cmdAH.test: ensure certain tests run in local filesystem. [Bug
	748960]

2003-07-18  Daniel Steffen  <[email protected]>

	* macosx/Makefile: added option to allow installing manpages in
	addition to default html help.

2003-07-18  Donal K. Fellows  <[email protected]>

	* doc/Utf.3: Tightened up documentation of Tcl_UtfNext and Tcl_UtfPrev
	to better match the behaviour. [Bug 769895]

2003-07-18  Jeff Hobbs  <[email protected]>

	* library/http/pkgIndex.tcl: upped to http v2.4.4
	* library/http/http.tcl: add support for user:pass info in URL.
	* tests/http.test:       [Bug 759888] (shiobara)

2003-07-18  Don Porter  <[email protected]>

	* doc/tcltest.n:                Restored the [Eval] proc to replace
	* library/tcltest/tcltest.tcl:  the [::puts] command when either the
	-output or -error option for [test] is in use, in order to capture
	data written to the output or error channels for comparison against
	what is expected.  This is easier to document and agrees better with
	most user expectations than the previous attempt to replace [puts]
	only in the caller's namespace.  Documentation made more precise on
	the subject.  [Bug 706359]

	* doc/AddErrInfo.3:	Improved consistency of documentation by
	* doc/CrtTrace.3:      	using "null" everywhere to refer to the
	* doc/Encoding.3:      	character '\0', and using "NULL" everywhere
	* doc/Eval.3:          	to refer to the value of a pointer that points
	* doc/GetIndex.3:      	to nowhere. Also dropped references to ASCII
	* doc/Hash.3:          	that are no longer true, and standardized on
	* doc/LinkVar.3:       	the hyphenated spelling of "null-terminated".
	* doc/Macintosh.3:
	* doc/OpenFileChnl.3:
	* doc/SetVar.3:
	* doc/StringObj.3:
	* doc/Utf.3:

	* doc/CrtSlave.3 (Tcl_MakeSafe):  Removed warning about possible
	deprecation (no TIP on that).

2003-07-17  Daniel Steffen  <[email protected]>

	* unix/tclUnixFCmd.c: fix for compilation errors on platforms where
	configure detects non-functional chflags(). [Bug 748946]

	* macosx/Makefile: Rewrote buildsystem for Mac OS X framework build
	to be purely make driven; in order to become independent of Apple's
	closed-source IDE and build tool. The changes are intended to be
	transparent to the Makefile user, all existing make targets and cmd
	line variable overrides should continue to work. Changed build to only
	include tcl specific html help in Tcl.framework, the tk specific html
	help is now included in Tk.framework. Added var to allow overriding of
	tclsh used during html help building (Landon Fuller).

	* macosx/Tcl.pbproj/project.pbxproj:
	* macosx/Tcl.pbproj/jingham.pbxuser: Changed to purely call through to
	the make driven buildsystem; Tcl.framework is no longer assembled by
	ProjectBuilder.
	Set default SYMROOT in target options to simplify setting up PB
	(manually setting common build folder for tcl & tk no longer needed).

	* tools/tcltk-man2html.tcl: Added options to allow building only the
	tcl or tk html help files; the default behaviour with none of the new
	options is to build both, as before.

	* unix/Makefile.in: Added targets for building only the tcl or tk help

	* macosx/README (new): Tcl specific excerpts of tk/macosx/README.

	* generic/tcl.h: Updated reminder comment about editing
	macosx/Tcl.pbproj/project.pbxproj when version number changes.

2003-07-16  Mumit Khan  <[email protected]>

	* generic/tclPathObj.c (SetFsPathFromAny): Add Cygwin specific code to
	convert POSIX filename to native format.
	* generic/tclFileName.c (Tcl_TranslateFileName): And remove from here.
	(TclDoGlob): Adjust for cygwin and append / for dirs instead of \
	* win/tclWinFile.c (TclpObjChdir): Use chdir on Cygwin.
	[Patch 679315]

2003-07-16  Jeff Hobbs  <[email protected]>

	* library/safe.tcl (FileInAccessPath): normalize paths before
	comparison. [Bug 759607] (myers)

	* unix/tclUnixNotfy.c (NotifierThreadProc): correct size of found and
	word vars from int to long. [Bug 767578] (hgo)

	* generic/tcl.h:       Add recognition of -DTCL_UTF_MAX=6 on the make
	* generic/regcustom.h: line to support UCS-4 mode. No config arg at
	this time, as it is not the recommended build mode.

	* generic/tclPreserve.c: In Result and Preserve'd routines, do not
	* generic/tclUtil.c:     assume that ckfree == free, as that is not
	* generic/tclResult.c:   always true. [Bug 756791] (fuller)

2003-07-16  Donal K. Fellows  <[email protected]>

	* doc/CrtSlave.3 (Tcl_MakeSafe): Updated documentation to strongly
	discourage use. IMHO code outside the core that uses this function is
	a bug... [Bug 655300]

2003-07-16  Don Porter  <[email protected]>

	* generic/tclFileName.c (Tcl_GlobObjCmd):	[Bug 771840]
	* generic/tclPathObj.c (Tcl_FSConvertToPathType):[Bug 771947]
	* unix/tclUnixFCmd.c (GetModeFromPermString):	[Bug 771949]
	Silence compiler warnings about unreached lines.

	* library/tcltest/tcltest.tcl (ProcessFlags):	Corrected broken call
	* library/tcltest/pkgIndex.tcl:			to [lrange]. Bumped to
	version 2.2.4. [Bug 772333]

2003-07-15  Mo DeJong  <[email protected]>

	* unix/dltest/pkga.c (Pkga_EqObjCmd): Fix typo that was causing a
	crash in load.test.

2003-07-15  Donal K. Fellows  <[email protected]>

	* doc/array.n: Make sure docs are synched with the 8.4 release.

2003-07-15  Don Porter  <[email protected]>

	* doc/http.n:  Updated SYNOPSIS to match actual syntax of commands.
	[Bug 756112]

	* unix/dltest/pkga.c:	Updated to not use Tcl_UtfNcmp and counted
	strings instead of strcmp (not defined in any #include'd header) and
	presumed NULL-terminated strings.

	* generic/tclCompCmds.c (TclCompileIfCmd):  Prior fix of Bug 711371 on
	2003-04-07 introduced a buffer overflow. Corrected. [Bug 771613]

2003-07-15  Kevin B. Kenny  <[email protected]>

	* win/rules.vc: Added a missing $(OPTDEFINES) which broke the build if
	STATS=memdbg was specified.

2003-07-15  Donal K. Fellows  <[email protected]>

	* generic/tclCmdIL.c (SortCompare): Cleared up confusing error
	message. [Bug 771539]

2003-07-11  Donal K. Fellows  <[email protected]>

	* tests/binary.test (binary-46.*): Tests to help enforce the current
	behaviour.
	* doc/binary.n: Documented that [binary format a] and [binary scan a]
	do encoding conversion by dropping high bytes, unlike the rest of the
	core. [Bug 735364]

2003-07-11  Don Porter  <[email protected]>

	* library/package.tcl:  Corrected [pkg_mkIndex] bug reported on
	comp.lang.tcl. The indexer was searching for newly indexed packages
	instead of newly provided packages.

2003-07-08  Vince Darley  <[email protected]>

	* tests/winFCmd.test: fix for five tests under win98 [Bug 767679]

2003-07-07  Jeff Hobbs  <[email protected]>

	* doc/array.n: add examples from Welton

2003-06-23  Vince Darley  <[email protected]>

	* doc/file.n: clarification of 'file tail' behaviour [Bug 737977]

2003-07-04  Donal K. Fellows  <[email protected]>

	* doc/expr.n: Tighten up the wording of some operations. [Bug 758488]

	* tests/cmdAH.test: Made tests of [file mtime] work better on FAT
	filesystems. [Patch 760768]  Also a little general cleanup.

	* generic/tclCmdMZ.c (Tcl_StringObjCmd): Made [string map] accept
	dictionaries for maps.  This is much trickier than it looks, since map
	entry ordering is significant. [Bug 759936]

	* generic/tclVar.c (Tcl_ArrayObjCmd, TclArraySet): Made [array get]
	and [array set] work with dictionaries, producing them and consuming
	them. Note that for compatibility reasons, you will never get a dict
	from feeding a string literal to [array set] since that alters the
	trace behaviour of "multi-key" sets. [Bug 759935]

2003-06-23  Vince Darley  <[email protected]>

	* generic/tclTrace.c: fix to Window debug build compilation error.

2003-06-27  Don Porter  <[email protected]>

	* tests/init.test: Added [cleanupTests] to report results of tests
	* tests/pkg.test:  that run in slave interps.  [Bugs 761334,761344]

	* tests/http.test: Used more reliable path to find httpd script.

2003-06-25  Don Porter  <[email protected]>

	* tests/init.test:  Added tests init-4.6.* to illustrate [Bug 760872]

2003-06-25  Donal K. Fellows  <[email protected]>

	* generic/tclTrace.c: New file, factoring out of virtually all the
	various trace-related things from tclBasic.c and tclCmdMZ.c with the
	goal of making this a separate maintenance area.

2003-06-25  Mo DeJong  <[email protected]>

	* unix/configure: Regen.
	* unix/tcl.m4 (SC_CONFIG_CFLAGS): Add -ieee when compiling with cc and
	add -mieee when compiling with gcc under OSF1-V5 "Tru64" systems. [Bug
	748957]

2003-06-24  Donal K. Fellows  <[email protected]>

	* doc/encoding.n: Corrected the docs to say that [source] uses the
	system encoding, which it always did anyway (since 8.1) [Bug 742100]

2003-06-24  Donal K. Fellows  <[email protected]>

	* generic/tclHash.c (Tcl_HashStats): Prevented occurrence of
	division-by-zero problems.  [Bug 759749]

2003-06-24  Mo DeJong  <[email protected]>

	* unix/tclUnixPort.h: #undef inet_ntoa before #define to avoid
	compiler warning under freebsd. [Bug 745844]

2003-06-23  Pat Thoyts  <[email protected]>

	* doc/dde.n:                 Committed TIP #135 which changes the
	* win/tclWinDde.c:           -exact option to -force. Also cleaned a
	* tests/winDde.test:         bug in the tests.
	* library/dde/pkgIndex.tcl:  Incremented version to 1.2.5

	* doc/dde.n:                 Committed TIP #120 which provides the
	* win/tclWinDde.c:           dde package for safe interpreters.
	* tests/winDde.test:         Incremented package version to 1.2.4
	* library/dde/pkgIndex.tcl:

2003-06-23  Vince Darley  <[email protected]>

	* generic/tclFCmd.c: fix to bad error message when trying to do 'file
	copy foo ""'. [Bug 756951]
	* tests/fCmd.test: added two new tests for the bug.

	* win/tclWinFile.c:
	* win/tclWin32Dll.c: recommitted some filesystem globbing speed-ups,
	but disabled some on the older Win 95/98/ME where they don't seem to
	work.

	* doc/FileSystem.3: documentation fix [Bug 720634]

2003-06-18  Miguel Sofer <[email protected]>

	* generic/tclNamesp.c (Tcl_Export): removed erroneous comments. [Bug
	756744]

2003-06-17  Vince Darley  <[email protected]>

	* win/makefile.vc:  fixes to check-in below so compilation now works
	again on Windows.

	* generic/tclCmdMZ.c:
	* tests/regexp.test: fixing of bugs related to regexp and regsub
	matching of empty strings. Addition of a number of new tests. [Bug
	755335]

2003-06-16  Andreas Kupries  <[email protected]>

	* win/Makefile.in:  Haven't heard back from David for a week. Now
	* win/configure:    committing the remaining changes.
	* win/configure.in: Note: In active contact with Helmut Giese about
	* win/makefile.vc:  the borland relatedchanges. This part will see
	* win/rules.vc:     future updates.
	* win/tcl.m4:
	* win/makefile.bc:

2003-06-10  Andreas Kupries  <[email protected]>

	* generic/tclConfig.c (ASSOC_KEY): Changed the key to
	"tclPackageAboutDict" (tcl prefix) to make collisions with the keys of
	other packages more unlikely.

2003-06-10  Miguel Sofer <[email protected]>

	* generic/tclBasic.c:
	* generic/tclExecute.c: let TclExecuteObjvInternal call
	TclInterpReady instead of relying on its callers to do so; fix for the
	part of [Bug 495830] that is new in 8.4.
	* tests/interp.test: Added tests 18.9 (knownbug) and 18.10

2003-06-09  Andreas Kupries  <[email protected]>

	* generic/tcl.decls:  Ported the changes from the
	* generic/tcl.h:      'tip-59-implementation' branch into the CVS
	* generic/tclBasic.c: head. Regenerated stub table. Regenerated the
	* generic/tclInt.h:   configure's scripts, with help from Joe English.
	* generic/tclDecls.h:
	* generic/tclStubInit.c:
	* generic/tclConfig.c:
	* generic/tclPkgConfig.c:
	* unix/Makefile.in:
	* unix/configure.in:  The changes in the windows section are not yet
	* unix/tcl.m4:        committed, they await feedback from David
	* unix/mkLinks:       Gravereaux.
	* doc/RegConfig.3:
	* mac/tclMacPkgConfig.c:
	* tests/config.test:

2003-06-09  Don Porter  <[email protected]>

	* string.test (string-4.15): Added test for [string first] bug
	reported in Tcl 8.3, where test for all-single-byte-encoded strings
	was not reliable.

2003-06-04  Joe Mistachkin  <[email protected]>

	* tools/man2help.tcl: Added duplicate help section checking and
	* tools/index.tcl:    corrected a comment typo for the getTopics proc
	in index.tcl. [Bug 748700]

2003-06-02  Vince Darley  <[email protected]>

	* win/tclWinFCmd.c:
	* tests/fCmd.test: fix to [Bug #747575] in which a bad error message
	is given when trying to rename a busy directory to one with the same
	prefix, but not the same name. Added three new tests.

2003-05-23  D. Richard Hipp <[email protected]>

	* win/tclWinTime.c: Add tests to detect and avoid a division by zero
	in the windows precision timer calibration logic.

2003-05-23  Don Porter  <[email protected]>

	* generic/tclObj.c (tclCmdNameType):  Converted internal rep
	management of the cmdName Tcl_ObjType the opposite way, to always use
	the twoPtrValue instead of always using the otherValuePtr. Previous
	fix on 2003-05-12 broke several extensions that wanted to poke around
	with the twoPtrValue.ptr2 value of a cmdName Tcl_Obj, like TclBlend
	and e4graph. [Bug 726018]
	Thanks to George Petasis for the bug report and Jacob Levy for testing
	assistance.

2003-05-23  Mo DeJong  <[email protected]>

	* unix/mkLinks: Set the var S to "" at the top of the file to avoid
	error when user has set S to something. [Tk Bug 739833]

2003-05-22  Daniel Steffen  <[email protected]>

	* macosx/Tcl.pbproj/project.pbxproj: added missing references to new
	source files tclPathObj.c and tclMacOSXFCmd.c.

	* macosx/tclMacOSXBundle.c: fixed a problem that caused only the first
	call to Tcl_MacOSXOpenVersionedBundleResources() for a given bundle
	identifier to succeed. This caused the tcl runtime library not to be
	found in all interps created after the inital one.

2003-05-19  Kevin B. Kenny  <kennykb@hippolyta>

	* unix/tclUnixTime.c: Corrected a bug in conversion of non-ASCII
	chars in the format string.

2003-05-19  Daniel Steffen  <[email protected]>

	* macosx/Tcl.pbproj/project.pbxproj: changed tclConfig.sh location in
	versioned framework subdirectories to be identical to location in
	framework toplevel; fixed stub library symbolic links to be tcl
	version specific.

	* unix/tclUnixTime.c: fixed typo.

2003-05-18  Kevin Kenny  <[email protected]>

	* compat/strftime.c:  Modified TclpStrftime to return its result in
	* generic/tclClock.c: UTF-8 encoding, and removed the conversion from
	* mac/tclMacTime.c:   system encoding to UTF-8 from [clock format].
	* unix/tclUnixTime.c: Needed to avoid double conversion of the
	* win/tclWinTime.c:   timezone name on Windows systems. [Bug 624408]

2003-05-16  Pat Thoyts  <[email protected]>

	* library/dde/pkgIndex.tcl:  Applied TIP #130 which provides for
	* tests/winDde.test:         unique dde server names. Added some more
	* win/tclWinDde.c:           tests. Fixes [Bug 219293]

	* doc/dde.n: Updated documentation re TIP #130.
	* tests/winDde.test: Applied patch for [Bug 738929] by KKB and changed
	to new-style tests.

2003-05-16  Kevin B. Kenny  <[email protected]>

	* unix/Makefile.in:	Removed one excess source file tclDToA.c

2003-05-16  Daniel Steffen  <[email protected]>

	* macosx/Tcl.pbproj/project.pbxproj: updated copyright year.

2003-05-15  Kevin B. Kenny  <[email protected]>

	* generic/tclGetDate.y: added further hackery to the yacc
	* generic/tclDate.c:    post-processing to arrange for the code to set
	* unix/Makefile.in:     up exit handlers to free the stacks. [Bug
				736425]

2003-05-15  Jeff Hobbs  <[email protected]>

	* win/tclWinFile.c (TclpMatchInDirectory): revert glob code to r1.44
	as 2003-04-11 optimizations broke Windows98 glob'ing.

	* doc/socket.n: nroff font handling correction

	* library/encoding/gb2312-raw.enc (new): This is the original
	gb2312.enc renamed to allow for it to still be used. This is needed by
	Tk (unix) because X fonts with gb2312* charsets really do want the
	original gb2312 encoding. [Bug 557030]

2003-05-14  Donal K. Fellows  <[email protected]>

	* generic/tclCmdAH.c (Tcl_FormatObjCmd): Stop unwarranted demotion of
	wide values to longs by formatting of int values. [Bug 699060]

2003-05-14  Jeff Hobbs  <[email protected]>

	* library/encoding/gb2312.enc: copy euc-cn.enc over original
	gb2312.enc. gb2312.enc appeared to not work as expected, and most uses
	of gb2312 really mean euc-cn (which may be the cause of the problem).
	[Bug 557030]

2003-05-14  Daniel Steffen  <[email protected]>

	Implementation of TIP 118:

	* generic/tclFCmd.c (TclFileAttrsCmd): return the list of attributes
	that can be retrieved without error for a given file, instead of
	aborting the whole command when any error occurs.

	* unix/tclUnixFCmd.c: added support for new file attributes and for
	copying Mac OS X file attributes & resource fork during [file copy].

	* generic/tclInt.decls: added declarations of new external commands
	needed by new file attributes support in tclUnixFCmd.c.

	* macosx/tclMacOSXFCmd.c (new): Mac OS X specific implementation of
	new file attributes and of attribute & resource fork copying.

	* mac/tclMacFCmd.c: added implementation of -rsrclength attribute &
	fixes to other attributes for consistency with OSX implementation.

	* mac/tclMacResource.c: fixes to OSType handling.

	* doc/file.n: documentation of [file attributes] changes.

	* unix/configure.in: check for APIs needed by new file attributes.

	* unix/Makefile.in:
	* unix/tcl.m4: added new platform specifc tclMacOSXFCmd.c source.

	* unix/configure:
	* generic/tclStubInit.c:
	* generic/tclIntPlatDecls.h: regen.

	* tools/genStubs.tcl: fixes to completely broken code trying to
	prevent overlap of "aqua", "macosx", "x11" and "unix" stub entries.

	* tests/unixFCmd.test: added tests of -readonly attribute.

	* tests/macOSXFCmd.test (new): tests of macosx file attributes and of
	preservation of attributes & resource fork during [file copy].

	* tests/macFCmd.test: restore -readonly attribute of test dir, as
	otherwise its removal can fail on unices supporting -readonly.

2003-05-13  David Gravereaux <[email protected]>

	* generic/tclEnv.c: Another putenv() copy behavior problem repaired
	when compiling on windows and using microsoft's runtime. [Bug 736421]

2003-05-13  Jeff Hobbs  <[email protected]>

	* generic/tclIOUtil.c: ensure cd is thread-safe.
	[Bug 710642] (vasiljevic)

2003-05-13  Donal K. Fellows  <[email protected]>

	* generic/tclEvent.c (Tcl_Finalize): Removed unused variable to reduce
	compiler warnings. [Bug 664745]

2003-05-13  Joe Mistachkin  <[email protected]>

	* generic/tcl.decls:  Changed Tcl_JoinThread parameter name from
	* generic/tclDecls.h: "id" to "threadId". [Bug 732477]
	* unix/tclUnixThrd.c:
	* win/tclWinThrd.c:
	* mac/tclMacThrd.c:

2003-05-13  Daniel Steffen  <[email protected]>

	* generic/tcl.decls:
	* macosx/tclMacOSXBundle.c: added extended version of the
	Tcl_MacOSXOpenBundleResources() API taking an extra version number
	argument: Tcl_MacOSXOpenVersionedBundleResources(). This is needed to
	be able to access bundle resources in versioned frameworks such as Tcl
	and Tk, otherwise if multiple versions were installed, only the latest
	version's resources could be accessed. [Bug 736774]

	* unix/tclUnixInit.c (Tcl_MacOSXGetLibraryPath): use new versioned
	bundle resource API to get tcl runtime library for TCL_VERSION. [Bug
	736774]

	* generic/tclPlatDecls.h:
	* generic/tclStubInit.c: regen.

	* unix/tclUnixPort.h: worked around the issue of realpath() not
	being thread-safe on Mac OS X by defining NO_REALPATH for threaded
	builds on Mac OS X. [Bug 711232]

2003-05-12  Donal K. Fellows  <[email protected]>

	* tests/cmdAH.test: General clean-up of tests so that all
	tcltest-specific commands are protected by constraints and all
	platforms see the same number of tests. [Bug 736431]

2003-05-12  Don Porter  <[email protected]>

	* generic/tclInterp.c: (AliasObjCmd):   Added refCounting of the words
	* tests/interp.test (interp-33.1):      of the target of an interp
	alias during its execution. Also added test. [Bug 730244]

	* generic/tclBasic.c (TclInvokeObjectCommand):  objv[argc] is no
	longer set to NULL (Tcl_CreateObjCommand docs already say that it
	should not be accessed).

	* tests/cmdMZ.test:  Forgot to import [temporaryDirectory].

	* generic/tclObj.c (tclCmdNameType):  Corrected variable use of the
	otherValuePtr or the twoPtrValue.ptr1 fields to store a
	(ResolvedCmdName *) as the internal rep. [Bug 726018]

	* doc/Eval.3:  Corrected prototype for Tcl_GlobalEvalObj [Bug 727622].

2003-05-12  Miguel Sofer <[email protected]>

	* generic/tclVar.c (TclObjLookupVar): [Bug 735335] temporary fix,
	disabling usage of tclNsVarNameType.
	* tests/var.test (var-15.1): test for [Bug 735335]

2003-05-10  Jeff Hobbs  <[email protected]>

	* win/tclWinSerial.c (SerialCloseProc): correct mem leak on closing a
	Windows serial port [Bug 718002] (schroedter)

	* generic/tclCmdMZ.c (Tcl_StringObjCmd): prevent string repeat crash
	when overflow sizes were given (throws error). [Bug 714106]

2003-05-09  Joe Mistachkin <[email protected]>

	* generic/tclThreadAlloc.c (TclFreeAllocCache): Fixed memory leak
	caused by treating cachePtr as a TLS index. [Bug 731754]

	* win/tclAppInit.c (Tcl_AppInit): Fixed memory leaks caused by not
	freeing the memory allocated by setargv and the async handler created
	by Tcl_AppInit. An exit handler has been created that takes care of
	both leaks. In addition, Tcl_AppInit now uses ckalloc instead of
	Tcl_Alloc to allow for easier leak tracking and to be more consistent
	with the rest of the Tcl core. [Bugs 733156, 733221]

	* tools/encoding/txt2enc.c (main): Fixed memory leak caused by failing
	to free the memory used by the toUnicode array of strings [Bug 733221]

2003-05-09  Miguel Sofer <[email protected]>

	* generic/tclCompile.c (TclCompileScript):
	* tests/compile.test (compile-3.5): corrected wrong test and
	behaviour in the earlier fix for [Bug 705406]; Don Porter reported
	this as [Bug 735055], and provided the solution.

2003-05-09  Donal K. Fellows  <[email protected]>

	* generic/tclCmdMZ.c (Tcl_ReturnObjCmd): The array of strings passed
	to Tcl_GetIndexFromObj must be NULL terminated. [Bug 735186]
	Thanks to Joe Mistachkin for spotting this.

2003-05-07  Donal K. Fellows  <[email protected]>

	* doc/trace.n: Fixed very strange language in the documentation for
	'trace add execution'. [Bug 729821]

	* generic/tclCmdMZ.c (Tcl_TraceObjCmd): Made error message for 'trace
	info' more consistent with documentation. [Bug 706961]

	* generic/tclDictObj.c (DictInfoCmd): Fixed memory leak caused by
	confusion about string ownership.  [Bug 731706]

2003-05-05  Don Porter  <[email protected]>

	* generic/tclBasic.c:		Implementation of TIP 90, which
	* generic/tclCmdAH.c:		extends the [catch] and [return]
	* generic/tclCompCmds.c:	commands to enable creation of a
	* generic/tclExecute.c:		proc that is a replacement for
	* generic/tclInt.h:		[return]. [Patch 531640]
	* generic/tclProc.c:
	* generic/tclResult.c:
	* tests/cmdAH.test:
	* tests/cmdMZ.test:
	* tests/error.test:
	* tests/proc-old.test:

	* library/tcltest/tcltest.tcl: The -returnCodes option to [test]
	failed to recognize the symbolic name "ok" for return code 0.

2003-05-05  Donal K. Fellows  <[email protected]>

	* generic/tclBasic.c (Tcl_HideCommand): Fixed error message for
	grammar and spelling.

2003-04-28  Donal K. Fellows  <[email protected]>

	* generic/tclDictObj.c (DictIncrCmd): Updated to reflect the behaviour
	with wide increments of the normal [incr] command.
	* generic/tclInt.decls: Added TclIncrWideVar2 to internal stub table
	and cleaned up.
	* tests/incr.test (incr-3.*):
	* generic/tclVar.c (TclIncrWideVar2, TclPtrIncrWideVar):
	* generic/tclExecute.c (TclExecuteByteCode):
	* generic/tclCmdIL.c (Tcl_IncrObjCmd): Make [incr] work when trying to
	increment by wide values. [Bug 728838]

	* generic/tclCompCmds.c (TclCompileSwitchCmd): Default mode of
	operation of [switch] is exact matching. [Bug 727563]

2003-04-25  Don Porter  <[email protected]>

	* generic/tclBasic.c:  Tcl_EvalObjv() failed to honor the
	TCL_EVAL_GLOBAL flag when resolving command names. Tcl_EvalEx passed a
	string rep including leading whitespace and comments to
	TclEvalObjvInternal().

2003-04-25  Andreas Kupries  <[email protected]>

	* win/tclWinThrd.c: Applied SF patch #727271. This patch changes the
	code to catch any errors returned by the windows functions handling
	TLS ASAP instead of waiting to get some mysterious crash later on due
	to bogus pointers. Patch provided by Joe Mistachkin.

	This is a stop-gap measure to deal with the low number of ?TLS slots
	provided by some of the variants of Windows (60-80).

2003-04-24  Vince Darley  <[email protected]>

	* generic/tclFileName.c: fix to bug reported privately by Jeff where,
	for example, 'glob -path {[tcl]} *' gets confused by the leading
	special character (which is escaped internally), and instead lists
	files in '/'. Bug only occurs on Windows where '\' is also a directory
	separator.
	* tests/fileName.test: added test for the above bug.

2003-04-22  Andreas Kupries  <[email protected]>

	* The changes below fix SF bugs [593810], and [718045].

	* generic/tclIO.c (Tcl_CutChannel, Tcl_SpliceChannel): Invoke
	TclpCutSockChannel and TclpSpliceSockChannel.

	* generic/tclInt.h: Declare TclpCutSockChannel and
	TclpSpliceSockChannel.

	* unix/tclUnixSock.c (TclpCutSockChannel, TclpSpliceSockChannel):
	Dummy functions, on unix the sockets are _not_ handled specially.

	* mac/tclMacSock.c (TclpCutSockChannel, TclpSpliceSockChannel):
	* win/tclWinSock.c (TclpCutSockChannel, TclpSpliceSockChannel): New
	functions to handle socket specific cut/splice operations: auto-init
	of socket system for thread on splice, management of the module
	internal per-thread list of sockets, management of association of
	sockets with HWNDs for event notification.

	* win/tclWinSock.c (NewSocketInfo): Extended initialization
	assignments to cover all items of the structure. During debugging of
	the new code mentioned above I found that two fileds could contain
	bogus data.

	* win/tclWinFile.c: Added #undef HAVE_NO_FINDEX_ENUMS before
	definition because when compiling in debug mode the compiler complains
	about a redefinition, and this warning is also treated as an error.

2003-04-21  Don Porter  <[email protected]>

	* library/tcltest/tcltest.tcl:  When the return code of a test does
	not meet expectations, report that as the reason for test failure, and
	do not attempt to check the test result for correctness. [Bug 725253]

2003-04-18  Jeff Hobbs  <[email protected]>

	* win/tclWinInt.h (VER_PLATFORM_WIN32_CE): conditionally define.
	* win/tclWinInit.c: recognize Windows CE as a Win platform. This just
	recognizes CE - full support will come later.

	* win/configure: regen
	* win/configure.in (SHELL): force it to /bin/sh as autoconf 2.5x
	uses /bin/bash, which can fail to find exes in the path (ie: lib).

	* generic/tclExecute.c (ExprCallMathFunc): remove incorrect
	extraneous cast from Tcl_WideAsDouble.

2003-04-18  Donal K. Fellows  <[email protected]>

	* doc/open.n:		Moved serial port options from [fconfigure] to
	* doc/fconfigure.n:	[open] as it is up to the creator of a channel
				to describe the channel's special config
				options. [Bug 679010]

2003-04-16  Don Porter  <[email protected]>

	* generic/tcl.h:	Made changes so that the "wideInt" Tcl_ObjType
	* generic/tclObj.c:	is defined on all platforms, even those where
	* generic/tclPort.h:	TCL_WIDE_INT_IS_LONG is defined. Also made the
	Tcl_Value struct have a wideValue field on all platforms. This is a
	***POTENTIAL INCOMPATIBILITY*** for TCL_WIDE_INT_IS_LONG platforms
	because that struct changes size. This is the same TIP 72
	incompatibility that was seen on other platforms at the 8.4.0 release,
	when this change should have happened as well. [Bug 713562]

	* generic/tclInt.h:  New internal macros TclGetWide() and
	TclGetLongFromWide() to deal with both forms of the "wideInt"
	Tcl_ObjType, so that conditional TCL_WIDE_INT_IS_LONG code is confined
	to the header file.

	* generic/tclCmdAH.c:	Replaced most coding that was conditional
	* generic/tclCmdIL.c:	on TCL_WIDE_INT_IS_LONG with code that
	* generic/tclExecute.c: works across platforms, sometimes using
	* generic/tclTest.c:	the new macros above to do it.
	* generic/tclUtil.c:
	* generic/tclVar.c:

2003-04-17  Donal K. Fellows  <[email protected]>

	* doc/socket.n: Added a paragraph to remind people to specify their
	encodings when using sockets. [Bug 630621]

2003-04-16  Donal K. Fellows  <[email protected]>

	* doc/CrtMathFnc.3: Functions also have to deal with wide ints, but
	this was not documented. [Bug 709720]

2003-04-16  Vince Darley  <[email protected]>

	* generic/tclPathObj.c: removed undesired 'static' for function which
	is now shared (previously it was duplicated).

2003-04-15  Joe English  <[email protected]>

	* doc/namespace.n: added example section "SCOPED SCRIPTS", supplied by
	Kevin Kenny. [Bug 219183]

2003-04-15  Kevin Kenny  <[email protected]>

	* makefile.vc: Updated makefile.vc to conform with Mo DeJong's changes
	to Makefile.in and tclWinPipe.c on 2003-04-14. Now passes TCL_PIPE_DLL
	in place of TCL_DBGX.
	* win/tclWinTime.c: Corrected use of types to make compilation
	compatible with VC++5.

2003-04-15  Vince Darley  <[email protected]>

	* generic/tclIOUtil.c: finished check-in from yesterday, removing
	duplicate function definition.

2003-04-14  Don Porter  <[email protected]>

	* generic/tclClock.c:	Corrected compiler warnings.
	* generic/tclTest.c:

2003-04-14  Mo DeJong  <[email protected]>

	* win/Makefile.in: Don't define TCL_DBGX symbol for every compile.
	Instead, define TCL_PIPE_DLL only when compiling tclWinPipe.c. This
	will break other build systems, so they will need to remove the
	TCL_DBGX define and replace it with a define for TCL_PIPE_DLL.
	* win/tclWinPipe.c (TclpCreateProcess): Remove PREFIX_IDENT and
	DEBUG_IDENT from top of file. Use TCL_PIPE_DLL passed in from build
	env instead of trying to construct the dll name from already defined
	symbols. This approach is more flexible and better in the long run.

2003-04-14  Kevin Kenny  <[email protected]>

	* win/tclWinFile.c: added conditionals to restore compilation on
	VC++6, which was broken by recent changes.

2003-04-14  Vince Darley  <[email protected]>

	* generic/tclIOUtil.c:
	* generic/tclPathObj.c:
	* generic/tclFileSystem.h: overlooked one function which was
	duplicated, so this is now shared between modules.
	* win/tclWinFile.c: allow this file to compile with VC++ 5.2 again
	since Mingw build fixes broke that.

2003-04-13  Mo DeJong  <[email protected]>

	* win/configure: Regen.
	* win/configure.in: Add check for FINDEX_INFO_LEVELS from winbase.h,
	known to be a problem in VC++ 5.2. Define HAVE_NO_FINDEX_ENUMS if the
	define does not exist.
	* win/tclWinFile.c: Put declarations for FINDEX_INFO_LEVELS and
	FINDEX_SEARCH_OPS inside a check for HAVE_NO_FINDEX_ENUMS so that
	these are not declared twice. This fixes the Mingw build.
	* win/tclWinTime.c: Rework the init of timeInfo so that the number or
	initializers matches the declaration. This was broken under Mingw. Add
	cast to avoid compile warning when calling the AccumulateSample
	function.

2003-04-12  Jeff Hobbs  <[email protected]>

	* win/Makefile.in (GENERIC_OBJS): add missing tclPathObj.c

2003-04-12  Kevin Kenny  <[email protected]>

	* doc/clock.n:
	* generic/tclClock.c (Tcl_ClockObjCmd):
	* tests/clock.test: Implementation of TIP #124. Also renumbered test
	cases to avoid duplicates. [Bug 710310]
	* tests/winTime.test:
	* win/tclWinTest.c (TestwinclockCmd, TestwinsleepCmd):
	* win/tclWinTime.c (Tcl_WinTime, UpdateTimeEachSecond,
	(ResetCounterSamples, AccumulateSample, SAMPLES, TimeInfo): Made
	substantial changes to the phase-locked loop (replaced an IIR filter
	with an FIR one) in a quest for improved loop stability (Bug not
	logged at SF, but cited in private communication from Jeff Hobbs).

2003-04-11  Don Porter  <[email protected]>

	* generic/tclCmdMZ.c (Tcl_StringObjCmd,STR_IS_INT):  Corrected
	inconsistent results of [string is integer] observed on systems where
	sizeof(long) != sizeof(int). [Bug 718878]
	* tests/string.test: Added tests for Bug 718878.
	* doc/string.n: Clarified that [string is integer] accepts 32-bit
	integers.

2003-04-11  Andreas Kupries  <[email protected]>

	* generic/tclIO.c (UpdateInterest): When dropping interest in
	TCL_READABLE now dropping interest in TCL_EXCEPTION too. This fixes a
	bug where Expect detects eof on a file prematurely on solaris 2.6 and
	higher. A much more complete explanation is in the code itself (40
	lines of comments for a one-line change :)

2003-04-11  Vince Darley  <[email protected]>

	* tests/cmdAH.test: fix test suite problem if /home is a symlink. [Bug
	703264]
	* generic/tclIOUtil.c: fix bad error message with 'cd ""'. [Bug
	704917]
	* win/tclWinFile.c, win/tclWin32Dll.c:
	* win/tclWinInt.h: allow Tcl to differentiate between reparse points
	which are symlinks and mounted volumes, and correctly handle the
	latter. This involves some elaborate code to find the actual drive
	letter (if possible) corresponding to a mounted volume. [Bug 697862]
	* tests/fileSystem.test: add constraints to stop tests running in
	ordinary tcl interpreter. [Bug 705675]

	* generic/tclIOUtil.c:
	* generic/tclPathObj.c: (new file)
	* generic/tclFileSystem.h: (new file)
	* win/makefile.vc:
	Split path object handling out of the virtual filesystem layer, into
	tclPathObj.c. This refactoring cleans up the internal filesystem code,
	and will make any future optimisations and forthcoming better
	thread-safety much easier.

	* generic/tclTest.c:
	* tests/reg.test: added some 'knownBug' tests for problems in Tcl's
	regexp code with the TCL_REG_CAN_MATCH flag (see Bug 703709). Code too
	impenetrable to fix right now, but a fix is needed for tip113 to work
	correctly.

	* tests/fCmd.test
	* win/tclWinFile.c: added some filesystem optimisation to the 'glob'
	implementation, and some new tests.

	* generic/tclCmdMZ.c: fix typo in comment

	* tests/winFile.test:
	* tests/ioUtil.test:
	* tests/unixFCmd.test: renumbered tests with duplicate numbers. [Bug
	710361]

2003-04-10  Donal K. Fellows  <[email protected]>

	* doc/binary.n: Fixed typo in [binary format w] desc. [Bug 718543]

2003-04-08  Donal K. Fellows  <[email protected]>

	* generic/tclCmdAH.c (Tcl_ErrorObjCmd): Strings are only empty if
	they have zero length, not if their first byte is zero, so fix test
	guarding Tcl_AddObjErrorInfo to take this into account. [Bug
	reported by Don Porter; no bug-id.]

2003-04-07  Don Porter  <[email protected]>

	* generic/tclCompCmds.c (TclCompileIfCmd):  Corrected string limits of
	arguments interpolated in error messages. [Bug 711371]

	* generic/tclCmdMZ.c (TraceExecutionProc):  Added missing
	Tcl_DiscardResult() call to avoid memory leak.

2003-04-07  Donal K. Fellows  <[email protected]>

	* generic/tclDictObj.c (Tcl_DictObjCmd): Stopped compilers from
	moaning about switch fall-through.  [Bug 716327]
	(DictFilterCmd): Yet more warning killing, this time reported by
	Miguel Sofer by private chat.

2003-04-07  Donal K. Fellows  <[email protected]>

	* tests/dict.test (dict-2.6):
	* generic/tclDictObj.c (Tcl_NewDictObj, Tcl_DbNewDictObj): Oops!
	Failed to fully initialise the Dict structure.
	(DictIncrCmd): Moved valueAlreadyInDictionary label to stop compiler
	complaints. [Bug 715751]

	* generic/tclDictObj.c (DictIncrCmd): Followed style in the rest of
	the core by commenting out wide-specific operations on platforms where
	wides are longs, and used longs more thoroughly than ints through
	[dict incr] anyway to forestall further bugs.
	* generic/tclObj.c: Made sure there's always a tclWideIntType
	implementation available, not that it is always useful. [Bug 713562]

2003-04-05  Donal K. Fellows  <[email protected]>

	* generic/tclDictObj.c: Removed commented out notes on declarations to
	be moved to elsewhere in the Tcl core.

	* generic/tclInt.h:	Final stages of plumbing in.
	* generic/tclBasic.c:
	* generic/tclObj.c (TclInitObjSubsystem):

	* unix/Makefile.in, win/Makefile.in, win/makefile.[bv]c: Build support.
	* generic/tcl.decls: Added dict public API to stubs table.
	* generic/tcl.h (Tcl_DictSearch): Added declaration of structure to
	allow user code to iterate over dictionaries.

	* doc/DictObj.3:	New files containing dictionary implementation
	* doc/dict.n:		documentation and tests as as mandated by TIP
	* generic/tclDictObj.c: #111.
	* tests/dict.test:

2003-04-03  Mo DeJong  <[email protected]>

	* unix/configure:
	* unix/tcl.m4 (SC_CONFIG_CFLAGS): Don't set TCL_LIBS if it is already
	set to support use of TCL_LIBS var from tclConfig.sh in the Tk
	configure script.

2003-04-03  Mo DeJong  <[email protected]>

	* unix/Makefile.in: Don't subst MATH_LIBS, LIBS, and DL_LIBS
	separately. Instead, just subst TCL_LIBS since it includes the
	others.
	* unix/configure: Regen.
	* unix/tcl.m4 (SC_CONFIG_CFLAGS, SC_TCL_LINK_LIBS): Set and subst
	TCL_LIBS in SC_CONFIG_CFLAGS instead of SC_TCL_LINK_LIBS. Don't subst
	MATH_LIBS since it is now covered by TCL_LIBS.
	* unix/tclConfig.sh.in: Use TCL_LIBS instead of DL_LIBS, LIBS, and
	MATH_LIBS.
	* unix/dltest/Makefile.in: Ditto.

2003-04-03  Don Porter  <[email protected]>

	* generic/tclCompCmds.c (TclCompileReturnCmd):  Now that [return]
	compiles to INST_RETURN, it is safe to compile even outside a proc.

2003-04-02  Mo DeJong  <[email protected]>

	* win/configure: Regen.
	* win/configure.in: Set stub lib flag based on new LIBFLAGSUFFIX
	variable.
	* win/tcl.m4 (SC_CONFIG_CFLAGS): Set new LIBFLAGSUFFIX that works like
	LIBSUFFIX, it is used when creating library names. The previous
	implementation would generate -ltclstub85 instead of -ltclstub85s when
	configured with --disable-shared.

2003-04-02  Don Porter  <[email protected]>

	* generic/tclParse.c (TclSubstTokens):  Moved declaration of
	utfCharBytes to beginning of procedure so that it does not go out of
	scope (get free()d) while append is still pointing to it. [Bugs
	703167, 713754]

2003-04-01  Mo DeJong  <[email protected]>

	* unix/configure: Regen.
	* unix/tcl.m4 (SC_CONFIG_CFLAGS): Check for inet_ntoa in -lbind inside
	the BeOS block since doing it later broke the build under SuSE 7.3.
	[Bug 713128]

2003-04-01  Don Porter  <[email protected]>

	* tests/README:  Direct [source] of *.test files is no longer
	recommended. The tests/*.test files should only be evaluated under the
	control of the [runAllTests] command in tests/all.tcl.

	* generic/tclExecute.c (INST_RETURN):  Bytecompiled [return] failed to
	reset iPtr->returnCode, causing tests parse-18.17 and parse-18.21 to
	fail strangely.
	* tests/parse.test (parse-18.21):  Corrected now functioning test.
	Added further coverage tests.

2003-03-31  Don Porter  <[email protected]>

	* tests/parse.test (parse-18.*):  Coverage tests for the new
	implementation of Tcl_SubstObj(). Note that tests parse-18.17 and
	parse-18.21 demonstrate some bugs left to fix in the current code.

2003-03-27  Mo DeJong  <[email protected]>

	* unix/configure: Regen.
	* unix/tcl.m4 (SC_CONFIG_CFLAGS): Use -Wl,--export-dynamic instead of
	-rdynamic for LDFLAGS. The -rdynamic is not documented so it seems
	better to pass the --export-dynamic flag to the linker. [Patch 573395]

2003-03-27  Miguel Sofer <[email protected]>

	* tests/encoding.test:
	* tests/proc-old.test:
	* tests/set-old.test: Altered test numers to eliminate duplicates,
	[Bugs 710313, 710320, 710352]

2003-03-27  Donal K. Fellows  <[email protected]>

	* tests/parseOld.test:	Altered test numers to eliminate duplicates.
	* tests/parse.test:	[Bugs 710365, 710369]
	* tests/expr-old.test:
	* tests/expr.test:

	* tests/utf.test:	Altered test numers to eliminate duplicates.
	* tests/trace.test:	[Bugs 710322, 710327, 710349, 710363]
	* tests/lsearch.test:
	* tests/list.test:
	* tests/info.test:
	* tests/incr-old.test:
	* tests/if-old.test:
	* tests/format.test:
	* tests/foreach.test:

2003-03-26  Mo DeJong  <[email protected]>

	* unix/configure: Regen.
	* unix/tcl.m4 (SC_CONFIG_CFLAGS, SC_TCL_LINK_LIBS): Add BeOS system to
	SC_CONFIG_CFLAGS. Check for inet_ntoa in -lbind, needed for BeOS.

2003-03-26  Don Porter  <[email protected]>

	* doc/tcltest.n:
	* library/tcltest/tcltest.tcl:  Added reporting during [configure
	-debug 1] operations to warn about multiple uses of the same test
	name. [FRQ 576693]

	* tests/msgcat.test (msgcat-2.2.1): changed test name to avoid
	duplication. [Bug 710356]

	* unix/dltest/pkg?.c:  Changed all Tcl_InitStubs calls to pass
	argument exact = 0, so that rebuilds are not required when Tcl
	bumps to a new version.  [Bug 701926]

2003-03-24  Miguel Sofer <[email protected]>

	* generic/tclVar.c:
	* tests/var.test: fixing ObjMakeUpvar's lookup algorithm for the
	created local variable. [Bug 631741] (Chris Darroch) and [Bug 696893]
	(David Hilker)

2003-03-24  Pat Thoyts  <[email protected]>

	* library/dde/pkgIndex.tcl: bumped version to 1.2.2 in tclWinDde.c,
	now adding here too.

2003-03-22  Kevin Kenny  <[email protected]>

	* library/dde/pkgIndex.tcl:
	* library/reg/pkgIndex.tcl: Fixed a bug where [package require dde]
	or [package require registry] attempted to load the release version
	of the DLL into a debug build. [Bug 708218] Thanks to Joe Mistachkin
	for the patch.
	* win/makefile.vc: Added quoting around the script name in the 'test'
	target; Joe Mistachkin insists that he has a configuration that fails
	to launch tcltest without it, and it appears harmless otherwise.

2003-03-22  Pat Thoyts  <[email protected]>

	* win/tclWinDde.c: Make dde services conform the the documentation
	such that giving only a topic name really returns all services with
	that topic. [Bug 219155]
	Prevent hangup caused by dde server applications failing to process
	messages. [Bug 707822]
	* tests/winDde.test: Corrected labels and added a test for search by
	topic name.

2003-03-20  Don Porter  <[email protected]>

	* generic/tclInt.h (tclOriginalNotifier):
	* generic/tclStubInit.c (tclOriginalNotifier):
	* mac/tclMacNotify.c (Tcl_SetTimer,Tcl_WaitForEvent):
	* unix/tclUnixNotfy.c (Tcl_SetTimer,Tcl_WaitForEvent,
	(Tcl_CreateFileHandler,Tcl_DeleteFileHandler):
	* win/tclWinNotify.c (Tcl_SetTimer,Tcl_WaitForEvent):  Some linkers
	apparently use a different representation for a pointer to a function
	within the same compilation unit and a pointer to a function in a
	different compilation unit. This causes checks like those in the
	original notifier procedures to fall into infinite loops. The fix is
	to store pointers to the original notifier procedures in a struct
	defined in the same compilation unit as the stubs tables, and compare
	against those values. [Bug 707174]

	* generic/tclInt.h:  Removed definition of ParseValue struct that is
	no longer used.

2003-03-19  Miguel Sofer <[email protected]>

	* generic/tclCompile.c:
	* tests/compile.test: bad command count on TCL_OUT_LINE_COMPILE.
	[Bug 705406] (Don Porter)

2003-03-19  Don Porter  <[email protected]>

	* library/auto.tcl:		Replaced [regexp] and [regsub] with
	* library/history.tcl:		[string map] where possible.  Thanks
	* library/ldAout.tcl:		to David Welton. [Bugs 667456,667558]
	* library/safe.tcl:		Bumped to http 2.4.3, opt 0.4.5, and
	* library/http/http.tcl:	tcltest 2.2.3.
	* library/http/pkgIndex.tcl:
	* library/opt/optparse.tcl:
	* library/opt/pkgIndex.tcl:
	* library/tcltest/tcltest.tcl:
	* library/tcltest/pkgIndex.tcl:
	* tools/genStubs.tcl:
	* tools/tcltk-man2html.tcl:
	* unix/mkLinks.tcl:

	* doc/Eval.3 (Tcl_EvalObjEx):			Corrected CONST and
	* doc/ParseCmd.3 (Tcl_EvalTokensStandard):	return type errors in
	documentation. [Bug 683994]

	* generic/tclCompCmds.c (TclCompileReturnCmd):  Alternative fix for
	* generic/tclCompile.c (INST_RETURN):	[Bug 633204] that uses a new
	* generic/tclCompile.h (INST_RETURN):	bytecode INST_RETURN to
	* generic/tclExecute.c (INST_RETURN):	properly bytecode the [return]
	command to something that returns TCL_RETURN.

2003-03-18  Mo DeJong  <[email protected]>

	* win/configure: Regen.
	* win/configure.in: Don't run the AC_CYGWIN macro since it uses
	AC_CANONICAL_HOST under autoconf 2.5X. Just check to see if __CYGWIN__
	is defined by the compiler and set the ac_cv_cygwin variable based on
	that. [Bug 705912]

2003-03-18  Kevin Kenny  <[email protected]>

	* tests/registry.test: Changed the conditionals to avoid an abort if
	[testlocale] is missing, as when running the test in tclsh rather than
	tcltest. [Bug 705677]

2003-03-18  Daniel Steffen  <[email protected]>

	* tools/tcltk-man2html.tcl: added support for building 'make html'
	from inside distribution directories named with 8.x.x version numbers.
	tcltk-man2html now uses the latest tcl8.x.x resp. tk8.x.x directories
	found inside its --srcdir argument.

2003-03-17  Mo DeJong  <[email protected]>

	* tests/format.test: Renumber tests, a bunch of tests all had the same
	id.

2003-03-17  Donal K. Fellows  <[email protected]>

	* doc/lsearch.n:	Altered documentation of -ascii options so
	* doc/lsort.n:		they don't specify that they operate on ASCII
				strings, which they never did anyway. [Bug
				703807]

2003-03-14  Donal K. Fellows  <[email protected]>

	* generic/tclCmdAH.c (Tcl_FormatObjCmd): Only add the modifier that
	indicates we've got a wide int when we're formatting in an integer
	style.  Stops some libc's from going mad. [Bug 702622] Also tidied
	whitespace.

2003-03-13  Mo DeJong  <[email protected]>

	* win/tcl.m4 (SC_WITH_TCL): Port version number fix that was made in
	tk instead of tcl sources.

2003-03-13  Mo DeJong  <[email protected]>

	Require autoconf 2.57 or newer, see TIP 34 for a detailed explanation
	of why this is good. This will no doubt break the build on some
	platforms, let the flaming begin.

	* tools/configure: Regen with autoconf 2.57.
	* tools/configure.in: Require autoconf 2.57.
	* unix/configure: Regen with autoconf 2.57.
	* unix/configure.in: Require autoconf 2.57.
	Apply AC_LIBOBJ changes from patch 529884.
	* unix/tcl.m4: Ditto.
	* win/configure: Regen with autoconf 2.57.
	* win/configure.in: Require autoconf 2.57.
	Don't subst LIBOBJS since this happens by default, this avoids an
	autoconf error.

2003-03-12  Don Porter  <[email protected]>

	* generic/tclBasic.c (Tcl_EvalTokensStandard):
	* generic/tclCmdMZ.c (Tcl_SubstObj):
	* generic/tclCompCmds.c (TclCompileSwitchCmd):
	* generic/tclCompExpr.c (CompileSubExpr):
	* generic/tclCompile.c (TclSetByteCodeFromAny,TclCompileScript,
	(TclCompileTokens,TclCompileCmdWord):
	* generic/tclCompile.h (TclCompileScript):
	* generic/tclExecute.c (TclCompEvalObj):
	* generic/tclInt.h (Interp,TCL_BRACKET_TERM,TclSubstTokens):
	* generic/tclParse.c (ParseTokens,Tcl_SubstObj,TclSubstTokens):
	* tests/subst.test (2.4, 8.7, 8.8, 11.4, 11.5):
	Substantial refactoring of Tcl_SubstObj to make use of the same
	parsing and substitution procedures as normal script evaluation.
	Tcl_SubstObj() moved to tclParse.c. New routine TclSubstTokens()
	created in tclParse.c which implements all substantial functioning of
	Tcl_EvalTokensStandard(). TclCompileScript() loses its "nested"
	argument, the Tcl_Interp struct loses its termOffset field and the
	TCL_BRACKET_TERM flag in the evalFlags field, all of which were only
	used (indirectly) by Tcl_SubstObj(). Tests subst-8.7,8.8,11.4,11.5
	modified to accomodate the only behavior change: reporting of parse
	errors now takes precedence over [return] and [continue] exceptions.
	All other behavior should remain compatible. [RFE 536831,684982] [Bug
	685106]

	* generic/tcl.h:        Removed TCL_PREFIX_IDENT and TCL_DEBUG_IDENT
	* win/tclWinPipe.c:     from tcl.h -- they are not part of Tcl's
	public interface.  Put them in win/tclWinPipe.c where they are used.

	* generic/tclInterp.c (Tcl_InterpObjCmd):       Corrected and added
	* tests/interp.test (interp-2.13):              test for option
	parsing beyond objc for [interp create --]. Thanks to Marco Maggi.
	[Bug 702383]

2003-03-11  Kevin Kenny  <[email protected]>

	* win/makefile.vc: Added two missing uses of $(DBGX) so that
	tclpip8x.dll loads without panicking on Win9x.

2003-03-09  Kevin Kenny  <[email protected]>

	* generic/tclTest.c (TestChannelCmd): Removed an unused local variable
	that caused compilation problems on some platforms.

2003-03-08  Don Porter  <[email protected]>

	* doc/tcltest.n:  Added missing "-body" to example. Thanks to Helmut
	Giese. [Bug 700011]

2003-03-07  Mo DeJong  <[email protected]>

	* tests/io.test:
	* tests/ioCmd.test: Define a fcopy constraint and add it to the
	constraint list of any test that depends on the fcopy command. This is
	only useful to Jacl which does not support fcopy.

2003-03-07  Mo DeJong  <[email protected]>

	* tests/encoding.test: Name temp files *.tcltestout instead of *.out
	so that when they are removed later, we don't accidently toast any
	files named *.out that the user has created in the build directory.

2003-03-07  Donal K. Fellows  <[email protected]>

	* generic/tclCmdAH.c (Tcl_FileObjCmd): Fix the setting of a file's
	mtime and atime on 64-bit platforms. [Bug 698146]

2003-03-06  Mo DeJong  <[email protected]>

	* tests/io.test: Doh! Undo accidental commenting out of a couple of
	tests.

2003-03-06  Mo DeJong  <[email protected]>

	* tests/io.test: Define a fileevent constraint and add it to the
	constraint list of any test that depends on the fileevent command.
	This is only useful to Jacl which does not support fileevent.

2003-03-06  Mo DeJong  <[email protected]>

	* tests/io.test: Define an openpipe constraint and add it to the
	constraint list of any test that creates a pipe using the open
	command. This is only useful to Jacl which does not support pipes.

2003-03-06  Don Porter  <[email protected]>

	* generic/TclUtf.c (Tcl_UniCharNcasecmp):       Corrected failure to
	* tests/utf.test (utf-25.*):    properly compare Unicode strings of
	different case in a case insensitive manner.  [Bug 699042]

2003-03-06  Kevin Kenny  <[email protected]>

	* generic/tclCompCmds.c (TclCompileSwitchCmd):
	Replaced a non-portable 'bzero' with a portable 'memset'. [Bug 698442]

2003-03-06  Mo DeJong  <[email protected]>

	* generic/tclIO.c (Tcl_Seek, Tcl_OutputBuffered): If there is data
	buffered in the statePtr->curOutPtr member then set the BUFFER_READY
	flag in Tcl_Seek. This is needed so that the next call to FlushChannel
	will write any buffered bytes before doing the seek. The existing code
	would set the BUFFER_READY flag inside the Tcl_OutputBuffered
	function. This was a programming error made when Tcl_OutputBuffered
	was originally created in CVS revision 1.35. The setting of the
	BUFFER_READY flag should not have been included in the
	Tcl_OutputBuffered function.
	* generic/tclTest.c (TestChannelCmd): Use the Tcl_InputBuffered and
	Tcl_OutputBuffered util methods to query the amount of buffered input
	and output.

2003-03-06  Mo DeJong  <[email protected]>

	* generic/tclIO.c (Tcl_Flush): Compare the nextAdded member of the
	ChannelBuffer to the nextRemoved member to determine if any output has
	been buffered. The previous check against the value 0 seems to have
	just been a coding error. See other methods like Tcl_OutputBuffered
	for examples where nextAdded is compared to nextRemoved to find the
	number of bytes buffered.

2003-03-06  Mo DeJong  <[email protected]>

	* generic/tclIO.c (Tcl_GetsObj): Check that the eol pointer has not
	gone past the end of the string when in auto translation mode and the
	INPUT_SAW_CR flag is set. The previous code worked because the end of
	string value \0 was being compared to \n, this patch just skips that
	pointless check.

2003-03-06  Mo DeJong  <[email protected]>

	* generic/tclIO.c (WriteBytes, WriteChars, Tcl_GetsObj, ReadBytes):
	Rework calls to TranslateOutputEOL to make it clear that a boolean
	value is being returned. Add some comments in an effort to make the
	code more clear. This patch makes no functional changes.

2003-03-06  Mo DeJong  <[email protected]>

	* generic/tclIO.c (Tcl_SetChannelOption): Invoke the
	Tcl_SetChannelBufferSize method as a result of changing the
	-buffersize option to fconfigure. The previous implementation used
	some inlined code that reset the buffer size to the default size
	instead of ignoring the request as implemented in
	Tcl_SetChannelBufferSize.
	* tests/io.test: Update test case so that it actually checks the
	implementation of Tcl_SetChannelBufferSize.

2003-03-05  David Gravereaux  <[email protected]>

	* win/rules.vc: updated default tcl version to 8.5.

2003-03-05  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmds.c (TclCompileSwitchCmd): First attempt at a
	bytecode-compiled switch command. It only handles the most common case
	of switching, but that should be enough for this to speed up a lot of
	people's code. It is expected that the speed gains come from two
	things: better handling of the switch itself, and integrated
	compilation of the arms instead of embedding separate bytecode
	sequences (i.e. better local variable handling.)
	* tests/switch.test (switch-10.*): Tests of both uncompiled and
	compiled switch behaviour. [Patch #644819]

	* generic/tclCompile.h (TclFixupForwardJumpToHere): Additional macro
	to make the most common kind of jump fixup a bit easier.

2003-03-04  Don Porter	<[email protected]>

	* README:				Bumped version number of
	* generic/tcl.h:			Tcl to 8.5a0.
	* library/init.tcl:
	* mac/README:
	* macosx/Tcl.pbproj/project.pbxproj:
	* tests/basic.test:
	* tools/configure.in:
	* tools/tcl.hpj.in:
	* tools/tcl.wse.in:
	* unix/configure.in:
	* unix/tcl.spec:
	* win/README:
	* win/README.binary:
	* win/configure.in:
	* win/makefile.bc:
	* win/makefile.vc:
	* win/tcl.m4:

	* tools/configure:	autoconf
	* unix/configure:
	* win/configure:

2003-03-03  Jeff Hobbs  <[email protected]>

	*** 8.4.2 TAGGED FOR RELEASE ***

2003-03-03  Daniel Steffen  <[email protected]>

	Mac OS Classic specific fixes:
	* generic/tclIOUtil.c (TclNewFSPathObj): on TCL_PLATFORM_MAC, skip
	potential directory separator at the beginning of addStrRep.
	* mac/tclMacChan.c (OpenFileChannel, CommonWatch): followup fixes to
	cut and splice implementation for file channels.
	* mac/tclMacFile.c (TclpUtime): pass native path to utime().
	* mac/tclMacFile.c (TclpObjLink): correctly implemented creation of
	alias files via new static proc CreateAliasFile().
	* mac/tclMacPort.h: define S_ISLNK macro to fix stat'ing of links.
	* mac/tclMacUtil.c (FSpLocationFromPathAlias): fix to enable stat'ing
	of broken links.

2003-03-03  Kevin Kenny  <[email protected]>

	* win/Makefile.vc: corrected bug introduced by 'g' for debug builds.

2003-03-03  Don Porter	<[email protected]>

	* library/dde/pkgIndex.tcl:	dde bumped to version 1.2.1 for
	* win/tclWinDde.c:		bundled release with Tcl 8.4.2

	* library/reg/pkgIndex.tcl:	registry bumped to version 1.1.1 for
	* win/tclWinReg.c:		bundled release with Tcl 8.4.2

	* library/opt/pkgIndex.tcl:	updated package index to version 0.4.4

2003-02-28  Jeff Hobbs  <[email protected]>

	* win/configure:
	* win/configure.in: check for 'g' for debug build type, not 'd'.
	* win/rules.vc (DBGX): correct to use 'g' for nmake win makefile to
	match the cygwin makefile for debug builds. [Bug 635107]

2003-02-28  Vince Darley  <[email protected]>

	* doc/file.n: subcommand is 'file volumes' not 'file volume'

2003-02-27  Jeff Hobbs  <[email protected]>

	* generic/tclIOUtil.c (MakeFsPathFromRelative): removed dead code
	check of typePtr (darley).

	* tests/winTime.test: added note about PCI hardware dependency issues
	with high performance clock.

2003-02-27  Donal K. Fellows  <[email protected]>

	* tests/lsearch.test (lsearch-10.7):
	* generic/tclCmdIL.c (Tcl_LsearchObjCmd): Stopped -start option from
	causing an option when used with an empty list. [Bug 694232]

2003-02-26  Chengye Mao <[email protected]>

	* win/tclWinInit.c: fixed a bug in TclpSetVariables by initializing
	dwUserNameLen with the sizeof(szUserName) before calling GetUserName.
	Don't know if this bug has been recorded: it caused crash in starting
	Tcl or wish in Windows.

2003-02-26  Jeff Hobbs	<[email protected]>

	* generic/tclCmdMZ.c (TraceCommandProc): Fix mem leak when deleting a
	command that had trace on it. [Bug 693564] (sofer)

2003-02-25  Don Porter	<[email protected]>

	* doc/pkgMkIndex.n:	Modified [pkg_mkIndex] to use -nocase matching
	* library/package.tcl:	of -load patterns, to better accomodate common
	user errors due to confusion between [package names] names and [info
	loaded] names.

2003-02-25  Andreas Kupries  <[email protected]>

	* tests/pid.test: See below [Bug 678412].
	* tests/io.test: Made more robust against spaces in paths [Bug 678400]

2003-02-25  Miguel Sofer <[email protected]>

	* tests/execute.test: cleaning up testobj's at the end, to avoid
	  leak warning by valgrind.

2003-02-22  Zoran Vasiljevic  <[email protected]>

	* generic/tclEvent.c (Tcl_FinalizeThread): Fix [Bug 571002]

2003-02-21  Donal K. Fellows  <[email protected]>

	* tests/binary.test (binary-44.[34]):
	* generic/tclBinary.c (ScanNumber): Fixed problem with unwanted
	sign-bit propagation when scanning wide ints. [Bug 690774]

2003-02-21  Daniel Steffen  <[email protected]>

	* mac/tclMacChan.c (TclpCutFileChannel, TclpSpliceFileChannel):
	Implemented missing cut and splice procs for file channels.

2003-02-21  Don Porter  <[email protected]>

	* library/package.tcl (tclPkgUnknown):  Minor performance tweaks to
	reduce the number of [file] invocations. Meant to improve startup
	times, at least a little bit. [Patch 687906]

2003-02-20  Daniel Steffen  <[email protected]>

	* unix/tcl.m4:
	* unix/tclUnixPipe.c: (macosx) use vfork() instead of fork() to create
	new processes, as recommended by Apple (vfork can be up to 100 times
	faster thank fork on macosx).
	* unix/configure: regen.

2003-02-20  Jeff Hobbs  <[email protected]>

	* generic/tclEncoding.c (LoadTableEncoding):
	* library/encoding/cp932.enc:      Correct jis round-trip encoding
	* library/encoding/euc-jp.enc:     by adding 'R' type to .enc files.
	* library/encoding/iso2022-jp.enc: [Patch 689341] (koboyasi, taguchi)
	* library/encoding/jis0208.enc:
	* library/encoding/shiftjis.enc:
	* tests/encoding.test:

	* unix/tclUnixChan.c (Tcl_MakeTcpClientChannel): add
	MakeTcpClientChannelMode that takes actual mode flags to avoid hang on
	OS X (may be OS X bug, but patch works x-plat). [Bug 689835] (steffen)

2003-02-20  Donal K. Fellows  <[email protected]>

	* doc/regsub.n: Typo fix [Bug 688943]

2003-02-19  Jeff Hobbs  <[email protected]>

	* unix/tclUnixThrd.c (TclpReaddir):
	* unix/tclUnixPort.h: update to Bug 689100 patch to ensure that there
	is a defined value of MAXNAMLEN (aka NAME_MAX in POSIX) and that we
	have some buffer allocated.

2003-02-19  Daniel Steffen  <[email protected]>

	* generic/tclStringObj.c: restored Tcl_SetObjLength() side-effect of
	always invalidating unicode rep (if the obj has a string rep). Added
	hasUnicode flag to String struct, allows decoupling of validity of
	unicode rep from buffer size allocated to it (improves memory
	allocation efficiency). [Bugs 686782, 671138, 635200]

	* macosx/Tcl.pbproj/project.pbxproj:
	* macosx/Makefile: reworked embedded build to no longer require
	relinking but to use install_name_tool instead to change the
	install_names for embedded frameworks. [Bug 644510]

	* macosx/Tcl.pbproj/project.pbxproj: preserve mod dates when running
	'make install' to build framework (avoids bogus rebuilds of dependent
	frameworks because tcl headers appear changed).

	* tests/ioCmd.test (iocmd-1.8): fix failure when system encoding is
	utf-8: use iso8859-1 encoding explicitly.

2003-02-18  Miguel Sofer <[email protected]>

	* generic/tclCompile.c (TclCompileExprWords): remove unused variable
	"range" [Bug 664743]
	* generic/tclExecute.c (ExprSrandFunc): remove unused variable
	"result" [Bug 664743]
	* generic/tclStringObj.c (UpdateStringOfString): remove unused
	variable "length" [Bug 664751]
	* tests/execute.test (execute-7.30): fix for [Bug 664775]

2003-02-18  Andreas Kupries  <[email protected]>

	* unix/tcl.m4: [Bug #651811] Added definition of _XOPEN_SOURCE and
	linkage of 'xnet' library to HP 11 branch. This kills a lot of
	socket-related failures in the testsuite when Tcl was compiled in 64
	bit mode (both PA-RISC 2.0W, and IA 64).

	* unix/configure: Regenerated.

2003-02-18  Jeff Hobbs  <[email protected]>

	* generic/tclIO.c (HaveVersion): correctly decl static

	* unix/tclUnixThrd.c (TclpReaddir): reduce size of name string in tsd
	to NAME_MAX instead of PATH_MAX. [Bug 689100] (waters)

2003-02-18  Mo DeJong  <[email protected]>

	* unix/configure: Regen.
	* unix/tcl.m4 (SC_ENABLE_THREADS): Make sure -lpthread gets passed on
	the link line when checking for the pthread_attr_setstacksize symbol.

2003-02-18  Vince Darley  <[email protected]>

	* generic/tclTest.c: cleanup of new 'simplefs' test code, and better
	documentation.

2003-02-17  Miguel Sofer <[email protected]>

	* generic/tclBasic.c (TclRenameCommand): fixing error in previous
	commit.

2003-02-17  Jeff Hobbs  <[email protected]>

	* generic/tclExecute.c (TclExecuteByteCode INST_STR_MATCH):
	* generic/tclCmdMZ.c (Tcl_StringObjCmd STR_MATCH):
	* generic/tclUtf.c (TclUniCharMatch):
	* generic/tclInt.decls:  add private TclUniCharMatch function that
	* generic/tclIntDecls.h: does string match on counted unicode
	* generic/tclStubInit.c: strings. Tcl_UniCharCaseMatch has the failing
	* tests/string.test:     that it can't handle strings or patterns with
	* tests/stringComp.test: embedded NULLs. Added tests that actually try
	strings/pats with NULLs. TclUniCharMatch should be TIPed and made
	public in the next minor version rev.

2003-02-17  Miguel Sofer <[email protected]>

	* generic/tclBasic.c (TclRenameCommand): 'oldFullName' object was not
	being freed on all function exits, causing a memory leak. [Bug 684756]

2003-02-17  Mo DeJong  <[email protected]>

	* generic/tclIO.c (Tcl_GetsObj): Minor change so that eol is only
	assigned at the top of the TCL_TRANSLATE_AUTO case block. The other
	cases assign eol so this does not change any functionality.

2003-02-17  Kevin Kenny  <[email protected]>

	* tests/notify.test: Removed Windows line terminators. [Bug 687913].

2003-02-15  Miguel Sofer <[email protected]>

	* generic/tclBasic.c (Tcl_EvalEx):
	* generic/tclCompExpr.c (CompileSubExpr):
	* generic/tclCompile.c (TclCompileScript):
	* generic/tclParse.c (Tcl_ParseCommand, ParseTokens):
	* generic/tclParseExpr.c (ParsePrimaryExpr):
	* tests/basic.test (47.1):
	* tests/main.test (3.4):
	* tests/misc.test (1.2):
	* tests/parse.test (6.18):
	* tests/parseExpr.test (15.35):
	* tests/subst.test (8.6): Don Porter's fix for bad parsing of nested
	scripts. [Bug 681841]

2003-02-15  Kevin Kenny  <[email protected]>

	* tests/notify.test (new-file):
	* generic/tclTest.c (TclTest_Init, EventtestObjCmd, EventtestProc,
	(EventTestDeleteProc):
	* generic/tclNotify.c (Tcl_DeleteEvents): Fixed Tcl_DeleteEvents not
	to get a pointer smash when deleting the last event in the queue.
	Added test code in 'tcltest' and a new file of test cases
	'notify.test' to exercise this functionality; several of the new test
	cases fail for the original code and pass for the corrected code. [Bug
	673714]

	* unix/tclUnixTest.c (TestfilehandlerCmd): Corrected a couple of typos
	in error messages. [Bug 596027]

2003-02-14  Jeff Hobbs  <[email protected]>

	* README:		Bumped to version 8.4.2.
	* generic/tcl.h:
	* tools/tcl.wse.in:
	* unix/configure:
	* unix/configure.in:
	* unix/tcl.m4:
	* unix/tcl.spec:
	* win/README.binary:
	* win/configure:
	* win/configure.in:
	* macosx/Tcl.pbproj/project.pbxproj:

	* generic/tclStringObj.c (Tcl_GetCharLength): perf tweak

	* unix/tcl.m4: correct HP-UX ia64 --enable-64bit build flags

2003-02-14  Kevin Kenny  <[email protected]>

	* win/tclWinTime.c: Added code to test and compensate for forward
	leaps of the performance counter. See the MSDN Knowledge Base article
	Q274323 for the hardware problem that makes this necessary on certain
	machines.
	* tests/winTime.test: Revised winTime-2.1 - it had a tolerance of
	thousands of seconds, rather than milliseconds. (What's six orders of
	magnitude among friends?) Both the above changes are triggered by a
	problem reported at:
	http://aspn.activestate.com/ASPN/Mail/Message/ActiveTcl/1536811
	although the developers find it difficult to believe that it accounts
	for the observed behavior and suspect a fault in the RTC chip.

2003-02-13  Kevin Kenny  <[email protected]>

	* win/tclWinInit.c: Added conversion from the system encoding to
	tcl_platform(user), so that it works with non-ASCII7 user names. [Bug
	685926]

	* doc/tclsh.1: Added language to describe the handling of the
	end-of-file character \u001a embedded in a script file. [Bug 685485]

2003-02-11  Vince Darley  <[email protected]>

	* tests/fileName.test:
	* unix/tclUnixFile.c: fix for [Bug 685445] when using 'glob -l' on
	broken symbolic links. Added two new tests for this bug.

2003-02-11  Kevin Kenny  <[email protected]>

	* tests/http.test: Corrected a problem where http-4.14 would fail when
	run in an environment with a proxy server. Replaced references to
	scriptics.com by tcl.tk.

2003-02-11  Jeff Hobbs  <[email protected]>

	* tests/lsearch.test:
	* generic/tclCmdIL.c (Tcl_LsearchObjCmd): protect against the case
	that lsearch -regepx list and pattern objects are equal.

	* tests/stringObj.test:
	* generic/tclStringObj.c (Tcl_GetCharLength): correct ascii char opt
	of 2002-11-11 to not stop early on \x00. [Bug 684699]

	* tests.parse.test: remove excess EOF whitespace

	* generic/tclParse.c (CommandComplete): more paranoid check to break
	on (p >= end) instead of just (p == end).

2003-02-11  Miguel Sofer <[email protected]>

	* generic/tclParse.c (CommandComplete):
	* tests/parse.test: fix for [Bug 684744], by Don Porter.

2003-02-11  Jeff Hobbs  <[email protected]>

	* generic/tclIOUtil.c (Tcl_FSJoinPath, Tcl_FSGetNormalizedPath):
	(UpdateStringOfFsPath): revert the cwdLen == 0 check and instead
	follow a different code path in Tcl_FSJoinPath.
	(Tcl_FSConvertToPathType, Tcl_FSGetNormalizedPath):
	(Tcl_FSGetFileSystemForPath): Update string rep of path objects before
	freeing the internal object. (darley)

	* tests/fileSystem.test: added test 8.3
	* generic/tclIOUtil.c (Tcl_FSGetNormalizedPath):
	(UpdateStringOfFsPath): handle the cwdLen == 0 case

	* unix/tclUnixFile.c (TclpMatchInDirectory): simplify the hidden file
	match check.

2003-02-10  Mo DeJong  <[email protected]>

	* win/configure:
	* win/configure.in: Generate error when attempting to build under
	Cygwin. The Cygwin port of Tcl/Tk does not build and people are filing
	bug reports under the mistaken impression that someone is actually
	maintaining the Cygwin port. A post to comp.lang.tcl asking someone to
	volunteer as an area maintainer has generated no results. Closing bugs
	680840, 630199, and 634772 and marking as "Won't fix".

2003-02-10  Donal K. Fellows  <[email protected]>

	* doc/append.n: Return value was not documented. [Bug 683188]

2003-02-10  Vince Darley  <[email protected]>

	* doc/FileSystem.3:
	* generic/tclIOUtil.c:
	* generic/tclInt.h:
	* tests/fileSystem.test:
	* unix/tclUnixFCmd.c:
	* unix/tclUnixFile.c:
	* win/tclWinFile.c: further filesystem optimization, applying [Patch
	682500]. In particular, these code examples are faster now:
	    foreach f $flist { if {[file exists $f]} {file stat $f arr;...}}
	    foreach f [glob -dir $dir *] { # action and/or recursion on $f }
	    cd $dir
	    foreach f [glob *] { # action and/or recursion on $f }
	    cd ..

	* generic/tclTest.c: Fix for [Bug 683181] where test suite left files
	in 'tmp'.

2003-02-08  Jeff Hobbs  <[email protected]>

	* library/safe.tcl: code cleanup of eval and string comp use.

2003-02-07  Vince Darley  <[email protected]>

	* win/tclWinFCmd.c: cleanup long lines
	* win/tclWinFile.c: sped up pure 'glob' by a factor of 2.5
	('foreach f [glob *] { file exists $f }' is still slow)
	* tests/fileSystem.text:
	* tests/fileName.test: added new tests to ensure correct behaviour in
	optimized filesystem code.

2003-02-07  Vince Darley  <[email protected]>

	* generic/tclTest.c:
	* tests/fileSystem.text: fixed test 7.2 to avoid a possible crash, and
	not change the pwd.

	* tests/http.text: added comment to test 4.15, that it may fail if you
	use a proxy server.

2003-02-06  Mo DeJong  <[email protected]>

	* generic/tclCompCmds.c (TclCompileIncrCmd):
	* tests/incr.test: Don't include the text "(increment expression)" in
	the errorInfo generated by the compiled version of the incr command
	since it does not match the message generated by the non-compiled
	version of incr. It is also not possible to match this error output
	under Jacl, which does not support a compiler.

2003-02-06  Mo DeJong  <[email protected]>

	* generic/tclExecute.c (TclExecuteByteCode): When an error is
	encountered reading the increment value during a compiled call to
	incr, add a "(reading increment)" error string to the errorInfo
	variable. This makes the errorInfo variable set by the compiled incr
	command match the value set by the non-compiled version.
	* tests/incr-old.test: Change errorInfo result for the compiled incr
	command case to match the modified implementation.
	* tests/incr.test: Add tests to make sure the compiled and
	non-compiled errorInfo messages are the same.

2003-02-06  Don Porter  <[email protected]>

	* library/tcltest/tcltest.tcl:  Filename arguments to [outputChannel]
	and [errorChannel] (also -outfile and -errfile) were [open]ed but
	never [closed]. Also, [cleanupTests] could remove output or error
	files. [Bug 676978].
	* library/tcltest/pkgIndex.tcl: Bumped to version 2.2.2.

2003-02-05  Mo DeJong  <[email protected]>

	* tests/interp.test:
	* tests/set-old.test: Run test cases that depend on hash order through
	lsort so that the tests also pass under Jacl. Does not change test
	results under Tcl.

2003-02-04  Vince Darley  <[email protected]>

	* generic/tclIOUtil.c:
	* generic/tclEvent.c:
	* generic/tclInt.h:
	* mac/tclMacFCmd.c:
	* unix/tclUnixFCmd.c:
	* win/tclWin32Dll.c:
	* win/tclWinFCmd.c:
	* win/tclWinInit.c:
	* win/tclWinInt.h:
	* tests/fileSystem.test: fix to finalization/unloading/encoding issues
	to make filesystem much less dependent on encodings for its cleanup,
	and therefore allow it to be finalized later in the exit process. This
	fixes fileSystem.test-7.1. Also fixed one more bug in setting of
	modification dates of files which have undergone cross-platform
	copies. [Patch 676271]

	* tests/basic.test:
	* tests/exec.test:
	* tests/fileName.test:
	* tests/io.test: fixed some test failures when tests are run from a
	directory containing spaces.

	* tests/fileSystem.test:
	* generic/tclTest.c: added regression test for the modification date
	setting of cross-platform file copies.

2003-02-03  Kevin Kenny  <[email protected]>

	* generic/tclBasic.c: Changed [trace add command] so that 'rename'
	callbacks get fully qualified names of the command. [Bug 651271].
	***POTENTIAL INCOMPATIBILITY***
	* tests/trace.test: Modified the test cases for [trace add command] to
	expect fully qualified names on the 'rename' callbacks. Added a case
	for renaming a proc within a namespace.
	* doc/trace.n: Added language about use of fully qualified names in
	trace callbacks.

2003-02-01  Kevin Kenny  <[email protected]>

	* generic/tclCompCmds.c: Removed an unused variable that caused
	compiler warnings on SGI. [Bug 664379]

	* generic/tclLoad.c: Changed the code so that if Tcl_StaticPackage is
	called to report the same package as being loaded in two interps, it
	shows up in [info loaded {}] in both of them (previously, it didn't
	appear in the static package list in the second).

	* tests/load.test Added regression test for the above bug. [Bug
	670042]

	* generic/tclClock.c: Fixed a bug that incorrectly allowed [clock
	clicks {}] and [clock clicks -] to be accepted as if they were [clock
	clicks -milliseconds].

	* tests/clock.test: Added regression tests for the above bug. [Bug
	675356]

	* tests/unixNotfy.test: Added cleanup of working files. [Bug 675609]

	* doc/Tcl.n: Added headings to the eleven paragraphs, to improve
	formatting in the tools that attempt to extract tables of contents
	from the manual pages. [Bug 627455]

	* generic/tclClock.c: Expanded mutex protection around the setting of
	env(TZ) and the thread-unsafe call to tzset(). [Bug 656660]

2003-01-31  Don Porter  <[email protected]>

	* tests/tcltest.test: Cleaned up management of file/directory
	creation/deletion to improve "-debug 1" output. [Bug 675614]
	The utility [slave] command failed to properly [list]-quote a
	constructed [open] command, causing failure when the pathname
	contained whitespace. [Bug 678415]

	* tests/main.test: Stopped main.test from deleting existing file. Test
	suite should not delete files that already exist. [Bug 675660]

2003-01-28  Don Porter  <[email protected]>

	* tests/main.test: Constrain tests that do not work on Windows. [Bug
	674387]

2003-01-28  Vince Darley  <[email protected]>

	* generic/tclIOUtil.c: fix to setting modification date in
	TclCrossFilesystemCopy. Also added 'panic' in
	Tcl_FSGetFileSystemForPath under illegal calling circumstances which
	lead to hard-to-track-down bugs.

	* generic/tclTest.c: added test suite code to allow exercising a
	vfs-crash-on-exit bug in Tcl's finalization caused by the encodings
	being cleaned up before unloading occurs.
	* tests/fileSystem.test: added new 'knownBug' test 7.1 to demonstrate
	the crash on exit.

2003-01-28  Mo DeJong  <[email protected]>

	* generic/tcl.h: Add TCL_PREFIX_IDENT and TCL_DEBUG_IDENT, used only
	by TclpCreateProcess.
	* unix/Makefile.in: Define TCL_DBGX.
	* win/Makefile.in: Define TCL_DBGX.
	* win/tclWinPipe.c (TclpCreateProcess): Check that the Tcl pipe dll
	actually exists in the Tcl bin directory and panic if it is not found.
	Incorporate TCL_DBGX into the Tcl pipe dll name. This fixes a really
	mysterious error that would show up when exec'ing a 16 bit application
	under Win95 or Win98 when Tcl was compiled with symbols. The error
	seemed to indicate that the executable could not be found, but it was
	actually the Tcl pipe dll that could not be found.

2003-01-26  Mo DeJong  <[email protected]>

	* win/README: Update msys+mingw URL to release 6. This version bundles
	gcc 3.

2003-01-26  Mo DeJong  <[email protected]>

	* win/configure: Regen.
	* win/configure.in: Add test that checks to see if the compiler can
	cast to a union type.
	* win/tclWinTime.c: Squelch compiler warning about union initializer
	by casting to union type when compiling with gcc.

2003-01-25  Mo DeJong  <[email protected]>

	* generic/tclIO.c (Tcl_CutChannel, Tcl_SpliceChannel): Invoke
	TclpCutFileChannel and TclpSpliceFileChannel.
	* generic/tclInt.h: Declare TclpCutFileChannel and
	TclpSpliceFileChannel.
	* unix/tclUnixChan.c (FileCloseProc, TclpOpenFileChannel,
	(Tcl_MakeFileChannel, TclpCutFileChannel, TclpSpliceFileChannel):
	Implement thread load data cut and splice for file channels. This
	avoids an invalid memory ref when compiled with -DDEPRECATED.
	* win/tclWinChan.c (FileCloseProc, TclpCutFileChannel,
	(TclpSpliceFileChannel): Implement thread load data cut and splice for
	file channels. This avoids an invalid memory ref that was showing up
	in the thread extension.

2003-01-25  Mo DeJong  <[email protected]>

	* win/tclWin32Dll.c (TclpCheckStackSpace, squelch_warnings):
	* win/tclWinChan.c (Tcl_MakeFileChannel, squelch_warnings):
	* win/tclWinFCmd.c (DoRenameFile, DoCopyFile, squelch_warnings):
	Re-implement inline ASM SEH handlers for gcc. The esp and ebp
	registers are now saved on the stack instead of in global variables so
	that the code is thread safe. Add additional checks when TCL_MEM_DEBUG
	is defined to be sure the values were recovered from the stack
	properly. Remove squelch_warnings functions and add a dummy call in
	the handler methods to squelch compiler warnings.

2003-01-25  Mo DeJong  <[email protected]>

	* win/configure:
	* win/configure.in: Define HAVE_ALLOCA_GCC_INLINE when we detect that
	no alloca function is found in malloc.h and we are compiling with GCC.
	Remove HAVE_NO_ALLOC_DECL define.
	* win/tclWin32Dll.c (TclpCheckStackSpace): Don't define alloca as a
	cdecl function. Doing this caused a tricky runtime bug because the
	_alloca function expects the size argument to be passed in a register
	and not on the stack. To fix this problem, we use inline ASM when
	compiling with gcc to invoke _alloca with the size argument loaded
	into a register.

2003-01-24  Jeff Hobbs  <[email protected]>

	* win/tclWinDde.c (Dde_Init): clarified use of tsdPtr.
	(DdeServerProc): better refcount handling of returnPackagePtr.

	* generic/tclEvent.c (Tcl_Finalize): revert finalize change on
	2002-12-04 to correct the issue with extensions that have TSD needing
	to finalize that before they are unloaded. This issue needs further
	clarification.

	* tests/unixFCmd.test: only do groups check on unix

2003-01-24  Vince Darley  <[email protected]>

	* generic/tclStringObj.c: proper fixes for Tcl_SetObjLength and
	Tcl_AttemptSetObjectLength dealing with string objects with both
	pure-unicode and normal internal representations. Previous fix didn't
	handle all cases correctly.
	* generic/tclIO.c: Add 'Tcl_GetString()' to ensure the object has a
	valid 'objPtr->bytes' field before manipulating it directly.

	This fixes [Bug 635200] and [Bug 671138], but may reduce performance
	of Unicode string handling in some cases. A further patch will be
	applied to address this, once the code is known to be correct.

2003-01-24  Mo DeJong  <[email protected]>

	* win/configure: Regen.
	* win/configure.in: Add test to see if alloca is undefined in
	malloc.h.
	* win/tclWin32Dll.c (TclpCheckStackSpace): Rework the SEH exception
	handler logic to avoid using the stack since alloca will modify the
	stack. This was causing a nasty bug that would set the exception
	handler to 0 because it tried to pop the previous exception handler
	off the top of the stack.

2003-01-23  Donal K. Fellows  <[email protected]>

	* doc/lset.n: Fixed fault in return values from lset in documentation
	examples [SF Bug #658463] and tidied up a bit at the same time.

2003-01-21  Joe English  <[email protected]>

	* doc/namespace.n (namespace inscope): Clarified documentation
	[Patch 670110]

2003-01-21  Mo DeJong  <[email protected]>

	* win/configure: Regen.
	* win/tcl.m4 (SC_CONFIG_CFLAGS): Set SHLIB_SUFFIX so that
	TCL_SHLIB_SUFFIX will be set to a useful value in the generated
	tclConfig.sh. Set SHLIB_LD_LIBS to "" or '${LIBS}' based on the
	--enable-shared flag. This matches the UNIX implementation.

2003-01-18  Jeff Hobbs  <[email protected]>

	* generic/tclCkalloc.c: change %ud to %u as appropriate.

2003-01-17  Mo DeJong  <[email protected]>

	* win/tclWinDde.c (DdeServerProc): Deallocate the Tcl_Obj returned by
	ExecuteRemoteObject if it was not saved in a connection object.

2003-01-17  Mo DeJong  <[email protected]>

	* generic/tcl.h: Revert earlier change that defined TCL_WIDE_INT_TYPE
	as long long and TCL_LL_MODIFIER as L when compiling with mingw. This
	change ended up causing some test case failures when compiling with
	mingw.
	* generic/tclObj.c (UpdateStringOfWideInt): Describe the warning
	generated by mingw and why it needs to be ignored so that someone is
	not tempted to "fix" this problem again in the future.

2003-01-16  Vince Darley  <[email protected]>

	* generic/tclStringObj.c: Tcl_SetObjLength fix for when the object has
	a unicode string rep. [Bug 635200]
	* tests/stringObj.test: removed 'knownBug' constraint from test 14.1
	now that this bug is fixed.

	* generic/tclInt.h:
	* generic/tclBasic.c:
	* generic/tclCmdMZ.z:
	* tests/trace.test: execution and command tracing bug fixes and
	cleanup. In particular fixed [Bug 655645], [Bug 615043], [Bug 571385]
	  - fixed some subtle cleanup problems with tracing. This required
	    replacing Tcl_Preserve/Tcl_Release with a more robust refCount
	    approach. Solves at least one known crash caused by memory
	    corruption.
	  - fixed some confusion in the code between new style traces (Tcl
	    8.4) and the very limited 'Tcl_CreateTrace' which existed before.
	  - made behaviour consistent with documentation (several tests even
	    contradicted the documentation before).
	  - fixed some minor error message details
	  - added a number of new tests

2003-01-16  Jeff Hobbs  <[email protected]>

	* win/tclWinSerial.c (SerialOutputProc): add casts for bytesWritten to
	allow strict compilation (no warnings).

	* tests/winDde.test:
	* win/tclWinDde.c (Tcl_DdeObjCmd): Prevent crash when empty service
	name is passed to 'dde eval' and goto errorNoResult in request and
	poke error cases to free up any allocated data.

2003-01-16  Mo DeJong  <[email protected]>

	* win/tclWin32Dll.c (squelch_warnings): Squelch compiler warnings from
	SEH ASM code.
	* win/tclWinChan.c (squelch_warnings): Squelch compiler warnings from
	SEH ASM code.
	* win/tclWinDde.c: Add casts to avoid compiler warnings. Pass pointer
	to DWORD instead of int to avoid compiler warnings.
	* win/tclWinFCmd.c (squelch_warnings): Add casts and fixup decls to
	avoid compiler warnings. Squelch compiler warnings from SEH ASM code.
	* win/tclWinFile.c: Add casts and fixup decls to avoid compiler
	warnings. Remove unused variable.
	* win/tclWinNotify.c: Declare as DWORD instead of int to avoid
	compiler warning.
	* win/tclWinReg.c: Add casts to avoid compiler warning. Fix assignment
	in if expression bug.
	* win/tclWinSerial.c: Add casts to avoid compiler warnings. Remove
	unused variable.
	* win/tclWinSock.c: Add casts and fixup decls to avoid compiler
	warnings.

2003-01-14  Jeff Hobbs  <[email protected]>

	* generic/tclClock.c (FormatClock): corrected typo that incorrectly
	conditionally defined savedTZEnv and savedTimeZone.

2003-01-13  Mo DeJong  <[email protected]>

	Fix mingw build problems and compiler warnings.

	* generic/tcl.h: Add if defined(__MINGW32__) check to code that sets
	the TCL_WIDE_INT_TYPE and TCL_LL_MODIFIER.
	* generic/tclClock.c (FormatClock): Don't define savedTimeZone and
	savedTZEnv if we are not going to use them.
	* generic/tclEnv.c: Add cast to avoid warning.
	* win/tclWinChan.c: Use DWORD instead of int to avoid compiler warning
	* win/tclWinThrd.c: Only define allocLock, allocLockPtr, and dataKey
	when TCL_THREADS is defined. This avoid a compiler warning about
	unused variables.

2003-01-12  Mo DeJong  <[email protected]>

	* win/README: Update msys + mingw URL, the new release includes the
	released 1.0.8 version of msys which includes a number of bug fixes.

2003-01-12  Mo DeJong  <[email protected]>

	* win/configure: Regen.
	* win/tcl.m4 (SC_CONFIG_CFLAGS): Pull in addition of shell32.lib to
	LIBS_GUI that was added to the Tk tcl.m4 but never made it back into
	the Tcl version.

2003-01-12  Mo DeJong  <[email protected]>

	* generic/tcl.h: Skip Tcl's define of CHAR, SHORT, and LONG when
	HAVE_WINNT_IGNORE_VOID is defined. This avoids a bunch of compiler
	warnings when building with Cygwin or Mingw.
	* win/configure: Regen.
	* win/configure.in: Define HAVE_WINNT_IGNORE_VOID when we detect a
	winnt.h that still defines CHAR, SHORT, and LONG when VOID has already
	been defined.
	* win/tcl.m4 (SC_LOAD_TCLCONFIG): Subst the TCL_DEFS loaded from
	tclConfig.sh so that Tcl defines can make it into the Tk Makefile.

2003-01-12  Mo DeJong  <[email protected]>

	* win/configure: Regen.
	* win/configure.in: Check for typedefs like LPFN_ACCEPT in winsock2.h
	and define HAVE_NO_LPFN_DECLS if not found.
	* win/tclWinSock.c: Define LPFN_* typedefs if HAVE_NO_LPFN_DECLS is
	defined. This fixes the build under Mingw and Cygwin, it was broken by
	the changes made on 2002-11-26.

2003-01-10  Vince Darley  <[email protected]>

	* generic/tclIOUtil.c:
	* win/tclWinInt.h:
	* win/tclWinInit.c: fix to new WinTcl crash on exit with vfs,
	introduced on 2002-12-06. Encodings must be cleaned up after the
	filesystem.

	* win/makefile.vc: fix to minor VC++ 5.2 syntax problem

2003-01-09  Don Porter  <[email protected]>

	* generic/tclCompCmds.c (TclCompileReturnCmd):  Corrected off-by-one
	problem with recent commit. [Bug 633204]

2003-01-09  Vince Darley  <[email protected]>

	* generic/tclFileName.c: remove unused variable 'macSpecialCase'
	[Bug 664749]

	* generic/tclIOUtil.c:
	* generic/tclInt.h:
	* unix/tclUnixFile.c:
	* mac/tclMacFile.c:
	* win/tclWinFile.c:
	* win/tclWinInt.h:
	* win/tclWin32Dll.c:
	* tests/cmdAH.test: fix to non-ascii chars in paths when setting mtime
	and atime through 'file (a|m)time $path $time'. [Bug 634151]

2003-01-08  Don Porter  <[email protected]>

	* generic/tclExecute.c (TclExprFloatError):  Use the IS_NAN macro for
	greater clarity of code.

2003-01-07  Don Porter  <[email protected]>

	* generic/tclCompCmds.c (TclCompileReturnCmd):
	* tests/compile.test:	Corrects failure of bytecompiled [catch
	{return}] to have result TCL_RETURN (not TCL_OK) [Bug 633204]. This
	patch is a workaround for 8.4.X. A new opcode INST_RETURN is a better
	long term solution for 8.5 and later.

2003-01-04  David Gravereaux  <[email protected]>

	* win/makefile.vc:
	* win/rules.vc:  Fixed INSTALLDIR macro problem that blanked itself by
	accident causing the install target to put the tree at the root of the
	drive built on. Whoops..

	Renamed the 'linkexten' option to be 'staticpkg'. Added 'thrdalloc' to
	allow the switching _on_ of the thread allocator. Under testing, I
	found it not to be benificial under windows for the purpose of the
	application I was using it for. It was more important for this app
	that resources for tcl threads be returned to the system rather than
	saved/moved to the global recycler. Be extra clean or extra fast for
	the default threaded build? Let's move to clean and allow it to be
	switched on for users who find it benificial for their use of threads.

	******************************************************************
	*** CHANGELOG ENTRIES FOR 2002 IN "ChangeLog.2002"             ***
	*** CHANGELOG ENTRIES FOR 2001 IN "ChangeLog.2001"             ***
	*** CHANGELOG ENTRIES FOR 2000 IN "ChangeLog.2000"             ***
	*** CHANGELOG ENTRIES FOR 1999 AND EARLIER IN "ChangeLog.1999" ***
	******************************************************************
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<










































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































Deleted ChangeLog.2004.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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
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
2004-12-29  Jeff Hobbs	<[email protected]>

	* win/tcl.m4, win/configure: update MSVC CFLAGS_OPT to -O2, remove -Gs
	(included in -O2) and -GD (outdated). Use "link -lib" instead of "lib"
	binary and remove -YX for MSVC7 portability. Add -fomit-frame-pointer
	for gcc OPT compiles. [Bug 1092952, 1091967] Align LIBS_GUI with Tk
	head needs.

2004-12-29  Kevin B. Kenny  <[email protected]>

	* generic/tclDate.c: Regen
	* generic/tclGetDate.y (TclDatelex): Fixed a problem where a
	four-digit group with >=2 leading zeroes appeared to be a two-digit
	group, leading to misinterpreting the time 0012 as 1200. [Bug 1090413]
	* library/clock.tcl: Added code to interpret correctly months outside
	the range 01-12 as reduced modulo 12 with a corresponding adjustment
	to the year. [Bug 1092789]
	* tests/clock.test: Added regression test cases for the above two bugs
	* unix/Makefile.in: Added --no-lines to the 'bison' command line to
	* win/Makefile.in: help constrain the number of diffs in a cvs checkin

2004-12-24  Miguel Sofer <[email protected]>

	* generic/tclCompile.c:
	* generic/tclCompile.h:
	* generic/tclExecute.c:
	* generic/tclInt.h:
	* generic/tclLiteral.c:
	* generic/tclProc.c:
	Avoid sharing cmdName literals accross namespaces, and generalise
	usage of the TclRegisterNewLiteral macro. [Patch 1090905]

2004-12-20  Miguel Sofer <[email protected]>

	* generic/tclCompile.c: moved TclInitCompiledLocals to tclProc.c
	* generic/tclProc.c: new static InitCompiledLocals to allow for a
	single pass over the proc's arguments at proc load time (instead of
	two as previously). TclObjInterpProc() now allocates the
	compiledLocals on the tcl execution stack, using the new
	TclStackAlloc/Free functions.

2004-12-16  Donal K. Fellows  <[email protected]>

	* generic/tclInterp.c (Tcl_LimitSetTime, TimeLimitCallback):
	(TclLimitRemoveAllHandlers, TclInitLimitSupport): Set a timer event to
	trigger when the time limit runs out. All the time limit actually does
	is check to see if the time limit has been exceeded, but this is
	enough to fix [Bug 1085023].
	* generic/tclInt.h (struct Interp): Added a field to hold the token
	for the timer event handler associated with the current time limit.
	* generic/tclEvent.c (Tcl_UpdateObjCmd, Tcl_VwaitObjCmd): Add error
	message when limit exceeded.
	* tests/interp.test (interp-34.[89]): Check that time limits handle
	the two cases reported in [Bug 1085023]

	* generic/tclTimer.c (TclCreateAbsoluteTimerHandler): New internal
	function that allows setting a timer handler that will be triggered at
	(or after) a specific time instead of at some number of milliseconds
	in the future. This is a candidate for future exposure via a TIP.

2004-12-15  Miguel Sofer <[email protected]>

	* generic/tclBasic.c:
	* generic/tclExecute.c:
	* generic/tclInt.decls:
	* generic/tclIntDecls.h:
	* generic/tclNamesp.c:
	* generic/tclProc.c:
	* generic/tclStubInit.c:
	* generic/tclTest.c: Added two new functions to allocate memory from
	the execution stack (TclStackAlloc, TclStackFree). Added functions
	TclPushStackFrame and TclPopStackFrame that do the work of
	Tcl_PushCallFrame and Tcl_PopCallFrame, but using frames allocated in
	the execution stack - i.e., heap instead of C-stack. The core uses
	these two new functions exclusively; the old ones remain for backwards
	compat, as at least two popular extensions (itcl, xotcl) are known to
	use them.

2004-12-14  Miguel Sofer <[email protected]>

	* generic/tclCmdIL.c:
	* generic/tclInt.h:
	* generic/tclProc.c:
	* generic/tclVar.c: changing the isProcCallFrame field of the
	CallFrame struct from a 0/1 field to flags. Should be perfectly
	backwards compatible.

2004-12-14  Don Porter	<[email protected]>

	* unix/configure.in: Added special processing to remove "$U" from
	libraries in the LIBOBJS value. This is an auto-make-ism we need to
	avoid. [Bug 1081541]

	* unix/configure: autoconf-2.57

2004-12-13  Don Porter	<[email protected]>

	* generic/tcl.h: Restored extern "C" guards so that C++ code sees
	function pointer typedef linkage consistent with earlier Tcl releases.
	[Bug 1082349]

	* generic/tclEncoding.c: Plugged some memory leaks. Thanks to Rolf Ade
	* generic/tclUtil.c:	 for reports and testing [Bug 1083082]

2004-12-13  Kevin B. Kenny  <[email protected]>

	* doc/clock.n: Clarify that the [clock scan] command does not accept
	the full range of ISO8601 point-in-time formats. [Bug 1075433]

2004-12-12  Miguel Sofer <[email protected]>

	* generic/tclVar.c (TclArrayObjCmd - ARRAY_NAMES): leaking an object
	[Bug 1084111] - thanks to Rolf Ade.

2004-12-12  Miguel Sofer <[email protected]>

	* generic/tclObj.c (TclSetCmdNameObj): special handling for fully
	qualified command names (as in fix [Patch 456668]).

2004-12-11  Miguel Sofer <[email protected]>

	* generic/tclInt.h:
	* generic/tclNamesp.c: converting the static function
	GetNamespaceFromObj() to MODULE_SCOPE TclGetNamespaceFromObj().

2004-12-10  Donal K. Fellows  <[email protected]>

	* tools/tcl.wse.in, unix/tcl.spec, win/README.binary, README:
	* win/configure.in, unix/configure.in, generic/tcl.h:
	Bumped version number to 8.5a3 to distinguish HEAD of CVS development
	from the recent 8.5a2 release.

2004-12-10  Miguel Sofer <[email protected]>

	* generic/tclCompile.c (TclInitCompiledLocals):
	* generic/tclCompile.h:
	* generic/tclInt.h:
	* generic/tclProc.c (TclObjInterpProc, TclCreateProc): optimised
	loops that initialise a proc's arguments and compiled local
	variables, removing tests from inner loops.

2004-12-10  Donal K. Fellows  <[email protected]>

	* generic/tclInt.h: Move ensemble API decls here from tclNamesp.c

2004-12-09  Donal K. Fellows  <[email protected]>

	* generic/tclNamesp.c (TclMakeEnsembleCmd, TclSetEnsemble*)
	(TclSetEnsemble*, TclFindEnsemble): Build an internal API for creating
	and manipulating ensembles; they can be deleted using the normal
	command-deletion API.

	* doc/Async.3: Reword for better grammar, better nroff and get the
	flag name right. (Reported by David Welton.)

2004-12-07  Don Porter	<[email protected]>

	* tests/unixInit.test (2.1-4): Added constraints so that when a value
	of TCL_LIBRARY is required for process initialization, we skip the
	tests that mess with that value.

2004-12-07  Donal K. Fellows  <[email protected]>

	*** 8.5a2 TAGGED FOR RELEASE ***

	* unix/Makefile.in: add library/{tzdata,msgs} to dist target (kbk)

	* doc/foreach.n: Adjust tabs to be friendlier to some HTML
	converters. [Bug 1078760]

2004-12-06  Jeff Hobbs	<[email protected]>

	* unix/tclUnixNotfy.c (NotifierThreadProc): init numFdBits
	[Bug 1079286]

	* doc/error.n, doc/SaveResult.3, doc/Thread.3: minor nroff typos

2004-12-06  Don Porter	<[email protected]>

	* tests/safe.test:	Trim auto_path to improve performance [1080039]

	* tests/msgcat.test:	makeFile/removeFile cleanup [1079117]

2004-12-04  Don Porter	<[email protected]>

	* generic/tclEncoding.c:	Different fix for [Bug 1077005].
	* generic/tclEvent.c:	Broke apart TclpSetInitialEncodings() on
	* generic/tclInt.h:	Windows into TclpSetInterfaces(), that is
	* unix/tclUnixInit.c:	fundamentally essential, and the initialization
	* win/tclWinInit.c:	of the system encoding, which is not. Made
	the TclpSetInterfaces call part of TclInitSubsystems so it cannot be
	overlooked.

2004-12-03  Jeff Hobbs	<[email protected]>

	* changes: updated for 8.5a2 release

2004-12-02  Don Porter	<[email protected]>

	* generic/tclUtil.c (TclSetProcessGlobalValue): Handle the case where
	a ProcessGlobalValue might be assigned to itself.

	* generic/tclEncoding.c (MakeFileMap): Correct refcounting errors
	managing values returned by TclPathPart (with refCount of 1!) that led
	to a memory leak. [Bug 1077474].

2004-12-02  Vince Darley  <[email protected]>

	* generic/tclPathObj.c:  fix and new tests for [Bug 1074671] to ensure
	* tests/fileSystem.test: tilde paths are not returned specially by
	'glob'.

2004-12-02  Kevin B. Kenny  <[email protected]>

	* win/Makefile.in: Added a 'sed' in the setting of ROOT_DIR_NATIVE to
	compensate for a bug in cygpath (at least version 1.36) that leaves a
	trailing backslash on the end of the converted path.

2004-12-02  Donal K. Fellows  <[email protected]>

	* generic/tclInterp.c (Alias,Target,Master): Rewrote these so that the
	aliases that refer to an interpreter are stored in a list and not a
	hashtable (which was only ever a convenience, and forced the use of a
	global mutex to generate keys!) [FRQ 1077210]
	* generic/tclNamesp.c (numNsCreated): Moved into thread-local storage
	to remove a global mutex. [FRQ 1077210]

2004-12-01  Don Porter	<[email protected]>

	* generic/tclUtil.c (TclGetProcessGlobalValue): Narrowed the scope of
	mutex locks.

	* generic/tclUtil.c:		Updated Tcl_GetNameOfExecutable() to
	* generic/tclEncoding.c:	make use of a ProcessGlobalValue for
	* generic/tclEvent.c:		storing the executable name. Added
	internal routines Tcl(Get|Set)ObjNameOfExecutable() to access that
	storage in Tcl_Obj, rather than string format.

	* unix/tclUnixFile.c:	Rewrote TclpFindExecutable() to use
	* win/tclWinFile.c:	TclSetObjNameOfExecutable to store the
	executable name it computes.

	* generic/tclInt.h:	Added internal stub entries for
	* generic/tclInt.decls: TclpFindExecutable and
	Tcl(Get|Set)ObjNameOfExecutable.

	* generic/tclIntDecls.h: make genstubs
	* generic/tclStubInit.c:

	* generic/tclCmdIL.c:	Retrieve executable name in Tcl_Obj form
	* win/tclWinPipe.c:	instead of string form.

	* unix/tclUnixTest.c:	Update [testfindexecutable] command to use new
	internal interfaces.

	* generic/tclEncoding.c:	Moved TclpSetInitialEncodings() call
	from Tcl_FindExecutable() into TclInitEncodingSubsystem(). This is
	important on Windows where it establishes whether the "ascii" or
	"unicode" set of system routines will be used, and that needs to be
	done earlier to support filesystem operations. [Bug 1077005]

2004-12-01  Donal K. Fellows  <[email protected]>

	* tests/winDde.test: Rewritten to use tcltest2 features more
	thoroughly (reducing the [catch] count!) and fix the problem with
	winDde-6.1 being out of synch with the implementation.

2004-11-30  Don Porter	<[email protected]>

	* library/init.tcl ([unknown]): Restored the save/restore of the
	variables ::errorCode and ::errorInfo. This is needed when the
	[::bgerror] command is auto-loaded (as it is by Tk).

	Patch 976520 reworks several of the details involved with
	startup/initialization of the Tcl library, focused on the activities
	of Tcl_FindExecutable().

	* generic/tclIO.c:	Removed bogus claim in comment that encoding
	"iso8859-1" is "built-in" to Tcl.

	* generic/tclInt.h:	Created a new struct ProcessGlobalValue,
	* generic/tclUtil.c:	routines Tcl(Get|Set)ProcessGlobalValue, and
	function type TclInitProcessGlobalValueProc. Together, these take care
	of the housekeeping for "values" (things that can be held in a
	Tcl_Obj) that are global across a whole process. That is, they are
	shared among multiple threads, and epoch and mutex protection must
	govern the validity of cached copies maintained in each thread.

	* generic/tclNotify.c:	Modified TclInitNotifier() to tolerate being
	called multiple times in the same thread.
	* generic/tclEvent.c:	Dropped the unused argv0 argument to
	TclInitSubsystems(). Removed machinery to unsure only one
	TclInitNotifier() call per thread, now that that is safe. Converted
	Tcl(Get|Set)LibraryPath to use a ProcessGlobalValue, and moved them to
	tclEncoding.c.
	* generic/tclBasic.c:	Updated caller.

	* generic/tclInt.h:	TclpFindExecutable now returns void.
	* unix/tclUnixFile.c:
	* win/tclWinFile.c:
	* win/tclWinPipe.c:

	* generic/tclEncoding.c: Built new encoding search initialization on a
	foundation of ProcessGlobalValues, exposing new routines
	Tcl(Get|Set)EncodingSearchPath. A cache of a map from encoding name to
	directory pathname keeps track of where encodings are available for
	loading. Tcl_FindExecutable greatly simplified into just three
	function calls. The "library path" is now misnamed, as its only
	remaining purpose is as a foundation for the default encoding search
	path.

	* generic/tclInterp.c:	Inlined the initScript that is evaluated by
	Tcl_Init(). Added verification after initScript evaluation that Tcl
	can find its installed *.enc files, and that it has initialized
	[encoding system] in agreement with what the environment expects.
	[tclInit] no longer driven by the value of $::tcl_libPath; it largely
	constructs its own search path now, rather than attempt to share one
	with the encoding system.

	* unix/tclUnixInit.c:	TclpSetInitialEncodings factored so that a new
	* win/tclWinInit.c:	routine TclpGetEncodingNameFromEnvironment can
	reveal that Tcl thinks the [encoding system] should be, even when an
	incomplete encoding search path, or a missing *.enc file won't allow
	that initialization to succeed. TclpInitLibraryPath reworked as an
	initializer of a ProcessGlobalValue.

	* unix/tclUnixTest.c:	Update implementations of [testfindexecutable],
	[testgetdefenc], and [testsetdefenc].

	* tests/unixInit.test:	Corrected tests to operate properly even when
	a value of TCL_LIBRARY is required to find encodings.

	* generic/tclInt.decls: New internal stubs: TclGetEncodingSearchPath,
	TclSetEncodingSearchPath, TclpGetEncodingNameFromEnvironment. These
	are candidates for public exposure by future TIPs.

	* generic/tclIntDecls.h: make genstubs
	* generic/tclStubInit.c:

	* generic/tclTest.c:	Updated [testencoding] to use
	* tests/encoding.test:	Tcl(Get|Set)EncodingSearchPath.	 Updated tests.

2004-11-30  Kevin B. Kenny  <[email protected]>

	* library/clock.tcl: Corrected the regular expressions that match a
	time zone to allow for time zones specified as +HH or -HH.
	* tests/clock.test: Added regression test case for the above issue.
	Thanks to Rolf Ade for reporting this issue [https://wiki.tcl-lang.org/page/Parsing+ISO8601+dates+and+times]
	* win/tclWinDde.c (Tcl_DdeObjCmd): Corrected a typo that caused a
	compilation failure on VC++.

2004-11-29  Andreas Kupries <[email protected]>

	* win/Makefile.in (install-libraries): Brought entry '2004-10-26 Don
	Porter (Tcl Modules)' into the windows world, actually the
	win/configure buildsystem. The other windows buildsystems (.vc, .bc)
	still have to be updated as well.

2004-11-26  Andreas Kupries <[email protected]>

	* win/tclWinDde.c (ExecuteRemoteObject): Removed bogus semicolon found
	at the end of the header for the function definition, terminating it
	early and preventing a compile. This is likely a fix for '2004-11-25
	Donal'. I have to conclude that it is also unknown if the other
	changes to this file actually pass the testsuite. Running testsuite
	... They don't. winDde-6.1 fails. This is only a message discrepance,
	i.e. not too bad. Leaving resolution of that to Pat and Donal.

2004-11-26  Don Porter	<[email protected]>

	* library/auto.tcl (tcl_findLibrary): Made sure the uniquifying
	operations on the search path does not also normalize. [Bug 1072136]

2004-11-26  Donal K. Fellows  <[email protected]>

	* unix/configure.in: Simplify the code to check for correctness of
	strstr, strtoul and strtod.
	* unix/tcl.m4 (SC_TCL_CHECK_BROKEN_FUNC): Split a complex stanza out
	of configure.in into its own function. Also force it to do the right
	thing with cacheing of results of AC_TRY_RUN to deal with issue raised
	in [Patch 1073524]

	* doc/foreach.n: Added simple example. [FRQ 1073334]

2004-11-25  Donal K. Fellows  <[email protected]>

	* generic/tclProc.c (TclObjInterpProc):	    Make it so that only
	* generic/tclIndexObj.c (Tcl_WrongNumArgs): [proc] instances do
	* tests/indexObj.test (indexObj-5.7):	    quoting of their first
	arguments, so keeping [Bug 942757] fixed and making [Bug 1066837] be
	fixed as well. Done with a load of #ifdef-ery because this hack is so
	ugly nobody should keep it around once Itcl's fixed.

2004-11-25  Reinhard Max  <[email protected]>

	* tests/tcltest.test: The order in which [glob] returns the file names
	is undefined, so tests should not depend on it.

2004-11-25  Zoran Vasiljevic <[email protected]>

	* doc/Thread.3:
	* doc/Notifier.3: Added changes from the core-8-4-branch

2004-11-25  Donal K. Fellows  <[email protected]>

	* doc/dde.n: Synchronized the documentation of the commands with the
	header of the docs and what the package actually does. Thanks to
	Andreas Kupries for spotting this.
	* win/tclWinDde.c (Tcl_DdeObjCmd): Much cleanup of argument parsing
	code.

2004-11-24  David Gravereaux <[email protected]>

	* generic/tclPort.h: Relative include of tclWinPort.h returned as it
	was requiring me set -I$(tcl_root)/win for my extensions that need to
	include tclInt.h and doesn't appear to serve any purpose for windows
	builds.

2004-11-24  Kevin B. Kenny  <[email protected]>

	* unix/tcl.m4 (SC_ENABLE_THREADS): Corrected bad check for 3-argument
	readdir_r [Bug 1001325].
	* unix/configure: Regenerated.
	* unix/tclUnixNotfy.c: Corrected all uses of 'select' to manage their
	masks using the FD_CLR, FD_ISSET, FD_SET, and FD_ZERO macros rather
	than bit-whacking that failed under Solaris-Sparc-64. [Bug 1071807]
	* win/tclWinInit.c (TclpInitLibraryPath): Removed unused vars 'pathc'
	and 'pathv' that caused compilation problems on VC++ with
	--enable-symbols.

2004-11-24  Don Porter	<[email protected]>

	* unix/tcl.m4 (SC_ENABLE_THREADS): Corrected failure to determine the
	number of arguments for readdir_r on SunOS systems. [Bug 1071701]

	* unix/configure:	autoconf-2.57

	* generic/tclCmdIL.c (InfoVarsCmd):	Corrected segfault in new
	* tests/info.test (info-19.6):	trivial matching branch [Bug 1072654]

2004-11-24  Donal K. Fellows  <[email protected]>

	* tools/man2html.tcl, tools/man2html1.tcl: Update to use Tcl 8.4.
	* tools/man2html2.tcl: Fix broken .SS handling.

2004-11-23  Donal K. Fellows  <[email protected]>

	* unix/Makefile.in: Add (commented-out) code to integrate tclConfig.h
	into the dependency tree and 'make distclean'. [Bug 1068171]

	* generic/tclResult.c (Tcl_AppendResultVA): Remove call to
	Tcl_GetStringResult to speed up repeated calls to Tcl_AppendResult
	with the side effect that code that wants to access interp->result
	should always call Tcl_GetStringResult first. See [Patch 1041072]
	discussion for more details.

2004-11-22  Mo DeJong  <[email protected]>

	* unix/configure: Regen.
	* unix/tcl.m4 (SC_TCL_64BIT_FLAGS): Define HAVE_TYPE_OFF64_T only when
	off64_t, open64(), and lseek64() are defined. IRIX 5.3 is known to not
	include an open64 function. [Bug 1030465]

2004-11-22  Mo DeJong  <[email protected]>

	* unix/configure: Regen.
	* unix/tcl.m4 (SC_ENABLE_THREADS): Check for a 2 argument version of
	readdir_r that is known to exists under IRIX 5.3.
	* unix/tclUnixThrd.c (TclpReaddir): Use either 2 arg or 3 arg version
	of readdir_r. [Bug 1001325]

2004-11-22  Don Porter	<[email protected]>

	* unix/tclUnixInit.c (TclpInitLibraryPath): Purged dead code that used
	* win/tclWinInit.c (TclpInitLibraryPath):  to extend the "library
	path". Search path construction for init.tcl is now done within the
	[tclInit] proc.
	* generic/tclInterp.c:	Restored several directories to the search
	* tests/unixInit.test:	path used to locate init.tcl within [tclInit].
	This change does not restore any directories to the encoding search
	path, so should still avoid the price of an unreasonably large number
	of filesystem accesses during encoding initialization at startup
	[Bug 976438]

2004-11-22  Vince Darley  <[email protected]>

	* generic/tclPathObj.c: fix and new test for [Bug 1043129] in the
	* tests/fileSystem.test: treatment of backslashes in file join on
	Windows.

2004-11-21  Don Porter	<[email protected]>

	* doc/AddErrInfo.3:	Typo corrections (Thanks Daniel South).
	* doc/interp.n:

2004-11-19  Don Porter	<[email protected]>

	* doc/AddErrInfo.3:	Docs for Tcl_(Get|Set)ReturnOptions. [TIP 227]

	* doc/AddErrInfo.3:
	* doc/Async.3:		Documentation updates to replace references
	* doc/BackgdErr.3:	to global variable ::errorInfo and ::errorCode
	* doc/SaveResult.3:	and to the ::bgerror command with references
	* doc/after.n:		to their preferred replacements, the
	* doc/bgerror.n:	-errorinfo and -errorcode return options,
	* doc/error.n:		the Tcl_*InterpState routines, and the
	* doc/exec.n:		[interp bgerror] command.
	* doc/exit.n:
	* doc/fileevent.n:
	* doc/interp.n:
	* doc/return.n:
	* doc/tclvars.n:
	* doc/update.n:

	* tests/unixInit.test: Removed "knownBug" constraints to prompt bug
	fixing before 8.5a2 release.

2004-11-19  Daniel Steffen  <[email protected]>

	* macosx/Makefile:
	* unix/configure.in:
	* unix/tclUnixInit.c (MacOSXGetLibraryPath): changed detection of tcl
	framework build when determining tclLibPath from overloaded
	TCL_LIBRARY to configuration define TCL_FRAMEWORK. [Bug 1068088]

	* unix/configure: autoconf-2.57
	* unix/tclConfig.h.in: autoheader-2.57

2004-11-18  Don Porter	<[email protected]>

	* doc/SaveResult.3:	Documentation for Tcl_*InterpState (TIP 226).

	* generic/tclEvent.c (HandleBgErrors):	Simplified program flow.

	* tests/basic.test:	Updated functional (not testing) uses of
	* tests/io.test:	[bgerror] to make use of [interp bgerror].
	* tests/socket.test:
	* tests/timer.test:

	* tests/interp.test (interp-36.*):	[interp bgerror] tests.

	* generic/tclInterp.c:	Corrected [interp bgerror] error messages.

2004-11-18  Reinhard Max  <[email protected]>

	* unix/tcl.m4 (SC_CONFIG_MANPAGES): Applied an improved version of
	* unix/configure.in:		    [Patch 996085], that introduces
	* unix/Makefile.in:		    --enable-man-suffix.

	* unix/installManPage:		    added
	* unix/mkLinks.tcl:		    removed
	* unix/mkLinks:			    removed
	* unix/configure:		    generated

	* unix/Makefile.in:		    Don't install tclConfig.h .

2004-11-17  Don Porter	<[email protected]>

	* unix/configure.in: The change below reveals that the public data
	type Tcl_StatBuf relies on config information. For now, disabled the
	use of the tclConfig.h file until its full impact on Tcl's interface
	can be assessed.

	* unix/configure:	autoconf-2.57

	* generic/tcl.h:	Moved the #include "tclConfig.h" out of
	* generic/tclInt.h:	tcl.h.	The config settings are not part of
	* generic/tclPort.:	the public interface, and having it there
	breaks compiled against uninstalled Tcl and extensions using
	autoconf-2.5*.

2004-11-16  Jeff Hobbs	<[email protected]>

	* unix/tclUnixChan.c (TtySetOptionProc): fixed crash configuring
	-ttycontrol on a channel. [Bug 1067708]

2004-11-16  Don Porter	<[email protected]>

	* generic/tclIOUtil.c (TclFSEpochOk): There were two code paths via
	which the thread copy of filesystemEpoch could be synched with the
	master copy, but only one kept the filesystem list cache up to date.
	Fix routes everything through a single code path. [Bug 1035775].

2004-11-16  Donal K. Fellows  <[email protected]>

	* unix/tcl.m4 (SC_CONFIG_CFLAGS): Stop architecture flags to 'ld' from
	getting lost when [load] is disabled. [Bug 1016796]

2004-11-16  Daniel Steffen  <[email protected]>

	* generic/tcl.h:
	* unix/configure.in: changed HAVE_CONFIG_H to HAVE_TCL_CONFIG_H.

	* unix/configure: autoconf-2.57

2004-11-15  Don Porter	<[email protected]>

	* generic/tclInt.h: Added comment warning that the old ERR_IN_PROGRESS
	and ERROR_CODE_SET flag values should not be re-used for the sake of
	those extensions that have accessed them.

	* generic/tclCmdMZ.c (Tcl_TraceObjCmd): Fixed Bug 1065378 which failed
	* tests/trace.test (trace-33.1):	to permit a variable trace
	created with [trace variable] to be destroyed with [trace remove].
	Thanks to Keith Vetter for the report.

2004-11-15  Donal K. Fellows  <[email protected]>

	* doc/tclvars.n: Added section to documentation on global variables
	that are specific to tclsh and wish. [Patch 1065732]

2004-11-12  Jeff Hobbs	<[email protected]>

	* generic/tclEncoding.c (TableFromUtfProc): correct crash condition
	when TCL_UTF_MAX == 6. [Bug 1004065]

2004-11-12  Donal K. Fellows  <[email protected]>

	* doc/interp.n: Basic documentation of the TIP#221 API.

2004-11-12  Don Porter	<[email protected]>

	TIP #221 IMPLEMENTATION
	* generic/tclBasic.c:	Define [::tcl::Bgerror] in new interps.
	* generic/tclEvent.c:	Update Tcl_BackgroundError to make use of the
				registered [interp bgerror] command.
	* generic/tclInterp.c:	New [interp bgerror] subcommand.
	* tests/interp.test:	syntax tests updated.

	TIP #226 IMPLEMENTATION
	* generic/tcl.decls:	Stubs for Tcl_(Save|Restore|Discard)InterpState
	* generic/tcl.h:	New public opaque type, Tcl_InterpState.
	* generic/tclInt.h:	Drop old private declarations. Add
				Tcl(Get|Set)BgErrorHandler
	* generic/tclResult.c:	Tcl_*InterpState implementations.
	* generic/tclDictObj.c:	Update callers.
	* generic/tclIOGT.c:
	* generic/tclTrace.c:

	TIP #227 IMPLEMENTATION
	* generic/tcl.decls:	Stubs for Tcl_(Get|Set)ReturnOptions.
	* generic/tclInt.h:	Drop old private declarations.
	* generic/tclResult.c:	Tcl_*ReturnOptions implementations.
	* generic/tclCmdAH.c:	Update callers.
	* generic/tclMain.c:

	* generic/tclDecls.h:	make genstubs
	* generic/tclStubInit.c:

	* unix/tclAppInit.c:	Removed tclConfig.h #include, now that tcl.h
				takes care of it for us.

	* generic/tclInt.h:	Moved verification of ptrdiff_t typedef from
	* generic/tclExecute.c: multiple .c files into one common header where
	* generic/tclVar.c:	it is verifiably after tclConfig.h inclusion.

2004-11-12  Daniel Steffen  <[email protected]>

	* generic/tcl.h:
	* generic/tclInt.h:
	* unix/Makefile.in: include tclConfig.h from tcl.h and install it as a
	public header. Normalized compiler include path order to
	-I${BUILD_DIR} -I${UNIX_DIR} -I${GENERIC_DIR}.

	* unix/dltest/Makefile.in: add ${BUILD_DIR}/.. to include path to pick
	up tclConfig.h.

	* unix/tclUnixInit.c: moved check for HAVE_CFBUNDLE define after
	#include "tclInt.h" to ensure tclConfig.h has been included.

2004-11-12  Reinhard Max  <[email protected]>

	* unix/config.h.in:
	* unix/tclConfig.h.in:	renamed

	* unix/Makefile.in:	Completed support for config header,
	* unix/configure.in:	fixed building outside of the unix dir,
	* unix/tclAppinit.c:	and reflected the name change of config.h.
	* generic/tclInt.h:

	* unix/configure:	generated

2004-11-12  Donal K. Fellows  <[email protected]>

	* unix/config.h.in:	Allow configure to put all the C #defs into
	* unix/configure.in:	a file (called config.h) so that Unix builds
	* unix/tcl.m4:		now take far fewer lines of scrollback to
	* unix/Makefile.in:	proceed (making it less likely that any errors
	* generic/tclInt.h:	or warnings will get missed).
	* unix/tclAppInit.c:	Part of the TIP#34 upgrades.

	* unix/tcl.m4, unix/tclUnixPort.h: Check for pthread_attr_get_np in
	<pthread.h> before forcing the use of <pthread_np.h> to make things
	work on NetBSD 2.0. [Bug 1064882]

	* doc/binary.n, doc/upvar.n: More minor fixes.

2004-11-12  Daniel Steffen  <[email protected]>

	* doc/CrtChannel.3:
	* doc/Interp.3:
	* doc/Limit.3:
	* doc/binary.n:
	* doc/dict.n:
	* doc/tm.n:
	* doc/upvar.n: fixed *roff errors uncovered by running 'make html'.

	* tools/tcltk-man2html.tcl: added faked support for bullet point
	lists, i.e. *nroff ".IP \(bu" syntax.

2004-11-11  Daniel Steffen  <[email protected]>

	* tests/fCmd.test:
	* unix/tclUnixFCmd.c (TraverseUnixTree): added option to rewind() the
	readdir() loop whenever the source hierarchy has been modified by
	traverseProc (e.g. by deleting files); this is required to ensure
	complete traversal of the source hierarchy on certain filesystems like
	HFS+. Added test for failing recursive delete on Mac OS X that was due
	to this. [Bug 1034337]

	* generic/tclListObj.c (Tcl_ListObjReplace): use memmove() instead of
	manual copy loop to shift list elements. Decreases time spent in
	Tcl_ListObjReplace() from 5.2% to 1.7% of overall runtime of tclbench
	on a ppc 7455 (i.e. 200% speed increase). [Patch 1064243]

	* generic/tclHash.c: hoisted some constant pointer dereferences out of
	loops to eliminate redundant loads that the gcc optimizer didn't deal
	with. Decreases time spend in Tcl_FindHashEntry() by 10% over a full
	run of the tcl testuite on a ppc 7455. [Patch 1064243]

	* tests/fileName.test:
	* tests/fileSystem.test:
	* tests/io.test:
	* tests/msgcat.test:
	* tests/tcltest.test:
	* tests/unixInit.test: fixed bugs causing failures when running tests
	with -tmpdir arg not set to working dir.

	* macosx/Makefile: corrected path to html help inside framework.
	Prevent parallel make from building several targets at the same time.

	* macosx/tclMacOSXFCmd.c (struct fileinfobuf): force struct to be
	packed to prevent failures when builing with -malign=natural.

2004-11-10  Andreas Kupries <[email protected]>

	* unix/tclUnixChan.c: [Bug 727786]. Exterminated the code marked
	DEPRECATED. This code has not been used in over a year now, and we
	have no complaints.

2004-11-08  David Gravereaux <[email protected]>

	* win/tclWinPipe.c: The pipe channel driver now respects the -blocking
	option when closing is the same way the UNIX side works. This is to
	avoid a hung shell when exiting due to open pipes that refuse to close
	in a graceful manner.
	* doc/open.n: Added a note about -blocking 0 and lack of exit status
	as it had never been documented. [Bug 947693]

	***POTENTIAL INCOMPATIBILITY***

	Scripts that use async pipes on windows, must (like the UNIX side) set
	-blocking to 1 before calling [close] to receive the exit status.

2004-11-07  David Gravereaux <[email protected]>

	* tests/winFile.test: added contraint to winFile-4.0 to prevent it
	being run on NT4 [Bug 981829]

2004-11-05  Donal K. Fellows  <[email protected]>

	* tests/reg.test: Major reorganization so that this file is much
	easier for a normal Tcl maintainer to comprehend. The test flags are
	still very cryptic, but they appear to have to be that way. The number
	of skipped tests has increased, but now the skipped tests have much
	more meaningful content.

	* tests/tm.test (genpaths): Add a [file normalize] so we pick up
	Windows drive letters, etc. [Bug 1053568]

2004-11-04  Don Porter	<[email protected]>

	* changes:	Updates toward an 8.5a2 release.

2004-11-03  Kevin B. Kenny  <[email protected]>

	* library/clock.tcl (FreeScan): Fixed a bug where scanning "Monday"
	with a base time other than midnight incorrectly carried the base time
	forward.

	* test/clock.test (clock-33.{5,5a}): Made the test failure more
	informative.

	* tests/clock.test (clock-34.{28,44,45,46}): Removed 'knownBug'
	constraints from tests that no longer fail.

	Thanks to Don Porter for reporting these.

2004-11-03  David Gravereaux <[email protected]>

	* generic/tcl.h:		Moved the preprocessor logic
	* generic/tclDecls.h:		from tclInt.h of setting the
	* generic/tclInt.h:		TCL_STORAGE_CLASS macro to the
	* generic/tclIntDecls.h:	tcl*Decls.h files now that no
	* generic/tclIntPlatDecls.h:	use of EXTERN is left in tclInt.h.
	* generic/tclPlatDecls.h:	Proto for Tcl_Main moved in tcl.h
	* win/tclWinPort.h:		to prior the inclusion of the Stubs
	headers as they are now resetting TCL_STORAGE_CLASS. Removed
	extraineous reset from tclWinPort.h. [Patch 1055668]

	* generic/tclCompile.h: Removed extrainious reset of TCL_STORAGE_CLASS
	missed in my last edit.

2004-11-03  Don Porter	<[email protected]>

	* library/init.tcl ([unknown]): Corrections to the 2004-10-25 mods to
	Aunt ??? in [unknown]. Flaws revealed by Itcl test suite, which still
	apparently relies on this brokenness. Also added comment suggesting
	the error message that any code using this hack *ought* to receive in
	reply.

	* generic/tclTrace.c (TclCallVarTraces):  Improved ability to debug
	* tests/incr-old.test (incr-old-2.6):	  errors during variable
	* tests/incr.test (incr-{1,2}.28):	  traces by preserving the
	* tests/set.test (set-{2,4}.4):		  -errorinfo data.
	* tests/trace.test (trace-33.1):	  [Bug 527164]

2004-11-02  David Gravereaux <[email protected]>

	* generic/tclInt.h: added a check for #ifdef __cplusplus around the
	#define of MODULE_SCOPE. About the only time it would be problem is
	when someone is statically linking to Tcl and accessing internals from
	a C++ file and has name mangling issues from the lack of "C" after
	'extern' [Patch 1055668].
	* generic/tclCompile.h: Exchanged use of the EXTERN macro to the new
	MODULE_SCOPE macro. Lowered exported internals count by 35. [Patch
	1055668]
	* win/tclWinInt.h:
	* win/tclWinPort.h: exported internals dropped by a count of 14.
	* generic/tclFileSystem.h: Added use of MODULE_SCOPE on protos.
	* generic/tclRegexp.h: manipulating TCL_STORAGE_CLASS unnecessary.

2004-11-02  Don Porter	<[email protected]>

	* library/tcltest/tcltest.tcl:		Corrected some misleading
	* tests/tcltest.test (tcltest-26.1,2):	displays of ::errorInfo and
	::errorCode information when the -setup, -body, and/or -cleanup scripts
	return an unexpected return code. Thanks to Robert Seeger for the fix.
	[RFE 1017151].

2004-11-02  Donal K. Fellows  <[email protected]>

	* generic/tclExecute.c (TclExecuteByteCode): Improved version of the
	NaN fix from Miguel Sofer. [Bug 761471]

2004-11-02  Kevin Kenny	 <[email protected]>

	* library/tzdata/America/Cuiaba: Change to DST rules for
	* library/tzdata/America/Havana: autumn of 2004.
	[ftp://elsie.nci.nih.gov/pub/tzdata2004g.tar.gz]

	* tools/tclZIC.tcl: Updated to be compatible with recent changes in
	library/clock.tcl.

2004-11-02  Vince Darley  <[email protected]>

	* win/tclWinFile.c: Simplify TclpUtime to use Tcl_FSGetNativePath, and
	add comments.

2004-11-02  Donal K. Fellows  <[email protected]>

	* generic/tclInt.h: Change uses of EXTERN to MODULE_SCOPE (defined in
	this file too to be 'extern' if not overridden) as nothing declared in
	tclInt.h is supposed to be visible outside the Tcl core. If there *is*
	anything that extensions are actually using, we can open this up later
	on. [Patch 1055668]

	* doc/CrtChannel.3 (Tcl_GetChannelMode): Add synopsis. [Bug 1058446]

2004-11-01  Kevin B. Kenny  <[email protected]>

	* win/tclWinFile.c (FromCTime, TclpUtime): Replaced a call to the
	Posix 'utime' function with calls to Windows-API equivalents, to avoid
	a bug where the VC++ versions misconvert times across a Daylight
	Saving Time boundary. [Bug 926106]
	* win/tclWinInt.h (TclWinProcs):
	* win/tclWin32Dll.c (asciiProcs, unicodeProcs): Removed now-unused
	reference to 'utime'.
	* tests/cmdAH.test (cmdAH-24.12): Added test case for the above bug.

2004-11-01  Donal K. Fellows  <[email protected]>

	* generic/tclExecute.c (TclExecuteByteCode): Make INST_EQ and friends
	handle NaN correctly in all cases. [Bug 761471]

	* generic/tclNamesp.c (NamespaceInscopeCmd): Make the error message
	generation the same as in NamespaceEvalCmd().
	(Tcl_Import): Rationalized to use Tcl_EvalObjv().

2004-10-31  Donal K. Fellows  <[email protected]>

	* tests/io.test (io-40.3): Convert umask2 test constraint into a form
	that most people will be able to satisfy.

	* tests/cmdAH.test (cmdAH-8.45): Removed broken test constraint. It
	didn't do what it was intended to do, and it implied the other correct
	constraint. [Bug 1053908]

	* generic/tclCmdIL.c (InfoGlobalsCmd):
	* tests/info.test (info-8.4): Strip leading global-namespace
	specifiers from the pattern argument. [Bug 1057461]

2004-10-30  Kevin Kenny	 <[email protected]>

	* generic/clock.c: Replaced WIN32 macro with __WIN32__. [Bug 1054357].
	Thanks to David Gravereaux for the patch.
	* win/tclWinFile.c: Removed a long-standing bug that causes incorrect
	conversion between file time and UTC time if the file time is recorded
	in a different Daylight Saving Time status than the current one. [Bug
	926106]

2004-10-29  Don Porter	<[email protected]>

	* library/tcltest/tcltest.tcl:	Correct reaction to errors in the
	obsolete processCmdLineArgsHook.	[Bug 1055673]
	* library/tcltest/pkgIndex.tcl:	Bump to tcltest 2.2.7
	* unix/Makefile.in:
	* tests/all.tcl:	Update to use [tcltest::configure].

2004-10-29  Donal K. Fellows  <[email protected]>

	* library/tm.tcl (::tcl::tm::*): Use the core proc engine to generate
	the wrong-num-args error messages for the path ensemble.

	Ensembles can now (sometimes) rewrite the error messages of their
	subcommands so they appear more like the arguments that the user
	passed to the ensemble. Below is a description of changes involved in
	doing this.

	* tests/namespace.test (namespace-50.*): Tests of ensemble subcommand
	error message rewriting.
	* generic/tclProc.c (TclObjInterpProc): Make procedures implement
	their wrong-num-args message using Tcl_WrongNumArgs instead of
	something baked-at-home.
	* generic/tclNamesp.c (TclIsEnsemble, NsEnsembleImplementationCmd):
	Added test of ensemble-hood (available to rest of core) and made
	ensembles set up the rewriting for Tcl_WrongNumArgs to take advantage
	of.
	* generic/tclInt.h (Interp.ensembleRewrite): Extra fields.
	* generic/tclIndexObj.c (Tcl_WrongNumArgs): Add knowledge of what is
	going on in ensembles' command rewriting so this command can generate
	the right error message itself.
	* generic/tclBasic.c (Tcl_CreateInterp, TclEvalObjvInternal): Added
	code to initialize (as empty) the rewriting fields and reset them when
	we leak outside an ensemble implementation.

2004-10-28  Miguel Sofer <[email protected]>

	* generic/tclExecute.c (INST_START_CMD):
	* tests/execute.test (execute-8.3): fix for execution stack corruption
	[Bug 1055676]. Credit dgp for detective work and fix.

2004-10-27  Don Porter	<[email protected]>

	* tests/socket.test (socket-13.1):	Balanced [makeFile] and
	[removeFile] commands.

	* tests/clock.test:	Correct duplicate test names.
	* tests/namespace.test:
	* tests/string.test:
	* tests/io.test (io-50.4):	Use namespace variables.

2004-10-27  David Gravereaux <[email protected]>

	* generic/tclInt.decls:	  The following 9 functions were moved from
	* generic/tclInt.h:	  tclInt.h to the private/int Stubs table for
	* generic/tclIntDecls.h:  use by the test suite. As tclTest.obj is
	* generic/tclStubInit.c:  linked to the shell, these functions need
	"blessed" status so as to always be exported from the library. Being
	placed in the Stubs table guarantees this [Bug 1054748]:
		TclpObjRemoveDirectory,	TclpObjCopyDirectory,
		TclpObjCreateDirectory,	TclpObjDeleteFile,
		TclpObjCopyFile,	TclpObjRenameFile,
		TclpObjStat,		TclpObjAccess,
		TclpOpenFileChannel

	* tests/registry.test:	Fixed test files to load the correct
	* tests/winDde.test:	registry and dde packages by using the info
	* win/Makefile.in:	from makefiles to tell tcltest where to load
	* win/makefile.vc:	them from. This avoids grabbing the wrong
	package from $auto_path which might be the install point rather than
	the dev location. Kudos to Jennifer Hom for adding -load and
	-loadfile to the tcltest package. [Bug 926088]

	* win/tclWinThrd.c (TclFinalizeLock): release the critical section
	before deleting it. [Bug 731778]

	* generic/tcl.h: Removed the file level 'extern "C" {' and the
	coresponding closing block as it serves no purpose given that all the
	function prototypes have the proper extern usage already.

	* unix/tclAppInit.c:	When built as tcltest, TclThread_Init was
	* win/tclAppInit.c:	getting called twice. First by Tcltest_Init,
	then again in Tcl_AppInit. The call from Tcl_AppInit is now removed.

2004-10-27  Andreas Kupries <[email protected]>

	* tests/tm.test:  Expanded on the testsuite entered by Donal.
	* library/tm.tcl: Even found bugs, these have been corrected.

2004-10-26  Kevin Kenny <[email protected]>

	* tests/format.test (format-19.1): Additional regression test for [Bug
	868489].

2004-10-27  Donal K. Fellows  <[email protected]>

	* doc/*.n: Many small general documentation fixes.

2004-10-26  David Gravereaux <[email protected]>

	* generic/tclPipe.c (TclCleanupChildren): bad cast of resolvedPid
	caused PIDs on win95 to go negative. winpipe-4.2 brought this to the
	surface. Fixed with sprintf in place of TclFormatInt. Thanks to hgiese
	[Patch 767676]

2004-10-26  Andreas Kupries <[email protected]>

	* library/tm.tcl (::tcl::tm::Defaults): Added a second [file dirname]
	around the location of the executable. This fixes [Bug 1038705].
	Instable of a bogus "foo/bin/lib" we now have the correct "foo/lib" as
	a base path for modules.

2004-10-26  Don Porter	<[email protected]>

	* generic/tclParse.c (Tcl_SubstObj):	Fix for failed subst-12.3 test
	* tests/subst.test (subst-12.3-5):	More tests for Bug 1036649.

	* unix/Makefile.in (install-libraries): Updated the installation of
	the http, msgcat, and tcltest packages to install as Tcl Modules on
	Unix systems. Other platform Makefiles still need updating. [Patch
	1054370]

	* tests/basic.test:	Added missing constraints.
	* tests/compile.test:
	* tests/fileSystem.test:

	* tests/init.test (init-2.8):	Updated to not rely on http package.

2004-10-26  Miguel Sofer <[email protected]>

	* generic/tclInt.h:
	* generic/tclVar.c: removed more direct references to the VAR flags,
	replaced with access macros.

2004-10-26  Donal K. Fellows  <[email protected]>

	* doc/expr.n: Clarified that non-num/non-bool literals require
	quoting. [Bug 1027849]. Also listed booleans as acceptable values.

2004-10-26  Kevin B. Kenny <[email protected]>

	* library/clock.tcl (FreeScan): Fixed a bug that caused relative days
	of the week in free-form [clock scan] to be evaluated in the wrong
	time zone.
	* tests/clock.test (clock-31.[456]): Made sure that there isn't an
	env(TZ) or env(TCL_TZ) lying around that will override the time zone
	that we're trying to establish with the simulated registry.
	Both problems reported as [Bug 1054101].

2004-10-25  Donal K. Fellows  <[email protected]>

	* doc/string.n (map): Rewrote to clarify that we don't just map single
	characters. [Bug 1048005]
	* doc/info.n (procs): Clarified that the pattern argument may have
	namespace separators in it. [Bug 1047928]

	* tests/cmdAH.test (cmdAH-8.45): Simplify in the hope that the reasons
	for [Bug 1053908] will become clearer.

2004-10-25  Don Porter	<[email protected]>

	* generic/tclExecute.c (IllegalExprOperandType,TclExecuteByteCode):
	Removed several DECACHE_INFO/CACHE_INFO pairs that are no longer
	needed for protection because routines like Tcl_SetErrorCode() and
	Tcl_AddErrorInfo() can no longer re-enter bytecode execution.

	* generic/tclResult.c (TclProcessReturn): Bug fix. Be sure that a
	missing -errorinfo option when code == TCL_ERROR causes the errorInfo
	field to get reset.

	* tests/thread.test (thread-4.4): Test depended on a ::errorInfo value
	initialized to "". Added code to test to setup that requirement.

	* library/auto.tcl:	Purged Tcl's script library of all
	* library/clock.tcl:	remaining references to global vars
	* library/init.tcl:	::errorInfo and ::errorCode.

	* generic/tclMain.c (Tcl_Main): Updated to make use of
	TclGetReturnOptions instead of ::errorInfo variable.

	* generic/tclInterp.c (tclInit): Bug fix. Access dict variables with
	[dict get], not array syntax.

2004-10-25  Donal K. Fellows  <[email protected]>

	* tests/tm.test: Rewrote the tests to actually perform syntax checks
	on the public API. Added a new test (currently failing) to indicate
	that the test suite is not complete yet.
	* library/tm.tcl (path): Rewrote to turn this command into an ensemble
	to make it faster and simpler.

2004-10-24  Miguel Sofer <[email protected]>

	* generic/tclCmdIL.c:
	* generic/tclExecute.c:
	* generic/tclInt.h:
	* generic/tclTrace.c: defined new macros to get/set the flags of
	variables. The only files that still access the flag values directly
	are tclCompCmds.c, tclCompile.c, tclProc.c and tclVar.c

2004-10-24  Don Porter	<[email protected]>

	* generic/tclBasic.c (Tcl_LogCommandInfo,Tcl_AddObjErrorInfo): Shift
	the initialization of errorCode to NONE to more central location.

	* generic/tclEvent.c (BgError,Tcl_BackgroundError,HandleBgErrors):
	Rewrite to build on the new TclGet/SetReturnOptions routines.

	* generic/tclResult.c (TclGetReturnOptions): Add call to
	Tcl_AddObjErrorInfo to be sure error fields are initialized.

	* generic/tclResult.c (TclTransferResult): Rewrite to build on the new
	TclGet/SetReturnOptions routines.

2004-10-22  Donal K. Fellows  <[email protected]>

	* doc/tm.n: Tightened up the documentation.
	* tests/tm.test: Created (with partially dummy content) so TIP#189 can
	be marked Final.

	* generic/tclNamesp.c (NsEnsembleImplementationCmd): Make ensembles
	cut their implementations out of error traces. This is the right thing
	to do more often than not.

2004-10-22  Kevin B. Kenny  <[email protected]>

	* library/clock.tcl: Fixed a typo where the fallback time zone became
	::localtime instead of :localtime. Fixed a bug where time zone names
	containing hyphens could not be loaded.
	* tests/clock.test: Added regression test cases that covers both bugs.
	Thanks to Todd M. Helfter <[email protected]> for finding
	these bugs.

2004-10-22  Donal K. Fellows  <[email protected]>

	* generic/tclExecute.c (TclCompEvalObj, Tcl_ExprObj):
	* generic/tclProc.c (TclProcCompileProc): Always call object
	freeIntRepProc's in the same way.

2004-10-22  Miguel Sofer <[email protected]>

	* generic/tclVar.c: fixed bug in commit of 2004-07-23, which was
	causing a leak of Proc structures and failure of compile-12.1. Two
	lines were 'zombies' from the previous way localVarNames worked.
	Credit dgp for finding this.

2004-10-21  Don Porter	<[email protected]>

	* generic/tclInt.h (Interp):
	* generic/tclBasic.c (Tcl_CreateInterp,Tcl_DeleteInterp):
	* generic/tclResult.c (GetKeys,ReleaseKeys,etc.): Moved the key values
	of the return options dictionary out of private fields of the Interp
	struct and into thread-static values managed in tclResult.c.

	* generic/tclCmdAH.c (Tcl_CatchObjCmd, Tcl_ErrorObjCmd): Updated to
	call the new TclGet/SetReturnOptions routines to do much of their
	work.

	* generic/tclInt.h (TclGetReturnOptions,TclSetReturnOptions):
	* generic/tclResult.c (TclGetReturnOptions,TclSetReturnOptions): New
	utility routines to get/set the return options of an interp. Intent is
	that these routines will be converted to public routines after TIP
	approval.

	* generic/tclCmdMZ.c (TclProcessReturn,TclMergeReturnOptions):
	* generic/tclResult.c (TclProcessReturn,TclMergeReturnOptions): Move
	internal utility routines from tclCmdMZ.c to tclResult.c.

	* generic/tclBasic.c (Tcl_CreateInterp, Tcl_DeleteInterp):
	* generic/tclResult.c (TclTransferResult): Rework so that
	iPtr->returnOpts can be NULL when there are no special options.

	* generic/tclResult.c (TclRestoreInterpState): Plug potential memory
	leak.

2004-10-21  Kevin B. Kenny  <[email protected]>

	* generic/tclBasic.c: Various changes to [clock format] that,
	* generic/tclClock.c: together, make it roughly twice as fast
	* generic/tclInt.h:   while all tests in the test suite
	* library/clock.tcl:  continue to pass.

2004-10-20  Andreas Kupries <[email protected]>

	* win/Makefile.in (install-msgs):   Fixed a problem with the
	* win/Makefile.in (install-tzdata): installation of timezone data and
	message catalogs. They used the installed tcl library directory, not
	the source library. Before it was installed. Switched to source lib
	dir. Thanks to Kevin for the help in figuring this out.

2004-10-20  Don Porter	<[email protected]>

	* generic/tclThreadTest.c (ThreadEventProc): Corrected subtle bug
	where the returned (char *) from Tcl_GetStringResult(interp) continued
	to be used without copying or refcounting, while activity on the
	interp continued. That's not safe, and recent changes demonstrated the
	lack of safety with failing tests thread-4.3 and thread-4.5.

2004-10-19  Donal K. Fellows  <[email protected]>

	* generic/tclDictObj.c (DictWithCmd): Make sure all paths (that are
	not themselves error paths) do not lose the result code.

2004-10-19  Don Porter	<[email protected]>

	* generic/tclInt.h (Tcl*InterpState):		New internal routines
	* generic/tclResult.c (Tcl*InterpState):	TclSaveInterpState,
	TclRestoreInterpState, and TclDiscardInterpState are superior
	replacements for Tcl_(Save|Restore|Discard)Result. Intent is that
	these routines will be converted to public routines after TIP
	approval. Interfaces for these routines were shamelessly stolen from
	Itcl.

	* generic/tclBasic.c (TclEvalObjvInternal):
	* generic/tclDictObj.c (DictUpdateCmd, DictWithCmd):
	* generic/tclIOGT.c (ExecuteCallback):
	* generic/tclTrace.c (Trace*Proc,TclCheck*Traces,TclCallVarTraces):
	Callers of Tcl_*Result updated to call the new routines. The calls
	were relocated in several cases to perform save/restore operations
	only when needed.

	* generic/tclEvent.c (HandleBgErrors):
	* generic/tclFCmd.c (CopyRenameOneFile): Calls to Tcl_*Result that
	were eliminated because they appeared to serve no useful purpose,
	typically saving/restoring an error message, only to throw it away.

2004-10-18  Don Porter	<[email protected]>

	* generic/tclBasic.c (Tcl_CreateInterp,Tcl_DeleteInterp):
	* generic/tclCmdAH.c (Tcl_CatchObjCmd):
	* generic/tclCmdMZ.c (TclMergeReturnOptions,TclProcessReturn):
	* generic/tclCompCmds.c (TclCompileReturnCmd):
	* generic/tclExecute.c (TclCompEvalObj):
	* generic/tclInt.h (Interp):
	* generic/tclProc.c (TclUpdateReturnInfo): Place primary storage of
	the -level and -code information in private fields of the Interp
	struct, rather than in a DictObj. This should significantly improve
	performance of TclUpdateReturnInfo.

2004-10-17  Miguel Sofer <[email protected]>

	* generic/tclResult.c: removed unused variable [Bug 1048588]. Thanks
	to Daniel South.

2004-10-15  Don Porter	<[email protected]>

	* generic/tclCmdMZ.c (TclProcessReturn):	Now that primary
	* generic/tclProc.c (TclUpdateReturnInfo):	storage for the
	errorInfo and errorCode values are internal fields, we can set them at
	the time of the [return] command, and not have to wait until the
	specified number of "-level"s have popped.

	* generic/tclBasic.c (Tcl_CreateInterp, Tcl_DeleteInterp)
	(TclEvalObjvInternal, Tcl_LogCommandInfo, TclAddObjErrorInfo):
	* generic/tclCmdAH.c (Tcl_CatchObjCmd):
	* generic/tclEvent.c (BgError, ErrAssocData, Tcl_BackgroundError)
	(HandleBgErrors, BgErrorDeleteProc):
	* generic/tclExecute.c (TclCreateExecEnv, TclDeleteExecEnv):
	* generic/tclIOUtil.c (comments only):
	* generic/tclInt.h (ExecEnv,Interp, ERR_IN_PROGRESS):
	* generic/tclInterp.c ([tclInit]):
	* generic/tclMain.c (comments only):
	* generic/tclNamesp.c (Tcl_CreateNamespace, Tcl_DeleteNamespace)
	(TclTeardownNamespace):
	* generic/tclProc.c (TclUpdateReturnInfo):
	* generic/tclResult.c (Tcl_ResetResult, TclTransferResult):
	* generic/tclTrace.c (CallVarTraces):
	Reworked management of the "errorInfo" data of an interp. That
	information is now primarily stored in a new private (Tcl_Obj *) field
	of the Interp struct, rather than using a global variable ::errorInfo
	as the primary storage. The ERR_IN_PROGRESS flag bit value is no
	longer required to manage the value in its new location, and is
	removed. Variable traces are established to support compatibility for
	any code expecting the ::errorInfo variable to hold the information.

	***POTENTIAL INCOMPATIBILITY***
	Code that sets traces on the ::errorInfo variable may notice a
	difference in timing of the firing of those traces. Code that uses the
	value ERR_IN_PROGRESS.

2004-10-14  Donal K. Fellows  <[email protected]>

	TIP#217 IMPLEMENTATION

	* generic/tclCmdIL.c (Tcl_LsortObjCmd): Add -indices option from James
	Salsman. [Patch 1017532]

	* generic/tclUtil.c (TclMatchIsTrivial): Detect degenerate cases of
	glob matching that let us avoid scanning through hash tables.
	* generic/tclCmdIL.c (InfoCommandsCmd, InfoGlobalsCmd, InfoProcsCmd):
	(InfoVarsCmd): Use this to speed up some [info] subcommands.

2004-10-12  Kevin B. Kenny  <[email protected]>

	* library/tzdata/America/Campo_Grande:
	* library/tzdata/America/Cuiaba:
	* library/tzdata/America/Sao_Paulo
	* library/tzdata/America/Argentina/Mendoza:
	* library/tzdata/America/Argentina/San_Juan:
	Synchronized to Olson's 'tzdata2004e'.

2004-10-08  Donal K. Fellows  <[email protected]>

	TIP#201 AND TIP#212 IMPLEMENTATIONS

	* doc/dict.n, doc/expr.n: Documentation for new functionality.
	* tests/expr.test: Basic tests of 'in' and 'ni' behaviour.
	* tests/dict.test (dict-21.*,dict-22.*): Tests for [dict update] and
	[dict with].
	* generic/tclExecute.c (TclExecuteByteCode): Implementation of the
	INST_LIST_IN and INST_LIST_NOT_IN bytecodes.
	* generic/tclParseExpr.c (GetLexeme): Parse the 'in' and 'ni'
	operators for TIP#201.
	* generic/tclDictObj.c (DictUpdateCmd,DictWithCmd): Core of
	implementation of TIP#212; docs and tests still to do...

2004-10-07  Don Porter	<[email protected]>

	* generic/tclTest.c (TestsetobjerrorcodeCmd):  Simplified.

2004-10-07  Vince Darley  <[email protected]>

	* generic/tclFileName.c:
	* generic/tclFileSystem.h:
	* generic/tclIOUtil.c:
	* generic/tclPathObj.c:
	* unix/tclUnixFile.c:
	* win/tclWinFile.c:
	* tests/fileName.test:
	* tests/winFCmd.test: code reorganization for better generic/platform
	code splitting [Bug 925620] removing the need for several #ifdef's,
	and tests and fix for an unreported Windows glob problem ('glob -dir
	C: -tails *').

2004-10-07  Donal K. Fellows  <[email protected]>

	* *.3: Convert CONST to const and VOID to void so we document how
	people should actually use the Tcl API and not the compatibility hacks
	that it has to have.

	* doc/man.macros, *.3: Update .AS macro so it can know how wide to
	make the third column of the argument list. Update documentation for C
	API (only users) to take advantage of this.

	* doc/FileSystem.3: Formatting fixes for greater documentation
	clarity.

2004-10-06  Donal K. Fellows  <[email protected]>

	* generic/tclFileName.c (DoGlob, TclGlob): Stop messy sharing of
	interpreter result and instead use a private object for collecting the
	result of the glob. This simplifies TclGlob quite a lot.
	* generic/tclIOUtil.c (Tcl_FSMatchInDirectory): Simplify by removing
	some nesting. Also standardize variable names.
	(FsAddMountsToGlobResult): Force updates to the list to be done
	in-place, putting a side-condition of non-shared-ness on the resultPtr
	argument to Tcl_FSMatchInDirectory, but everything would have broken
	before if that was shared *anyway*.

	* generic/tclEncoding.c (LoadTableEncoding): Removed reference to Tcl
	interpreter; it wasn't needed as direct object use is more efficient.

	* generic/tclPathObj.c: Made this file follow the style rules in the
	Engineering Manual more closely, and also take advantage of the
	internal object manipulation macros more.

	* generic/tclCmdMZ.c (Tcl_SwitchObjCmd): Reorganized to have fewer
	magic flag variables and to separate the code that scans for a match
	from the code that processes a match body.

2004-10-06  Don Porter	<[email protected]>

	* generic/tclBasic.c:
	* generic/tclBinary.c:
	* generic/tclCmdAH.c:
	* generic/tclCmdIL.c:
	* generic/tclCmdMZ.c:
	* generic/tclCompExpr.c:
	* generic/tclDictObj.c:
	* generic/tclEncoding.c:
	* generic/tclExecute.c:
	* generic/tclFCmd.c:
	* generic/tclHistory.c:
	* generic/tclIndexObj.c:
	* generic/tclInterp.c:
	* generic/tclIO.c:
	* generic/tclIOCmd.c:
	* generic/tclNamesp.c:
	* generic/tclObj.c:
	* generic/tclPkg.c:
	* generic/tclResult.c:
	* generic/tclScan.c:
	* generic/tclTimer.c:
	* generic/tclTrace.c:
	* generic/tclUtil.c:
	* generic/tclVar.c:
	* unix/tclUnixFCmd.c:
	* unix/tclUnixPipe.c:
	* win/tclWinDde.c:
	* win/tclWinFCmd.c:
	* win/tclWinPipe.c:
	* win/tclWinReg.c:
	It is a poor practice to directly set or append to the value of the
	objResult of an interp, because that value might be shared, and in
	that circumstance a Tcl_Panic() will be the result. Searched for
	example of this practice and replaced with safer alternatives, often
	using the Tcl_AppendResult() routine that dkf just rehabilitated.
	* library/dde/pkgIndex.tcl: Bump to dde 1.3.1
	* library/reg/pkgIndex.tcl: Bump to registry 1.1.5

2004-10-06  Donal K. Fellows  <[email protected]>

	* doc/SetResult.3: Made Tcl_AppendResult non-deprecated; better that
	people use it than most of the common alternatives!
	* generic/tclResult.c (Tcl_AppendResultVA): Make this work better with
	Tcl_Objs. [Patch 1041072]
	(Tcl_SetResult, Tcl_AppendElement): Change string to stringPtr to
	avoid C++ keywords.

2004-10-05  Don Porter	<[email protected]>

	* generic/tclBasic.c (TclObjInvoke): More simplification of the
	TclObjInvoke routine toward unification with the rest of the
	evaluation stack.

	* generic/tclBasic.c (Tcl_CreateInterp, Tcl_DeleteInterp)
	(TclEvalObjvInternal, Tcl_LogCommandInfo):
	* generic/tclCmdAH.c (Tcl_CatchObjCmd):
	* generic/tclEvent.c (BgError, Tcl_BackgroundError, HandleBgErrors):
	* generic/tclInt.h (Interp, ERROR_CODE_SET):
	* generic/tclNamesp.c (Tcl_CreateNamespace, Tcl_DeleteNamespace)
	(TclTeardownNamespace):
	* generic/tclResult.c (Tcl_ResetResult, Tcl_SetObjErrorCode)
	(TclTransferResult):
	* generic/tclTrace.c (CallVarTraces):
	Reworked management of the "errorCode" data of an interp. That
	information is now primarily stored in a new private (Tcl_Obj *) field
	of the Interp struct, rather than using a global variable ::errorCode
	as the primary storage. The ERROR_CODE_SET flag bit value is no longer
	required to manage the value in its new location, and is removed.
	Variable traces are established to support compatibility for any code
	expecting the ::errorCode variable to hold the information.

	***POTENTIAL INCOMPATIBILITY***
	Code that sets traces on the ::errorCode variable may notice a
	difference in timing of the firing of those traces.

	* generic/tclNamesp.c (Tcl_PopCallFrame): Removed Bug 1038021
	workaround. That bug is now fixed.

2004-10-04  Kevin B. Kenny  <[email protected]>

	* tests/clock.test (clock-34.*): Removed an antibug that forced
	comparison of [clock scan] results with the :localtime time zone. Now
	that [clock scan] uses the current time zone instead, the antibug
	caused several tests to fail. [Bug 1038554]

2004-10-04  Donal K. Fellows  <[email protected]>

	* generic/tclParseExpr.c (GetLexeme): Ensure that the 'eq' and 'ne'
	operators are followed by non-alphabetic characters so lexemes can't
	run together. [Bug 884830]

	* doc/DictObj.3, doc/dict.n: Clarified that a dictionary is not
	order-preserving. [Bug 1032243] Also added another example to show off
	more ways of using a dictionary and a few other formatting
	improvements.

2004-10-02  Donal K. Fellows  <[email protected]>

	* generic/tclDictObj.c (TraceDictPath, Tcl_DictObjPutKeyList): Add
	support for automatic creation of dictionary paths since that is what
	everyone seems to actually expect of the API! [Bug 1037235]
	(Tcl_DictObjNext): Make calling this after Tcl_DictObjDone non-fatal
	as that simplifies a number of internal APIs. This doesn't break any
	existing working code as it is a case which previously caused a panic.

2004-10-02  Don Porter	<[email protected]>

	* tests/namespace.test (namespace-8.7):	Another test for save/restore
	of ::errorInfo and ::errorCode during global namespace teardown.

2004-10-01  Donal K. Fellows  <[email protected]>

	* generic/tclProc.c (TclObjGetFrame, Tcl_UplevelObjCmd):
	* generic/tclVar.c (Tcl_UpvarObjCmd): Cache stackframe level
	references in the level object for speed.

2004-09-30  Don Porter	<[email protected]>

	* generic/tclBasic.c (Tcl_CreateInterp):
	* generic/tclInt.h (Interp): Removed the flag bit value
	EXPR_INITIALIZED. It was set during interp creation and never tested.
	Whatever purpose it had is in the past.

	* generic/tclBasic.c (Tcl_EvalObjEx):	Removed the flag bit value
	* generic/tclInt.h (Interp):	        USE_EVAL_DIRECT. It was used
	* generic/tcLTest.c (TestevalexObjCmd): only in the testing command
	* tests/parser.test (parse-9.2):        [testevalex] and nothing in
	the test suite made use of the capability it enabled.

	* generic/tclBasic.c (Tcl_AddObjErrorInfo): More re-organization
	* generic/tclCmdAH.c (Tcl_ErrorObjCmd):	    of the management of
	* generic/tclCmdMZ.c (TclProcessReturn):    the errorCode value.
	* tests/error.test (error-6.4-9):

	* generic/tclNamespace.c (TclTeardownNamespace): Tcl_Obj-ified
	* tests/namespace.test (namespace-8.5,6):	 the save/restore of
	::errorInfo and ::errorCode during global namespace teardown. Revised
	the comment to clarify why this is done, and added tests that will
	fail if this is not done.

	* generic/tclResult.c (TclTransferResult): Added safety checks so that
	unexpected undefined ::errorInfo or ::errorCode will not lead to a
	segfault.

	* generic/tclTrace.c (TclCallVarTraces):  Save/restore the flag values
	* tests/var.test (var-16.1):	          that define part of the
	interpreter state during variable traces. [Bug 1038021].

2004-09-30  Miguel Sofer <[email protected]>

	* tests/subst.test (12.1-2): added tests for [Bug 1036649]

2004-09-29  Don Porter	<[email protected]>

	* tests/basic.test (49.*): New tests for TCL_EVAL_GLOBAL.

2004-09-29  Donal K. Fellows  <[email protected]>

	* generic/tclVar.c (TclObjLookupVar, TclObjLookupVar):
	(TclObjUnsetVar2, SetArraySearchObj):
	* generic/tclUtil.c (SetEndOffsetFromAny):
	* generic/tclStringObj.c (Tcl_SetStringObj):
	(Tcl_SetUnicodeObj, SetStringFromAny):
	* generic/tclResult.c (ResetObjResult):
	* generic/tclRegexp.c (Tcl_GetRegExpFromObj):
	* generic/tclPathObj.c (TclFSMakePathRelative, SetFsPathFromAny):
	(TclFSMakePathFromNormalized, Tcl_FSNewNativePath):
	* generic/tclObj.c (TclFreeObj, Tcl_SetBooleanObj, SetBooleanFromAny):
	(Tcl_SetDoubleObj, SetDoubleFromAny, Tcl_SetIntObj):
	(SetIntOrWideFromAny, Tcl_SetLongObj, SetWideIntFromAny):
	(Tcl_SetWideIntObj, TclSetCmdNameObj, SetCmdNameFromAny):
	* generic/tclNamesp.c (SetNsNameFromAny, MakeCachedEnsembleCommand):
	* generic/tclListObj.c (Tcl_SetListObj, SetListFromAny):
	* generic/tclIndexObj.c (Tcl_GetIndexFromObjStruct):
	* generic/tclDictObj.c (SetDictFromAny):
	* generic/tclCompile.c (TclInitByteCodeObj):
	* generic/tclBinary.c (Tcl_SetByteArrayObj, SetByteArrayFromAny):
	* generic/tclInt.h (TclFreeIntRep): Factorize out deletion of object
	internal representation to a shared macro, so simplifying much code.

2004-09-27  Miguel Sofer <[email protected]>

	* generic/tclBasic.c (TclObjInvoke): fix for bogus gcc warning about
	uninitialised variable.

2004-09-27  Don Porter	<[email protected]>

	* generic/tclBasic.c:	Removed internal routines TclInvoke,
	* generic/tclInt.decls: TclGlobalInvoke, TclObjInvokeGlobal and the
	* tests/basic.test:	portion of TclObjInvoke that handles calls
	without TCL_INVOKE_HIDDEN enabled. None of this code is called any
	longer within the core, and the superior public interface,
	Tcl_EvalObjv, is available for any external callers.

	* generic/tclIntDecls.h:	make genstubs
	* generic/tclStubInit.c:

	* generic/tclEvent.c (HandleBgErrors): Updated [bgerror] invocations
	to make use of Tcl_Obj based routines, dropping the calls to
	TclGlobalInvoke()

2004-09-27  Vince Darley  <[email protected]>

	* generic/tclFileName.c:
	* generic/tclFileSystem.h:
	* generic/tclIOUtil.c:
	* generic/tclPathObj.c:
	* tests/cmdAH.test:
	* tests/fileSystem.test:
	* tests/winFCmd.test: fix to bad error message with 'cd' on windows,
	when permissions are inadequate [Bug 1035462] and to treatment of a
	volume-relative pwd on Windows [Bug 1018980].

	* doc/FileSystem.3: added missing Tcl_GlobTypeData documentation [Bug
	935853]

2004-09-27  Kevin Kenny	 <[email protected]>

	* compat/strftime.c (Removed):
	* generic/tclClock.c (removed TclClockOldscanObjCmd):
	* generic/tclDate.c (Regenerated):
	* generic/tclGetDate.y:
	* generic/tclInt.decls (removed TclGetDate and TclpStrftime):
	* generic/tclInt.h (removed TclGetDateInfo):
	* generic/tclIntDecls.h (Regenerated):
	* generic/tclStubInit.c (Regenerated):
	* library/clock.tcl:
	* unix/tclUnixTime.c (removed TclpStrftime):
	* win/Makefile.in:
	* win/makefile.bc:
	* win/makefile.bc:
	* win/tcl.dsp:
	Continued refactoring of [clock] for TIP 173 changes. Broke the
	free-form parser apart so that the Bison parser is responsible for
	only parsing, while clock.tcl handles relative times like "next
	Thursday", "next January". This change is needed to make timezones
	other than :localtime and :Etc/UTC work with free-form scanning. This
	change closes out the issue identified as being "for another day" in
	my log message of 2004-09-08. The refactored code also eliminates the
	last known references to TclpStrftime and TclGetDate, so those
	routines (including compat/strftime.c) have been removed. The
	refactoring also has the benefit that all storage in the Bison parser
	is now on the C stack, eliminating any need for mutex protection
	around [clock scan]. Also, changed the Makefiles so that 'make
	gendate' is available on Windows as well as Unix.

	* generic/tclCmdAH.c (Tcl_FormatObjCmd): Removed some grubby
	* generic/tclObj.c (SetBooleanFromAny):	 work-around code that was
	needed only because of Bug 868489.

	* generic/tclBasic.c (TclObjInvoke): Removed three unused variables to
	silence a compiler warning in VC++.

2004-09-27  Vince Darley  <[email protected]>

	* doc/FileSystem.3: fix to small typo.

2004-09-26  Miguel Sofer <[email protected]>

	* generic/tclCompCmds.c:
	* generic/tclCompExpr.c:
	* generic/tclCompile.c:
	* generic/tclCompile.h:
	* generic/tclInt.h:
	* generic/tclProc.c:
	* tests/compExpr-old.test:
	* tests/compExpr.test:
	* tests/expr.test:
	* tests/for.test:
	* tests/if.test:
	* tests/incr.test:
	* tests/while.test:
	Report compilation errors at runtime, [Patch 1033689] by dgp.

2004-09-23  Mo DeJong  <[email protected]>

	* unix/dltest/Makefile.in (clean): Fixup make clean rule so that it
	does not delete all files when SHLIB_SUFFIX is set to the empty string
	in a static build. [Bug 1016726]

2004-09-23  Don Porter	<[email protected]>

	* generic/tclBasic.c:	Corrections to the 2004-09-21 commit
	* generic/tclExecute.c:	regarding ERR_ALREADY_LOGGED. That commit
	* generic/tclNamesp.c:	caused Tk test send-10.7 to fail. Added
	* tests/namespace.test (25.7,8): tests in the Tcl test suite
	* tests/pkg.test (2.25,26):	 to catch this error without the aid
	of Tk in the future.

	* generic/tclCmdAH.c (Tcl_ExprObjCmd):	Simplified the TclObjCmdProc
	of [expr] with a call to Tcl_ConcatObj.

2004-09-22  Don Porter	<[email protected]>

	* generic/tclCmdMZ.c (TclProcessReturn):	Support the -errorline
	* generic/tclCompile.c (TclCompileScript):	option to [return].
	* tests/compile.test (16.23.*):	Use that capability to defer reporting
	* tests/misc.test (1.2):	of parse errors until runtime. Updated
	tests to reflect change. [Bug 1032805]

2004-09-22  Miguel Sofer <[email protected]>

	* generic/tclExecute.c (INST_START_CMD):
	* tests/proc.test (7.2-3): fix for [Bug 729692] was incorrect whenever
	a loop exception was returned.

2004-09-22  Kevin B. Kenny  <[email protected]>

	* library/tzdata/America/Montevideo: Updated to reflect
	ftp://elsie.nci.nih.gov/pub/tzdata2004d.tar.gz. (Changes to
	Asia/Jerusalem were in the comments only.) [Routine maintenance - no
	bug] Spanish-language description of the change at
	http://www.presidencia.gub.uy/decretos/2004091502.htm

2004-09-21  Don Porter	<[email protected]>

	* generic/tclCompCmds.c:	Tolerate [append] syntax errors
	* tests/appendComp.test (8.1):	at compile time, and allow runtime to
	raise the error (or succeed if a redefined [append] allows).

	* generic/tclBasic.c:	Reworked management of the interp flag
	* generic/tclCompile.c:	ERR_ALREADY_LOGGED, to reduce its exposure.
	* generic/tclExecute.c: Still left several referebces that are just
	* generic/tclNamesp.c:	too nice on performace to do away with.	These
	changes also resolve an inconsistency in the ::errorInfo values
	produced by [namespace eval x error foo bar] and [namespace eval x
	{error foo bar}].

	* generic/tclExecute.c (TclCompEvalObj):	Simplified the
	TclCompEvalObj routine. Much housekeeping now reliably happens
	elsewhere. [Patch 1031949]

2004-09-21  Donal K. Fellows  <[email protected]>

	* doc/interp.n: Tighten up wording on how [interp eval] and [interp
	invokehidden] operate w.r.t. stack frames. [Bug 926590]

2004-09-20  Don Porter	<[email protected]>

	* tests/error.test (error-6.2,3):	Added more tests to verify
	::errorCode setting by/after a [catch].

2004-09-19  Miguel Sofer <[email protected]>

	* generic/tclCmdAH.c: removed outdated comment [Bug 1029518].

2004-09-18  David Gravereaux <[email protected]>

	* win/tclAppInit.c: Dde package can load into a safe interp. Claim
	this fact for the Tcl_StaticPackage() call when the shell is built
	with the TCL_USE_STATIC_PACKAGES option.

2004-09-18  Donal K. Fellows  <[email protected]>

	* generic/tclExecute.c (TEBC-INST_LSHIFT,INST_RSHIFT): Ensure that
	large shifts end up shifting correctly. [Bug 868467]

	* doc/FileSystem.3, doc/OpenFileChnl.3: More documentation fixes from
	Mikhail Kolesnitchenko. [Patch 1022527]
	* doc/*: Standardize highlighting of symbols defined in tcl.h

2004-09-17  Don Porter	<[email protected]>

	* generic/tclBasic.c (Tcl_AddObjErrorInfo, Tcl_LogCommandInfo):
	* generic/tclCmdAH.c ([catch], [error]):
	* generic/tclCmdMZ.c ([return]):
	* generic/tclProc.c (TclUpdateReturnInfo):
	* generic/tclResult.c (Tcl_SetErrorCodeVA, Tcl_SetObjErrorCode)
	(TclTransferResult):	Refactored so that all errorCode setting flows
	through Tcl_SetObjErrorCode(). This greatly reduces the number of
	different places in the code that need to know details about an
	internal bitflag field of the Interp struct. Also places errorCode
	setting in one place for easier future mods.

2004-09-17  Kevin B.Kenny  <[email protected]>

	* generic/tclDate.c:	Revised tclGetDate.y to use bison instead of
	* generic/tclGetDate.y: yacc to build the parser, eliminating all the
	* generic/tclInt.h:	complicated hackery involving 'sed'
	* unix/Makefile.in:	postprocessing. Rebuilt the parser.

2004-09-14  Kevin B. Kenny  <[email protected]>

	* generic/tclClock.c (ClockOldscanObjCmd): Silenced a compiler warning
	(long passed as a param where unsigend long was expected). 'Unsigned
	long' is wrong, but the fix is really to change the signature of
	TclGetDate to return a structure of its 'yy' variables and then do the
	remaining work inside clock.tcl. But, as I said on 2004-09-08, that's
	a job for another day. [Bug 1027993]

2004-09-10  Miguel Sofer <[email protected]>

	* doc/interp.n:
	* generic/tclInterp.c (TclPreventAliasLoop, AliasCreate):
	* tests/interp.test (17.4-6, 19.3-4): fixing problems with renaming of
	aliases [Bugs 707104 1026493]. Fix designed by dgp.

2004-09-13  Donal K. Fellows  <[email protected]>

	* generic/tclNamesp.c (NsEnsembleImplementationCmd): Add token field
	to internal rep of EnsembleCmdRep structure so that we can check it to
	see if the subcommand object is really being used with the same
	ensemble. [Bug 1026903]

2004-09-11  Kevin B. Kenny  <[email protected]>

	* generic/tclClock.c (TclMktimeObjCmd): Corrected a bad check for
	error return from 'mktime'.
	* generic/tclObj.c (Tcl_GetIntFromObj): Corrected a problem where
	demoting a wide to an int failed on a big-endian machine. [Bug
	1026125].
	* tests/clock.test (clock-43.1): Added regression test for error
	return from 'mktime'.

2004-09-11  Miguel Sofer <[email protected]>

	* generic/tclExecute.c (INST_CONCAT1): fix for [Bug 1025834]; avoid
	unnecessary string copies.

2004-09-10  David Gravereaux <[email protected]>

	* tests/tcltest.test: tcltest-12.3-4 needed to have
	::tcltest::loadScript set to empty in their -setup

2004-09-10  Donal K. Fellows  <[email protected]>

	* generic/tclObj.c (SetIntOrWideFromAny): Rewritten integral value
	parsing code so that values do not flip so easily between numeric
	representations. Thanks to KBK for this! [Bug 868489]

	* generic/tclIO.c (Tcl_Seek): Make sure wide seeks do not fail to set
	::errorCode on error. [Bug 1025359]

2004-09-10  Andreas Kupries  <[email protected]>

	* generic/tcl.h: Micro formatting fixes.
	* generic/tclIOGT.c: Channel version fixed, must be 3, to have
	wideseekProc. Thanks to David Graveraux <[email protected]>.

2004-09-11  Don Porter	<[email protected]>

	* generic/tclNamespace.c (TclGetNamespaceForQualName): Resolved
	longstanding inconsistency in the treatment of the TCL_NAMESPACE_ONLY
	flag revealed by testing the 2004-09-09 commits against Itcl.
	TCL_NAMESPACE_ONLY now acts as specified in the pre-function comment,
	forcing resolution in the passed in context namespace. It has been
	incorrectly forcing resolution in the interp's current namespace.

2004-09-10  Kevin Kenny	 <[email protected]>

	* library/clock.tcl: Fixed a bug where %z always put a plus sign on
	the time zone in :localtime.
	* tests/clock.test: Added test case for the above bug.

2004-09-10  Miguel Sofer <[email protected]>

	* generic/tclExecute.c (INST_CONCAT1): added a peephole optimisation
	for concatting an empty string. This enables replacing the idiom 'K $x
	[set x {}]' by '$x[set x {}]' for fastest execution.

2004-09-09  David Gravereaux <[email protected]>

	* win/tclWinConsole.c: Calls to WriteFile and WriteConsoleA changed to
	WriteConsole for simplicity.

2004-09-09  Don Porter	<[email protected]>

	* generic/tclNamesp.c (Tcl_ForgetImport):	Corrected faulty

	* tests/namespace.test: logic that relied exclusively on string
	matching and failed in the presence of [rename]s. [Bug 560297] Also
	corrected faulty prevention of [namespace import] cycles. [Bug 1017299]

2004-09-08  Don Porter	<[email protected]>

	* generic/tclBasic.c (Tcl_CreateInterp):	Removed obsolete field
	for storing the string-based command procedure of built-in commands.
	We no longer have any string-based built-in commands!

2004-09-08  Kevin B. Kenny <[email protected]>

	* compat/strftime.c (_conv): Corrected a problem where hour 0 would
	format as a blank format group with %k.
	* doc/clock.n: Corrected a buglet in the header information. [Bug
	1024058]
	* generic/tclClock.c (TclClockMktimeObjCmd): Fixed a bug where the
	month was scanned incorrectly in -timezone :localtime.
	* tests/clock.test (clock-34.*,clock-40.1, clock-41.1): Adjusted the
	clock-34.* test cases so that the consistency check is performed in
	:localtime rather than the current time zone. This change allows
	dealing with issues where the C library has a different idea of DST
	conversion than Tcl. (Real fix would be to break TclGetDate into
	separate parser and time converter, and do the time conversion in
	clock.tcl. That's for another day.) Added regression test case for the
	bug where month was scanned incorrectly in -timezone :localtime. [Bug
	1023779] Added regression test case for %k at the zero hour.

2004-09-07  David Gravereaux <[email protected]>

	* win/makefile.vc: some quoting needed to be removed as it was
	breaking with VC7. [Bug 1023150]

2004-09-07  Kevin B. Kenny  <[email protected]>

	* doc/clock.n: Documented the default -format, and changed references
	to a (nonexistent) msgcat command to refer to the msgcat package. [Bug
	1023870]
	* generic/tclTimer.c: Removed a premature optimisation that attempted
	to store the assoc data in the client data; the optimisation caused a
	bug that [after] would overwrite its imports. [Bug 1016167]
	* library/clock.tcl (InitTZData, ClearCaches): Changed so that the
	in-memory time zone :UTC (and its aliases) always gets reinitialised,
	in case tzdata is absent. [Bug 1019537, 1023779]
	* library/tzdata/*: Regenerated.
	* tests/clock.test (clock-31.*, clock-39.1): Corrected a problem where
	the 'system' locale tests fail on a non-English Windows machine. [Bug
	1023761]. Added a test to make sure that alias time zones load
	correctly. [Bug 1023779].
	* tests/timer.test (timer-1.1, timer-2.1): Changed to (one hopes!) be
	more resilient on an overloaded system, if [after 200] sleeps for 300
	ms or longer.
	* tools/tclZIC.tcl (writeLinks): Corrected a problem where alias time
	zone names were written incorrectly, causing them to fail to load at
	run time. [Bug 1023779].
	* win/tclWinTime.c (Tcl_GetTime): Eliminated CPUID tests on Win64 -
	assuming that HAL vendors now do a better job of keeping the
	performance counters synchronized among CPU's. [Bug 1020445]

2004-09-06  Donal K. Fellows  <[email protected]>

	* doc/tclvars.n, doc/tcltest.n, doc/tclsh.1, doc/safe.n, doc/expr.n
	* doc/WrongNumArgs.3, doc/Utf.3, doc/TraceVar.3, doc/Thread.3
	* doc/TCL_MEM_DEBUG.3, doc/SubstObj.3, doc/StdChannels.3
	* doc/SetResult.3, doc/RegExp.3, doc/RegConfig.3, doc/RecEvalObj.3
	* doc/PrintDbl.3, doc/ParseCmd.3, doc/Panic.3, doc/ObjectType.3
	* doc/Object.3, doc/Namespace.3, doc/Interp.3, doc/IntObj.3
	* doc/Hash.3, doc/GetOpnFl.3, doc/GetIndex.3, doc/Eval.3
	* doc/Encoding.3, doc/DoubleObj.3, doc/DictObj.3, doc/CrtTimerHdlr.3
	* doc/CrtObjCmd.3, doc/CrtMathFnc.3, doc/CrtCommand.3, doc/CrtChannel.3
	* doc/ChnlStack.3, doc/ByteArrObj.3, doc/AssocData.3, doc/Alloc.3:
	More documentation fixes from Mikhail Kolesnitchenko. [Patch 1022527]

2004-09-03  Donal K. Fellows  <[email protected]>

	* unix/tclUnixFCmd.c: Stop NULL interp arguments from triggering a
	crash when an error happens. [Bug 1020538]

2004-09-02  Donal K. Fellows  <[email protected]>

	* doc/lsearch.n: Clarified meaning of -dictionary. [Bug 759545]

2004-09-02  Vince Darley  <[email protected]>

	* win/makefile.vc: clock.tcl needs to be installed.

2004-09-01  Jeff Hobbs	<[email protected]>

	* win/tclWinReg.c (BroadcastValue): WIN64 cast corrections

	* win/tclWinDde.c (DdeClientWindowProc):
	(DdeServicesOnAck, DdeEnumWindowsCallback): WIN64 corrections

	* win/tclWin32Dll.c (TclWinCPUID): need _asm for WIN64 (Itanium),
	until we have it, just return unknown. [Bug 1020445]

2004-09-01  Donal K. Fellows  <[email protected]>

	* doc/regsub.n, doc/RegConfig.3, doc/Environment.3:
	* doc/CrtChannel.3, doc/safe.n: Use correct abbreviations.

2004-08-31  Donal K. Fellows  <[email protected]>

	* doc/trace.n, doc/socket.n, doc/registry.n, doc/pid.n:
	* doc/namespace.n, doc/msgcat.n, doc/lsort.n, doc/lsearch.n:
	* doc/linsert.n, doc/info.n, doc/http.n, doc/history.n:
	* doc/format.n, doc/file.n, doc/exec.n, doc/dde.n, doc/clock.n:
	* doc/catch.n, doc/binary.n: More spelling and grammar fixes from
	Mikhail Kolesnitchenko. [Patch 1018486]

2004-08-31  Vince Darley  <[email protected]>

	* doc/FileSystem.3:
	* generic/tclIOUtil.c: Clarified documentation regarding ability of a
	filesystem to say that it doesn't support a given operation using the
	EXDEV posix error code (copyFileProc, renameFileProc, etc), and
	updated one piece of code to ensure correct behaviour when an
	operation is not supported [Bug 1017072]

	* tests/fCmd.test: fix to test suite problem [Bug 1002884]

2004-08-31  Daniel Steffen  <[email protected]>

	* unix/Makefile.in (install-libraries): portable sh fix.

2004-08-30  Donal K. Fellows  <[email protected]>

	* generic/tclCmdMZ.c (Tcl_StringObjCmd): Stop [string map] from
	crashing when its map and input string are the same object.

2004-08-27  Donal K. Fellows  <[email protected]>

	* generic/tclNamesp.c (FindEnsemble): Factor out the code to convert a
	command name into an ensemble configuration and add support for
	ignoring [namespace import] link chains. [Bug 1017022]
	(NamespaceWhichCmd): Rework to use newer option parsing API.

2004-08-27  Daniel Steffen  <[email protected]>

	* unix/Makefile.in: added customization of default module path roots
	via TCL_MODULE_PATH makefile variable.
	* macosx/Makefile: add platform standard locations to default module
	path roots. [Patch 942881]

	* tests/env.test: macosx fixes.

2004-08-25  Don Porter	<[email protected]>

	* tests/timer.test (timer-10.1):	Test for Bug 1016167.
	* generic/tclTimer.c: Workaround for situation when a [namespace
	import] causes the objv[0] value to be something other than what
	Tcl_AfterObjCmd expects. [Bug 1016167].

2004-08-25  Donal K. Fellows  <[email protected]>

	* generic/tclNamesp.c (NsEnsembleImplementationCmd): Use the ensemble
	command token to get the name of the ensemble for passing to the
	-unknown handler instead of relying on objv[0], which may contain
	useless info in the presence of [namespace import]. Problem found by
	Don Porter when investigating [Bug 1016167].

2004-08-24  Don Porter	<[email protected]>

	* generic/tclProc.c:		The routine TclProcInterpProc was a
	* generic/tclTestProcBodyObj.c: specific instance of the general
	service already provided by TclObjInvokeProc. Removed
	TclProcInterpProc and TclGetInterpProc from the code...

	* generic/tclInt.decls:	...and from the internal stubs table.
	* generic/tclIntDecls.h
	* generic/tclStubInit.c

2004-08-24  Donal K. Fellows  <[email protected]>

	* doc/string.n: Added clarifying note.

2004-08-23  Don Porter	<[email protected]>

	* library/auto.tcl:	Updated [tcl_findLibrary] search path to
	include any [<pkg>::pkgconfig get scriptdir,runtime] directory, as
	well as the $::auto_path. [RFE 695441]

2004-08-21  Kevin B. Kenny  <[email protected]>

	* tests/clock.test (clock-38.1): Changed TZ setting to specify CET in
	excruciating detail to deal with systems that lack the Posix defaults
	for DST changes (and to be formally correct with the change dates for
	CET).

2004-08-19  Donal K. Fellows  <[email protected]>

	* generic/tclScan.c (Tcl_ScanObjCmd, ValidateFormat): Ensure that the
	%ld conversion works correctly on 64-bit platforms. [Bug 1011860]

2004-08-19  Kevin Kenny	 <[email protected]>

	* library/clock.tcl (format): Changed default timezone format from
	alphabetic to numeric to produce scannable times in more locales.
	* tests/clock.test (clock-37.1): Removed now-unused 'needPST'
	constraint and the comments that refer to it.

2004-08-18  Andreas Kupries  <[email protected]>

	* library/init.tcl: Integrated TIP #189. We source a separate file
	(see below), instead of inlining the contents of that file. This
	should beeasier to maintain, and easier to backport/install in 8.4
	installations.

	Note: Usage of Tcl Modules is restricted to non-safe interps. It
	cannot be loaded into a safe interp.

	* library/tm.tcl: New file, the v2 reference implementation for TIP
	#189, Tcl Modules.

	* doc/tm.n: New file, documentation for Tcl Modules, based on the TIP.

	* unix/mkLinks: Regenerated.
	* win/makefile.vc: Added tm.tcl to list of files to install.

2004-08-18  Kevin Kenny	 <[email protected]>

	* tests/httpd (httpdRespond): Corrected an abuse of the [clock]
	command that caused test failures for some values of [clock clicks].

	* doc/clock.n
	* generic/tclBasic.c (Tcl_CreateInterp, Tcl_HideUnsafeCommands):
	* generic/tclClock.c (all):
	* generic/tclInt.h:
	* generic/tclInterp.c (CreateSlave):
	* library/clock.tcl: (new file)
	* library/init.tcl (clock):
	* library/msgs/*.msg:(new files)
	* library/tzdata/*:
	* library/tzdata/*/*:
	* library/tzdata/*/*/*: (new files)
	* tools/installData.tcl: (new file)
	* tools/loadICU.tcl: (new file)
	* tools/makeTestCases.tcl: (new file)
	* tools/tclZIC.tcl: (new file)
	* unix/Makefile.in:
	* unix/configure: (regenerated)
	* unix/tcl.m4:
	* tests/clock.test (all):
	* win/Makefile.in:
	* win/Makefile.vc:
		Implementation of TIPs #173 and #209.

	The [clock] command is now a Tcl ensemble, with most of its
	functionality written in Tcl and callouts to C code only to access
	low-level functions such as localtime, mktime and tzset.

	In addition to the functionality changes called out in the two TIPs,
	it is worth noting that the [clock] command in a safe slave
	interpreter is now an alias to the [clock] command in the master, and
	that [clock] is otherwise not expected to function entirely correctly
	in safe interps. C code that simply does Tcl_MakeSafe needs to be
	aware that [clock] may need special handling. (It appears unlikely
	that such code actually exists.)

	One incompatibility of note is that if the time zone cannot be
	determined from the TZ, TCL_TZ environment variables, or from the
	Windows control panel, so that the C library must be used for date and
	time conversions, then times outside the range of time_t will fail;
	they used to return bad data silently.

	Many thanks to all the many people who assisted with testing,
	debugging, criticism of the specification, and localisation. Deserving
	of particular mention are Joe English, Clif Flynt, Donal K. Fellows,
	Jeff Hobbs, Cameron Laird, Arjen Markus, Reinhard Max, Christopher
	Nelson, Steve Offutt, Donald G. Porter, Pascal Scheffers, Peter da
	Silva and Richard Suchenwirth-Bauersachs.

	*** POTENTIAL INCOMPATIBILITY ***

2004-08-16  Miguel Sofer <[email protected]>

	* doc/SetVar.3:
	* generic/tclTest.c (TestseterrorcodeCmd):
	* generic/tclVar.c (TclPtrSetVar):
	* tests/result.test (result-4.*, result-5.*): [Bug 1008314] detected
	and fixed by dgp.

2004-08-13  Don Porter	<[email protected]>

	* library/msgcat/msgcat.tcl:	Added checks to prevent [mclocale]
	* tests/msgcat.test:	from registering filesystem paths to possibly
	malicious code to be evaluated by a later [mcload].

2004-08-10  Zoran Vasiljevic <[email protected]>

	* unix/tclUnixThrd.c (TclpThreadCreate): changed handling of the
	returned thread ID since broken on 64-bit systems (Cray). Thanks to
	Rob Ratcliff for reporting the bug.

2004-08-03  Donal K. Fellows  <[email protected]>

	* generic/tclNamesp.c (MakeCachedEnsembleCommand): Initialize the
	epoch field cached in the subcommand. [Bug 989298]
	(NsEnsembleImplementationCmd): Plug a leak (thanks to Miguel Sofer for
	spotting it with valgrind) and reduce the number of goto labels to
	make the code clearer.

2004-08-02  Don Porter	<[email protected]>

	* library/package.tcl (pkg_mkIndex):	Updated [pkg_mkIndex] to make
	use of [glob -directory $dir -tails] and return options.

	TIP#207 IMPLEMENTATION

	* doc/interp.n:		Added support for a -namespace option to the
	* generic/tclBasic.c:	[interp invokehidden] command.	Also added an
	* generic/tclInt.h:	internal routine TclObjInvokeNamespace() and
	* generic/tclInterp.c:	corrected the flag names TCL_FIND_ONLY_NS and
	* generic/tclNamesp.c:	TCL_CREATE_NS_IF_UNKNOWN that are passed to the
	* generic/tclTrace.c:	internal routine TclGetNamespaceForQualName().
	* tests/interp.test:	[Patch 981841]

	* generic/tclLiteral.c (TclCleanupLiteralTable):	Corrected
	* tests/compile.test (compile-12.4):	flawed deletion of literal
	internal reps that could lead to accessing of freed memory. Thanks to
	Kevin Kenny for test case and fix [Bug 1001997].

2004-07-30  Don Porter	<[email protected]>

	* tests/safe.test (safe-2.1):  Disabled senseless test.	 [Bug 999612]

	* library/auto.tcl (auto_reset):  Removed "protected" list of commands
	from [auto_reset]. All entries in the auto_index can be re-loaded.
	* library/package.tcl: Updated comment to reflect 2004-07-28 commit.

	* generic/tclEvent.c (Tcl_Finalize):	Re-organized Tcl_Finalize so
	that Tcl_ExitProc's that call Tcl_Finalize recursively do not cause
	deadlock. [Patch 999084 fixes Tk Bug 714956]

2004-07-30  Daniel Steffen  <[email protected]>

	* unix/configure:
	* unix/tcl.m4 (SC_CONFIG_CFLAGS): Darwin: instead of setting PLAT_OBJS
	to explict object files in tcl.m4, refer to MAC_OSX_OBJS makefile var.
	* unix/Makefile.in: added MAC_OSX_OBJS variable.

2004-07-29  Don Porter	<[email protected]>

	* library/package.tcl: [::pkg::create] is now an alias. Test safe-2.1
	will now fail until Bug 999612 is corrected.

2004-07-28  Don Porter	<[email protected]>

	* library/package.tcl:		Moved private command
	* library/tclIndex:		[pkg_compareExtension] into ::tcl::Pkg.
	* tests/pkg_mkIndex.test:	Also moved implementation of
	[::pkg::create] to [::tcl::Pkg::Create].

2004-07-25  Pat Thoyts	<[email protected]>

	* tests/io.test: Make io-61.1 create file as binary to pass on Win32

2004-07-23  Miguel Sofer <[email protected]>

	* generic/tclVar.c: simplify tclLocalVarNameType, removing the
	reference to the corresponding proc. The reference is now seen as
	unnecessary, and it may cause leaking circular references under some
	circumstances (see for example [Bug 994838]).

2004-07-22  Don Porter	<[email protected]>

	* tests/eofchar.data (removed): Test io-61.1 now generates its own
	* tests/io.test:	file of test data as needed.

2004-07-20  Jeff Hobbs	<[email protected]>

	* generic/tclEvent.c:	    Correct threaded obj allocator to
	* generic/tclInt.h:	    fully cleanup on exit and allow for
	* generic/tclThreadAlloc.c: reinitialization. [Bug 736426]
	* unix/tclUnixThrd.c:	    (mistachkin, kenny)
	* win/tclWinThrd.c:

2004-07-21  Kevin Kenny	 <[email protected]>

	* generic/tclBasic.c (DeleteInterpProc):
	* generic/tclLiteral.c (TclCleanupLiteralTable):
	* generic/tclInt.h: added a TclCleanupLiteralTable function, called
	from DeleteInterpProc, that frees internal representations of shared
	literals early when an interpreter is being deleted. This change
	corrects a number of memory mismanagement issues in the cases where
	the internal representation of one literal contains a reference to
	another, and avoids conditions such as resolved variable names
	referring to procedure and namespace contexts that no longer exist.
	[Bug 994838]

2004-07-20  Daniel Steffen  <[email protected]>

	* unix/Makefile.in:
	* win/Makefile.in: added 'install-private-headers' makefile target to
	allow optionally installing private tcl headers. [FR 922727]

	* macosx/Makefile: use new 'install-private-headers' target to install
	private headers into framework. [FR 922727]

	* unix/tclUnixFile.c (NativeMatchType): added support for readonly
	matching of user immutable files (where available).

	* macosx/tclMacOSXBundle.c: dynamically acquire address for
	CFBundleOpenBundleResourceMap symbol, since it is only present in full
	CoreFoundation on Mac OS X and not in CFLite on pure Darwin.

2004-07-19  Zoran Vasiljevic <[email protected]>

	* win/tclwinThrd.c: redefined MASTER_LOCK to call TclpMasterLock.
	Fixes [Bug 987967]

2004-07-17  Vince Darley  <[email protected]>

	* generic/tclIOUtil.c: fix to rare 'cd' infinite loop in normalization
	with vfs [Bug 991420].
	* tests/fileSystem.test: added test for above bug.

	* doc/FileSystem.3: clarified documentation of posix error codes in
	'remove directory' FS proc - 'EEXIST' is used to signify a non-empty
	directory error (bug reported against tclvfs).

2004-07-16  Jeff Hobbs	<[email protected]>

	* unix/Makefile.in, unix/tcl.m4:     move (C|LD)FLAGS after their
	* unix/configure.in, unix/configure: _DEFAULT to allow for env setting
	to override m4 switches. Move SC_MISSING_POSIX_HEADERS up and
	consolidate calls to limit redundancy in configure.
	(CFLAGS_WARNING): Remove -Wconversion
	(SC_ENABLE_THREADS): Set m4 to force threaded build when built against
	a threaded Tcl core.

2004-07-16  Andreas Kupries  <[email protected]>

	* generic/tclIOCmd.c (Tcl_FcopyObjCmd): Corrected a typo in the
	generation of error messages and simplified by reusing data in a
	variable instead of retrieving the string again. Fixes [Bug 835289].

	* doc/OpenFileChnl.3: Added description of the behaviour of
	Tcl_ReadChars when its 'charsToRead' argument is set to -1. Fixes [Bug
	934511].

	* doc/CrtCommand.3: Added note that the arguments given to the command
	proc of a Tcl_CreateCommand are in utf-8 since Tcl 8.1. Closing [Patch
	414778].

	* doc/ChnlStack.3: Removed the declaration that the interp argument to
	Tcl_(un)StackChannel can be NULL. This fixes [Bug 881220], reported by
	Marco Maggi <[email protected]>.

	* tests/socket.test: Accepted two new testcases by Stuart Casoff
	<[email protected]> checking that -server and -async don't go
	together [Bug 796534].

	* unix/tclUnixNotfy.c (NotifierThreadProc): Accepted Joe Mistachkin's
	patch for [Bug 990500], properly closing the notifier thread when its
	exits.

2004-07-15  Andreas Kupries  <[email protected]>

	* unix/tclUnixThrd.c (TclpFinalizeMutex): Accepted Joe Mistachkin's
	patch for [Bug 990453], closing leakage of mutexes. They were not
	destroyed properly upon finalization.

2004-07-15  Andreas Kupries  <[email protected]>

	* generic/tclIO.h (CHANNEL_INCLOSE):	   New flag. Set in
	* generic/tclIO.c (Tcl_UnregisterChannel): 'Tcl_Close' while the
	* generic/tclIO.c (Tcl_Close):		   close callbacks are
	run. Checked in 'Tcl_Close' and 'Tcl_Unregister' to prevent recursive
	call of 'close' in the close-callbacks. This is a possible error made
	by implementors of virtual filesystems based on 'tclvfs', thinking
	that they have to close the channel in the close handler for the
	filesystem.

2004-07-14  Andreas Kupries  <[email protected]>

	* generic/tclIO.c:
	* generic/tclIO.h:
	* Not reverting, but #ifdef'ing the changes from May 19, 2004 out of
	the core. This removes the ***POTENTIAL INCOMPATIBILITY*** for channel
	drivers it introduced. This has become possible due to Expect gaining
	a BlockModeProc and now handling blockingg and non-blocking modes
	correctly. Thus [SF Tcl Bug 943274] is still fixed if a recent enough
	version of Expect is used.

	* doc/CrtChannel.3: Added warning about usage of a channel without a
	BlockModeProc.

2004-07-15  Andreas Kupries  <[email protected]>

	* generic/tclIOCmd.c (Tcl_PutsObjCmd): Added length check to the old
	depreceated newline syntax, to ensure that only "nonewline" is
	accepted. [Tcl SF Bug 985869], reported by Joe Mistachkin
	<[email protected]>.

2004-07-15  Zoran Vasiljevic <[email protected]>

	* generic/tclEvent.c (Tcl_Finalize): stuffed memory leak incurred by
	re-initializing of TSD slots after the last call to
	TclFinalizeThreadData (done from within Tcl_FinalizeThread()). We
	basically just repeat the TclFinalizeThreadData() once more before
	tearing down TSD keys in TclFinalizeSynchronization(). There should be
	more elaborate mechanism in place for handling such issues, based on
	thread cleanup handlers registered on the OS level. Such change
	requires much more work and would also require TIP because some
	visible parts of Tcl API would have to be modified. In the meantime,
	this will do.

	* generic/tclNotify.c (TclFinalizeNotifier): Added conditional
	notifier finalization based on the fact that an TclInitNotifier has
	been called for the current thread. This fixes the [Bug 770053] again.
	Hopefully this time w/o unwanted side-effects.

2004-07-15  Kevin Kenny	 <[email protected]>

	* generic/tclLiteral.c (TclReleaseLiteral): Removed unused variable
	'codePtr' to silence a message from VC++.

2004-07-15  Miguel Sofer <[email protected]>

	* generic/tclCompile.c (TclCompileScript):
	* generic/tclLiteral.c (TclReleaseLiteral): fix for [Bug 467523],
	which resurfaced with the latest changes. The previous strategy was to
	have special code in TclReleaseLiteral to handle the self-references
	generated by empty scripts. The new approach avoids the self-reference
	altogether, by having empty scripts return an unshared literal.

2004-07-15  Zoran Vasiljevic <[email protected]>

	* generic/tclEvent.c (NewThreadProc): Backout of changes to fix the
	[Bug 770053]. See SF bugreport for more info.

2004-07-11  Miguel Sofer <[email protected]>

	* generic/tclBasic.c (Tcl_EvalEx): leak fix by dgp, release
	objv[objectsUsed] on error.

2004-07-11  Miguel Sofer <[email protected]>

	* generic/tclParse.c (Tcl_SubstObj): leak fix by dgp, release result
	on error.

2004-07-11  Donal K. Fellows  <[email protected]>

	* generic/tclNamesp.c (BuildEnsembleConfig): Don't forget to clean out
	references when deleting the hash table.
	* generic/tclDictObj.c (Tcl_DictObjRemoveKeyList): Oops, forgot to
	delete value object when removing the hash entry. [Bug 989093 in part]

2004-07-11  Miguel Sofer <[email protected]>

	* generic/tclExecute.c (TEBC): fixed leak of expandNestList objs when
	there is an error while an expansion is in progress (code added at
	checkForCatch).

2004-07-11  Vince Darley  <[email protected]>

	* generic/tclIOUtil.c: fix to 'cd' bug when vfs is active [tclvfs Bug
	986944] - this bug recently introduced by some threading fixes. Need
	to work out how to add tests for this.

2004-07-10  Kevin Kenny	 <[email protected]>

	* tests/clock.test (clock-2.11): Changed the test so that it isn't an
	infinite loop when run under valgrind on a slow virtual machine.
	Thanks to Miguel Sofer for the bug report. Also put in code to restore
	env(LC_TIME) after tests complete, silencing a warning from 'make
	TESTFLAGS="-debug 1" test'.

2004-07-08  Miguel Sofer <[email protected]>

	* generic/tclBasic.c (DeleteInterpProc): reverted the modification of
	3 days ago, as the leak of [Bug 983660] is now handled by the change
	in TclCleanupByteCode.
	* generic/tclCompile.c (TclCleanupByteCode): let each bytecode remove
	its references to literals at interp deletion, without updating the
	dying literal table.
	* generic/tclLiteral.c (TclDeleteLiteralTable): with the above change
	to TclCleanupByteCode, this function now removes a single reference to
	the literal object and cleans up its own structures.

2004-07-08  Kevin Kenny	 <[email protected]>

	* win/tclWinInit.c (AppendEnvironment): Silenced a compilation warning
	about a type mismatch.

2004-07-07  Miguel Sofer <[email protected]>

	* generic/tclCompile.c (TclCompileScript): fix for [Bug 458361].
	Single-word scripts are compiled with an unshared cmdName to avoid
	shimmering between bytecode and cmdName reps.

2004-07-07  Don Porter	<[email protected]>

	* generic/tclCmdMZ.c (TclMergeReturnOptions):  Simplified logic and
	removed potential memory leak. [Bug 986257].

2004-07-07  Donal K. Fellows  <[email protected]>

	* tools/man2help2.tcl (setTabs, IPmacro): Added support for the more
	advanced *roff macros used in Tk's doc/bind.n

	* generic/tclObj.c (TclInitObjSubsystem): Declare all current object
	types.

2004-07-06  Don Porter	<[email protected]>

	* tests/cmdMZ.test (cmdMZ-return-2.17): Added a test that a word
	containing backslash-quoted value is treated correctly.

	* generic/tclCompile.c (TclWordKnownAtCompileTime): [Bug 986196]
	Corrected flaw above and the flaw that caused TCL_TOKEN_SIMPLE_WORDs
	to have their original word value copied ( "{a b}" ) rather than the
	actual value ( "a b" ). Thanks to Kevin Kenny for report and tests.

2004-07-06  Kevin B. Kenny  <[email protected]>

	* tests/cmdMZ.test (cmdMZ-return-2.15,cmdMZ-return-2.16): Added a test
	that a return code containing spaces is correctly returned.

2004-07-06  Donal K. Fellows  <[email protected]>

	* tools/man2html2.tcl (IPmacro, setTabs): Added support for the more
	advanced *roff macros used in Tk's doc/bind.n

2004-07-05  Miguel Sofer <[email protected]>

	* generic/tclBasic.c (DeleteInterpProc): fix for [Bug 983660], found
	by pspjuth. Tear down the global namespace before freeing the interp
	handle, to allow the bytecodes to free their non-shared literals.
	* generic/tclLiteral.c (TclReleaseLiteral): moved special code for
	self-ref so that it is also used for non-shared literals. Possible bug
	found by inspection.

2004-07-03  Miguel Sofer <[email protected]>

	* generic/tclExecute.c (ExprRoundFunc):
	* tests/expr-old.test (39.1): added support for wide integers to
	round(); [Bug 908375], reported by Hemang Lavana.

2004-07-03  Miguel Sofer <[email protected]>

	* generic/tclCompile.h:
	* generic/tclInt.decls:
	* generic/tclIntDecls.h:
	* generic/tclStubInit.c: Moved declaration of TclCompEvalObj() from
	tclCompile.h to the internal stubs table, for compiler
	experimentation.

2004-07-02  Jeff Hobbs	<[email protected]>

	* generic/regcomp.c (stid): correct minor pointer size error

	* generic/tclPipe.c (TclCreatePipeline): applied TIP #202 patch that
	* doc/exec.n, tests/exec.test:		 adds 2>@1 as a special case
	redirection of stderr to the result output.

2004-07-02  Kevin B. Kenny  <[email protected]>

	* tests/io.test: Changed several tests to run the event loop rather
	than just calling [update] periodically, avoiding intermittent
	failures (usually in io-29.32) that stemmed from unreaped processes on
	Windows.
	* tests/winPipe.test (winpipe-1.11): Fixed a bug that caused test to
	fail if the path name of the working directory contained whitespace
	[Bug 678430]

2004-07-01  Vince Darley  <[email protected]>

	* tests/fileSystem.test: Added test for [Bug 970529]

2004-07-01  Donal K. Fellows  <[email protected]>

	* win/README.binary, win/README: Updated references to Tcl and Tk 8.4
	to point to 8.5 instead. Thanks to Theo Verelst for spotting this.
	* generic/tcl.h: Added note to help prevent those changes from getting
	missed in the future.

	* doc/Namespace.3, doc/load.n, doc/Limit.3: Typo fixes and remove
	duplicate documentation. [Bug 983146]

2004-06-30  Don Porter	<[email protected]>

	* tests/fileSystem.test: Minor correction to new fileSystem-9.X tests
	so that they clean up temporary directories correctly.

2004-06-30  Vince Darley  <[email protected]>

	* doc/filename.n: clarified behaviour concerning trailing slashes in
	filenames [Bug 971976]

	* win/tclWinFile.c:
	* tests/fileSystem.test: fix and tests for [Bug 979879]

2004-06-30  Donal K. Fellows  <[email protected]>

	TIP#188 IMPLEMENTATION

	* doc/string.n, tests/string.test:	 Add 'wideinteger' to things
	* generic/tclCmdMZ.c (Tcl_StringObjCmd): that can be tested for with
	the [string is] subcommand. [Patch 940915, by Kevin Kenny]

2004-06-29  Don Porter	<[email protected]>

	* win/tclWinInit.c:	Corrected reference counting flaw in recent
	changes. Thanks to Pat Thoyts. [Bug 981893].

2004-06-29  Vince Darley  <[email protected]>

	* win/tclWin32Dll.c: fix to compilation with VC++ 5.2

2004-06-29  Donal K. Fellows  <[email protected]>

	* library/safe.tcl: Make sure that the temporary variable is local to
	the namespace and not inadvertently global. [Bug 981733]

2004-06-24  Donal K. Fellows  <[email protected]>

	* tests/unixNotfy.test: Modified constraints so that testing with a
	threaded tclsh (not tcltest) will not hang.

2004-06-23  Don Porter	<[email protected]>

	* generic/tclThreadStorage.c: Corrected type casting errors that led
	to calculation of a negative index value, thus accesses outside the
	threadStorageCache array, thus memory corruption. Crash observed on
	Mac OS X platform.

2004-06-23  Joe Mistachkin  <[email protected]>

	* generic/tclThread.c: Implements platform independent thread storage
	* generic/tclThreadStorage.c: mechanism and fixes associated bugs on
	platforms where there is limited thread local storage space
	(Win98/WinNT4). [Patch 976496]

	* generic/tclInt.decls:
	* generic/tclIntDecls.h: Added thread storage functions to the
	* generic/tclStubInit.c: internal stubs table.

	* unix/Makefile.in:
	* unix/configure:
	* unix/tcl.m4:
	* win/makefile.vc:
	* win/rules.vc:
	* win/Makefile.in: Modified the unix, VC++, and Cygwin build systems
	* win/configure: to include the new "tclThreadStorage.c" and the new
	* win/tcl.m4: USE_THREAD_STORAGE define.

2004-06-23  Pat Thoyts	<[email protected]>

	* tests/io.test: Added -force to 18.1 and 18.2. This was failing on
	WinXP.

	* tests/winFCmd.test: Added a cleanup to winFCmd-16.11 to avoid a
	failure in 16.12.

	* tests/eofchar.data: Added -kb option to ensure a binary checkout to
	win32 systems. This fixes a failure in io-61.1

	* win/makefile.vc: fix for [Bug 977369] about launching tclsh to
	generate a tclConfig.sh with the nmake build system

2004-06-23  Kevin B. Kenny  <[email protected]>

	* tests/winDde.test (createChildProcess): Added a 200-ms delay (with
	the event loop live) when shutting down the test DDE server process.
	With the delay in place, nuisance failures of tests winDde-4.2, -6.5,
	and -6.6 appear to be much less frequent. [Bug 957449]

2004-06-23  Donal K. Fellows  <[email protected]>

	* tests/*.test: Standardize use of platform constraints.

	* unix/tclUnixInit.c (GetStackSize, TclpCheckStackSpace):
	* unix/tclUnixThrd.c (TclpThreadGetStackSize): Added code to check
	whether the C stack is about to be exceeded, from [Patch 746378] by
	Joe Mistachkin but with substantial revisions.

2004-06-22  Kevin Kenny	 <[email protected]>

	* generic/tclEvent.c (NewThreadProc): Fixed broken build on Windows
	caused by missing TCL_THREAD_CREATE_RETURN.

	* tests/stack.test (stack-3.1): Corrected nuisance error in threaded
	builds.

2004-06-22  Zoran Vasiljevic <[email protected]>

	* generic/tclEvent.c:
	* generic/tclInt.h:
	* unix/tclUnixNotfy.c:
	* unix/tclUnixThrd.c:
	* win/tclWinThrd.c: [Bug 770053]. See bug report for more information
	about what it does.

	* tests/unixNotfy.test: rewritten to use tcltest::threadReap to
	gracefully wait for the test thread to exit. Otherwise we got a race
	condition with main thread exiting before the test thread. This
	exposed the long-standing Tcl lib issue with resource
	garbage-collection on application exit.

2004-06-21  Mo DeJong  <[email protected]>

	* win/tclWin32Dll.c (DllMain, _except_dllmain_detach_handler)
	(TclpCheckStackSpace, _except_checkstackspace_handler)
	(TclWinCPUID, _except_TclWinCPUID_detach_handler):
	* win/tclWinChan.c (Tcl_MakeFileChannel)
	(_except_makefilechannel_handler):
	* win/tclWinFCmd.c (DoRenameFile, _except_dorenamefile_handler)
	(DoCopyFile, _except_docopyfile_handler):
	Rework pushing of exception handler function pointer so that compiling
	with gcc -O3 works. Remove empty function call to avoid compiler
	warning. Mark the DllMain function as noinline to avoid compiler error
	from duplicated asm labels in generated code.

2004-06-21  Donal K. Fellows  <[email protected]>

	* generic/tclThreadAlloc.c (Ptr2Block): Rewrote so as to maximize the
	chance of detecting and reporting a memory inconsistency without
	relying on things being consistent. [Bug 975895]

2004-06-18  Don Porter	<[email protected]>

	* tests/load.test:	Relaxed strictness of error message matching
	for test load-2.3 so that it will pass on Mac OSX.

	* generic/tclEncoding.c: Static TclFindEncodings -> FindEncodings.
	* generic/tclInt.h:	Updated TclpFindExecutable() so that failed
	* generic/tclUtil.c:	attempts to find the executable are saved
	* unix/tclUnixFile.c:	just as successful finds are. [Patch 966053]
	* unix/tclUnixTest.c:

2004-06-18  Kevin B. Kenny  <[email protected]>

	* tests/winFCmd.test (winFCmd-16.12): Changed test to compute the
	target directory, so as not to fail if the user's HOME isn't the root.

2004-06-19  Daniel Steffen  <[email protected]>

	* unix/tcl.m4: autoconf 2.5 fixes in Darwin section.
	* unix/configure: autoconf-2.57

2004-06-18  Donal K. Fellows  <[email protected]>

	* unix/tclUnixInit.c (localeTable): Added some more locale to encoding
	mapping info from Jim Huang <[email protected]>

	* generic/tclInt.h (PendingObjData,TclFreeObjMacro,etc):
	* generic/tclObj.c (TclFreeObj): Added scheme for making TclFreeObj()
	avoid blowing up the C stack when freeing up very large object trees.
	[Bug 886231]

	* win/tclWinInit.c (SetDefaultLibraryDir): Fix logic, simplify and add
	comments.

2004-06-17  Don Porter	<[email protected]>

	* generic/tclObj.c:	Added missing space in panic message.

	* win/tclWinInit.c:	Inform [tclInit] about the default library
	directory via the ::tclDefaultLibrary variable. This should correct a
	problem with my 2004-06-11 commit. Better solutions still in the
	works. Thanks to Joe Mistachkin for pointing out the breakage.

2004-06-16  Don Porter	<[email protected]>

	* doc/library.n:	Moved variables ::auto_oldpath and
	* library/auto.tcl:	::unknown_pending into ::tcl namespace.
	* library/init.tcl:	[Bugs 808319, 948794]

2004-06-15  Donal K. Fellows  <[email protected]>

	* doc/binary.n: Added some notes to the documentation of the 'a'
	format to address the point raised in [RFE 768852].

2004-06-15  Jeff Hobbs	<[email protected]>

	* unix/tclConfig.sh.in (TCL_EXTRA_CFLAGS): set to @CFLAGS@, which is
	the configure-time CFLAGS. Addendum to m4 change on 2004-05-26.

2004-06-14  Kevin Kenny	 <[email protected]>

	* win/Makefile.in: Corrected compilation flags for tclPkgConfig.c so
	that it doesn't require Stubs.
	* generic/tclBasic.c (Tcl_CreateInterp): Removed comment stating that
	TclInitEmbeddedConfigurationInformation needs Stubs; with the change
	above, the comment is now erroneous.

2004-06-11  Don Porter	<[email protected]>

	* doc/Encoding.3:	Removed bogus claims about tcl_libPath.

	* generic/tclInterp.c (Tcl_Init):	Stopped setting the
	tcl_libPath variable. [tclInit] can get all its directories without it.

	* tests/unixInit.test:	Modified test code that made use of
	tcl_libPath variable.

	* unix/tclUnixInit.c:	Stopped setting the tclDefaultLibrary variable,
	execept on the Mac OS X platform with HAVE_CFBUNDLE. In that
	configuration we should seek some way to make use of the TIP 59
	facilities and get rid of that usage of tclDefaultLibrary as well.

	* generic/tclInterp.c:	Updated [tclInit] to make $env(TCL_LIBRARY) an
	absolute path, and to include the scriptdir,runtime configuration value
	on the search path for init.tcl.

	* unix/tclUnixInit.c:	The routines Tcl_Init() and TclSourceRCFile()
	* win/tclWinInit.c:	had identical implementations for both win and
	* generic/tclInterp.c:	unix. Moved to a single generic implementation.
	* generic/tclMain.c:
	* library/init.tcl:
	* generic/tclInitScript.h (removed):
	* unix/Makefile.in:
	* win/tcl.dsp:

	* unix/configure.in:	Updated TCL_PACKAGE_PATH value to handle
	* win/configure.in:	--libdir configuration.

	* unix/configure.in:	autoconf-2.57
	* win/configure.in:

	* generic/tclBasic.c (Tcl_CreateInterp): Moved call to
	TclInitEmbeddedConfigurationInformation() earlier in
	Tcl_CreateInterp() so that other parts of interp creation and
	initialization may access and use the config values.

2004-06-11  Kevin Kenny	 <[email protected]>

	* win/tclAppInit.c: Restored the 'setargv' procedure when compiling
	with mingw. Apparently, the command line parsing in mingw doesn't work
	as well as that in vc++, and the result was (1) that winPipe-8.19
	failed, and (2) that 'make test' would work at all only with
	TESTFLAGS='-singleproc 1'. [Bug 967195]

2004-06-10  Zoran Vasiljevic <[email protected]>

	* generic/tclIOUtil.c: removed forceful setting of the private cached
	current working directory rep from within the Tcl_FSChdir(). We
	delegate this task to the Tcl_FSGetCwd() which does this task anyway.
	The relevant code is still present but disabled temporarily until the
	change proves correct. The Tcl test suite passes all test with the
	given change so I suppose it is good enough.

2004-06-10  Don Porter	<[email protected]>

	* unix/tclUnixInit.c (TclpInitLibraryPath):	Disabled addition of
	* win/tclWinInit.c (TclpInitLibraryPath):	relative-to-executable
	directories to the library search path. A first step in reform of
	Tcl's startup process.

	***POTENTIAL INCOMPATIBILITY***
	Attempts to directly run ./tclsh or ./tcltest out of a build directory
	will either fail, or will make use of an installed script library in
	preference to the one in the source tree. Use `make shell` or `make
	runtest` instead.

	* tests/unixInit.test:	Modified tests to suit above changes.

	* generic/tclPathObj.c:	Corrected [file tail] results when operating
	on a path produced by TclNewFSPathObj(). [Bug 970529]

2004-06-09  Zoran Vasiljevic <[email protected]>

	* generic/tclIOUtil.c: partially corrected [Bug 932314]. Also
	corrected return values of Tcl_FSChdir() to reflect those of the
	underlying platform-specific call. Originally, return codes were mixed
	with those of Tcl.

2004-06-08  Miguel Sofer <[email protected]>

	* generic/tclCompile.c:
	* generic/tclExecute.c: handle warning [Bug 969066]

2004-06-08  Donal K. Fellows  <[email protected]>

	* generic/tclHash.c (RebuildTable): Move declaration of variable so it
	is only declared when it is used. [Bug 969068]

2004-06-07  Donal K. Fellows  <[email protected]>

	* doc/lsearch.n: Added correct option to example. [Bug 968219]

2004-06-05  Kevin B. Kenny  <[email protected]>

	* generic/tcl.h: Corrected Tcl_WideInt declarations so that the mingw
	build works again.
	* generic/tclDecls.h:			Changes to the tests for clock
	* generic/tclInt.decls:			frequency in Tcl_WinTime so
	* generic/tclIntDecls.h:		that any clock frequency is
	* generic/tclIntPlatDecls.h:		accepted provided that all
	* generic/tclPlatDecls.h:		CPU's in the system share a
	* generic/tclStubInit.c:		common chip, and hence,
	* tests/platform.test (platform-1.3):	presumably, a common clock.
	* win/tclWin32Dll.c (TclWinCPUID):	This change necessitated a
	* win/tclWinTest.c (TestwincpuidCmd)	small burst of assembly code
	* win/tclWinTime.c (Tcl_GetTime):	to read CPU ID information,
	which was added as TclWinCPUID in the internal Stubs. To test this
	code in the common case of a single-processor machine, a
	'testwincpuid' command was added to tclWinTest.c, and a test case in
	platform.test. Thanks to Jeff Godfrey and Richard Suchenwirth for
	reporting this bug. [Bug 976722]

2004-06-04  Don Porter	<[email protected]>

	* generic/tcl.h:	Restored #include <stdio.h> to tcl.h,
	rejecting the "fix" for "Bug" 945570. Tcl_FSSeek() needs the values of
	SEEK_SET, etc. and too many extensions rely on tcl.h providing stdio.h
	for them.

2004-06-02  Jeff Hobbs	<[email protected]>

	* win/tclWinFile.c (TclpFindExecutable): when using GetModuleFileNameA
	(Win9x), convert from CP_ACP to WCHAR then convert back to utf-8.
	Adjunct to 2004-04-07 fix.

2004-06-02  David Gravereaux <[email protected]>

	* tests/winPipe.test (winpipe-6.1): blocking set to 1 before closing
	to ensure we get an exitcode. The windows pipe channel driver doesn't
	differentiate between a blocking and non-blocking close just yet, but
	will soon. Part of [Bug 947693]

2004-06-02  Vince Darley  <[email protected]>

	* doc/file.n: fix to documentation of 'file volumes' (Bug 962435)

2004-06-01  David Gravereaux <[email protected]>

	* win/makefile.vc: check for either MSDEVDIR or MSVCDIR being in the
	environment, for VC7. [Bug 942214]

	* generic/tclIO.c (Tcl_SetChannelOption): -buffersize wasn't
	understanding hexidecimal notation nor was reporting number conversion
	errors. The behavior to silently ignore settings outside the
	acceptable range of Tcl_SetChannelBufferSize (<10 or >1M) is
	unchanged. This silent ignoring behavior might be up for review soon.

2004-05-30  David Gravereaux <[email protected]>

	* win/tclWinPipe.c:
	* win/tclWinPort.h:  Reworked the win implementation of Tcl_WaitPid to
	support exitcodes in the 'signed short' range. Even though this range
	is non-portable, it is valid on windows. Detection of exception codes
	are now more accurate. Previously, an application that exited with
	ExitProcess((DWORD)-1); was improperly reported as exiting with
	SIGABRT.

2004-05-30  Donal K. Fellows  <[email protected]>

	* generic/tclInterp.c: Added comments describing the purposes of each
	function in the limit implementation and rewrote the names of some
	non-public functions for greater clarity of purpose.
	* doc/interp.n: Added note about what happens when a limited
	interpreter creates a slave interpreter.
	* doc/Limit.3: Added manual page for the resource limit subsystem's C
	API. [Bug 953903]

2004-05-29  Joe English	 <[email protected]>

	* doc/global.n, doc/interp.n, doc/lrange.n: Fix minor markup errors.

2004-05-28  Donal K. Fellows  <[email protected]>

	* doc/*.n: Added examples to many (too many to list) more man pages.

2004-05-25  Miguel Sofer <[email protected]>

	* generic/tclExecute.c:
	* generic/tclVar.c: using (ptrdiff_t) instead of (int) casting to
	correct compiler warnings [Bug 961657], reported by Bob Techentin.

2004-05-27  Kevin B. Kenny  <[email protected]>

	* tests/clock.test: Added a single test for the presence of %G in
	[clock format], and conditioned out the clock-10.x series if they're
	all going to fail because of a broken strftime() call. [Bug 961714]

2004-05-27  Donal K. Fellows  <[email protected]>

	* generic/tclHash.c (CompareStringKeys): Added #ifdef to allow people
	to instruct this function to use strcmp(). [FRQ 951168]

	* generic/tclVar.c: Moved declarations into #if guards so they only
	happen when required.
	* unix/tclUnixPort.h: Guard declaration of strtod() so it is only
	enabled when we don't have a declaration in stdlib.h
	* unix/tclUnixThrd.c (Tcl_CreateThread):	Added declarations
	* unix/tclUnixTest.c (AlarmHandler):		and casts so that
	* unix/tclUnixChan.c (TtyModemStatusStr):	all functions are
	* generic/tclScan.c (Tcl_ScanObjCmd):		defined before use
	* generic/tclDictObj.c (InvalidateDictChain):	and no cross-type
	* generic/tclCmdMZ.c (Tcl_StringObjCmd):	uses are performed.

	The overall effect is to make building with gcc with the additional
	flags -Wstrict-prototypes -Wmissing-prototypes produce no increase in
	the total number of warnings (except for main(), which is undeclared
	for traditional reasons.)

2004-05-26  Jeff Hobbs	<[email protected]>

	* unix/Makefile.in:  Rework configure ordering to TCL_LINK_LIBS,
	* unix/tcl.m4:	     ENABLE_SHARED, CONFIG_CFLAGS, & ENABLE_SYMBOLS
	* unix/configure:    before TCL_EARLY_FLAGS and TCL_64BIT_FLAGS
	* unix/configure.in: (about 400 lines earlier) in configure.in. This
	forces CFLAGS configuration to be done before many tests, which is
	needed for 64-bit builds and may affect other builds. Also make
	CONFIG_CFLAGS append to CFLAGS directly instead of using EXTRA_CFLAGS,
	and have LDFLAGS append to any existing value. [Bug 874058]
	* unix/dltest/Makefile.in: change EXTRA_CFLAGS to DEFS

2004-05-26  Don Porter	<[email protected]>

	* library/tcltest/tcltest.tcl:	Correction to debug prints and testing
	* library/tcltest/pkgIndex.tcl:	if TCLTEST_OPTIONS value. Corrected
	* tests/tcltest.test:		double increment of numTestFiles in
	-singleproc 1 configurations. Updated tcltest-19.1 to tcltest 2.1
	behavior. Corrected tcltest-25.3 to not falsely report a failure in
	tcltest.test. Bumped to tcltest 2.2.6. [Bugs 960560, 960926]

2004-05-25  Jeff Hobbs	<[email protected]>

	* doc/http.n (http::config): add -urlencoding option (default utf-8)
	* library/http/http.tcl:     that specifies encoding conversion of
	* library/http/pkgIndex.tcl: args for http::formatQuery. Previously
	* tests/http.test:	     undefined, RFC 2718 says it should be
	utf-8. 'http::config -urlencoding {}' returns previous behavior, which
	will throw errors processing non-latin-1 chars. Bumped http package to
	2.5.0.

2004-05-25  Donal K. Fellows  <[email protected]>

	* generic/tclInterp.c (DeleteScriptLimitCallback): Move all deletion
	of script callback hash table entries to happen here so the entries
	are correctly removed at the right time. [Bug 960410]

2004-05-25  Miguel Sofer <[email protected]>

	* docs/global.n: added details for qualified variable names [Bug
	959831]

2004-05-25  Miguel Sofer <[email protected]>

	* generic/tclNamesp.c (Tcl_FindNamespaceVar):
	* tests/namespace.test (namespace-17.10-12): reverted commit of
	2004-05-23 and removed the tests, as it interferes with the varname
	resolver and there are apps that break (AlphaTk). A fix will have to
	wait for Tcl9.

	* generic/tclVar.c: Caching of namespace variables disabled: no simple
	way was found to avoid interfering with the resolver's idea of
	variable existence. A cached varName may keep a variable's name in the
	namespace's hash table, which is the resolver's criterion for
	existence.

	* tests/namespace.c (namespace-17.10): testing for interference
	between varname caching and name resolver.

2004-05-25  Kevin Kenny	 <[email protected]>

	* tests/winFCmd.test: Correct test for the presence of a CD-ROM so
	that it doesn't misdetect some other sort of filesystem with a
	write-protected root as being a CD-ROM drive. [Bug 918267]

2004-05-25  Don Porter	<[email protected]>

	* tests/winPipe.test:	Protect against path being set
	* tests/unixInit.test:	Unset path when done.
	* tests/unload.test (unload-3.1): Verify [pkgb_sub] does not exist.
	Delete interps when done.
	* tests/stringComp.test:	stop re-use of string.test test names
	* tests/regexpComp.test:	stop re-use of regexp.test test names
	* tests/namespace.test (namespace-46.3): Verify [p] does not exist.
	* tests/http.test:	Clear away the custom [bgerror] when done.
	* tests/io.test:	Take care to use namespace variables.
	* tests/autoMkindex.test (autoMkindex-5.2): Use variable "result"
	that gets cleaned up.
	* tests/exec.test:	Clean up the "path" array.
	* tests/interp.test (interp-9.3): Initialize res, so prior values
	cannot make the test fail.
	* tests/execute.test (execute-8.1):  Updated to remove the trace set
	on ::errorInfo. When left in place, that trace can cause later tests
	to fail.

2004-05-25  Donal K. Fellows  <[email protected]>

	* generic/tclBasic.c: Removed references to Tcl_RenameCommand from
	* generic/tcl.h:      comments. [Bug 848440, second part]

	* tests/fCmd.test: Rewrote tests that failed consistently on NFS so
	they either succeed (through slightly more liberal matching of the
	results) or are constrained to not run. [Bug 931312]

	* doc/bgerror.n: Use idiomatic open flags for working with log
	files. [Bug 959602]

2004-05-24  Jeff Hobbs	<[email protected]>

	* generic/tclExecute.c (VerifyExprObjType): use GET_WIDE_OR_INT to
	properly have tclIntType used for smaller values. This corrects [TclX
	Bug 896727] and any other 3rd party extension that created math
	functions but was not yet WIDE_INT aware in them.

2004-05-24  Donal K. Fellows  <[email protected]>

	* generic/tclInterp.c (TclInitLimitSupport): Made limits work on
	platforms where sizeof(void*)!=sizeof(int). [Bug 959193]

2004-05-24 Miguel Sofer <[email protected]>

	* doc/set.n: accurate description of name resolution process,
	referring to namespace.n for details [Bug 959180]

2004-05-23  Miguel Sofer <[email protected]>

	* generic/tclNamesp.c (Tcl_FindNamespaceVar): [Bug 959052] fixed,
	insuring that no "zombie" variables are found.
	* generic/tclVar.c (TclLookupSimpleVar): comments re [Bug 736729]
	(predecessor of [Bug 959052]) removed.
	* tests/namespace.test: added tests 17.10-12

	The patch modifies non-documented behaviour, and passes every test in
	the testsuite. However, scripts relying on the old behaviour may
	break.
	Note that the only behaviour change concerns the creative writing of
	unset variables. More precisely, which variable will be created when
	neither a namespace variable nor a global variable by that name
	exists, as defined by [info vars]. The new behaviour is that the
	namespace resolution process deems a variable to exist exactly when
	[info vars] finds it - ie, either it has value, or else it was "fixed"
	by a call to [variable].
	Note: this patch was removed on 2002-05-25.

2004-05-22  Miguel Sofer <[email protected]>

	* generic/tclVar.c (TclObjLookupVar, TclObjUnsetVar2): fix for new (in
	tcl8.4) exteriorisations of [Bug 736729] due to the use of
	tclNsVarNameType obj types. Reenabling the use of this objType ("VAR
	ref absolute" benchmark down to 66 ms, from 230). Added comments in
	TclLookupSimpleVar explaining my current understanding of [Bug
	736729].

2004-05-22  Miguel Sofer <[email protected]>

	* generic/tclVar.c: fix for [Bug 735335]. The use of tclNsVarNameType
	objs is still disabled, pending resolution of [Bug 736729].

2004-05-21  Miguel Sofer <[email protected]>

	* tests/namespace.test (namespace-41.3): removed the {knownBug}
	constraint: [Bug 231259] is closed since nov 2001, and the fix of [Bug
	729692] (INST_START_CMD) makes the test succeed.

2004-05-21  Donal K. Fellows  <[email protected]>

	* generic/tclExecute.c (TclExecuteByteCode): Move a few declarations a
	short distance so pre-C99 compilers can cope. Also fix so
	TCL_COMPILE_DEBUG path compiles...

2004-05-21  Miguel Sofer <[email protected]>

	* generic/tclExecute.c (TclExecuteByteCode): reorganised TEBC
	automatic variables, defining them in tight blocks instead of at the
	function level. This has three purposes:
	- it simplifies the analysis of individual instructions
	- it is preliminary work to the non-recursive engine
	- it allows a better register allocation by the optimiser; under
	gcc3.3, this results in up to 10% runtime in some tests

2004-05-20  Donal K. Fellows  <[email protected]>

	* generic/tclInterp.c (TclLimitRemoveAllHandlers):
	* generic/tclBasic.c (DeleteInterpProc):
	* tests/interp.test (interp-34.7): Ensure that all limit callbacks are
	deleted when their interpreters are deleted. [Bug 956083]

2004-05-19  Kevin B. Kenny  <[email protected]>

	* win/tclWinFile.c (TclpMatchInDirectory): fix for an issue where
	there was a sneak path from Tcl_DStringFree to SetErrorCode(0). The
	result was that the error code could be reset between a call to
	FindFirstFileEx and the check of its status return, leading to a
	bizarre error return of {POSIX unknown {No error}}. (Found in
	unplanned test - no incident logged at SourceForge.)

2004-05-19  Donal K. Fellows  <[email protected]>

	* tests/interp.test (interp-34.3): Rewrite this test to see if a time
	limit can catch a tight bytecode loop, a maximally aggressive
	denial-of-service attack.
	* generic/tclInterp.c (Tcl_LimitCheck): Fix the sense of checks to see
	whether a time limit has been extended.

	* tests/*.test: Many minor fixes, including ensuring that every test
	is run (so constraints control whether the test is doing anything) and
	making sure that constraints are always set using the API instead of
	poking around inside tcltest's internal datastructures. Also got rid
	of all trailing whitespace lines from the test suite!

2004-05-19  Andreas Kupries  <[email protected]>

	* generic/tclIO.c: Fixed [SF Tcl Bug 943274]. This is the same problem
	* generic/tclIO.h: as [SF Tcl Bug 462317], see ChangeLog entry
	2001-09-26. The fix done at that time is incomplete. It is possible to
	get around it if the actual read operation is defered and not executed
	in the event handler itself. Instead of tracking if we are in an read
	caused by a synthesized fileevent we now track if the OS has delivered
	a true event = actual data and bypass the driver if a read finds that
	there is no actual data waiting. The flag is cleared by a short or
	full read.

	***POTENTIAL INCOMPATIBILITY*** for channel drivers.

2004-05-17  Vince Darley  <[email protected]>

	* generic/tclPathObj.c: fix to (Bug 956063) in 'file dirname'.
	* tests/cmdAH.test: added test for this bug.

	* doc/FileSystem.3: better documentation of refCount requirements of
	some FS functions (Bug 956126)

2004-05-19  Donal K. Fellows  <[email protected]>

	* generic/tclTest.c (TestgetintCmd): Made the tests in get.test check
	* tests/get.test:		     Tcl_GetInt() since the core now
					     avoids that function.

2004-05-18  Kevin B. Kenny  <[email protected]>

	* compat/strftime.c (_fmt, ISO8601Week):
	* doc/clock.n:
	* tests/clock.test: Major rework to the handling of ISO8601 week
	numbers. Now passes all the %G and %V test cases on Windows, Linux and
	Solaris [Bugs 500285, 500389, and 852944]

2004-05-18  Donal K. Fellows  <[email protected]>

	* doc/append.n, doc/upvar.n: Added example.

2004-05-18  David Gravereaux <[email protected]>

	* win/makefile.vc: now generates a tclConfig.sh from Pat Thoyts [Patch
	909911]

2004-05-18  Donal K. Fellows  <[email protected]>

	* doc/lsearch.n: Improve clarity (based on [Patch 955361] by Peter
	Spjuth)

	* tools/man2help2.tcl (macro,SHmacro): Added support for subsection
	(.SS) header macros.

	* doc/interp.n: Added user documentation for the TIP#143 resource
	limits and some examples.

	* generic/tclInterp.c (Tcl_LimitCheck, Tcl_LimitTypeReset): Reset the
	limit-exceeded flag when removing a limit.

2004-05-18  Miguel Sofer <[email protected]>

	* generic/tclExecute.c (TclExecuteByteCode): added comments to
	classify the variables according to their use in TEBC.

2004-05-17  Donal K. Fellows  <[email protected]>

	* doc/global.n, doc/uplevel.n: Added an example.

	* tests/info.test (info-3.1): Corrected test result back to what it
	used to be in Tcl 7.* now that command counts are being correctly kept

	* generic/tclExecute.c (TEBC:INST_START_CMD): Make sure that the
	command-count is always advanced. Allows TIP#143 limits to tell that
	work is being done.

	* doc/list.n: Updated example to fit with the unified format.
	* doc/seek.n: Added some examples.

2004-05-17  Vince Darley  <[email protected]>

	* win/tclWinFile.c:
	* tests/cmdAH.test: fix to (Bug 954263) where 'file executable' was
	case-sensitive.

2004-05-17  Donal K. Fellows  <[email protected]>

	* doc/OpenFileChnl.3: Documented type of 'offset' argument to Tcl_Seek
	was wrong. [Bug 953374]

2004-05-16  Miguel Sofer <[email protected]>

	* generic/tclExecute.c (TclExecuteByteCode): remove one level of
	indirection for compiledLocals addressing.

2004-05-16  Miguel Sofer <[email protected]>

	* generic/tclExecute.c (INST_CALL_FUNC1): bugfix; restored
	(DE)CACHE_STACK_INFO pair around the call - the user defined math
	function could cause a recursive call to TEBC.

2004-05-16  Miguel Sofer <[email protected]>

	* generic/tclBasic.c (Tcl_DeleteInterp):
	* generic/tclExecute.c (INST_START_CMD): interp deletion now modifies
	the compileEpoch, eliminating the need for the check for interp
	deletion in INST_START_CMD.

2004-05-16  Miguel Sofer <[email protected]>

	* generic/tclCompile.h:
	* generic/tclCompile.c:
	* generic/tclExecute.c: changed implementation of {expand}, last
	chance while in alpha as ...

	***POTENTIAL INCOMPATIBILITY***
	Scripts precompiled with ProComp under previous tcl8.5a versions may
	malfunction due to changed instruction numbers for
	INST_LIST_INDEX_IMM, INST_LIST_RANGE_IMM and INST_START_CMD.

2004-05-14  Kevin B. Kenny  <[email protected]>

	* generic/tclInt.decls:	     Promoted TclpLocaltime and TclpGmtime
	* generic/tclIntDecls.h:     from Unix-specific stubs to the generic
	* generic/tclIntPlatDecls.h: internal Stubs table. Reran 'genstubs'
	* generic/tclStubInit.c:
	* unix/tclUnixPort.h:

	* generic/tclClock.c: Changed a buggy 'GMT' timezone specification
			      to the correct 'GMT0'. [Bug 922848]

	* unix/tclUnixThrd.c: Moved TclpGmtime and TclpLocaltime to
			      unix/tclUnixTime.c where they belong.

	* unix/tclUnixTime.c (TclpGmtime, TclpLocaltime, TclpGetTimeZone,
			      ThreadSafeGMTime [removed],
			      ThreadSafeLocalTime [removed],
			      SetTZIfNecessary, CleanupMemory):
	Restructured to make sure that the same mutex protects all calls to
	localtime, gmtime, and tzset. Added a check in front of those calls to
	make sure that the TZ env var hasn't changed since the last call to
	tzset, and repeat tzset if necessary. [Bug 942078] Removed a buggy
	test of the Daylight Saving Time information in 'gettimeofday' in
	favor of applying 'localtime' to a known value. [Bug 922848]

	* tests/clock.test (clock-3.14): Added test to make sure that changes
	to $env(TZ) take effect immediately.

	* win/tclWinTime.c (TclpLocaltime, TclpGmtime): Added porting layer
	for 'localtime' and 'gmtime' calls.

2004-05-14  Miguel Sofer <[email protected]>

	* generic/tclExecute.c:
	* generic/tclCompile.h: the math functions receive a pointer to top of
	the stack (tosPtr) instead of the execution environment (eePtr). First
	step towards a change in the execution stack management - it is now
	only used within TEBC.

2004-05-13  Donal K. Fellows  <[email protected]>

	TIP#143 IMPLEMENTATION

	* generic/tclExecute.c (TclCompEvalObj, TclExecuteByteCode):
	* generic/tclBasic.c (TclEvalObjvInternal): Enable limit checking.
	* generic/tclInterp.c (Tcl_Limit*): Public limit API.
	* generic/tcl.decls:
	* tests/interp.test: Basic tests of command limits.

	* doc/binary.n:		TIP#129 IMPLEMENTATION [Patch 858211]
	* generic/tclBinary.c:	Note that the test suite probably has many more
	* tests/binary.test:	failures now due to alterations in constraints.

2004-05-12  Miguel Sofer <[email protected]>

	Optimisations for INST_START_CMD [Bug 926164].
	* generic/tclCompile.c (TclCompileScript): avoid emitting
	INST_START_CMD as the first instruction in a bytecoded Tcl_Obj. It is
	not needed, as the checks are done before calling TEBC.
	* generic/tclExecute.c (TclExecuteByteCode): runtime peephole
	optimisation: check at INST_POP if the next instruction is
	INST_START_CMD, in which case we fall through.

2004-05-11  Donal K. Fellows  <[email protected]>

	* doc/split.n, doc/join.n: Updated examples and added more.

2004-05-11  Vince Darley  <[email protected]>

	* doc/glob.n: documented behaviour of symbolic links with 'glob -types
	d' (Bug 951489)

2004-05-11  Donal K. Fellows  <[email protected]>

	* doc/scan.n: Updated the examples to be clearer about their relevance
	to the scan command.

2004-05-10  Donal K. Fellows  <[email protected]>

	* doc/scan.n: Added examples.

2004-05-10  David Gravereaux <[email protected]>

	* win/tclWinPipe.c (BuildCommandLine): Moved non-obvious appending
	logic to outside the loop and added commentary for its purpose. Also
	use the existence of contents in the linePtr rather than the scratch
	DString post the append, as this more clear.

	(TclpCreateProcess): When under NT, with no console, and executing a
	DOS application, the path priming does not need an ending space as
	BuildCommandLine() will do this for us.

2004-05-08  Vince Darley  <[email protected]>

	* generic/tclFileName.c:
	* generic/tclIOUtil.c: remove some compiler warnings on MacOS X.

2004-05-07  Chengye Mao <[email protected]>

	* win/tclWinPipe.c: refixed bug 789040 re-entered in rev 1.41. Let's
	be careful and don't re-enter previously fixed bugs.

2004-05-08  Donal K. Fellows  <[email protected]>

	* doc/format.n: Added examples.

2004-05-07  Miguel Sofer <[email protected]>

	* doc/unset.n: added upvar.n to the "see also" list

2004-05-07  Reinhard Max  <[email protected]>

	* generic/tclEncoding.c:
	* tests/encoding.test: added support and tests for translating
	embedded null characters between real nullbytes and the internal
	representation on input/output [Bug 949905].

2004-05-07  Vince Darley  <[email protected]>

	* generic/tclFileName.c:
	* generic/tclIOUtil.c:
	* generic/tclFileSystem.h:
	* tests/fileSystem.test: fix for [Bug 943995], in which vfs-registered
	root volumes were not handled correctly as glob patterns in all
	circumstances.

2004-05-06  Miguel Sofer <[email protected]>

	* generic/tclInt.h:
	* generic/tclObj.c (TclFreeObj): made TclFreeObj use the new macro
	TclFreeObjMacro(), so that the allocation and freeing of Tcl_Obj is
	defined in a single spot (the macros in tclInt.h), with the exception
	of the TCL_MEM_DEBUG case.
	The #ifdef logic for the corresponding macros has been reformulated to
	make it clearer.

2004-05-05  Donal K. Fellows  <[email protected]>

	* doc/break.n, doc/continue.n, doc/for.n, doc/while.n: More examples.

2004-05-05  Don Porter	<[email protected]>

	* tests/unixInit.test (unixInit-2.10):	Test correction for Mac OSX.
	Be sure to consistently compare normalized path names. Thanks to
	Steven Abner (tauvan). [Bug 948177]

2004-05-05  Donal K. Fellows  <[email protected]>

	* doc/CrtObjCmd.3: Remove reference to Tcl_RenameCommand; there is no
	such API. [Bug 848440]

2004-05-05  David Gravereaux <[email protected]>

	* win/tclWinSock.c (SocketEventProc) : connect errors should fire both
	the readable and writable handlers because this is how it works on
	UNIX [Bug 794839]

	* generic/tclEncoding.c (TclFinalizeEncodingSubsystem):
	FreeEncoding(systemEncoding); moved to before the hash table iteration
	as it was causing a double free attempt under some conditions.

	* win/coffbase.txt: Added the tls extension to the list of preferred
	load addresses.

2004-05-04  Jeff Hobbs	<[email protected]>

	* tests/fileSystem.test (filesystem-1.39): replace 'file volumes'
	* tests/fileName.test (filename-12.9,10):  lindex with direct C:/
	hard-coded because A:/ was being used and that is empty for most.

	* tests/winFCmd.test (winFCmd-16.12): test volumerelative $HOME

2004-05-04  Don Porter	<[email protected]>

	* generic/tclAlloc.c:		Make sure Tclp*Alloc* routines get
	* generic/tclInt.h:		declared in the TCL_MEM_DEBUG and
	* generic/tclThreadAlloc.c:	TCL_THREADS configuration. [Bug 947564]

	* tests/tcltest.test:	Test corrections for Mac OSX. Thanks to Steven
	Abner (tauvan). [Bug 947440]

2004-05-04  Donal K. Fellows  <[email protected]>

	* generic/tclEvent.c (TclSetLibraryPath): Suppress a warning.

2004-05-03  Andreas Kupries  <[email protected]>

	* Applied [Patch 868853], fixing a mem leak in TtySetOptionProc.
	Report and Patch provided by Stuart Cassoff <[email protected]>.

2004-05-03  Miguel Sofer <[email protected]>

	* generic/tclProc.c (TclCreateProc): comments corrected.

2004-05-03  Miguel Sofer <[email protected]>

	* generic/tclCompile.c (TclCompileScript): setting the compilation
	namespace outside of the loop.

2004-05-03  Miguel Sofer <[email protected]>

	* generic/tclCompile.c:
	* generic/tclInt.h: reverted fix for [Bug 926445] of 2004-04-02,
	restoring TCL_ALIGN to the header file. Todd Helfter reported that the
	macro is required by tbcload.

2004-05-03  Kevin Kenny	 <[email protected]>

	* win/tclWin32Dll.c (TclpCheckStackSpace):
	* tests/stack.test (stack-3.1): Fix for undetected stack overflow in
	TclReExec on Windows. [Bug 947070]

2004-05-03  Don Porter	<[email protected]>

	* library/init.tcl:	Corrected unique prefix matching of
	interactive command completion in [unknown]. [Bug 946952]

2004-05-02  Miguel Sofer <[email protected]>

	* generic/tclProc.c (TclObjInvokeProc):
	* tests/proc.test (proc-3.6): fix for bad quoting of multi-word proc
	names in error messages [Bug 942757]

2004-04-30  Donal K. Fellows  <[email protected]>

	* doc/glob.n, doc/incr.n, doc/set.n:	More examples.
	* doc/if.n, doc/rename.n, doc/time.n:

2004-04-30  Don Porter	<[email protected]>

	* generic/tclInt.h:		Replaced Kevin Kenny's temporary
	* generic/tclThreadAlloc.c:	fix for Bug 945447 with a cleaner,
	more permanent replacement.

2004-04-30  Kevin B. Kenny   <[email protected]>

	* generic/tclThreadAlloc.c: Added a temporary (or so I hope!)
	inclusion of "tclWinInt.h" to avoid problems when compiling on
	Win32-VC++ with --enable-threads. [Bug 945447]

2004-04-30  Donal K. Fellows  <[email protected]>

	* doc/puts.n: Added a few examples.

2004-04-29  Don Porter	<[email protected]>

	* tests/execute.test (execute-8.2):	Avoid crashes when there is
	limited system stack space (threads-enabled).

2004-04-28  Miguel Sofer <[email protected]>

	* doc/global.n:
	* doc/upvar.n:
	* generic/tclVar.c (ObjMakeUpvar):
	* tests/upvar.test (upvar-8.11):
	* tests/var.test (var-3.11): Avoid creation of unusable variables:
	[Bug 600812] [TIP 184].

2004-04-28  Donal K. Fellows  <[email protected]>

	* doc/lsearch.n: Fixed fault in documentation of -index option [943448]

2004-04-26  Don Porter	<[email protected]>

	* unix/tclUnixFCmd.c (TclpObjNormalizePath):  Corrected improper
	positioning of returned checkpoint. [Bug 941108]

2004-04-26  Donal K. Fellows  <[email protected]>

	* doc/open.n, doc/close.n: Updated (thanks to David Welton) to be
	clearer about pipeline errors and added example to open(n) that shows
	simple pipeline use. [Patches 941377,941380]

	* doc/DictObj.3: Added warning about the use of Tcl_DictObjDone and an
	example of use of iteration. [Bug 940843]

	* doc/Thread.3: Reworked to remove references to testing interfaces
	and instead promote the use of the Thread package. [Patch 932527]
	Also reworked and reordered the page for better readability.

2004-04-25  Don Porter	<[email protected]>

	* generic/tcl.h:	Removed obsolete declarations and #include's.
	* generic/tclInt.h:	[Bugs 926459, 926486]

2004-04-24  David Gravereaux <[email protected]>

	* win/tclWin32Dll.c (DllMain): Added DisableThreadLibraryCalls() for
	the DLL_PROCESS_ATTACH case. We're not interested in knowing about
	DLL_THREAD_ATTACH, so disable the notices.

2004-04-24  Daniel Steffen  <[email protected]>

	* generic/tclPort.h:
	* macosx/Makefile:
	* unix/Makefile.in: followup on tcl header reform [FR 922727]: removed
	use of relative #include paths in tclPort.h to allow installation of
	private headers outside of tcl source tree; added 'unix' dir to
	compiler header search path; add newly required tcl private headers to
	Tcl.framework on Mac OSX.

2004-04-23  Andreas Kupries  <[email protected]>

	* generic/tclIO.c (Tcl_SetChannelOption): Fixed [SF Tcl Bug 930851].
	When changing the eofchar we have to zap the related flags to prevent
	them from prematurely aborting the next read.

2004-04-25  Vince Darley  <[email protected]>

	* generic/tclPathObj.c: fix to [Bug 940281]. Tcl_FSJoinPath will now
	always return a valid Tcl_Obj when the input is valid.
	* generic/tclIOUtil.c: fix to [Bug 931823] for a more consistent
	Tcl_FSPathSeparator() implementation which allows filesystems not to
	implement their Tcl_FSFilesystemSeparatorProc if they wish to use the
	default '/'. Also fixed associated memory leak seen with, e.g., tclvfs
	package.
	* doc/FileSystem.3: documented Tcl_FSJoinPath return values more
	clearly, and Tcl_FSFilesystemSeparatorProc requirements.

2004-04-23  David Gravereaux <[email protected]>

	* win/tclWin32Dll.c: Removed my mistake from 4/19 of adding an exit
	handler to TclWinInit. TclWinEncodingsCleanup called from
	TclFinalizeFilesystem does the Tcl_FreeEncoding for us.

	* win/tclWinChan.c (Tcl_MakeFileChannel): Case for CloseHandle
	returning zero and not throwing a
	RaiseException(EXCEPTION_INVALID_HANDLE) now being done.

2004-04-22  David Gravereaux <[email protected]>

	* generic/tclEvent.c: TclSetLibraryPath's use of caching the stringrep
	of the pathPtr object to TclGetLibraryPath called from another thread
	was ineffective if the original's stringrep had been invalidated as
	what happens when it gets muted to a list.

	* win/tclWinTime.c: If the Tcl_ExitProc (StopCalibration) is called
	from the stack frame of DllMain's PROCESS_DETACH, the wait operation
	should timeout and continue.

	* generic/tclInt.h:
	* generic/tclThread.c:
	* generic/tclEvent.c:
	* unix/tclUnixThrd.c:
	* win/tclWinThrd.c: Provisions made so masterLock, initLock, allocLock
	and joinLock mutexes can be recovered during Tcl_Finalize.

2004-04-22  Donal K. Fellows  <[email protected]>

	* doc/switch.n: Reworked the examples to be more systematically named
	and to cover some TIP#75 capabilities.

	* doc/cd.n: Documentation clarification from David Welton.

	* doc/exec.n: Added some examples, Windows ones from Arjen Markus and
	Unix ones by myself.

2004-04-21  Donal K. Fellows  <[email protected]>

	* doc/Hash.3: Added note to Tcl_{First,Next}HashEntry docs that
	deleting the element they return is supported (and is in fact the only
	safe update you can do to the structure of a hashtable while an
	iteration is going over it.)

	* doc/bgerror.n: Added example from David Welton. [Patch 939473]

	* doc/after.n: Added examples from David Welton. [Patch 938820]

2004-04-19  David Gravereaux <[email protected]>

	* win/tclWin32Dll.c: Added an exit handler in TclWinInit() so
	tclWinTCharEncoding could be freed during Tcl_Finalize().

	* generic/tclEncoding.c: Added FreeEncoding(systemEncoding) in
	TclFinalizeEncodingSubsystem because its ref count was incremented in
	TclInitEncodingSubsystem.

2004-04-19  Donal K. Fellows  <[email protected]>

	* doc/read.n: Added example from David Welton. [Patch 938056]

2004-04-19  Kevin B. Kenny   <[email protected]>

	* generic/tclObj.c (Tcl_GetDoubleFromObj) Corrected "short circuit"
	conversion of int to double. Reported by Jeff Hobbs on the Tcl'ers
	Chat.

2004-04-16  Donal K. Fellows  <[email protected]>

	* doc/lreplace.n, doc/lrange.n, doc/llength.n:	More examples for
	* doc/linsert.n, doc/lappend.n:			the documentation.

2004-04-16  Vince Darley  <[email protected]>

	* doc/FileSystem.3: Corrected documentation of Tcl_FSUtime, and the
	corresponding filesystem driver Tcl_FSUtimeProc. [Bug 935838]

2004-04-16  Donal K. Fellows  <[email protected]>

	* doc/socket.n: Added example from [Patch 936245].
	* doc/gets.n: Added example based on [Patch 935911].

2004-04-15  Donal K. Fellows  <[email protected]>

	* generic/tclClock.c (Tcl_ClockObjCmd): Minor fault in a [clock
	clicks] error message.

2004-04-07  Jeff Hobbs	<[email protected]>

	* win/tclWinInit.c (TclpSetInitialEncodings): note that WIN32_CE is
	also a unicode platform.
	* generic/tclEncoding.c (TclFindEncodings, Tcl_FindExecutable):
	* generic/tclInt.h:			    Correct handling of UTF
	* unix/tclUnixInit.c (TclpInitLibraryPath): data that is actually
	* win/tclWinFile.c (TclpFindExecutable):    "clean", allowing the
	* win/tclWinInit.c (TclpInitLibraryPath):   loading of Tcl from paths
	that contain multi-byte chars on Windows [Bug 920667]

	* win/configure:    define TCL_LIB_FLAG, TCL_BUILD_LIB_SPEC,
	* win/configure.in: TCL_LIB_SPEC, TCL_PACKAGE_PATH in tclConfig.sh.

2004-04-06  Don Porter	<[email protected]>

	Patch 922727 committed.	 Implements three changes:

	* generic/tclInt.h:	Reworked the Tcl header files into a clean
	* unix/tclUnixPort.h:	hierarchy where tcl.h < tclPort.h < tclInt.h
	* win/tclWinInt.h:	and every C source file should #include
	* win/tclWinPort.h:	at most one of those files to satisfy its
	declaration needs. tclWinInt.h and tclWinPort.h also better organized
	so that tclWinPort.h includes the Windows implementation of
	cross-platform declarations, while tclWinInt.h makes declarations that
	are available on Windows only.

	* generic/tclBinary.c (TCL_NO_MATH):	Deleted the generic/tclMath.h
	* generic/tclMath.h (removed):		header file. The internal Tcl
	* macosx/Makefile (PRIVATE_HEADERS):	header, tclInt.h, has a
	* win/tcl.dsp:				#include <math.h> directly,
	and file external to Tcl needing libm should do the same.

	* win/Makefile.in (WIN_OBJS):	Deleted the win/tclWinMtherr.c file.
	* win/makefile.bc (TCLOBJS):	It's a vestige from matherr() days
	* win/makefile.vc (TCLOBJS):	gone by.
	* win/tcl.dsp:
	* win/tclWinMtherr.c (removed):

	End Patch 922727.

	* tests/unixInit.test (unixInit-3.1):	Default encoding on Darwin
	systems is utf-8. Thanks to Steven Abner (tauvan). [Bug 928808]

2004-04-06  Donal K. Fellows  <[email protected]>

	* tests/cmdAH.test (cmdAH-18.2): Added constraint because
	access(...,X_OK) is defined to be permitted to be meaningless when
	running as root, and OSX exhibits this. [Bug 929892]

2004-04-02  Miguel Sofer <[email protected]>

	* generic/tclCompile.c:
	* generic/tclInt.h: removed the macro TCL_ALIGN() from tclInt.h,
	replaced by the static macro ALIGN() in tclCompile.c [Bug 926445]

2004-04-02  Miguel Sofer <[email protected]>

	* generic/tclCompile.h: removed redundant #ifdef _TCLINT [Bug 928415],
	reported by tauvan.

2004-04-02  Don Porter	<[email protected]>

	* tests/tcltest.test: Corrected constraint typos: "nonRoot" ->
	"notRoot". Thanks to Steven Abner (tauvan). [Bug 928353]

2004-04-01  Don Porter	<[email protected]>

	* generic/tclInt.h:  Removed obsolete tclBlockTime* declarations. [Bug
	926454]

2004-04-01  Vince Darley  <[email protected]>

	* generic/tclIOUtil.c: Fix to privately reported vfs bug with 'glob
	-type d -dir . *' across a vfs boundary. No tests for this are
	currently possible without effectively moving tclvfs into Tcl's test
	suite.

2004-03-31  Don Porter	<[email protected]>

	* doc/msgcat.n:	Clarified message catalog file encodings. [Bug 811457]
	* library/msgcat/msgcat.tcl: Updated internals to make use of [dict]s
	to store message catalog data and to use [source -encoding utf-8] to
	access catalog files. Thanks to Michael Sclenker. [Patch 875055, RFE
	811459] Corrected [mcset] to be able to successfully set a translation
	to the empty string. [mcset $loc $src {}] was incorrectly set the $loc
	translation of $src back to $src. Also changed [ConvertLocale] to
	minimally require a non-empty "language" part in the locale value. If
	not, an error raised prompts [Init] to keep looking for a valid locale
	value, or ultimately fall back on the "C" locale. [Bug 811461].
	* library/msgcat/pkgIndex.tcl:	Bump to msgcat 1.4.1.

2004-03-30  Donal K. Fellows  <[email protected]>

	* generic/tclHash.c (HashStringKey): Cleaned up. This function is not
	faster, but it is a little bit clearer.
	* generic/tclLiteral.c (HashString): Applied logic from HashObjKey.
	* generic/tclObj.c (HashObjKey): Rewrote to fix fault which hashed
	every single-character object to the same hash bucket. The new code is
	shorter, simpler, clearer, and (happily) faster.

2004-03-30  Miguel Sofer <[email protected]>

	* generic/tclExecute.c (TEBC): reverting to the previous method for
	async tests in TEBC, as the new method turned out to be too costly.
	Async tests now run every 64 instructions.

2004-03-30  Miguel Sofer <[email protected]>

	* generic/tclCompile.c:	    New instruction code INST_START_CMD that
	* generic/tclCompile.h:	    allows checking the bytecode's validity
	* generic/tclExecute.c:	    [Bug 729692] and the interp's readyness
	* tests/interp.test (18.9): [Bug 495830] before running the command.
	* tests/proc.test (7.1):    It also changes the mechanics of the async
	* tests/rename.test (6.1):  tests in TEBC, doing it now at command
	start instead of every 16 instructions.

2004-03-30  Vince Darley  <[email protected]>

	* generic/tclFileName.c:  Fix to Windows glob where the pattern is a
	* generic/tclIOUtil.c:	  volume relative path or a network share [Bug
	* tests/fileName.test:	  898238]. On windows 'glob' will now return
	* tests/fileSystem.test:  the results of 'glob /foo/bar' and 'glob
	\\foo\\bar' as 'C:/foo/bar', i.e. a correct absolute path (rather than
	a volume relative path).

	Note that the test suite does not test commands like
	'glob //Machine/Shared/*' (on a network share).

2004-03-30  Vince Darley  <[email protected]>

	* generic/tclPathObj.c:	  Fix to filename bugs recently
	* tests/fileName.test:	  introduced [Bug 918320].

2004-03-29  Don Porter	<[email protected]>

	* generic/tclMain.c (Tcl_Main, StdinProc):	Append newline only
	* tests/basic.test (basic-46.1):		to incomplete scripts
	as part of multi-line script construction. Do not add an extra
	trailing newline to the complete script. [Bug 833150]

2004-03-28  Miguel Sofer <[email protected]>

	* generic/tclCompile.c (TclCompileScript): corrected possible segfault
	when a compilation returns TCL_OUTLINE_COMPILE after having grown the
	compile environment [Bug 925121].

2004-03-27  Miguel Sofer <[email protected]>

	* doc/array.n: added documentation for trace-realted behaviour of
	'array get' [Bug 449893]

2004-03-26  Don Porter	<[email protected]>

	* README:		Bumped version number to 8.5a2 to distinguish
	* tools/tcl.wse.in:	HEAD of CVS development from the recent 8.5a1
	* unix/configure.in:	release.
	* unix/tcl.spec:
	* win/README.binary:
	* win/configure.in:

	* unix/configure:	autoconf-2.57
	* win/configure:

2004-03-26  Vince Darley  <[email protected]>

	* generic/tclPathObj.c:	  Fix to Windows-only volume relative path
	* tests/fileSystem.test:  normalization. [Bug 923568]. Also fixed
	another volume relative bug found while testing.

2004-03-24  Donal K. Fellows  <[email protected]>

	* generic/tclNamesp.c (NsEnsembleImplementationCmd): Fix messed up
	handling of strncmp result which just happened to work in some libc
	implementations. [Bug 922752]

2004-03-23  Donal K. Fellows  <[email protected]>

	* doc/StringObj.3: Inverted the sense of the documentation of how the
	bytes parameter is documented to match behaviour. [Bug 921464]

2004-03-19  Kevin B. Kenny   <[email protected]>

	* compat/strtoll.c:
	* compat/strtoull.c:
	* generic/tclIntDecls.h:
	* generic/tclMain.c:
	* generic/tclObj.c:
	* win/tclWinDde.c:
	* win/tclWinReg.c:
	* win/tclWinTime.c:	   Made HEAD build on Windows VC++ again.

2004-03-19  Donal K. Fellows  <[email protected]>

	* generic/tclIntDecls.h: Made HEAD build on Solaris again by applying
	fix recommended by Don Porter.

2004-03-18  Reinhard Max  <[email protected]>

	* generic/tclIntDecls.h: Removed TclpTime_t. It wasn't really needed,
	* generic/tclInt.h:	 but caused warnings related to
	* generic/tclInt.decls:	 strict aliasing with GCC 3.3.
	* generic/tclClock.c:
	* generic/tclDate.c:
	* generic/tclGetDate.y:
	* win/tclWinTime.c:
	* unix/tclUnixTime.c:

	* generic/tclNamesp.c:	 Added temporary pointer variables to work
	* generic/tclStubLib.c:	 around warnings related to
	* unix/tclUnixChan.c:	 strict aliasing with GCC 3.3.

	* unix/tcl.m4:		 Removed -Wno-strict-aliasing.

2004-03-18  Daniel Steffen  <[email protected]>

	Removed support for Mac OS Classic platform [Patch 918142]

	* README:
	* compat/string.h:
	* doc/Encoding.3:
	* doc/FileSystem.3:
	* doc/Init.3:
	* doc/Macintosh.3 (removed):
	* doc/OpenFileChnl.3:
	* doc/OpenTcp.3:
	* doc/SourceRCFile.3:
	* doc/Thread.3:
	* doc/clock.n:
	* doc/exec.n:
	* doc/fconfigure.n:
	* doc/file.n:
	* doc/filename.n:
	* doc/glob.n:
	* doc/open.n:
	* doc/puts.n:
	* doc/resource.n (removed):
	* doc/safe.n:
	* doc/source.n:
	* doc/tclvars.n:
	* doc/unload.n:
	* generic/README:
	* generic/tcl.decls:
	* generic/tcl.h:
	* generic/tclAlloc.c:
	* generic/tclBasic.c:
	* generic/tclCmdAH.c:
	* generic/tclDate.c:
	* generic/tclDecls.h:
	* generic/tclFCmd.c:
	* generic/tclFileName.c:
	* generic/tclGetDate.y:
	* generic/tclIOCmd.c:
	* generic/tclIOUtil.c:
	* generic/tclInitScript.h:
	* generic/tclInt.decls:
	* generic/tclInt.h:
	* generic/tclIntDecls.h:
	* generic/tclIntPlatDecls.h:
	* generic/tclMain.c:
	* generic/tclMath.h:
	* generic/tclNotify.c:
	* generic/tclPathObj.c:
	* generic/tclPlatDecls.h:
	* generic/tclPort.h:
	* generic/tclStubInit.c:
	* generic/tclTest.c:
	* generic/tclThreadJoin.c:
	* library/auto.tcl:
	* library/init.tcl:
	* library/package.tcl:
	* library/safe.tcl:
	* library/tclIndex:
	* mac/AppleScript.html (removed):
	* mac/Background.doc (removed):
	* mac/MW_TclAppleScriptHeader.h (removed):
	* mac/MW_TclAppleScriptHeader.pch (removed):
	* mac/MW_TclBuildLibHeader.h (removed):
	* mac/MW_TclBuildLibHeader.pch (removed):
	* mac/MW_TclHeader.h (removed):
	* mac/MW_TclHeader.pch (removed):
	* mac/MW_TclHeaderCommon.h (removed):
	* mac/MW_TclStaticHeader.h (removed):
	* mac/MW_TclStaticHeader.pch (removed):
	* mac/MW_TclTestHeader.h (removed):
	* mac/MW_TclTestHeader.pch (removed):
	* mac/README (removed):
	* mac/bugs.doc (removed):
	* mac/libmoto.doc (removed):
	* mac/morefiles.doc (removed):
	* mac/porting.notes (removed):
	* mac/tclMac.h (removed):
	* mac/tclMacAETE.r (removed):
	* mac/tclMacAlloc.c (removed):
	* mac/tclMacAppInit.c (removed):
	* mac/tclMacApplication.r (removed):
	* mac/tclMacBOAAppInit.c (removed):
	* mac/tclMacBOAMain.c (removed):
	* mac/tclMacChan.c (removed):
	* mac/tclMacCommonPch.h (removed):
	* mac/tclMacDNR.c (removed):
	* mac/tclMacEnv.c (removed):
	* mac/tclMacExit.c (removed):
	* mac/tclMacFCmd.c (removed):
	* mac/tclMacFile.c (removed):
	* mac/tclMacInit.c (removed):
	* mac/tclMacInt.h (removed):
	* mac/tclMacInterupt.c (removed):
	* mac/tclMacLibrary.c (removed):
	* mac/tclMacLibrary.r (removed):
	* mac/tclMacLoad.c (removed):
	* mac/tclMacMath.h (removed):
	* mac/tclMacNotify.c (removed):
	* mac/tclMacOSA.c (removed):
	* mac/tclMacOSA.r (removed):
	* mac/tclMacPanic.c (removed):
	* mac/tclMacPkgConfig.c (removed):
	* mac/tclMacPort.h (removed):
	* mac/tclMacProjects.sea.hqx (removed):
	* mac/tclMacResource.c (removed):
	* mac/tclMacResource.r (removed):
	* mac/tclMacSock.c (removed):
	* mac/tclMacTclCode.r (removed):
	* mac/tclMacTest.c (removed):
	* mac/tclMacThrd.c (removed):
	* mac/tclMacThrd.h (removed):
	* mac/tclMacTime.c (removed):
	* mac/tclMacUnix.c (removed):
	* mac/tclMacUtil.c (removed):
	* mac/tcltkMacBuildSupport.sea.hqx (removed):
	* tests/all.tcl:
	* tests/binary.test:
	* tests/cmdAH.test:
	* tests/cmdMZ.test:
	* tests/fCmd.test:
	* tests/fileName.test:
	* tests/fileSystem.test:
	* tests/interp.test:
	* tests/io.test:
	* tests/ioCmd.test:
	* tests/load.test:
	* tests/macFCmd.test (removed):
	* tests/osa.test (removed):
	* tests/resource.test (removed):
	* tests/socket.test:
	* tests/source.test:
	* tests/unload.test:
	* tools/cvtEOL.tcl (removed):
	* tools/genStubs.tcl:
	* unix/Makefile.in:
	* unix/README:
	* unix/mkLinks:
	* unix/tcl.spec:
	* win/README.binary:
	* win/tcl.dsp:

2004-03-17  Donal K. Fellows  <[email protected]>

	* doc/lsearch.n: Improved examples on the advanced capabilities of
	lsearch (with the right options, set element removal can be done)
	following discussion on tkchat.

2004-03-16  Don Porter	<[email protected]>

	* doc/catch.n:	Compiled [catch] no longer fails to catch syntax
	errors. Removed the claims in the documentation that it does.
	* doc/return.n:	Updated example to use [dict merge].

2004-03-16  Jeff Hobbs	<[email protected]>

	* unix/configure, unix/tcl.m4: add -Wno-strict-aliasing for GCC to
	suppress useless type puning warnings.

2004-03-16  Donal K. Fellows  <[email protected]>

	* doc/file.n: *roff formatting fix. [Bug 917171]

2004-03-15  David Gravereaux <[email protected]>

	* win/tclWinNotify.c: Fixed a mistake where the return value of
	MsgWaitForMultipleObjectsEx for "a message is in the queue" wasn't
	accurate. I removed the check on the case result==(WAIT_OBJECT_0 + 1)
	This was having the error of falling into GetMessage and waiting there
	by accident, which wasn't alertable through Tcl_AlertNotifier. I'll do
	some more study on this and try to find-out why.

2004-03-12  Donal K. Fellows  <[email protected]>

	IMPLEMENTATION OF TIP#163
	* generic/tclDictObj.c (DictMergeCmd):	This is based on work by Joe
	* tests/dict.test (dict-20.*):		English in Tcl [FRQ 745851]
	* doc/dict.n:				but not exactly.

2004-03-10  Kevin B. Kenny <[email protected]>

	* generic/tclGetDate.y (TclGetDate): Fix so that [clock scan
	<timeOfDay> -gmt true] uses the GMT base date instead of the local
	one. [Bug 913513]
	* tests/clock.test: Added test cases for wrong ISO8601 week number
	[Bug 500285] and wrong GMT base date [Bug 913513]. Several tests still
	fail on Windows, and these are actual faults in [clock scan]. Fix is
	still pending.
	* generic/tclDate.c: Regenerated.

2004-03-08  Vince Darley  <[email protected]>

	* generic/tclFileName.c:  Fix to 'glob -path' near the root
	* tests/fileName.test:	  of the filesystem. [Bug 910525]

2004-03-08  Don Porter	<[email protected]>

	* generic/tclParse.c (TclParseInit):	Modified TclParseInit so
	* generic/tclTest.c ([testexprparser]): that Tcl_Parse initialization
	conforms to documented promised about what fields will not be
	modified by what Tcl_Parse* routines. [Bug 910595]

2004-03-05  Mo DeJong  <[email protected]>

	* win/configure: Regen.
	* win/configure.in: Check for define of MWMO_ALERTABLE in winuser.h.
	* win/tclWinPort.h: If MWMO_ALERTABLE is not defined in winuser.h then
	define it. This is needed for Mingw.

2004-03-05  Kevin B. Kenny <[email protected]>

	* generic/tclTest.c: Modified TesteventObjCmd to use a
	Tcl_QueuePosition in place of an 'int' for the enumerated queue
	position, to avoid a compiler warning on SGI. [Bug 771960]

2004-03-05  Kevin B. Kenny <[email protected]>

	* tests/registry.test: Applied fix from [Patch 910174] to make the test
	for an English-language system include any country code, rather than
	just English-United States.1252. Thanks to Pat Thoyts for the changes.

2004-03-04  Pat Thoyts	<[email protected]>

	* tests/registry.test: Applied fixed from [Bug 766159] to skip two
	tests on Win98 that depend on a Unicode registry (NT specific).

2004-03-04  Don Porter	<[email protected]>

	* generic/tclInt.h (TclParseInit):	Factored the common code
	* generic/tclParse.c (TclParseInit):	for initializing a Tcl_Parse
	* generic/tclParseExpr.c:		struct into one routine.

2004-03-04  Pat Thoyts	<[email protected]>

	* library/reg/pkgIndex.tcl:  Added TIP #100 support to the
	* win/tclWinReg.c:	     registry package [patch 903831]
	This provides a Windows test of the TIP #100 mechanism and a sample to
	show how unloading an extension can be done.

2004-03-04  Donal K. Fellows  <[email protected]>

	* unix/dltest/pkgua.c: Fix minor syntax problems. [Bug 909288]

2004-03-03  Jeff Hobbs	<[email protected]>

	*** 8.5a1 TAGGED FOR RELEASE ***

	* changes: updated for 8.5a1

2004-03-03  David Gravereaux <[email protected]>

	* win/makefile.vc: default environment variable for VC++ is %MSDevDir%
	not %MSVCDir%, although vcvars32.bat sets both.

	* win/tclWinNotify.c (Tcl_WaitForEvent) : Allows an idling notifier to
	service "Asynchronous Procedure Calls" from its wait state. Only
	useful for extension authors who decide they might want to try
	"completion routines" with WriteFileEx(), as an example. From
	experience, I recommend that "completion ports" should be used instead
	as the execution of the callbacks are more managable.

2004-03-01  Jeff Hobbs	<[email protected]>

	* README:	    update patchlevel to 8.5a1
	* generic/tcl.h:
	* tools/tcl.wse.in, tools/tclSplash.bmp:
	* unix/configure, unix/configure.in, unix/tcl.spec:
	* win/README.binary, win/configure, win/configure.in:

	* unix/tcl.m4: update HP-11 build libs setup

2004-03-01  Don Porter	<[email protected]>

	* unix/tcl.m4 (SC_CONFIG_CFLAGS):	Allow 64-bit enabling on
	IRIX64-6.5* systems. [Bug 218561]
	* unix/configure:	autoconf-2.57

	* generic/tclTrace.c (TclCheckInterpTraces):	The TIP 62
	* generic/tclTest.c (TestcmdtraceCmd):	implementation introduced a
	* tests/trace.test (trace-29.10):	bug by testing the CallFrame
	level instead of the iPtr->numLevels level when deciding what traces
	created by Tcl_Create(Obj)Trace to call. Added test to expose the
	error, and made fix. [FRQ 462580]

2004-02-28  Vince Darley  <[email protected]>

	* tests/fileSystem.test: fix to Tcl Bug 905163.
	* tests/fileName.test: fix to Tcl Bug 904705.

	* doc/{various}.n: removed 'the the' typos.

2004-02-26  Daniel Steffen  <[email protected]>

	* macosx/Makefile: fixed copyright year in Tcl.framework Info.plist

2004-02-25  Don Porter	<[email protected]>

	* tests/basic.test:	Made several tests more robust to the
	* tests/cmdMZ.test:	list-quoting of path names that might contain
	* tests/exec.test:	Tcl-special chars like { or [. Should help us
	* tests/io.test:	sort out [Bug 554068]
	* tests/pid.test:
	* tests/socket.test:
	* tests/source.test:
	* tests/unixInit.test:

2004-02-25  Donal K. Fellows  <[email protected]>

	* generic/tclLoad.c (Tcl_LoadObjCmd): Missing dereference caused
	segfault with non-loadable extension. [Bug 904307]

	* unix/tclUnixChan.c (TcpGetOptionProc): Stop memory leak with very
	long hostnames. [Bug 888777]

2004-02-25  Pat Thoyts	<[email protected]>

	* win/tclWinDde.c: Removed some gcc warnings - except for the
	-Wconversion warning for GetGlobalAtomName. gcc is just wrong about
	this.

2004-02-24  Donal K. Fellows  <[email protected]>

	IMPLEMENTATION OF TIP#100 FROM GEORGIOS PETASIS
	* generic/tclLoad.c (Tcl_UnloadObjCmd): Implementation.
	* tests/unload.test:			Test suite.
	* unix/dltest/pkgua.c:			Helper for test suite.
	* doc/unload.n:				Documentation.
	Also assorted changes (mostly small) to several other files.

2004-02-23  Donal K. Fellows  <[email protected]>

	* generic/regc_locale.c (cclass): Buffer was having its size reset
	instead of being released => memleak. [Bug 902562]

2004-02-21  Donal K. Fellows  <[email protected]>

	* generic/tclLoad.c (Tcl_LoadObjCmd): Fixed memory leak due to an
	improper error exit route.

2004-02-20  David Gravereaux <[email protected]>

	* win/tclWinSock.c (SocketThreadExitHandler): Don't call
	TerminateThread when WaitForSingleObject returns a timeout.
	Tcl_Finalize called from DllMain will pause all threads. Trust that
	the thread will get the close notice at a later time if it does ever
	wake up before being cleaned up by the system anyway.

2004-02-17  Don Porter	<[email protected]>

	* doc/tcltest.n:
	* library/tcltest/tcltest.tcl:	Changed -verbose default value to
	{body error} so that detailed information on unexpected errors in
	tests is provided by default, even after the fix for [Bug 725253]

2004-02-17  Jeff Hobbs	<[email protected]>

	* tests/unixInit.test (unixInit-7.1):
	* unix/tclUnixInit.c (TclpInitPlatform): ensure the std fds exist to
	prevent crash condition [Bug 772288]

2004-02-17  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmds.c (TclCompileSwitchCmd): Bozo mistake in memory
	releasing order when in an error case. [Bug 898910]

2004-02-16  Jeff Hobbs	<[email protected]>

	* generic/tclTrace.c (TclTraceExecutionObjCmd)
	(TclTraceCommandObjCmd): fix possible mem leak in trace info.

2004-02-12  Mo DeJong  <[email protected]>

	* win/tclWinInit.c (AppendEnvironment): Use the tail component of the
	passed in lib path instead of just blindly using lib+4. That worked
	when lib was "lib/..." but fails for other values. Thanks go to
	Patrick Samson for pointing this out.

2004-02-10  David Gravereaux  <[email protected]>

	* win/nmakehlp.c: better macro grepping logic.

2004-02-07  David Gravereaux  <[email protected]>

	* win/makefile.vc:
	* win/rules.vc:
	* win/tcl.rc:
	* win/tclsh.rc: Added an 'unchecked' option to the OPTS macro so a
	core built with symbols can be linked to the non-debug enabled C
	run-time. As per discussion with Kevin Kenny. Called like this:

		nmake -af makefile.vc OPTS=unchecked,symbols

	This clarifies the meaning of the 'g' naming suffix to mean only that
	the binary requires the debug enabled C run-time. Whether the binary
	contains symbols or not is a different condition.

2004-02-06  Don Porter	<[email protected]>

	* doc/clock.n:	Removed reference to non-existent [file ctime].

2004-02-05  David Gravereaux  <[email protected]>

	* docs/tclvars.n: Added clarification of the tcl_platform(debug) var
	that it only refers to the flavor of the C run-time, and not whether
	the core contains symbols.

2004-02-05  Don Porter	<[email protected]>

	* generic/tclFileName.c (SkipToChar): Corrected CONST and type-casting
	issues that caused compiler warnings.

2004-02-04  Don Porter	<[email protected]>

	* generic/tclCmdAH.c (StoreStatData): Removed improper refcount
	decrement of the varName parameter. This error was causing segfaults
	following test cmdAH-28.7.

	* library/tcltest/tcltest.tcl: Corrected references to non-existent
	$name variable in [cleanupTests]. [Bug 833637]

2004-02-03  Don Porter	<[email protected]>

	* library/tcltest/tcltest.tcl:	Corrected parsing of single command
	line argument (option with missing value) [Bug 833910]
	* library/tcltest/pkgIndex.tcl:	Bump to version 2.2.5.

2004-02-02  David Gravereaux <[email protected]>

	* generic/tclIO.c (Tcl_Ungets): Fixes improper filling of the channel
	buffer. This is the buffer before the splice. [Bug 405995]

2004-02-01  David Gravereaux <[email protected]>

	* tests/winPipe.test: more pass-thru commandline verifications.
	* win/tclWinPipe.c (BuildCommandLine): Special case quoting for '{'
	not required by the c-runtimes's parse_cmdline().
	* win/tclAppInit.c: Removed our custom setargv() in favor of the work
	provided by the c-runtime. [Bug 672938]

	* win/nmakehlp.c: defensive techniques to avoid static buffer
	overflows and a couple envars upsetting invokations of cl.exe and
	link.exe. [Bug 885537]

	* tests/winPipe.test: Added proof that BuildCommandLine() is not doing
	the "N backslashes followed a quote -> insert N * 2 + 1 backslashes
	then a quote" rule needed for the crt's parse_cmdline().
	* win/tclWinPipe.c: Fixed BuildCommandLine() to pass the new cases.

2004-01-30  David Gravereaux <[email protected]>

	* win/makefile.vc: Use the -GZ compiler switch when building for
	symbols. This is supposed to emulate the release build better to avoid
	hiding problems that only show themselves in a release build.

2004-01-29  Vince Darley  <[email protected]>

	* generic/tclPathObj.c: fix to [Bug 883143] in file normalization

2004-01-29  Vince Darley  <[email protected]>

	* doc/file.n:
	* generic/tclFCmd.c
	* generic/tclTest.c
	* library/init.tcl
	* mac/tclMacFile.c
	* tests/fileSystem.test: fix to [Bug 886352] where 'file copy -force'
	had inconsistent behaviour wrt target files with insufficient
	permissions, particular from vfs->native fs. Behaviour of '-force' is
	now always consistent (and now consistent with behaviour of 'file
	delete -force'). Added new tests and documentation and cleaned up the
	'simplefs' test filesystem.

	* generic/tclIOUtil.c
	* unix/tclUnixFCmd.c
	* unix/tclUnixFile.c
	* win/tclWinFile.c: made native filesystems more robust to C code
	which asks for mount lists.

	* generic/tclPathObj.c: fix to [Bug 886607] removing warning/error
	with some compilers.

2004-01-28  Donal K. Fellows  <[email protected]>

	* generic/tclObj.c (SetBooleanFromAny): Rewrite to do more efficient
	string->bool conversion.
	Many other minor whitespace/style fixes to this file too.

2004-01-27  David Gravereaux <[email protected]>

	* win/nmakehlp.c: Use '.\nul' as the sourcefile name instead of 'nul'
	so VC 5.2 doesn't try searching the path for it and failing with a
	possible dialogbox popping up about having to add a CD to an empty
	drive. Also added a SetErrorMode() call to disable any dialogs that
	cl.exe or link.exe might create. [Bug 885537]

2004-01-22  Vince Darley  <[email protected]>

	* doc/file.n: clarified documentation of 'file system' [Bug 883825]
	* tests/fCmd.test: improved test result in failure case.

2004-01-22  Vince Darley  <[email protected]>

	* tests/fileSystem.test: 3 new tests
	* generic/tclPathObj.c: fix to [Bug 879555] in file normalization.
	* doc/filename.n: small clarification to Windows behaviour with
	filenames like '.....', 'a.....', '.....a'.

	* generic/tclIOUtil.c: slight improvement to native cwd caching on
	Windows.

2004-01-21  David Gravereaux <[email protected]>

	* doc/Panic.3:	Mentions of 'panic' and 'panicVA' removed from the
	documentation.

2004-01-21  Vince Darley  <[email protected]>

	* doc/FileSystem.3:
	* generic/tcl.decls:
	* generic/tclCmdAH.c
	* generic/tclDecls.h
	* generic/tclFCmd.c
	* generic/tclFileName.c
	* generic/tclFileSystem.h
	* generic/tclIOUtil.c
	* generic/tclInt.decls
	* generic/tclInt.h
	* generic/tclIntDecls.h
	* generic/tclPathObj.c
	* generic/tclStubInit.c
	* generic/tclTest.c
	* mac/tclMacFile.c
	* tests/fileName.test
	* tests/fileSystem.test
	* tests/winFCmd.test
	* unix/tclUnixFile.c
	* win/tclWin32Dll.c
	* win/tclWinFCmd.c
	* win/tclWinFile.c
	* win/tclWinInt.h

	Three main issues accomplished: (1) cleaned up variable names in the
	filesystem code so that 'pathPtr' is used throughout. (2) applied a
	round of filesystem optimisation with better handling and caching of
	relative and absolute paths, requiring fewer conversions. (3)
	clarifications to the documentation, particularly regarding the
	acceptable refCounts of objects. Some new tests added. Tcl benchmarks
	show a significant improvement over 8.4.5, and on Windows typically a
	small improvement over 8.3.5 (Unix still appears to require
	optimisation). TCL_FILESYSTEM_VERSION_2 introduced, but for internal
	use only. There should be no public incompatibilities from these
	changes. Thanks to dgp for extensive testing.

2004-01-19  David Gravereaux <[email protected]>

	* win/tclWinPipe.c (Tcl_WaitPid): Fixed a thread-safety problem with
	the process list. The delayed cut operation after the wait was going
	stale by being outside the list lock. It now cuts within the lock and
	does a locked splice for when it needs to instead. [Bug 859820]

2004-01-18  Donal K. Fellows  <[email protected]>

	* generic/tclCompile.c, generic/tclCompile.h: Two new opcodes,
	INST_LIST_INDEX_IMM and INST_LIST_RANGE_IMM, that have operand(s) of
	new type OPERAND_IDX4 which represents indexes into things like lists
	(and perhaps other things eventually.)
	* generic/tclExecute.c (TclExecuteByteCode): Implementation of the new
	opcodes. INST_LIST_INDEX_IMM does a simple [lindex] with either front-
	or end-based simple indexing. INST_LIST_RANGE_IMM does an [lrange]
	with front- or end-based simple indexing for both the reference to the
	first and last items in the range.
	* generic/tclCompCmds.c (TclCompileLassignCmd): Generate bytecode for
	the [lassign] command.

2004-01-17  David Gravereaux <[email protected]>

	* win/tclWinInit.c: added #pragma comment(lib, "advapi32.lib") when
	compiling under VC++ so we don't need to specify it when linking.

2004-01-17  Donal K. Fellows  <[email protected]>

	* generic/tclCmdIL.c (Tcl_LassignObjCmd): Add more shimmering
	protection for when the list is also one of the variables.

	BASIC IMPLEMENTATION OF TIP#57
	* generic/tclCmdIL.c (Tcl_LassignObjCmd): Implementation of the
	[lassign] command that takes full advantage of Tcl's object API.
	* doc/lassign.n: New file documenting the command.
	* tests/cmdIL.test (cmdIL-6.*): Test suite for the command.

2004-01-15  David Gravereaux <[email protected]>

	* win/tclWinReg.c: Placed the requirement for advapi.lib into the
	object file itself with #pragma comment (lib, ...) when built with
	VC++. This will simplify linking for users of the static library.

	* win/rules.vc: Added new 'fullwarn' to the CHECKS commandline macro;
	sets $(FULLWARNINGS).

	* win/makefile.vc: Removed 'advapi.lib' from $(baselibs). Added new
	logic to crank-up the warning levels for both compile and link when
	$(FULLWARNINGS) is set. Some clean-up with how the resource files are
	built and how -DTCL_USE_STATIC_PACKAGES is sent when compiling the
	shells.

	* win/tclAppInit.c: Small change in how TCL_USE_STATIC_PACKAGES is
	used.

	* win/tcl.rc:
	* win/tclsh.rc: Some clean-up with how the resource files are built.
	Fixed 'OriginalFilename' problem that still thought a debug suffix was
	still 'd', now is 'g'.

2004-01-14  Donal K. Fellows  <[email protected]>

	* generic/tclDictObj.c (TraceDictPath, DictExistsCmd): Adjusted
	behaviour of [dict exists] so a failure to look up a dictionary along
	the path of dicts doesn't trigger an error. This is how it was
	documented to behave previously... [Bug 871387]

	* generic/tclDictObj.c: Assorted dict fixes from Peter Spjuth relating
	to [Bug 876170].
	(SetDictFromAny): Make sure that lists retain their ordering even when
	converted to dictionaries and back.
	(TraceDictPath): Correct object reference count handling!
	(DictReplaceCmd, DictRemoveCmd): Stop object leak.
	(DictIncrCmd,DictLappendCmd,DictAppendCmd,DictSetCmd,DictUnsetCmd):
	Simpler handling of reference counts when assigning to variables.
	* tests/dict.test (dict-19.2): Memory leak stress test

2004-01-13  Don Porter	<[email protected]>

	* generic/tclCmdMZ.c (Tcl_SwitchObjCmd):  Silence compiler warnings.

	Patch 876451: restores performance of [return]. Also allows forms such
	as [return -code error $msg] to be bytecompiled.

	* generic/tclInt.h:	Factored Tcl_ReturnObjCmd() into two pieces:
	* generic/tclCmdMZ.c:	TclMergeReturnOptions(), which can parse the
	options to [return], check their validity, and create the
	corresponding return options dictionary, and TclProcessReturn(), which
	takes that return options dictionary and performs the [return]
	operation.

	* generic/tclCompCmds.c: Rewrote TclCompileReturnCmd() to call
	TclMergeReturnOptions() at compile time so the return options
	dictionary is computed at compile time (when it is fully known). The
	dictionary is pushed on the stack along with the result, and the code
	and level values are included in the bytecode as operands. Also
	supports optimized compilation of un-[catch]ed [return]s from procs
	with default options into the INST_DONE instruction.

	* generic/tclExecute.c: Rewrote INST_RETURN instruction to retrieve
	the code and level operands, pop the return options from the stack,
	and call TclProcessReturn() to perform the [return] operation.

	* generic/tclCompile.h:	New utilities include TclEmitInt4 macro
	* generic/tclCompile.c:	and TclWordKnownAtCompileTime().

	End Patch 876451.

	* generic/tclFileName.c (Tcl_GlobObjCmd): Latest changes to management
	of the interp result by Tcl_GetIndexFromObj() exposed improper interp
	result management in the [glob] command procedure. Corrected by
	adopting the Tcl_SetObjResult(Tcl_NewStringObj) pattern. This stopped
	a segfault in test filename-11.36. [Bug 877677]

2004-01-13  Donal K. Fellows  <[email protected]>

	* generic/tclIndexObj.c (Tcl_GetIndexFromObjStruct, Tcl_WrongNumArgs):
	Create fresh objects instead of using the one currently in the
	interpreter, which isn't guaranteed to be fresh and unshared. The cost
	for the core will be minimal because of the object cache, and this
	fixes [Bug 875395].

2004-01-12  Miguel Sofer <[email protected]>

	* generic/tclCompExpr.c (CompileLandOrLorExpr): cosmetic changes.

2004-01-12  Miguel Sofer <[email protected]>

	* generic/tclCompExpr.c (CompileLandOrLorExpr): new logic, fewer
	instructions. As a side effect, the instructions INST_LOR and
	INST_LAND are now never used.
	* generic/tclExecute.c (INST_JUMP*): small optimisation; fix a bug in
	debug code.

2004-01-11  David Gravereaux <[email protected]>

	* win/tclWinThrd.c (Tcl_ConditionNotify): condPtr must be dereferenced
	to see if there are waiters else uninitialized datum is manipulated.
	[Bug 849007 789338 745068]

2004-01-09  David Gravereaux <[email protected]>

	* generic/tcl.h: Renamed and deprecated #defines moved to within the
	#ifndef TCL_NO_DEPRECATED block. This allows us to build Tcl to check
	for deprecated functions in use, such as panic() and Tcl_Ckalloc(). By
	request from DKF. Extensions that build with -DTCL_NO_DEPRECATED now
	have these macros as restricted.
	***POTENTIAL INCOMPATIBILITY***

	* win/makefile.vc:
	* win/rules.vc:	 Added -DTCL_NO_DEPRECATED usage to makefile.vc.
	Called like this:   nmake -af makefile.vc CHECKS=nodep

2004-01-09  Vince Darley  <[email protected]>

	* generic/tclIOUtil.c: fix to infinite loop in TclFinalizeFilesystem
	[Bug 873311]

	******************************************************************
	*** CHANGELOG ENTRIES FOR 2003 IN "ChangeLog.2003"	       ***
	*** CHANGELOG ENTRIES FOR 2002 IN "ChangeLog.2002"	       ***
	*** CHANGELOG ENTRIES FOR 2001 IN "ChangeLog.2001"	       ***
	*** CHANGELOG ENTRIES FOR 2000 IN "ChangeLog.2000"	       ***
	*** CHANGELOG ENTRIES FOR 1999 AND EARLIER IN "ChangeLog.1999" ***
	******************************************************************
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<






















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































Deleted ChangeLog.2005.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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
2005-12-30  Kevin B. Kenny  <[email protected]>

	* generic/tclStubLib.c: Corrected a typo in "missing Stubs table
	pointer."

2005-12-27  Kevin B. Kenny  <[email protected]>

	* generic/tcl.decls:  Destubbed TclTomMathInitializeStubs - it is in
	* generic/tcl.h:      the stub library, not the main shared
	* generic/tclBasic.c: library. Exported Tcl_InitBignumFromDouble.
	* generic/tclExecute.c:
	* generic/tclInt.h:
	* generic/tclStrToD.c:

	* generic/tclDecls.h:
	* generic/tclStubLib.c:
	* generic/tclStubInit.c: Regenerated.

	* generic/clock.tcl: Reverted to using the time zone abbreviation and
	not its name to "stop the bleeding" on [Bug 1386377]. This is *not* a
	good long-term solution, but there may not be one.

	* libtommath/bn_mp_sqrt.c: Improved the initial approximation to the
	square root, roughly doubling the speed of the routine. (This is a
	local change that needs to be communicated to Tom.)

	* win/Makefile.in: Corrected a bug where tommath_class.h and
	tommath_superclass.h were not installed, making it impossible for
	client code to compile against the tommath stubs.

	* library/tzdata: Updated to Olson's tzdata2005r. (Latest changes to
	Daylight Saving Time in Canada, plus redefinition of the Posix-style
	zones [e.g., EST5EDT] to be locale-independent.)

	* libtommath: Updated to Tom St.Denis's release 0.37.

2005-12-20  Donal K. Fellows  <[email protected]>

	* generic/tclThreadAlloc.c (Tcl_GetMemoryInfo): Format values as longs
	and not ints, so they are less likely to wrap on 64-bit machines.

2005-12-19  Don Porter  <[email protected]>

	* generic/tclCmdMZ.c:	Modified [string is double] to use
	* tests/string.test:	TclParseNumber() to parse trailing whitespace.
	Ensures consistency, and makes it easier to cleanup after invalid
	internal reps left behind by parsing [Bugs 1360532 1382287].

	* generic/tclParseExpr.c:	Added TCL_PARSE_NO_WHITESPACE to
	* generic/tclScan.c:	TclParseNumber() calls since [scan] and [expr]
	* tests/scan.test:	parsing don't want spaces in parsed numbers.

	* generic/tclInt.h:	Added TCL_PARSE_NO_WHITESPACE flag to the
	* generic/tclStrToD.c:	TclParseNumber() interface.

2005-12-19  Donal K. Fellows  <[email protected]>

	* doc/Tcl.n: Clarify what is going on in variable substitution
	following thread on comp.lang.tcl.

2005-12-18  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmds.c (TclCompileDictCmd): Ensure that we only do an
	'endCatch' when there's a preceding 'beginCatch'. [Bug 1382528] Many
	thanks to Anton Kovalenko for finding this and pointing out that it was
	a catch stack handling problem!

2005-12-14  Daniel Steffen  <[email protected]>

	* generic/tclIOUtil.c: workaround gcc warning "comparison is always
	* generic/tclTest.c:   false due to limited range of data type".

	* macosx/Tcl.xcode/project.pbxproj:
	* macosx/Tcl.xcodeproj/project.pbxproj:
	* unix/Makefile.in: add new tclTomMath* files.

	* generic/tclBasic.c: replace panic with Tcl_Panic.

2005-12-13  Kevin B. Kenny  <[email protected]>

	* generic/tcl.decls:    Added changes to export an additional stubs
	* generic/tclBasic.c:   table to represent the 'libtommath' routines
	* generic/tclDecls.h:   that Tcl uses and export them to callers.
	* generic/tclInt.decls: Reran 'genstubs'
	* generic/tclInt.h:
	* generic/tclIntDecls.h:
	* generic/tclIntPlatDecls.h:
	* generic/tclStubInit.c:
	* generic/tclStubLib.c:
	* generic/tclTomMath.decls:
	* generic/tclTomMath.h:
	* generic/tclTomMathDecls.h:
	* generic/tclTomMathInterface.c:
	* generic/tommath.h:
	* tools/fix_tommath_h.tcl:
	* unix/Makefile.in:
	* win/Makefile.in:
	* win/makefile.vc:

	* generic/tclClock.c:   Made changes to silence a number of compiler
	* generic/tclIO.c:	warnings when building with mingw.
	* generic/tclIORChan.c:
	* generic/tclLink.c:
	* generic/tclListObj.c:
	* generic/tclObj.c:
	* generic/tclParseExpr.c:
	* generic/tclProc.c:
	* generic/tclTimer.c:
	* win/tclWinChan.c:
	* win/tclWinConsole.c:
	* win/tclWinDde.c:
	* win/tclWinFCmd.c:
	* win/tclWinFile.c:
	* win/tclWinReg.c:
	* win/tclWinSock.c:

2005-12-13  Donal K. Fellows  <[email protected]>

	* generic/tclExecute.c (TEBC:DICT_FIRST,DICT_DONE): Only decrease the
	references to the dictionary once the iteration completes. Do this by
	storing the dict in the iterator context variable. [Bug 1379349] Thanks
	to Ulrich Ring and Tobias Hippler for finding this.

2005-12-12  Jeff Hobbs  <[email protected]>

	* unix/tcl.m4, unix/configure: Fix sh quoting error reported in
	bash-3.1+ [Bug 1377619] (schafer)

2005-12-12  Kevin B. Kenny  <[email protected]>

	* doc/mathfunc.n: Changed two examples from the incorrect 'tcl::math::'
	to 'tcl::mathfunc::' [Bug 1378818]

2005-12-09  Mo DeJong  <[email protected]>

	* win/configure: Regen.
	* win/tcl.m4 (SC_CONFIG_CFLAGS): Define MACHINE for gcc builds. The
	lack of a definition of this variable in the manifest file was causing
	a runtime error in wish built with gcc.

2005-12-09  Donal K. Fellows  <[email protected]>

	* tests/lsearch.test (lsearch-10.8..10):  If the -start is off the end,
	* generic/tclCmdIL.c (Tcl_LsearchObjCmd): searching should find nothing
	at all. [Bug 1374778]

2005-12-08  Jeff Hobbs  <[email protected]>

	* win/Makefile.in, win/makefile.vc: Add Win x64 and CE build support
	* win/tcl.m4, win/configure:        CE still requires C code fixes.

	* generic/tcl.h: use struct __stat64 (not _stat64) for MSC_VER >= 1400
	(i.e. latest Platform SDK).

2005-12-07  Donal K. Fellows  <[email protected]>

	* doc/socket.n: Cross-referenced the socket documentation better to the
	fconfigure documentation on the topic of asynch sockets.
	* doc/fconfigure.n: Added keyword to documentation of -blocking option
	so that people looking for "asynch" can find it as well.

2005-12-05  Daniel Steffen  <[email protected]>

	* unix/tclUnixPort.h (Darwin): fix incorrect __DARWIN_UNIX03 configure
	overrides that were originally copied from Darwin CVS (rdar://3693001)

2005-12-05  Kevin B. Kenny  <[email protected]>

	* tools/tclZIC.tcl: Updated to reflect changes in calling sequence when
	GetJulianDateFromEraYearMonthDay moved to C.
	* library/tzdata: Regenerated from Olson's tzdata2005p.tar.gz - the
	'systemv' changes appear not to affect Tcl's processing of the dates.

2005-12-05  Daniel Steffen  <[email protected]>

	* unix/configure.in: move check for fts API to configure.in and run it
	* unix/tcl.m4:       on all platforms, since Linux glibc2 and *BSDs
	also have this; using fts is more efficient than a recursive
	opendir/readdir.
	* unix/tclUnixFCmd.c (TraverseUnixTree): add support to fts code for
	platforms with stat64.
	* unix/configure:
	* unix/tclConfig.h.in: regen.

2005-12-05  Jeff Hobbs  <[email protected]>

	* unix/configure:     Use fts file API on Darwin if available.
	* unix/tcl.m4:        Addresses file delete issues in readdir noted
	* unix/tclUnixFCmd.c: in [Bug 1034337]. (steffen)
	Remove redundant stat call for each file in DoCopyFile. (steffen)

2005-12-02  Kevin B. Kenny  <[email protected]>

	* generic/tclClock.c: Moved a tiny bit more of [clock format] from run
	* library/clock.tcl: time to compile time, and fixed a l10n bug in the
	process. [Bug 1371446]. Also, conditoned the call to SetupTimeZone to
	speed the common case where TZData($timezone) already exists, and
	achieved a puny speedup by making ::tcl::clock::getenv not throw
	errors.
	* unix/Makefile.in: Made some changes to support a 'make' command that
	is present on some antiquated versions of Solaris.

2005-12-01  Kevin B. Kenny  <[email protected]>

	* library/clock.tcl: Continued rationalizing the code, eliminating
	numerous redundant [mc] calls. Added another time boost by precompiling
	a [::format] command to do the bulk of the work of [clock format].

2005-12-01  Donal K. Fellows  <[email protected]>

	* unix/Makefile.in: Add remaining dependency info. While automated
	maintenance of this information would be good, having it at all is much
	better than a poke in the eye with a sharp stick...

2005-12-01  Daniel Steffen  <[email protected]>

	* generic/tclClock.c: fix warning.

	* unix/tcl.m4 (Darwin): fix error when MACOSX_DEPLOYMENT_TARGET unset
	* unix/configure: regen.

2005-11-30  Donal K. Fellows  <[email protected]>

	* unix/Makefile.in: Add dependency information relating to tclCompile.h
	since when the list of opcodes changes it is usually useful to rebuild
	everything that depends on it (but which is nonetheless a small
	fraction of the total set of Tcl source files).

	***POTENTIAL INCOMPATIBILITY*** for bytecode savers/loaders. See below

	* generic/tclCompCmds.c (TclCompileSwitchCmd): Arrange for very simple
	[switch] invokations to be compiled into hash lookups into jump tables;
	only a very specific kind of [switch] can be safely compiled this way,
	but that happens to be the most common kind. This makes around 5-10%
	difference to the speed of execution of clock.test.
	* generic/tclExecute.c (TEBC:INST_JUMP_TABLE): New instruction to allow
	for jumps to locations looked up in a hashtable. Requires a new AuxData
	type, tclJumptableInfoType (supported by the functions DupJumptableInfo
	and FreeJumptableInfo in tclCompCmds.c) so anything that saves bytecode
	containing this *must* be updated!

2005-11-30  Kevin Kenny  <[email protected]>

	* generic/tclClock.c: Fixed a bad refcount in previous commit that led
	to a corrupted heap. Also silenced a warning that some compilers gave
	about the excessively long constant for JULIAN_SEC_POSIX_EPOCH. Also
	fixed a bug where [clock format] would fail in the :localtime zone for
	times before the Posix Epoch. Thanks to Miguel Sofer for pointing out
	all of these. Also rationalized the code a little bit by moving parts
	of [clock scan] into C, eliminating some code that was duplicated in
	the C and Tcl layers.

2005-11-29  Kevin Kenny  <[email protected]>

	* generic/tclBasic.c:	Moved a big part of [clock format] down
	* generic/tclClock.c:   to the C level in order to make it go faster.
	* generic/tclInt.h:     Preliminary measurements suggest that it
	* generic/clock.tcl:    more than doubles in speed with this change.

2005-11-29  Donal K. Fellows  <[email protected]>

	* generic/tclCmdIL.c (Tcl_LsearchObjCmd): Allow [lsearch -regexp] to
	process REs that contain backreferences. This expensive mode of
	operation is only used if the RE would otherwise cause a compilation
	failure. [Bug 1366683]

2005-11-28  Kevin Kenny  <[email protected]>

	* tools/tclZIC.tcl (convertTimeOfDay): Corrected a typo that caused
	wrong DST transitions in any time zone where the transition is
	specified as local Standard Time (as opposed to wall-clock or UTC).
	(Also updated the code to be bignum-safe.)
	* tests/clock.test (clock-51.1): Added regression test for the above.
	* library/tzdata: Updated to Olson's 'tzdata2005o' (changes for Cuba,
	Nicaragua, Jordan, and Georgia) and regenerated. Thanks to Paul
	Mackerras for reporting this problem.

2005-11-27  Daniel Steffen  <[email protected]>

	* unix/tcl.m4 (Darwin): add 64bit support, check for Tiger copyfile(),
	add CFLAGS to SHLIB_LD to support passing -isysroot in env(CFLAGS) to
	configure (flag can't be present twice, so can't be in both CFLAGS and
	LDFLAGS during configure), don't use -prebind when deploying on 10.4,
	define TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING (rdar://3171542).
	(SC_ENABLE_LANGINFO, SC_TIME_HANDLER): add/fix caching, fix obsolete
	autoconf macros. Sync with tk/unix/tcl.m4.

	* unix/configure.in: fix obsolete autoconf macros, sync gratuitous
	formatting/ordering differences with tk/unix/configure.in.

	* unix/Makefile.in: add CFLAGS to tclsh/tcltest link to make executable
	linking the same as during configure (needed to avoid losing any linker
	relevant flags in CFLAGS, in particular flags that cannot be in
	LDFLAGS). Avoid concurrent linking of tclsh and compiling of
	tclTestInit.o or xtTestInit.o during parallel make.
	(checkstubs, checkdoc, checkexports): dependency and Darwin fixes
	(dist): add new macosx files.

	* unix/tclLoadDyld.c (TclpDlopen): use NSADDIMAGE_OPTION_WITH_SEARCHING
	on second NSAddImage only. [Bug 1204237]
	(TclGuessPackageName): should not be MODULE_SCOPE.
	(TclpLoadMemory): ppc64 and endian (i386) fixes, add support for
	loading universal (fat) bundles from memory.

	* unix/tclUnixFCmd.c:
	* macosx/tclMacOSXFCmd.c: ppc64 and endian (i386) fixes.
	(TclMacOSXCopyFileAttributes): add support for new Tiger copyfile() API
	to enable copying of xattrs & ACLs by [file copy].

	* generic/tcl.h: add Darwin specifc configure overrides for TCL_WIDE
	defines to support fat compiles of ppc and ppc64 at the same time,
	(replaces Darwin CVS fix by emoy, rdar://3693001). add/correct location
	of version numbers in macosx files.

	* generic/tclInt.h: clarify fat compile comment.

	* unix/tclUnixPort.h: add Darwin specifc configure overrides to support
	fat compiles, where configure runs only once for multiple architectures
	(replaces Darwin CVS fix by emoy, rdar://3693001).

	* macosx/tclMacOSXBundle.c:
	* macosx/tclMacOSXNotify.c:
	* unix/tclUnixNotfy.c:
	* unix/tclUnixPort.h: fix #include order to support compile time
	override of HAVE_COREFOUNDATION in tclUnixPort.h when building for
	ppc64

	* macosx/Tcl.pbproj/default.pbxuser (new file):
	* macosx/Tcl.pbproj/jingham.pbxuser:
	* macosx/Tcl.pbproj/project.pbxproj:
	* macosx/Tcl.xcode/default.pbxuser (new file):
	* macosx/Tcl.xcode/project.pbxproj (new file):
	* macosx/Tcl.xcodeproj/default.pbxuser (new file):
	* macosx/Tcl.xcodeproj/project.pbxproj (new file): new/updated
	projects for Xcode 2.2 on 10.4, Xcode 1.5 on 10.3 & ProjectBuilder on
	10.2, with native tcltest targets and support for universal (fat)
	compiles.

	* macosx/README: clarification/cleanup, document new Xcode projects and
	universal (fat) builds via CFLAGS (i.e. all of ppc ppc64 i386 at once).

	* unix/Makefile.in:
	* unix/aclocal.m4:
	* unix/configure.in:
	* unix/dltest/Makefile.in:
	* macosx/configure.ac (new file): add support for inclusion of
	unix/configure.in by macosx/configure.ac, allows generation of a config
	headers enabled configure script in macosx (required by Xcode
	projects).

	* macosx/GNUmakefile: rename from Makefile to avoid overwriting by
	configure run in tcl/macosx, add support for reusing configure cache,
	build target fixes, remove GENERIC_FLAGS override now handled by
	tcl.m4.

	* generic/tcl.decls: add Tcl_Main declaration as comment to avoid
	'checkstubs' target complaining about it missing from stubs.

	* generic/regex.h:
	* generic/tclDate.c:
	* generic/tclEnv.c:
	* generic/tclGetDate.y:
	* generic/tclIOUtil.c:
	* generic/tclObj.c:
	* generic/tclStubInit.c:
	* generic/tclStubLib.c:
	* generic/tclPathObj.c:
	* generic/tclThreadAlloc.c:
	* generic/tclThreadStorage.c:
	* generic/tclTrace.c:
	* generic/tclVar.c:
	* generic/tommath.h:
	* tools/fix_tommath_h.tcl:
	* unix/tclUnixFCmd.c: ensure externally visible symbols not contained
	in stubs table are declared as MODULE_SCOPE (or as static if not used
	outside of own source file). These changes allow 'make checkstubs' to
	complete without error on Darwin with gcc 4.

	* generic/rege_dfa.c (getvacant):
	* generic/regexec.c (cfind):
	* generic/tclCompExpr.c (CompileSubExpr):
	* generic/tclNamesp.c (NamespaceEnsembleCmd):
	* unix/tclUnixChan.c (TclUnixWaitForFile): initialise variables to
	silence gcc 4 warnings.

	* generic/tclExecute.c (TclExecuteByteCode): fix unused variable
	warning when NO_WIDE_TYPE is defined.

	* generic/regguts.h: only #define NDEBUG if not already #defined.

	* unix/tclUnixNotfy.c:
	* macosx/tclMacOSXNotify.c: sync whitespace & comments.

	* unix/tclUnixPort.h:
	* win/tclWinPort.h: remove declaration of obsolete&unused TclpMutex
	API.

	* unix/configure:
	* unix/tclConfig.h.in: regen.

2005-11-21  Andreas Kupries  <[email protected]>

	* unix/Makefile.in (install-libraries): Updated Makefile to new
	* win/Makefile.in (install-libraries):  version of the http package.
	This fixes the ifneeded/provide mismatch reported when trying to
	require http. Should we maybe try to automatically extract the version
	number from the http code to prevent future breakage ?

	This follows the update of the version number by dgp on Nov 15 (No
	entry found in the ChangeLog).

2005-11-20  Joe English  <[email protected]>

	* generic/tclStubLib.c: Don't set tclStubsPtr to 0 when
	Tcl_PkgRequireEx() fails [Fix for [Bug 1091431] "Tcl_InitStubs failure
	crashes wish"]

2005-11-18  Miguel Sofer  <[email protected]>

	* tests/trace.test (trace-34.5): [Bug 1047286], added a second test
	illustrating the role of "ns in callStack" in the ns's visibility
	during deletion traces.

2005-11-18  Kevin B. Kenny  <[email protected]>

	* doc/clock.n: Restored several missing lines near the %w format group
	so that %w and %W are documented with their actual behaviour. [Bug
	1359183]

2005-11-18  Jeff Hobbs  <[email protected]>

	* generic/tclIO.c (TclFinalizeIOSubsystem): preserve statePtr until we
	retrieve the next statePtr from it.

2005-11-18  Miguel Sofer  <[email protected]>

	* generic/tclObj.c (GetBignumFromObj): replace NULL with
	tclEmptyStringRep to stop memcpy from complaining in a debug build
	(the corresponding branch is eliminated by the optimiser otherwise).

2005-11-18  Andreas Kupries  <[email protected]>

	* generic/tclIO.c (TclFinalizeIOSubsystem): Applied Pat Thoyts' patch
	for [Bug 1359094]. This moves the retrieval of the next channel state
	to the end of the loop, as the called closeproc may close other
	channels, i.e. modify the list we are iterating, invalidating any
	pointer retrieved earlier.

2005-11-18  Don Porter  <[email protected]>

	* generic/tclListObj.c:	Restored the SetListFromAny routine to the
	* generic/tclObj.c:	"list" Tcl_ObjType, and restored the
	Tcl_RegisterObjType() call for "list". This addresses the needs of some
	"bridge" extensions to examine whether the Tcl_ObjType of a Tcl_Obj is
	that of the "list" Tcl_ObjType.

2005-11-18  Donal K. Fellows  <[email protected]>

	* library/http/http.tcl (http::geturl): Improved syntactic validation
	of URLs, and better error messages in some cases. [Bug 1358369]

2005-11-17  Miguel Sofer  <[email protected]>

	* tests/namespace.test: fix comment

2005-11-14  Don Porter  <[email protected]>

	* generic/tclStrToD.c:	More data in the "can't happen" Tcl_Panic to
	aid debugging.

	* generic/tclBasic.c (CallCommandTraces): Save/restore the interp
	result during traces to fix [Bug 1355342].

2005-11-13  Miguel Sofer  <[email protected]>

	* generic/tclInt.h:
	* generic/tclNamesp.c:
	* tests/namespace.test: fix for [Bug 1354540] and [Bug 1355942]. The
	new tests 7.3-6 and the modified 51.13 fail due to the unrelated [Bug
	1355342]

	* tests/trace.test: added tests 20.13-16 for [Bug 1355342]

2005-11-12  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c (Tcl_DeleteCommandFromToken):
	* generic/tclObj.c (Tcl_GetCommandFromObj): more partial fixes for
	[Bug 1354540] - making sure that cached references to a command being
	deleted cannot be made reusable by a delete trace.

2005-11-12  Donal K. Fellows  <[email protected]>

	* generic/tclNamesp.c (Tcl_FindCommand): Do not find commands in dead
	namespaces on the path. Partial fix for [Bug 1354540].

2005-11-11  Don Porter  <[email protected]>

	* generic/tclInt.h:	Revised TclParseNumber interface to enable
	* generic/tclScan.c:	revision to the [scan] command implementation
	* generic/tclStrToD.c:	to permit tests scan-4.44,55 to pass again.
	[Bug 1348067].

2005-11-11  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c (Tcl_DeleteCommandFromToken):
	* generic/tclObj.c (Tcl_GetCommandFromObj): bump the cmd epoch early
	to insure that cached references to this command are invalidated.
	Partial fix for [Bug 1352734] - at least insures that namespace-51.13
	does not cause a panic. The test is still marked as knownbug, pending
	resolution of what is actually the correct return value ([Bug
	1354540])

2005-11-09  Kevin B. Kenny  <[email protected]>

	* generic/tclTimer.c: Changed [after] so that it behaves correctly
	* tests/timer.test:   with negative arguments [Bug 1350293] and
	arguments that overflow a 32-bit word. [Bug 1350291]

2005-11-08  Don Porter  <[email protected]>

	* tests/compile.test:	Updated tests with changed behavior
	* tests/execute.test:	due to addition of bignums.
	* tests/expr-old.test:
	* tests/expr.test:
	* tests/parseExpr.test:
	* tests/platform.test:
	* tests/string.test:

2005-11-08  Jeff Hobbs  <[email protected]>

	* unix/tclUnixFCmd.c (MAX_READDIR_UNLINK_THRESHOLD): reduce to 130
	based on errors seen on OS X 10.3 with lots of links in a dir.
	[Bug 1034337 followup]

2005-11-09  Donal K. Fellows  <[email protected]>

	* unix/Makefile.in (gdb-test): Added a new target to make it easier to
	run the test suite inside a debugger.

2005-11-08  Don Porter  <[email protected]>

	* tests/compExpr-old.test:	Updated tests with changed behavior due
	to addition of bignums.

	* tests/expr.test:      Portable tests expr-46.13-18 [Bug 1341368]

	* generic/tclPkg.c:	Corrected inconsistencies in the value returned
	* tests/pkg.test:	by Tcl_PkgRequire(Ex) so that the returned
	values will always agree with what is stored in the package database.
	This way repeated calls to Tcl_PkgRequire(Ex) have the same results.
	Thanks to Hemang Lavana. [Bug 1162286].

2005-11-08  Donal K. Fellows  <[email protected]>

	* generic/tclTrace.c (TraceVarEx): Factor out heart of Tcl_TraceVar2
	(TclTraceVariableObjCmd,TraceVarProc): Use the new internal API to
	arrange for the clientData to be cleaned up at the same time as the
	rest of the main trace record. This simplifies the code a bit at the
	same time.

2005-11-07  Miguel Sofer  <[email protected]>

	* tests/trace.test (trace-13.2-4): added tests to detect leak, see [Bug
	1348775]. The recently added trace-8.9 test is now 13.4.

2005-11-07  Donal K. Fellows  <[email protected]>

	* tests/dict.test (dict-19.2): arrange for the stress testing code to
	only stress test the dict code and not the trace code as well. [Bug
	1342858]

2005-11-05  Miguel Sofer  <[email protected]>

	* tests/trace.test (trace-8.9): added test to detect leak, see [Bug
	1348775].

2005-11-04  Pat Thoyts  <[email protected]>

	* win/tclWinPort.h:  Applied [Patch 1267871] by Matt Newman for
	* win/tclWinPipe.c:  extended error code support on Windows.
	* tests/exec.test:   Tests for extended error codes.
	* generic/tclPipe.c: Permit long codes (platform macros permitting).

2005-11-04  Miguel Sofer  <[email protected]>

	* generic/tclBinary.c:
	* generic/tclCmdAH.c:
	* generic/tclCmdIL.c:
	* generic/tclCmdMZ.c:
	* generic/tclDictObj.c:
	* generic/tclExecute.c:
	* generic/tclIOCmd.c:
	* generic/tclLink.c:
	* generic/tclTest.c:
	* generic/tclVar.c: fix for [Bug 1334947]. The functions TclPtrSetVar,
	Tcl_ObjSetVar2 and Tcl_SetVar2Ex now always consume the newValuePtr
	argument - i.e., they will free a 0-refCount object if they failed to
	set the variable. Fixed all callers in the core.

2005-11-04  Kevin Kenny  <[email protected]>

	* generic/tclGetDate.y: Added abbreviations for the Korean
	* library/clock.tcl:    timezone. [Patch 1298737]
	* generic/tclDate.c:    Regenerated.

	* tools/findBadExternals.tcl: Added this script, which locates external
	symbols that do not begin with 'Tcl' or 'tcl' and hence might be in
	conflict with other link libraries. Thanks to George Peter Staplin for
	the idea and the initial version of the script. [Bug 1263012]

	* unix/Makefile.in: Trimmed a bunch of fat out of the tommath/
	directory in 'make dist'. [RFE 1333318]

	* unix/tcl.m4: Added code to enable [load] on LynxOS. Thanks to
	[email protected] for the patch. [Bug 1163896]. Removed the last
	vestiges of GNU dld from the Unix build [RFE 1071992].

	* unix/tclLoadDld.c: Removed.
	* unix/configure: Regenerated.

2005-11-04  Miguel Sofer  <[email protected]>

	* generic/tclInt.h:
	* generic/tclNamesp.c:
	* generic/tclVar.c:
	* tests/trace.test: fix for [Bugs 1338280/1337229]; changed to use the
	same approach as the 8.4 patch in the ticket (i.e., removed the patch
	committed on 2005-31-10).

2005-11-03  Pat Thoyts  <[email protected]>

	* win/tclWin32Dll.c:   Applied [Patch 1256872] to provide unicode
	* win/tclWinConsole.c: support in the console on suitable systems.
	* win/tclWinInt.h:     Patch by Anton Kovalenko

2005-11-02  Pat Thoyts  <[email protected]>

	Applied [Patch 1096916] to support building with MSVC 8.
	* generic/regerror.c: Avoid use of reserved word.
	* generic/tcl.h:      Select the right Tcl_Stat structure
	* generic/tclDate.c:  Casts to handle 64 bit time_t case.
	* tests/env.test:     Include essential envvar on Win32
	* win/nmakehlp.c:     Handle new return codes.
	* win/makefile.vc:    Use the selected options.
	* win/rules.vc:       Check options are applicable
	* win/tclWinPort.h:   Disable deprecated function warnings
	* win/tclWinSock.c:   Provide default value to avoid warning.
	* win/tclWinTime.c:   Add casts to handle 64bit time_t type.

2005-11-01  Don Porter  <[email protected]>

	* generic/tclTrace.c (TclCheckExecutionTraces): Corrected mistaken
	assumption that all command traces are set at the script level.
	Report/fix from Jacques H. de Villiers. [Bug 1337941]

	* tests/unixNotfy.test (1.1,2):	Update error message whitespace to
	match changes in code.

	* tests/expr-old.test (expr-32.52): Use int(.) to restrict result of
	left shift to the C long range.

	* expr.test (expr-46.13): Added test that illustrates shortcoming of
	[Patch 1340260].

2005-10-31  Miguel Sofer  <[email protected]>

	* generic/tclNamesp.c: fix for [Bugs 1338280/1337229]. Thanks Don.
	* tests/trace.test: fix duplicate test numbers

2005-10-31  Donal K. Fellows  <[email protected]>

	* win/tclWinSerial.c (SerialSetOptionProc): Cleaned up option parsing
	to produce more informative error messages and separate error and
	non-error code paths better.
	* tests/ioCmd.test (iocmd-8-19): Updated.

2005-10-29  Miguel Sofer  <[email protected]>

	* generic/tclTrace.c (TraceVarProc): [Bug 1337229], partial fix. Ensure
	that a second call with TCL_TRACE_DESTROYED does not lead to a second
	call to Tcl_EventuallyFree(). It is still true that that second call
	should not happen, so the bug is not completely fixed.
	* tests/trace.test (test-18.3-4): added tests for [Bug 1337229] and
	[Bug 1338280].

2005-10-23  Vince Darley  <[email protected]>

	* generic/tclFileName.c: fix to memory leak in glob [Bug 1335006] Obj
	leak detection and patch by Eric Melbardis.

	* tests/fCmd.test:
	* win/tclWinFile.c: where appropriate windows API is available, try to
	set 'nlink' and 'ino' stat fields (previously they were always 0). [Bug
	1325803]

2005-10-22  Miguel Sofer  <[email protected]>

	* tests/foreach.test (foreach-8.1): added test for [Bug 1189274]

2005-10-22  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c (INST_INCR_*): fixed [Bug 1334570]. Obj leak
	detection and patch by Eric Melbardis.

2005-10-21  Kevin B. Kenny  <[email protected]>

	* generic/tclStrToD.c (RefineApproximation): Plugged a memory leak
	where two intermediate results were not freed on one return path. [Bug
	1334461]. Thanks to Eric Melbardis for the patch.

2005-10-21  Donal K. Fellows  <[email protected]>

	* doc/binary.n: Clarify that virtually all code that uses the 'h'
	format in [binary scan] should be using the 'H' format instead. It is
	nearly always a bug to use the other!

2005-10-20  Miguel Sofer  <[email protected]>

	* generic/tclListObj.c (TclLsetFlat):
	* tests/lset.test (lset-10.3): fixed handling of unshared lists with
	shared sublists, [Bug 1333036] reported by neuronstorm.

2005-10-19  Donal K. Fellows  <[email protected]>

	* generic/tclIORChan.c (PassReceivedError,PassReceivedErrorInterp):
	Fix crash caused by passing -1 as the length to TclNewStringObj(). Only
	Tcl_NewStringObj (the function call, not the macro) handles that sort
	of thing correctly. This makes ioCmd.test pass again.

2005-10-19  Don Porter  <[email protected]>

	* generic/tclClock.c:		Removed some dead code.
	* generic/tclCmdIL.c:
	* generic/tclCompCmds.c:
	* generic/tclDictObj.c:
	* generic/tclExecute.c:
	* generic/tclLiteral.c:
	* generic/tclParseExpr.c:
	* generic/tclScan.c:
	* generic/tclUtil.c:
	* generic/tclVar.c:

2005-10-19  Donal K. Fellows  <[email protected]>

	* generic/tclIORChan.c: General cleanup, removing checks that are
	unnecessary due to the general contracts of other functions in the
	core, converting to using ANSI declarations, etc. Note that nearly the
	whole file has changed, but it is often just cosmetic.

2005-10-19  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c (INST_DICT_APPEND, INST_DICT_LAPPEND): fixed
	faulty peephole optimisation that can cause crashes, [Bug 1331475]
	reported by Aric Bills.

2005-10-18  Don Porter  <[email protected]>

	* generic/tclExecute.c: Added optimization for I32L64 systems to avoid
	using bignums to perform int multiplies. The improvement shows up most
	dramatically in tclbench's matrix.bench.

2005-10-15  Don Porter  <[email protected]>

	* generic/tclExecute.c:	Restored some optimizations of the
	INST_INCR_SCALAR1_IMM opcode.

2005-10-14  Zoran Vasiljevic  <[email protected]>

	* generic/tclIO.c (Tcl_ClearChannelHandlers): removed change dated
	2005-10-04 (see below). Look into [Bug 1323992] for detailed
	discussion.

	* generic/tcl.h: Fixed bad definition of CRTEXPORT which should have
	been CRTIMPORT rather. This broke compilation of generic/tclMain.c and
	was probably introduced by mistake while applying the fix for [Bug
	1256937] below.

2005-10-14  Kevin Kenny  <[email protected]>

	* generic/tclExecute.c (TclIncrObj, TclExecuteByteCode): Tidied up a
	couple of infelicitous do {...} while(0) constructs.

2005-10-14  Pat Thoyts  <[email protected]>

	* generic/tcl.h:     Fix for [Bug 1256937] - correctly decorate
	* generic/tclMain.c: imported functions from msvcrt in static builds.

2005-10-13  Donal K. Fellows  <[email protected]>

	* tests/format.test: "Forward"-port of test updates relating to [Bug
	1284178]. The bug itself was fixed by TIP#237.

2005-10-13  Zoran Vasiljevic  <[email protected]>

	* generic/tclIO.c (Tcl_ClearChannelHandlers): temporary ifdef
	TCL_THREADS changes done to de-activate pending event processing when
	channel is being closed/cutted.

2005-10-13  Don Porter  <[email protected]>

	* generic/tclExecute.c:	Removed obsolete use of NO_ERRNO_H.
	* tools/man2tcl.c:
	* unix/tcl.m4:
	* unix/tclConfig.h.in:
	* win/configure.in:

	* unix/configure:	autoconf-2.59
	* win/configure:

	* compat/tclErrno.h:	Removed obsolete file.

	* generic/tclStrToD.c (TclParseNumber): Missing goto caused crash when
	parsing "Na". [Bug 1325833]

2005-10-12  Don Porter  <[email protected]>

	* generic/tclExecute.c (GetNumberFromObj):	Restored some lost
	optimizations for empty string values. We avoid cost of a call to
	TclParseNumber just to tell us an empty string isn't a number.

2005-10-12  Donal K. Fellows  <[email protected]>

	* generic/tclPathObj.c (SetFsPathFromAny): TclGetString macro must not
	be combined with post-increment arguments. [Bug 1325099]

2005-10-12  Kevin Kenny  <[email protected]>

	* generic/tclExecute.c (Tcl_ExecuteByteCode, TclIncrObj): Several
	common cases inlined in hopes of gaining a little performance in [incr]

2005-10-10  Miguel Sofer  <[email protected]>

	* generic/tclCompCmds.c: New convenience macro CompileTokens().

2005-10-10  Don Porter  <[email protected]>

	* generic/tclExecute.c: Corrections to the NO_WIDE_TYPE build. Also
	added missing "break" to a switch that broke wide XOR operations.

2005-10-10  Donal K. Fellows  <[email protected]>

	* generic/tclInterp.c (DeleteScriptLimitCallback)
	(SetScriptLimitCallback): Improve the interlocking between the script
	limit callback record and the hash table of current such records, to
	prevent crashes in callbacks that create callbacks.
	(Tcl_LimitSetTime): Reset the correct flag. Problem reported by
	Nicolas Castagne <[email protected]> on comp.lang.tcl

2005-10-10  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c: Fixing errors in last commit. (Two commits, the
	second removes wrong comment).

2005-10-09  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c:
	* generic/tclExecute.c:
	* generic/tclStrToD.c:
	* generic/tclStringObj.c: Initialise variables to avoid compiler
	warnings ([Bug 1320818] among others).

2005-10-08  Don Porter  <[email protected]>

	TIP#237 IMPLEMENTATION

	[kennykb-numerics-branch] Resynchronized with the HEAD; at this
	checkpoint [-rkennykb-numerics-branch-20051008], the HEAD and
	kennykb-numerics-branch contain identical code.

	[kennykb-numerics-branch]	Merge updates from HEAD

	* generic/tclExecute.c: More performance macros and special handling of
	the wide integer type for performance on 32-bit systems.

2005-10-07  Don Porter  <[email protected]>

	[kennykb-numerics-branch]

	* generic/tclExecute.c:	Macro GetNumberFromObj() is version of
	TclGetNumberFromObj() that saves a function call for common uses.

	* generic/tclInt.h:	Made #undef NO_WIDE_TYPE the default on 32-bit
	systems. Being able to use 64-bit values without leaping to mp_int
	should help with performance.

	* generic/tclObj.c:	Bug fixes in the #undef NO_WIDE_TYPE
	* generic/tclExecute.c:	configuration.

	* generic/tclExecute.c: Improved performance of comparison opcodes and
	bitwise operations and removed yet more dead code.

2005-10-07  Jeff Hobbs  <[email protected]>

	* unix/tclUnixFCmd.c (TraverseUnixTree): Adjust 2004-11-11 change to
	* tests/fCmd.test (fCmd-20.2):           account for NFS special files
	with a readdir rewind threshold. [Bug 1034337]

2005-10-06  Don Porter  <[email protected]>

	[kennykb-numerics-branch]

	* generic/tclExecute.c:	Improved performance of INST_RSHIFT and
	INST_LSHIFT.

2005-10-05  Don Porter  <[email protected]>

	[kennykb-numerics-branch]

	* generic/tclExecute.c: Improved performance of INST_MULT, INST_DIV,
	INST_ADD, and INST_SUB and replaced a "goto... label" with a "break
	from loop" in TclIncrObj() and removed some dead code.

2005-10-05  Andreas Kupries  <[email protected]>

	* generic/tclPipe.c (TclCreatePipeline): Fixed [Bug 1109294]. Applied
	the patch provided by David Gravereaux.

	* doc/CrtChannel.3: Fixed [Bug 1104682], by application of David
	Welton's patch for it, and added a note about wideSeekProc.

	* generic/tclIORChan.c (RcClose): Removed unreachable panic/return
	statements. This fixes the remainder of [Bug 1286256].

2005-10-05  Jeff Hobbs  <[email protected]>

	* tests/env.test (env-6.1):
	* win/tclWinPort.h: define USE_PUTENV_FOR_UNSET 1
	* generic/tclEnv.c (TclSetEnv, TclUnsetEnv): add USE_PUTENV_FOR_UNSET
	to existing USE_PUTENV define to account for various systems that have
	putenv(), but can't unset env vars with it. Note difference between
	Windows and Linux for actually unsetting the env var (use of '=').
	Correct the resizing of the environ array. We assume that we are in
	full ownership, but that's not correct.[Bug 979640]

2005-10-04  Don Porter  <[email protected]>

	[kennykb-numerics-branch]
	* generic/tclExecute.c: Updated TclIncrObj() to more efficiently add
	native long integers. Also updated IllegalExprOperandType and the
	INST_UMINUS, INST_UPLUS, INST_BITNOT, and INST_TRY_CVT_TO_NUMERIC
	sections for performance.

	* generic/tclBasic.c: Updated more callers to make use of
	TclGetNumberFromObj. Removed some dead code.

2005-10-04  Jeff Hobbs  <[email protected]>

	* win/tclWinSerial.c (SerialSetOptionProc): free argv [Bug 1067708]

	* tests/http.test:              do not URI encode -._~ according
	* library/http/http.tcl (init): to RFC3986. [Bug 1182373] (aho)

	* unix/tclLoadShl.c (TclpDlopen): use DYNAMIC_PATH on second shl_load
	only. [Bug 1204237]

	* doc/scan.n: scan %[] requires "one or more chars" [Bug 1277503]

	* tests/winFile.test (getuser): allow valid Windows usernames. [Bug
	1311285]

	* generic/tclParse.c (Tcl_ParseCommand): add code that recognizes {} in
	addition to {expand} for word expansion (make with
	-DALLOW_EMPTY_EXPAND).

2005-10-04  Zoran Vasiljevic  <[email protected]>

	* generic/tclIO.c (Tcl_ClearChannelHandlers): now deletes any
	outstanding timer for the channel. Also, prevents events still in the
	event queue from triggering on the current channel.

	* generic/tclTimer.c (Tcl_DeleteTimerHandler): bail out early if passed
	NULL argument.

2005-10-03  Don Porter  <[email protected]>

	[kennykb-numerics-branch]

	* generic/tclBasic.c:	Re-implemented ExprRoundFunc and
	ExprEntierFunc to use TclGetNumberFromObj.

	* generic/tclInt.h:	Added new routine TclGetNumberFromObj to
	* generic/tclObj.c:	provide efficient access to the actual
	internal rep of a numeric Tcl_Obj without conversions.

2005-10-03  Kevin Kenny  <[email protected]>

	* tools/loadICU.tcl:  Changed the file names of message catalogs to
			      lowercase.
	* tools/makeTestCases.tcl:
	* library/tzdata/*:   Olson's tzdata2005n.tar.gz. Includes new DST
	rules for USA and a number of changes to other locales.
	* tests/clock.test:   Regenerated for new US DST rules.

2005-09-30  Don Porter  <[email protected]>

	* generic/tclMain.c: Separate encoding conversion of command line
	arguments from list formatting. [Bug 1306162].

2005-09-30  Don Porter  <[email protected]>

	[kennykb-numerics-branch]

	* generic/tclStringObj.c:	Bug fix: Missing cast to large enough
	integral size before << operations led to broken [format %llx] results.
	Thanks to Robert Henry for reporting the bug.

2005-09-29  Jeff Hobbs  <[email protected]>

	* doc/mathfunc.n:   implementation for TIP #255, expr min/max
	* library/init.tcl:
	* tests/info.test, tests/expr-old.test:

2005-09-27  Don Porter  <[email protected]>

	[kennykb-numerics-branch]

	* generic/tcl.h:	Changed name of the new Tcl_Obj intrep field
	* generic/tclObj.c:	from "bignumValue" to "ptrAndLongRep" as
	* generic/tclProc.c:	described in TIP 237, and more suitable for
	other more general uses.

2005-09-27  Donal K. Fellows  <[email protected]>

	* tests/binary.test (binary-14.18): Added test for [Bug 1116542] though
	the bug itself was already fixed by unrelated changes.

2005-09-26  Kevin Kenny  <[email protected]>

	[kennykb-numerics-branch] Merge updates from HEAD.

2005-09-26  Kevin Kenny  <[email protected]>

	* libtommath/:                   Updated to release 0.36.
	* generic/tommath.h:             Regenerated.
	* generic/tclTomMathInterface.h: Added ten missing aliases for mp_*
	functions to avoid namespace pollution in Tcl's exported symbols. [Bug
	1263012]

2005-09-23  Don Porter  <[email protected]>

	[kennykb-numerics-branch]

	* unix/Makefile.in:	Added -DMP_PREC=4 switch to all compiles so
	* win/Makefile.in:	that minimum memory requirements of mp_int's
	* win/makefile.vc:	will not be quite so large. [Bug 1299153].

	* generic/tclStrToD.c:	Fixed memory leak. [Bug 1299803].
	* generic/tclObj.c:

2005-09-20  Don Porter  <[email protected]>

	[kennykb-numerics-branch]

	* generic/tclExecute.c:	Revise TclIncrObj() to call
	Tcl_GetBignumAndClearObj.

	* generic/tcl.decls:	Add Tcl_GetBignumAndClearObj.
	* generic/tclObj.c:

	* generic/tclDecls.h:	make genstubs
	* generic/tclStubInit.c:

2005-09-16  Don Porter  <[email protected]>

	[kennykb-numerics-branch]

	* generic/tclInt.h:		 Added TclBNInitBigNumFromWideInt() so
	* generic/tclTomMathInterface.c: that every caller isn't required to
	duplicate the sign logic to use the unsigned interface.

	* generic/tclBasic.c:	Reduce the number of places where Tcl intrudes
	* generic/tclExecute.c:	into the internal format details of the mp_int
	* generic/tclObj.c:	struct.
	* generic/tclStrToD.c:
	* generic/tcLStringObj.c:

	* generic/tclTomMath.h:	Added mp_cmp_d to routines from libtommath
	* unix/Makefile.in:	used by Tcl.
	* win/Makefile.in:
	* win/makefile.vc:

	* libtommath/bn_mp_add_d.c: Bug fix. For mp_add_d(&a, d, &c), when &a
	has the value -d, then the value &c computed should be zero, but
	mp_add_d was producing an inconsistent zero value with a sign field of
	MP_NEG, something like a value of -0, which other routines in
	libtommath can't handle.

	* generic/tclExecute.c:	Dropped all creation of "bigOne" values and
	just use tommath routines that accept the value "1" directly.

2005-09-15  Miguel Sofer  <[email protected]>

	* doc/ParseCmd.3: copy/paste fix [Bug 1292427]

2005-09-15  Don Porter  <[email protected]>

	[kennykb-numerics-branch]	Merge updates from HEAD.

	* generic/tclStringObj.c (TclAppendFormattedObjs):	Revision to
	eliminate one round of string copying.

	* generic/tclBasic.c:	More callers of TclObjPrintf and
	* generic/tclCkalloc.c:	TclFormatToErrorInfo.
	* generic/tclCmdMZ.c:
	* generic/tclExecute.c:
	* generic/tclIORChan.c:
	* generic/tclMain.c:
	* generic/tclProc.c:
	* generic/tclTimer.c:
	* generic/tclUtil.c:
	* unix/tclUnixFCmd.c

	* unix/configure:	autoconf-2.59

2005-09-15  Donal K. Fellows  <[email protected]>

	* unix/tcl.m4 (SC_TCL_EARLY_FLAGS): Added extra hack to allow Tcl to
	transparently open large files on RHEL 3. [Bug 1287638]

2005-09-14  Don Porter  <[email protected]>

	* generic/tclStringObj.c:	Bug fixes: ObjPrintfVA needed to
	support "*" fields and needed to interpret precision limits on %s
	conversions as a maximum number of bytes, not Tcl_UniChars, to take
	from the (char *) argument.

	* generic/tclBasic.c:	Updated several callers to use
	* generic/tclCkalloc.c: TclFormatToErrorInfo() and/or
	* generic/tclCmdAH.c:	TclObjPrintf().
	* generic/tclCmdIL.c:
	* generic/tclCmdMZ.c:
	* generic/tclDictObj.c:
	* generic/tclExecute.c:
	* generic/tclIORChan.c:
	* generic/tclIOUtil.c:
	* generic/tclNamesp.c:
	* generic/tclProc.c:

	* library/init.tcl:	Keep [unknown] in sync with errorInfo
	formatting rules.

2005-09-13  Don Porter  <[email protected]>

	* generic/tclBasic.c:	First caller of TclFormatToErrorInfo.

	* generic/tclInt.h:		Using stdarg.h conventions, add more
	* generic/tclStringObj.c:	fixed arguments to TclFormatObj() and
	TclObjPrintf(). Added new routine TclFormatToErrorInfo().

	* generic/tcl.h:	Explicitly standardized on the use of stdarg.h
	* generic/tclBasic.c:	conventions for functions with variable number
	* generic/tclInt.h:	of arguments. Support for varargs.h has been
	* generic/tclPanic.c:	implicitly gone for some time now. All
	* generic/tclResult.c:	TCL_VARARGS* macros purged from Tcl sources,
	* generic/tclStringObj.c:	leaving only some deprecated #define's
	* tools/genStubs.tcl:	in tcl.h for the sake of older extensions.

	* generic/tclDecls.h:	make genstubs

	* doc/AddErrInfo.3:	Replaced all documented requirement for use of
	* doc/Eval.3:		TCL_VARARGS_START() with requirement for use of
	* doc/Panic.3:		va_start().
	* doc/SetResult.3:
	* doc/StringObj.3:

2005-09-12  Don Porter  <[email protected]>

	[kennykb-numerics-branch]	Merge updates from HEAD.

	* generic/tclCmdAH.c:		Added support for the "ll" width
	* generic/tclStringObj.c:	specifier to [format].

	* generic/tclStringObj.c (TclAppendFormattedObjs):	Bug fix: make
	sure %ld formats force the collection of a wide value, when the value
	could be a different long.

2005-09-09  Andreas Kupries  <[email protected]>

	* generic/tclIORChan.c (RcDecodeEventMask): Added missing type
	declaration for the parameter 'mask'. This fixes the [Bug 1286256]. The
	other warning can be removed only by removing the panic/return code.

2005-09-09  Don Porter  <[email protected]>

	[kennykb-numerics-branch]	Merge updates from HEAD.

2005-09-09  Kevin Kenny  <[email protected]>

	* generic/tclStringObj.c:  Added two missing casts to silence messages
	from MSVC6.

2005-09-09  Don Porter  <[email protected]>

	* generic/tclInt.h:		New internal routine TclObjPrintf()
	* generic/tclStringObj.c:	is similar to TclFormatObj() but
	accepts arguments in non-Tcl_Obj format.

	* generic/tclInt.h:		New internal routines TclFormatObj()
	* generic/tclStringObj.c:	and TclAppendFormattedObjs() to offer
	sprintf()-like means to append to Tcl_Obj. Work in progress toward
	[RFE 572392].

	* generic/tclCmdAH.c:	Compiler directive NEW_FORMAT when #define'd
	directs the [format] command to be implemented in terms of the new
	TclAppendFormattedObjs() routine.

2005-09-08  Donal K. Fellows  <[email protected]>

	TIP#254 IMPLEMENTATION

	* generic/tclLink.c (LinkTraceProc,ObjValue): Added many new of C var
	* generic/tcl.h:			      to link to, making it
	* doc/LinkVar.3:			      easier to seamlessly
	* generic/tclTest.c (TestlinkCmd):	      couple C code and Tcl
	* tests/link.test:			      scripts in an
	application. [Patch 1242844]

2005-09-07  Don Porter  <[email protected]>

	* generic/tclUtf.c (Tcl_UniCharToUtf):	Corrected handling of negative
	* tests/utf.test (utf-1.5):	    Tcl_UniChar input value. Incorrect
	handling was producing byte sequences outside of Tcl's legal internal
	encoding. [Bug 1283976].

2005-09-06  Donal K. Fellows  <[email protected]>

	* generic/tclInt.h (List): Added flag to keep track of whether a list
	* generic/tclListObj.c:    with a string rep is provably canonical.
	* generic/tclUtil.c (Tcl_ConcatObj):  Do efficient concatenation and
	* generic/tclBasic.c (Tcl_EvalObjEx): evaluation when the list is
	canonical, and not just when the list is pure. This should make the
	"pure list" hacking introduced in 8.3 much more robust.

2005-09-05  Donal K. Fellows  <[email protected]>

	* generic/tclObj.c (pendingObjDataKey): Added missing 'static' to stop
	symbol from leaking outside the Tcl library. [Bug 1263012]

2005-09-02  Don Porter  <[email protected]>

	[kennykb-numerics-branch]

	* generic/tclScan.c:	Bug fix: The %o, %x, %i formats of [scan] must
	not accept any 0b or 0o prefixes. [scan $s %o] must continue to work
	even with KILL_OCTAL enabled.

	* generic/tclInt.h:	Added TCL_PARSE_SCAN_PREFIXES to the flags
	* generic/tclStrToD.c:	accepted by TclParseNumber.

2005-09-01  Andreas Kupries  <[email protected]>

	* unix/tclUnixSock.c (InitializeHostName): Synchronized use of static
	modifier in declaration and definition of function.

	* unix/tclUnixChan.c (FileTruncateProc): Synchronized use of static
	modifier in declaration and definition of function.

	* generic/tclResult.c (ReleaseKeys): Synchronized use of static
	modifier in declaration and definition of function.

	* generic/tclListObj.c (NewListIntRep): Synchronized use of static
	modifier in declaration and definition of function.

	* generic/tclEncoding.c (InitializeEncodingSearchPath): Synchronized
	use of static modifier in declaration and definition of function.

	* generic/tclEncoding.c (FillEncodingFileMap): Synchronized use of
	static modifier in declaration and definition of function.

	* generic/tclIORChan.c (RcNewHandle): Synchronized use of static
	modifier in declaration and definition of function.

2005-09-01  Don Porter  <[email protected]>

	[kennykb-numerics-branch]

	* generic/tclObj.c:	TclParseNumber calls meant to parse an integer
	value now pass the TCL_PARSE_INTEGER_ONLY flag.

	* generic/tclScan.c:	Extended [scan] to accept the %lld, %llo, %llx,
	and %lli formats. Numeric scanning is now done via TclParseNumber calls

	* generic/tclInt.h:	Extended TclParseNumber to accept new flag
	* generic/tclStrToD.c:	values TCL_PARSE_INTEGER_ONLY,
	TCL_PARSE_OCTAL_ONLY, and TCL_PARSE_HEXIDECIMAL_ONLY, to give caller
	more control over the parsing rules.

2005-08-31  Vince Darley  <[email protected]>

	* doc/FileSystem.3:
	* unix/tclUnixFile.c:
	* windows/tclWinFile.c: clarify that Tcl_FSMatchInDirectory may be
	called with a NULL interpreter, and fix the code so this is allowed.
	Tcl's core itself (tclEncoding.c:FillEncodingFileMap()) calls this
	with a NULL interpreter.

2005-08-30  Don Porter  <[email protected]>

	[kennykb-numerics-branch]

	* generic/tclObj.c:	Extended bignum support to include bignums so
	large they will not pack into a Tcl_Obj. When they outgrow Tcl's string
	rep length limits, a panic will result.

	* generic/tclTomMath.h:	Added mp_sqrt to routines from
	* unix/Makefile.in:	libtommath used by Tcl.
	* win/Makefile.in:
	* win/makefile.vc:

	* generic/tclBasic.c:	Extended sqrt(.) so that range covers the
	entire double range, accepting as many bignums in the domain as that
	will allow.

2005-08-29  Andreas Kupries  <[email protected]>

	* library/tm.tcl (::tcl::tm::roots): Accepted Don Porter's patch for
	[Bug 1189657]. Syncs the implementation to the specification (TIP #189)

2005-08-29  Don Porter  <[email protected]>

	[kennykb-numerics-branch]	Merge updates from HEAD.

	* generic/tclBasic.c:	Restored round(.) to the Tcl 8.4 rules.

2005-08-29  Kevin Kenny  <[email protected]>

	* generic/tclBasic.c (ExprMathFunc): Restored "round away from zero"
	* tests/expr.test (expr-46.*):       behaviour to the "round" function.
	Added test cases for the behavior, including the awkward case of a
	number whose fractional part is 1/2-1/2ulp. [Bug 1275043]

2005-08-26  Andreas Kupries  <[email protected]>

	* generic/tclIO.c: Moved Tcl_{Cut,Splice}Channel to
	{Cut,Splice}Channel for internal use, and created new public functions
	for Tcl_{Cut,Splice}Channel which walk the whole stack of
	transformations and invoke the necessary thread actions. Added code to
	Tcl_(Un)StackChannel to properly invoke the thread actions when pushing
	and popping transformations on/from a channel.

2005-08-26  Donal K. Fellows  <[email protected]>

	* generic/tclNamesp.c (NamespaceEnsembleCmd): Reset the result after
	creating an ensemble to clear any result object sharing (potentially
	caused by delete traces) so that we can safely return the name of the
	ensemble. Previously, this caused crashes in Snit's test suite.

2005-08-25  Donal K. Fellows  <[email protected]>

	* generic/tclListObj.c (UpdateStringOfList): Stop uncontrolled and
	unsafe crashes from happening when working with very large string
	representations. [Bug 1267380]

	* generic/tclExecute.c (TEBC:INST_DICT_LAPPEND): Stop dropping a
	duplicated object on the floor, which was a memory leak (and a wrong
	result too). Thanks to Andreas Kupries for reporting this.

2005-08-25  Don Porter  <[email protected]>

	[kennykb-numerics-branch] Merge updates from HEAD

	* generic/tclExecute.c: Bug fix. INST_RSHIFT: shift of negative values
	produced incorrect results.

	* generic/tclExecute.c: Bug fix. INST_*SHIFT opcodes stack management.
	[expr 0<<6] should be 0, not 6.

	* generic/tclBasic.c: Extended the domain of round(.) to all non-Inf,
	non-NaN doubles, using bignums for the result as needed.

2005-08-24  Andreas Kupries  <[email protected]>

	TIP#219 IMPLEMENTATION

	* doc/SetChanErr.3: ** New File **. Documentation of the new channel
	API functions.
	* generic/tcl.decls:  Stub declarations of the new channel API.
	* generic/tclDecls.h: Regenerated
	* generic/tclStubInit.c:

	* tclIORChan.c: ** New File **. Implementation of the reflected
	channel.
	* generic/tclInt.h: Integration of reflected channel and new error
	* generic/tclIO.c:  propagation into the generic I/O core.
	* generic/tclIOCmd.c:
	* generic/tclIO.h:
	* library/init.tcl:

	* tests/io.test:    Extended testsuite.
	* tests/ioCmd.test:
	* tests/chan.test:
	* generic/tclTest.c:
	* generic/tclThreadTest.c:

	* unix/Makefile.in: Integration into the build machinery.
	* win/Makefile.in:
	* win/Makefile.vc:

2005-08-24  Kevin Kenny  <[email protected]>

	* generic/tclStrToD.c (Tcl_DoubleDigits): Fixed the corner cases of
	* tests/binary.test (binary-65.*)         formatting floating point
	numbers with the largest and smallest possible significands, and added
	test cases for them.

2005-08-24  Kevin Kenny  <[email protected]>

	[kennykb-numerics-branch]

	* generic/tclExecute.c: Corrected some TRACE bugs that prevented
	compilation with --enable-symbols=all.
	* generic/tclStrToD.c: Revised commentary to prepare for a renaming of
	the file, removed some dead code, and fixed a bug where
	TclBignumToDouble failed on huge negative numbers.
	* tests/binary.test (binary-65.*): Added missing 'ieeeFloatingPoint'
	to large/small significand tests.
	* tests/expr.test (expr-45.*) Added missing braces around expressions.

2005-08-24  Don Porter  <[email protected]>

	[kennykb-numerics-branch]

	* generic/tclBasic.c:	Revised implementation of the ceil(.) and
	* generic/tclInt.h:	floor(.) math functions in light of the
	* generic/tclStrToD.c:	revised comparison operators, so that it is
	always true that ($x <= ceil($x)) and ($x >= floor($x)). The simple
	approach of "convert to double and call ceil() or floor()" could not
	guarantee that.

	* generic/tclExecute.c:	Bug fix: TclBignumToDouble return -Inf when
	appropriate. Removed declarations of removed routines.

	* generic/tclExecute.c: Revised the type promotion rules of the
	comparison operators so that they form proper equivalence classes over
	the set of numeric strings.

2005-08-23  Mo DeJong  <[email protected]>

	* unix/configure.in:
	* win/configure: Regen.
	* win/configure.in: Update minimum autoconf version to 2.59.

2005-08-23  Kevin Kenny  <[email protected]>

	[kennykb-numerics-branch]

	* generic/tclCmdMZ.c (Tcl_StringObjCmd):
	* generic/tclInt.h:
	* generic/tclObj.c (Tcl_GetBooleanFromObj, SetDoubleFromAny,
	Tcl_GetLongFromObj, Tcl_GetWideIntFromObj, Tcl_GetBignumFromObj):
	* generic/tclParseExpr.c (GetLexeme):
	* generic/tclScan.c (Tcl_ScanObjCmd):
	* generic/tclStrToD.c (TclParseNumber):
	* tests/binary.test (binary-62.1-65.7):
	* tests/expr.test (expr-40.1-42.1):
	* scan.test (scan-14.1,14.2):
	Modified Tcl_ParseNumber to accept an argument to force interpretation
	as decimal, and modified [scan] to use it. Corrected a bug where Not a
	Number with hexadecimal information bits returned consistently
	incorrect values. #ifdef-ed out some code that is needed only for IBM
	hexadecimal floating point. Fixed bugs in code to handle the corner
	cases of smallest and largest significands. Added test cases to improve
	test coverage in generic/tclStrToD.c. Added test cases for 0b notation
	(TIP #114). Removed TclStrToD, and the static functions that it calls,
	which are now dead code (TclParseNumber now does all input
	floating-point conversions.)

2005-08-23  Don Porter  <[email protected]>

	[kennykb-numerics-branch]

	* generic/tclStrToD.c:	Bug fix: set shift magnitude properly whether
	we're expanding to mp_int type or not.

	* generic/tclExecute.c:	Bug fix: ACCEPT_NAN under INST_UMINUS.

	* generic/tclStrToD.c:	New macros TIP_114_FORMATS and KILL_OCTAL to
	configure acceptance of 0o and 0b numbers and rejection of "leading
	zero as octal".

	* generic/tclBasic.c:	Re-used the guts of int(.) and wide(.) math
	functions to perform conversions in OldMathFuncProc.

	* generic/tclBasic.c:	Support for ACCEPT_NAN.
	* generic/tclExecute.c:

	* generic/tclInt.decls:	Restored TclExprFloatError to internal stubs
	* generic/tclBasic.c:	table, and moved definition back to
	* generic/tclExecute.c:	tclExecute.c from tclBasic.c to handle #undef
	ACCEPT_NAN.

	* generic/tclIntDecls.h:	make genstubs
	* generic/tclStubInit.c:

	* generic/tclInt.h:	New internal macros TclIsNaN and TclIsInfinite
	* generic/tclBasic.c:	replace the IS_NAN and IS_INF macros scattered
	* generic/tclExecute.c:	here and there.
	* generic/tclObj.c:
	* generic/tclStrToD.c:
	* generic/tclUtil.c:

2005-08-22  Daniel Steffen  <[email protected]>

	* unix/tclConfig.h.in: autoheader-2.59.

2005-08-22  Don Porter  <[email protected]>

	[kennykb-numerics-branch]

	* generic/tclInt.h:	New ACCEPT_NAN macro to mark code that
	* generic/tclCmdAH.c:	supports or disables accepting of the NaN
	* generic/tclExecute.c:	value at various points.
	* generic/tclLink.c:

	* generic/tclStrToD.c:	Bug fix. Parsing of +/- Infinity was reversed.

	* generic/tclTestObj.c:	Disabled unused [testconvertobj] command.

	* generic/tclBasic:	Added [expr {entier(.)}]. Rewrote int(.) and
	wide(.) to use the same guts, accepting all non-Inf doubles as
	arguments.

	* generic/tclInt.h:	New routine TclInitBignumFromDouble.
	* generic/tclStrToD.c:	Modified to return code and write error
	message.

	* generic/tclInt.h:	TCL_WIDE_INT_IS_LONG implies NO_WIDE_TYPE.
	* generic/tclObj.c:	Removed now unnecessary tests of the
	* generic/tclStrToD.c:	TCL_WIDE_INT_IS_LONG definition.

	* generic/tclInt.h:	New internal routine TclSetBignumIntRep
	* generic/tclObj.c:	consolidates packing of bignum value into a
	* generic/tclStrToD.c:	Tcl_Obj within one source code file.

	* tests/expr.test:	Corrected the wideIs64bit constraint.
	* tests/format.test:
	* tests/scan.test:

2005-08-21  Don Porter  <[email protected]>

	[kennykb-numerics-branch]

	* generic/tclInt.h:		Moved TclParseInteger to tclUtil.c and
	* generic/tclParseExpr.c:	made it static.
	* generic/tclUtil.c:

	* generic/tclInt.decls:	Moved TclExprFloatError to tclBasic.c and made
	* generic/tclBasic.c:	it static.
	* generic/tclExecute.c:

	* generitc/tclIntDecls.h:	make genstubs
	* generic/tclStubInit.c:

	* generic/tclExecute.c:	errno, IS_NAN, IS_INF, LLD no longer called in
	this file; dropped/disabled support for them.

	* generic/tclCompExpr.c:	errno no longer used in these files;
	* generic/tclParseExpr.c:	dropped support "hack" for it.

	* generic/tclStrToD.c:	Disabled out of date support "hack" for errno.

	* generic/tclBasic.c:	Eliminated VerifyExprObjType. Initialize errno
	to zero in OldMathFuncProc.

2005-08-19  Don Porter  <[email protected]>

	[kennykb-numerics-branch]

	* generic/tclBasic.c:	Updated OldMathFuncProc and ExprAbsFunc to do
	less invasion into numeric Tcl_Obj internals. Made ExprDoubleFunc,
	ExprIntFunc, ExprWideFunc, and ExprRoundFunc bignum-aware. Revised
	ExprSrandFunc error message.

	* generic/tclProc.c:	Wrapped a few tclWideIntType uses in
	* generic/tclCmdMZ.c:	#ifndef NO_WIDE_TYPE.

	* generic/tclInt.h:	#define'd NO_WIDE_TYPE.

	* generic/tclVar.c:	Replaced TclPtrIncrVar and TclPtrIncrWideVar
	* generic/tclInt.h:	with TclPtrIncrObjVar and replaced TclIncrVar2
	* generic/tclInt.decls:	and TclIncrWideVar2 with TclIncrObjVar2. New
	routines call on TclIncrObj to do the work.

	* generic/tclIntDecls.h:	make genstubs
	* generic/tclStubInit.c:

	* generic/tclCmdIL.c:	Rework Tcl_IncrObjCmd and the INST_*INCR*
	* generic/tclExecute.c:	opcodes to use the new routines.

2005-08-18  Don Porter  <[email protected]>

	[kennykb-numerics-branch]

	* generic/tclExecute.c:		Fixed string rep invalidation bug in
	* tests/dict.test (dict-11.17):	INST_DICT_INCR_IMM rewrite.

	* generic/tclDictObj.c:	DictIncrCmd rewrite to use TclIncrObj.

	* generic/tclInt.h:	TclIncrObj static -> internal
	* generic/tclExecute.c:

2005-08-17  George Peter Staplin  <[email protected]>

	* generic/tclBasic.c: eliminate a namespace clash caused by
	BuiltinFuncTable not being static.

	* generic/tclObj.c: fix a namespace clash caused by a missing
	static for pendingObjData.

2005-08-17  Kevin Kenny  <[email protected]>

	* generic/tclEvent.c (Tcl_Finalize): Removed a copy-and-paste accident
	that caused a (mostly harmless) double finalize of the load and
	filesystem subsystems.
	* tests/clock.test: Eliminated the bad test clock-43.1, and split
	clock-50.1 into two tests, with a more permissive check on the error
	message for an out-of-range value.

2005-08-17  Kevin Kenny  <[email protected]>

	[kennykb-numerics-branch]

	* generic/tclBasic.c (Tcl_Expr{Long,Double}{,Obj}): Updated to
	* generic/tclTest.c:                                deal with
	* tests/expr-old.test:                              bignums (well,
	* tests/expr.test:                                  mostly).
	Added a missing "errno=0;" in ExprUnaryFunc so that spurious error
	returns aren't detected.
	Added test cases for Tcl_Expr* and Tcl_Expr*Obj because there was very
	poor test coverage in those areas.
	* generic/tclParseExpr.c: Reworked parsing of numbers to call
	TclParseNumber rather than trying to do things locally.
	* generic/tclStrToD.c: Corrected a comment. Changed so that *endPtrPtr
	does not include any trailing whitespace.

2005-08-17  Don Porter  <[email protected]>

	[kennykb-numerics-branch]

	* generic/tclExecute.c: New routine TclIncrObj to centralize the
	increment operation needed in many places. Updated INST_DICT_INCR_IMM
	to make use of it.

2005-08-16  Don Porter  <[email protected]>

	[kennykb-numerics-branch]

	* generic/tclExecute.c:	Made bit shifting opcodes and INST_MOD
	bignum-aware.

	* tests/scan.test:	Making << bignum-aware means that repeated
	* tests/string.test:	left shifting cannot turn a positive into a
	negative. Revised [int_range] and [largest_int] utility commands in the
	test suite that relied on that happening. Without revision they became
	infinite loops.

	* generic/tclExecute.c:	Made binary bitwise opcodes bignum-aware.

	* generic/tclTomMath.h:	Added mp_or and mp_xor to routines from
	* unix/Makefile.in:	libtommath used by Tcl.
	* win/Makefile.in:
	* win/makefile.vc:

2005-08-15  Don Porter  <[email protected]>

	[kennykb-numerics-branch]	Updates from HEAD.
	* generic/tclExecute.c:	More revisions to IllegalExprOperandType.
	Merged INST_BITNOT with INST_UMINUS and make it bignum-aware according
	to the rule: ~a = -a - 1. Disabled unused code and noted more TODOs.

	* generic/tclInt.decls: Disabled TclLooksLikeInt() and all callers.
	* generic/tclUtil.c:
	* generic/tclCompCmds.c:

	* generic/tclBasic.c:	Rewrite of VerifyExprObjType().

	* generic/tclIntDecls.h:	make genstubs
	* generic/tclStubInit.c:

	* generic/tclExecute.c: Updated execution of comparison bytecodes to
	be bignum-aware, routing string compares through INST_STR_CMP.

2005-08-14  Don Porter  <[email protected]>

	[kennykb-numerics-branch]

	* generic/tclExecute.c: Updated execution of arithmetic bytecodes to
	be bignum-aware, and to allow calculations on NaN to produce a NaN
	result. INST_UMINUS updated to call mp_neg.

	* generic/tclTomMath.h:	Added mp_and, mp_expt_d, and mp_neg to
	* unix/Makefile.in:	routines from libtommath used by Tcl.
	* win/Makefile.in:
	* win/makefile.vc:

2005-08-13  Don Porter  <[email protected]>

	[kennykb-numerics-branch]

	* generic/tclObj.c:	Extended Bignum auto-narrowing to auto-narrow
	to tclWideIntType when appropriate; this helps keep things working as
	the bytecode execution code is migrated to supporting bignums.

	* generic/tclExecute.c:	Major overhaul of IllegalExprOperandType.
	Changed several TclNewFooObj() calls to more logically appropriate
	ones. Added several TODO comments marking opportunies for future work.
	Made more use of the eePtr->constants. Made INST_UMINUS bignum aware.

2005-08-12  Don Porter  <[email protected]>

	[kennykb-numerics-branch]

	* generic/tclExecute.c: Simplify doCondJump. Use eePtr->constants as
	result of INST_DICT_NEXT, INST_LAND, and INST_LOR. Separate INST_LNOT
	from INST_UMINUS and simplify.

2005-08-12  Kevin Kenny  <[email protected]>

	* generic/tclClock.c (MktimeObjCmd):
	* library/clock.tcl (GetSystemTimeZone, LoadZoneinfoFile)
	(ReadZoneinfoFile):
	* tests/clock.test (clock-50.1):
	Added functionality to read /etc/localtime if it exists, so that Tcl's
	time can track system time on Linux even if TZ is not set. Changed
	::tcl::clock::Mktime to check for failure, and added a test case that
	mimics failure but is really success.

2005-08-11  Don Porter  <[email protected]>

	[kennykb-numerics-branch]

	* generic/tclExecute.c: Rewrite of INST_LAND/INST_LOR to take advantage
	of loss of "pure double" issues. Merged INST_UPLUS with
	INST_TRY_CVT_TO_NUMERIC and updated to use improved rules for impure
	"double"s as well.

	* generic/tclStrToD.c:	Restored conditional generation of
	tclWideIntType values by TclParseNumber so that Tcl's not completely
	broken while bignum calculation support is incomplete. The NO_WIDE_TYPE
	macro can be used to disable this.

	* generic/tclBasic.c (ExprAbsFunc): First pass making [expr abs(.)]
	bignum-aware.

2005-08-11  Kevin Kenny  <[email protected]>

	* generic/tclEvent.c:         Eliminated the USE_THREAD_STORAGE option
	* generic/tclInt.h:           (which is on in every build generated by
	* generic/tclThread.c:        by the standard configurator).
	* generic/tclThreadStorage.c: Eliminated the code for thread specific
	* unix/configure:             data without USE_THREAD_STORAGE and
	* unix/tcl.m4:                radically refactored the code for
	* unix/tclConfig.h.in:        USE_THREAD_STORAGE so that it has fewer
	* unix/tclUnixThrd.c:         dependencies on the order of
	* win/configure:              finalization. (Also, made 'make
	* win/Makefile.in:            distclean' on Windows clean just a little
	* win/rules.vc:               bit cleaner.)
	* win/tcl.m4:
	* win/tclWinThrd.c:

2005-08-10  Don Porter  <[email protected]>

	[kennykb-numerics-branch]

	* generic/tclTomMath.h:	Added mp_shrink, mp_to_unsigned_bin,
	* unix/Makefile.in:	mp_to_unsigned_bin_n, and mp_unsigned_bin_size
	* win/Makefile.in:	to routines from libtommath used by Tcl.
	* win/makefile.vc:

	* generic/tommath.h:	make gentommath_h

	* generic/tclObj.c:	Substantial rewrite to make all number parsing
	flow through TclParseNumber(). Also established the NO_WIDE_TYPE and
	BIGNUM_AUTO_NARROW #ifdef's to help track the assumptions of different
	portions of the code.

	* generic/tclInt.h:	Added NO_WIDE_TYPE #ifdefs

2005-08-10  Kevin Kenny  <[email protected]>

	* generic/tclEvent.c (Tcl_Finalize): Pushed Tcl_FinalizeLoad and
	Tcl_ResetFilesystem down after Tcl_FinalizeThreadAlloc because we can't
	unload DLL's until after their TSD keys are finalized. (Note that we'll
	still see aborts if an unloaded DLL has TSD - that still needs to be
	fixed.

	* tests/compExpr-old.test (compExpr-3.8): Made tests conditional on
	* tests/expr.test (expr-3.8):             'unix' because they get
	stack overflows on Win32 threaded builds,

2005-08-09  Vince Darley  <[email protected]>

	* generic/tclPathObj.c: fix to [file rootname] bug in optimized code
	path reported on comp.lang.tcl.

2005-08-08  Don Porter  <[email protected]>

	[kennykb-numerics-branch]

	* generic/tclObj.c:	Replaced some goto's with loops and started
	use of BIGNUM_AUTO_NARROW and NO_WIDE_TYPE.

2005-08-06  Donal K. Fellows  <[email protected]>

	* generic/tclThreadStorage.c: Stop exposing the guts of the thread
	storage system through the internal stubs table. Client code should
	always use the standard API.

2005-08-05  Don Porter  <[email protected]>

	[kennykb-numerics-branch]
	* generic/tclObj.c:	Rewrote Tcl_GetDoubleFromObj().

2005-08-05  Donal K. Fellows  <[email protected]>

	* unix/tclUnixInit.c (localeTable): Solaris uses a non-standard name
	for the cp1251 charset. Thanks to Victor Wagner for reporting this.
	[Bug 1252475]

2005-08-05  Kevin Kenny  <[email protected]>

	* win/makefile.vc: Removed unused file ldAout.tcl.
	* win/makefile.bc: [Bug 1244361]

	* tests/binary.test: Cleaned up testing for scanning of NaN. [Bug
	1246264]

	* generic/tclBasic.c (ExprAbsFunc): Added code to handle the corner
	* tests/expr.test (expr-38.1):      case of applying 'abs' to the
	smallest 32-bit integer. [Bug 1241572]

2005-08-04  Andreas Kupries  <[email protected]>

	* generic/tclIO.c (CloseChannel): Fixed comment nit, added apparently
	missing word to complete a sentence.

	* generic/tclObj.c (Tcl_DbDecrRefCount): Fixed whitespace nit in panic
	message.

2005-08-04  Don Porter  <[email protected]>

	[kennykb-numerics-branch] Updated from HEAD

	* generic/tclObj.c:	Rewrote Tcl_GetBooleanFromObj() and supporting
	routines to make use of TclParseNumber. This reduces the potential
	number of times a string value must be scanned.

	* generic/tclObj.c:	Simplified routines that manage the typeTable.
	Deleted the UpdateStringOfBoolean() routine, that can never be called.

2005-08-03  Don Porter  <[email protected]>

	* generic/tclCompExpr.c:	Untangled some dependencies in the
	* generic/tclEvent.c:		order of finalization routines.
	* generic/tclInt.h:		[Bug 1251399]
	* generic/tclObj.c:

2005-08-02  Don Porter	<[email protected]>

	[kennykb-numerics-branch] Updated from HEAD

2005-07-30  Daniel Steffen  <[email protected]>

	* unix/tclLoadDyld.c (TclpDlopen, TclpLoadMemory): workarounds for
	bugs/changes in behaviour in Mac OS X 10.4 Tiger.

2005-07-29  Donal K. Fellows  <[email protected]>

	* generic/tclCmdIL.c (InfoGlobalsCmd): Even in high-speed mode, still
	have to take care with non-existant variables. [Bug 1247135]

2005-07-28  Mo DeJong  <[email protected]>

	* win/README: Update link to msys_mingw8.zip.

2005-07-28  Don Porter	<[email protected]>

	* tests/compExpr-old.test:	Still more conversion of "nonPortable"
	* tests/error.test:		tests into tests with constraints that
	* tests/expr-old.test:		describe the limits of their
	* tests/expr.test:		portability. Also more consolidation
	* tests/fileName.test:		of constraint synonyms.
	* tests/format.test:		wideis64bit, 64bitInts => wideIs64bit
	* tests/get.test:		wideIntegerUnparsed => wideIs32bit
	* tests/load.test:		wideIntExpressions => wideBiggerThanInt
	* tests/obj.test:
	* tests/parseExpr.test:		Dropped "roundOffBug" constraint that
	* tests/string.test:		protected from buggy sprintf.

2005-07-28  Donal K. Fellows  <[email protected]>

	* generic/tclPipe.c (TclCreatePipeline): Arrange for POSIX systems to
	* unix/tclUnixPipe.c (TclpOpenFile):	 use the O_APPEND flag for
	* tests/exec.test (exec-19.1):		 files opened in a pipeline
	like ">>this". Note that Windows cannot support such access; there is
	no equivalent flag on the handle that can be set at the kernel-call
	level. The test is unix-specific in every way. [Bug 1245953]

2005-07-27  Don Porter	<[email protected]>

	* generic/tclUtil.c:	Converted the $::tcl_precision value to be kept
	per-thread to prevent different threads from stomping on each others'
	formatting prescriptions.

	***POTENTIAL INCOMPATIBILITY*** Multi-threaded programs that set the
	value of ::tcl_precision will now have to set it in each thread.

	* tests/expr.test:	Consolidated equivalent constraints into
	* tests/fileName.test:	single definitions and (more precise) names:
	* tests/get.test:	longis32bit, 32bit, !intsAre64bit => longIs32bit
	* tests/listObj.test:	empty => emptyTest; winOnly => win
	* tests/obj.test:	intsAre64bit => longIs64bit
	Also updated some "nonPortable" tests to use constraints that mark
	precisely what about them isn't portable, so the tests can run where
	they work.

	* library/init.tcl ([unknown]): Corrected return code handling in the
	portions of [unknown] that expand incomplete commands during
	interactive operations. [Bug 1214462].

2005-07-26  Mo DeJong  <[email protected]>

	* unix/configure: Regen.
	* unix/configure.in: Check for a $prefix/share directory and add it the
	the package if found. This will check for Tcl packages in
	/usr/local/share when Tcl is configured with the default dist install.
	[Patch 1231015]

2005-07-26  Don Porter	<[email protected]>

	* generic/tclBasic.c (Tcl_CallWhenDeleted):	Converted to use
	per-thread counter, rather than a process global one that required
	mutex protection. [RFE 1077194]

	* generic/tclNamesp.c (TclTeardownNamespace):	Re-ordering so that
	* tests/trace.test (trace-34.4):	command delete traces fire
	while the command still exists. [Bug 1047286]

2005-07-24  Mo DeJong  <[email protected]>

	* unix/configure: Regen.
	* unix/tcl.m4 (SC_PROG_TCLSH, SC_BUILD_TCLSH):
	* win/configure: Regen.
	* win/tcl.m4 (SC_PROG_TCLSH, SC_BUILD_TCLSH): Split confused search
	for tclsh on PATH and build and install locations into two macros.
	SC_PROG_TCLSH searches just the PATH. SC_BUILD_TCLSH determines the
	name of the tclsh executable in the Tcl build directory. [Bug 1160114]
	[Patch 1244153]

2005-07-23  Don Porter	<[email protected]>

	* library/auto.tcl:	Updates to the Tcl script library to make use
	* library/history.tcl:	of Tcl 8.4 features. Forward port of
	* library/init.tcl:	appropriate portions of [Patch 1237755].
	* library/package.tcl:
	* library/safe.tcl:
	* library/word.tcl:

2005-07-23  Mo DeJong  <[email protected]>

	* tests/string.test: Add string is tests for functionality that was not
	tested.
	* win/README: Update msys + mingw URL. Remove old Cygwin + mingw info.

2005-07-23  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c (INST_DICT_*): stop 2 compiler warnings for
	uninitialised variables.

2005-07-23  Donal K. Fellows  <[email protected]>

	* generic/tclExecute.c (TEBC:INST_DICT_INCR_IMM): Fix the incrementor
	to work correctly with wide values.

2005-07-21  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmds.c (TclCompileDictCmd): First run at a compiler
	* generic/tclExecute.c (TclExecuteByteCode): for dictionaries. Also
	added an instruction to support 'finally'-like clauses, exposed more of
	the dict guts to the rest of the core, and defined a few tests to
	exercise more obscure parts of the compiler's operation that were bugs
	during development.

2005-07-21  Kevin B. Kenny  <[email protected]>

	* library/ldAout.tcl (***REMOVED***):	Removed support for ancient
	* unix/configure:			BSD's, IRIX 4, RISCos and
	* unix/Makefile.in:			Ultrix. Removed two files whose
	* unix/tcl.m4:				code is used only on those
	* unix/tclLoadAout.c (***REMOVED***):	antique platforms.

	***POTENTIAL INCOMPATIBILITY*** if anyone actually uses those
	platforms; it is to be noted though, that an error in the installer has
	actually not caused a necessary file to be installed on those platforms
	in several releases, and nobody's complained.

2005-07-16  Kevin B. Kenny  <[email protected]>

	* generic/tclStrToD.c (RefineResult):  Plugged a stupid memory leak in
	RefineResult (called from Tcl_StrToD). [Tk Bug 1227781]

2005-07-15  Kevin B. Kenny  <[email protected]>

	* generic/tclClock.c (TclClockLocaltimeObjCmd,ThreadSafeLocalTime):
	* library/clock.tcl (GuessWindowsTimeZone, ClearCaches):
	* tests/clock.test (clock-49.1, clock-49.2):
	Handle correctly the case where localtime() returns NULL to report a
	conversion error. Also handle the case where the Windows registry
	contains timezone values that can be mapped to a tzdata file name but
	the corresponding file does not exist or is corrupted, by falling back
	on a Posix timezone string instead; this last case will avoid calls to
	localtime() in starpacks on Windows. [Bug 1237907]

2005-07-14  Donal K. Fellows  <[email protected]>

	* generic/tclCompile.c: Update to follow style guidelines.
	(TclPrintInstruction): Reorganize to do better printing out of bytecode
	with far fewer "special hacks" for particular opcodes.
	* generic/tclCompile.h: Requires two new opcode types.

2005-07-13  Don Porter	<[email protected]>

	* unix/tclUnixSock.c:	Use a ProcessGlobalValue to store the value
	* win/tclWinSock.c:	returned by Tcl_GetHostName() ([info
	hostname]). Also re-order initialization of the value on Windows to
	favor GetComputerName() over gethostname() as a source of the
	information.

2005-07-12  Kevin Kenny  <[email protected]>

	[kennykb-numerics-branch] Updated from HEAD

	* generic/tclCmdMZ.c (Tcl_StringObjCmd):
	* generic/tclInt.h:
	* generic/tclObj.c (Tcl_GetDoubleFromObj, SetDoubleFromAny)
	(Tcl_GetIntFromObj, SetIntOrWideFromAny):
	* generic/tclStrToD.c (TclParseNumber, etc.):
	* tclTomMathInterface.c (TclBNInitBignumFromWideUInt):
	* tests/obj.test (obj-1.1, obj-2.2, obj-3.1, obj-3.2):

	Initial attempt at an implementation of TIP #249, comprising a unified
	parser and modifications to the Tcl_Get*FromObj routines to use it.
	Further integration of the parser is necessary and planned.

2005-07-12  Donal K. Fellows  <[email protected]>

	* doc/lsearch.n: Clarify documentation of -exact option; wording was
	open to misinterpretation by non-English speakers.

2005-07-11  Donal K. Fellows  <[email protected]>

	* generic/tclExecute.c: General style cleanup.

2005-07-08  Mo DeJong  <[email protected]>

	* generic/tclExecute.c (TclExecuteByteCode): Reimplement long and wide
	type integer division and modulus operations so that the smallest and
	largest integer values are handled properly. The divide operation is
	more efficient since it no longer does a modulus or negation and only
	checks for a remainder when the quotient will be a negative number.
	The modulus operation is now a bit more complex because of a number of
	special cases dealing with the smallest and largest integers.
	* tests/expr.test: Add test cases for division and modulus operations
	on the smallest and largest integer values for 32 and 64 bit types.
	[Patch 1230205]

2005-07-06  Don Porter	<[email protected]>

	* generic/tclLink.c:	Simplified LinkTraceProc [Bug 1208108].

2005-07-05  Don Porter	<[email protected]>

	* unix/Makefile.in:	Purged use of TCLTESTARGS [RFE 1161550].

	* generic/tclUtil.c:	Converted TclFormatInt() into a macro.
	* generic/tclInt.decls:	[RFE 1194015]
	* generic/tclInt.h:

	* generic/tclIntDecls.h:	make genstubs
	* generic/tclStubInit.c:

	* generic/tclNamesp.c:	Allow for [namespace import] of a command
	* tests/namespace.test:	over a previous [namespace import] of itself
	without throwing an error. [RFE 1230597]

2005-07-04  Donal K. Fellows  <[email protected]>

	* generic/tclDictObj.c (DictForCmd, DictFilterCmd): Interlocking of
	dictionary internal representations is now done in the core of the dict
	iterator. Purge the last attempts at doing it at a higher level as they
	didn't work and were no longer needed.

2005-07-01  Zoran Vasiljevic  <[email protected]>

	* unix/tclUnixNotfy.c: protect against spurious wake-ups while waiting
	on the condition variable when tearing down the notifier thread [Bug
	1222872].

2005-06-28  Mo DeJong  <[email protected]>

	* generic/tclExecute.c (TclExecuteByteCode): When parsing an integer
	operand for a unary minus expression operator, check for a wide integer
	that is actually LONG_MIN. If found, convert back to a long int type.
	* tests/expr.test: Add constraint for 32bit long int type and 64bit
	wide int type. Add tests that parse the smallest/largest long int and
	wide int values.

2005-06-24  Kevin Kenny  <[email protected]>

	* generic/tclEvent.c (Tcl_Finalize):
	* generic/tclInt.h:
	* generic/tclPreserve.c (TclFinalizePreserve): Changed the finalization
	logic so that Tcl_Preserve finalizes after exit handlers run; a lot of
	code called from Tk's exit handlers presumes that Tcl_Preserve will
	still work even from an exit handler.

2005-06-24  Don Porter	<[email protected]>

	* library/auto.tcl:	Make file safe to re-[source] without
	destroying registered auto_mkindex_parser hooks.

2005-06-23  Kevin Kenny  <[email protected]>

	* win/tclWinChan.c: More rewriting of __asm__ blocks that implement
	* win/tclWinFCmd.c: SEH in GCC, because mingw's gcc 3.4.2 is not as
	forgiving of violations committed by the old code and caused panics.
	[Bug 1225957]

2005-06-23  Daniel Steffen  <[email protected]>

	* tools/tcltk-man2html.tcl: fixed useversion glob pattern to accept
	multi-digit patchlevels.

2005-06-22  Don Porter	<[email protected]>

	* win/tclWinFile.c: Potential buffer overflow. [Bug 1225571] Thanks to
	Pat Thoyts for discovery and fix.

2005-06-22  Kevin Kenny  <[email protected]>

	* generic/tclInt.h:			    Changed the finalization
	* generic/tclEvent.c (Tcl_Finalize):	    logic to defer the
	* generic/tclIO.c (TclFinalizeIOSubsystem): shutdown of the pipe
	* unix/tclUnixPipe.c (TclFinalizePipes):    management until after all
	* win/tclWinPipe.c (TclFinalizePipes):	    channels have been closed,
	in order to avoid a situation where the Windows PipeCloseProc2 would
	re-establish the exit handler after exit handlers had already run,
	corrupting the heap. [Bug 1225727] Also corrected a potential read of
	uninitialized memory in PipeClose2Proc [Bug 1225044]

2005-06-21  Andreas Kupries  <[email protected]>

	* generic/tclInt.h: Followup to change made on 2005-06-18 by Daniel
	Steffen. There are compilers (*) who error out on the redefinition of
	WORDS_BIGENDIAN. We have to undef the previous definition (on the
	command line) first to make this acceptable. (*): AIX native.

2005-06-21  Kevin B. Kenny  <[email protected]>

	* generic/tclFileName.c: Changed [file split] and [file join] to treat
	Windows drive letters similarly to ~ syntax and make sure that they
	appear with "./" in front when they are in intermediate components of
	the path. [Bug 1194458]
	* tests/fileName.test: Added test for the above bug.

2005-06-21  Don Porter	<[email protected]>

	* generic/tclBasic.c:	Added missing walk of the list of active
	* generic/tclTrace.c:	traces to cleanup references to traces being
	* generic/tclInt.h:	deleted. [Bug 1201035] Made the walk of the
	* tests/trace.test (trace-34.*): active trace list aware of the
	direction of trace scanning, so the proper correction can be made.
	[Bug 1224585]

2005-06-21  Donal K. Fellows  <[email protected]>

	* unix/tcl.m4 (SC_ENABLE_SYMBOLS): Only enable the 'compile' special
	debugging feature when requested in configure.in; removes irrelevant
	junk from the configure files of extensions that use Tcl's tcl.m4.

2005-06-20  Donal K. Fellows  <[email protected]>

	* generic/tclCompile.h (INST_PUSH_RETURN_OPTIONS): New opcode to allow
	* generic/tclCompCmds.c (TclCompileCatchCmd):	   compilation of
	* generic/tclCompile.c:				   TIP#90 catch [Bug
	* generic/tclExecute.c (TclExecuteByteCode):	   1219112]

	* generic/tclCompCmds.c (TclCompileSwitchCmd): Ensure we spill to the
	command form in all cases where it generates an error.

2005-06-20  Mo DeJong  <[email protected]>

	* generic/tclCmdMZ.c (Tcl_SwitchObjCmd): Generate an error if a mode
	argument like -exact is passed more than once to the switch command.
	The previous implementation silently accepted invalid switch
	invocations like [switch -exact -glob $str ...].
	* tests/for.test: Check some error cases when invoking continue and
	break inside a for loop next script.
	* tests/switch.test: Add checks for shortened version of a mode
	argument like -exact. Add test for more than one mode argument. Add
	test for odd case of passing a variable as a body script.

2005-06-18  Daniel Steffen  <[email protected]>

	* generic/tclInt.h: ensure WORDS_BIGENDIAN is defined correctly with
	fat compiles on Darwin (i.e. ppc and i386 at the same time), the
	configure AC_C_BIGENDIAN check is not sufficient in this case because a
	single run of the compiler builds for two architectures with different
	endianness.

	* unix/tcl.m4 (Darwin): add -headerpad_max_install_names to LDFLAGS to
	ensure we can always relocate binaries with install_name_tool.

	* unix/configure: autoconf-2.59

2005-06-18  Donal K. Fellows  <[email protected]>

	* generic/tclCmdAH.c (Tcl_FormatObjCmd): Fix for [Bug 1154163]; only
	* tests/format.test: insert 'l' modifier when it is needed.

2005-06-17  Donal K. Fellows  <[email protected]>

	* generic/tclTimer.c (AfterDelay): Split out the code to manage
	synchronous-delay [after] commands.
	* tests/interp.test (interp-34.10): Time limits and synch-delay [after]
	did not mix well... [Bug 1221395]

2005-06-14  Donal K. Fellows  <[email protected]>

	* generic/tclBasic.c (Tcl_DeleteCommandFromToken): Only delete a
	* tests/namespace.test (namespace-49.2): command from the hashtable on
	reentrant processing if it has not been already deleted; at least three
	deletes of the same command are possible. [Bug 1220058]
	* generic/tclTrace.c (TraceCommandProc): Remove bogus error message
	creation when traces trigger in situations where the command has
	already been deleted.

2005-06-13  Vince Darley  <[email protected]>

	* generic/tclFCmd.c: correct fix to file mkdir 2005-06-09 [Bug 1219176]

2005-06-12  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmds.c: Factor out some common idioms into named forms
	for greater clarity.

2005-06-10  Donal K. Fellows  <[email protected]>

	* doc/chan.n: Fold in the descriptive parts of the documentation for
	all the commands that [chan] builds on top of.

2005-06-09  Vince Darley  <[email protected]>

	* generic/tclFCmd.c: fix to race condition in file mkdir [Bug 1217375]
	* doc/glob.n: improve glob documentation [Bug 1190891]

2005-06-09  Donal K. Fellows  <[email protected]>

	* doc/expr.n, doc/mathfunc.n: Fix minor typos [Bug 1211078] and add
	mention of distinctly-relevant [namespace path] subcommand.

2005-06-07  Don Porter	<[email protected]>

	* generic/tclInt.h:		Reduced the Tcl_ObjTypes "index",
	* generic/tclIndexObj.c:	"ensembleCmd", "localVarName", and
	* generic/tclNamesp.c:		"levelReference" to file static scope.
	* generic/tclProc.c:
	* generic/tclVar.c:

	* generic/tclObj.c:	Restored registration of the "procbody"
	Tcl_ObjType, as required by the tclcompiler application.

	* generic/tclDecls.h:		make genstubs
	* generic/tclStubInit.c:

2005-06-07  Donal K. Fellows  <[email protected]>

	* generic/tclIO.c (Tcl_ChannelTruncateProc): Stop proliferation of
	* generic/tcl.h:			     channel type versions
	* doc/CrtChannel.3:			     following advice from AKu

	Bump patchlevel to a4 to distinguish from a3 release.

	* generic/tclInt.h (INTERP_TRACE_IN_PROGRESS): Add flag so the error
	* generic/tclIndexObj.c (Tcl_WrongNumArgs):    messages from ensembles
	* generic/tclIOCmd.c (Tcl_ReadObjCmd):	       can be correct.

	TIP#208 IMPLEMENTATION

	* library/init.tcl: Create the chan ensemble.
	* tests/chan.test: Rudimentary test suite.
	* doc/chan.n: General documentation.

	TRUNCATION API (part of TIP#208)
	* generic/tcl.h, generic/tcl.decls: Declaration of the API.
	* doc/CrtChannel.3, doc/OpenFileChnl.3: Documentation of the API.
	* generic/tclBasic.c (Tcl_CreateInterp): Create the mapping into Tcl.
	* generic/tclIOCmd.c (TclChanTruncateObjCmd): Implementation of
	Tcl-level truncation API.
	* generic/tclIO.c (Tcl_TruncateChannel): Generic C-level truncation API
	implementation.
	* unix/tclUnixChan.c (FileTruncateProc): Basic implementation of
	truncating driver.

	* win/tclWinChan.c (FileTruncateProc): Added implementation of file
	truncation for Windows.
	* tests/chan.test (chan-15.2): Added real test of truncation.

2005-06-06  Kevin B. Kenny  <[email protected]>

	* win/tclWin32Dll.c: Corrected another buglet in the assembly code for
	stack probing on Win32/gcc. [Bug 1213678]
	* generic/tclObj,c: Added missing 'static' on definition of
	UpdateStringOfBignum, and removed a 'switch' on a 'long long' operand
	(which HP-UX native 'cc' seems unable to handle). [Bug 1215775]

2005-06-04  Jeff Hobbs	<[email protected]>

	*** 8.5a3 TAGGED FOR RELEASE ***

	* unix/Makefile.in (dist): add libtommath

2005-06-03  Donal K. Fellows  <[email protected]>

	* library/parray.tcl (parray): Only generate the sorted list of element
	names once. Thanks to Andreas Leitgeb for spotting this.

2005-06-03  Daniel Steffen  <[email protected]>

	* macosx/Makefile: fixed 'embedded' target.

2005-06-02  Jeff Hobbs	<[email protected]>

	* unix/Makefile.in (html): add BUILD_HTML_FLAGS optional var
	* tools/tcltk-man2html.tcl: add a --useversion to prevent confusion
	when multiple Tcl source dirs exist.

2005-06-01  Don Porter	<[email protected]>

	* generic/tclBasic.c:	For compatibility with earlier Tcl releases,
	* generic/tclResult.c:	when a command procedure simply does a
	* generic/tclTest.c:	"return TCL_RETURN;" we must interpret that
	* tests/result.test:	the same as
	"return Tcl_SetReturnOptions(interp, Tcl_NewObj());"  [Bug 1209759].

2005-06-01  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmds.c (TclCompileSwitchCmd): Allow compilation of
	-nocase -glob [switch]es (only one we know how to compile).

	TIP#241 IMPLEMENTATION from Joe Mistachkin

	* generic/tclCmdIL.c (Tcl_LsearchObjCmd, Tcl_LsortObjCmd):
	* generic/tclCmdMZ.c (Tcl_SwitchObjCmd): Implementation of -nocase
	option for [lsearch], [lsort] and [switch] commands.
	* win/tclWinPort.h: Win uses nonstandard function names...
	* tests/cmdIL.test, tests/lsearch.test, tests/switch.test: Tests
	* doc/lsearch.n, doc/lsort.n, doc/switch.n: Docs

	* generic/tclCompCmds.c (TclCompileLindexCmd): Compile the most common
	case of [lindex] more efficiently.

	* unix/tclUnixNotfy.c (Tcl_FinalizeNotifier): Pass the correct number
	of arguments to Tcl_JoinThread.

2005-05-31  Donal K. Fellows  <[email protected]>

	* unix/configure.in, unix/tcl.m4: Standardize generation of help
	messages to always use AC_HELP_STRING and always (except for --with-tcl
	and --with-tk, where the default is complex) say what the default is.

2005-05-31  Zoran Vasiljevic  <[email protected]>

	* unix/tclUnixNotfy.c: the notifier thread is now created as joinable
	thread and it is properly joined in Tcl_FinalizeNotifier. This is an
	attempt to fix the [Bug 1082283].

2005-05-30  Zoran Vasiljevic  <[email protected]>

	* win/tclWinThrd.c: Fixed [Bug 1204064]

2005-05-30  Donal K. Fellows  <[email protected]>

	TIP #229 IMPLEMENTATION

	* generic/tclNamesp.c (Tcl_FindCommand, TclResetShadowedCmdRefs)
	(NamespacePathCmd, SetNsPath, UnlinkNsPath, TclInvalidateNsPath):
	Implementation of the [namespace path] command and the command name
	resolution engine.
	* doc/info.n, doc/namespace.n: Doc updates.
	* tests/namespace.test (namespace-51.*): Test updates.
	* generic/tclResolve.c (BumpCmdRefEpochs, Tcl_SetNamespaceResolvers):
	* generic/tclBasic.c (Tcl_CreateCommand, Tcl_CreateObjCommand): Ensure
	that people don't see stale paths.
	* generic/tclInt.h (Namespace, NamespacePathEntry): Structure defs.
	* generic/tclCmdIL.c (InfoCommandsCmd): Updates to [info commands].

2005-05-26  Daniel Steffen  <[email protected]>

	* macosx/Makefile: moved & corrected EMBEDDED_BUILD check.

	* unix/configure.in: corrected framework finalization to softlink stub
	library to Versions/8.x subdir instead of Versions/Current.
	* unix/configure: autoconf-2.59

2005-05-25  Jeff Hobbs	<[email protected]>

	* generic/tclCmdMZ.c (Tcl_TimeObjCmd): add necessary cast

2005-05-25  Don Porter	<[email protected]>

	TIP#182 IMPLEMENTATION	[Patch 1165062]

	* doc/mathfunc.n:	New built-in math function bool().
	* generic/tclBasic.c:
	* tests/expr.test:
	* tests/info.test:

2005-05-24  Don Porter	<[email protected]>

	* library/init.tcl:	Updated [unknown] to be sure the [return]
	* tests/init.test:	options from an auto-loaded command are seen
	correctly by the caller.

2005-05-24  Daniel Steffen  <[email protected]>

	* tests/env.test: added DYLD_FRAMEWORK_PATH to the list of env vars
	that need to be handled specially.

	* macosx/Makefile:
	* macosx/README:
	* macosx/Tcl-Info.plist.in (new file):
	* unix/Makefile.in:
	* unix/configure.in:
	* unix/tcl.m4:
	* unix/tclUnixInit.c: moved all Darwin framework build support from
	macosx/Makefile into the standard unix configure/make buildsystem, the
	macosx/Makefile is no longer required to build Tcl.framework (but its
	functionality is still available for backwards compatibility).
	* unix/configure: autoconf-2.59

	* generic/tclIOUtil.c (TclLoadFile):
	* generic/tclInt.h:
	* unix/tcl.m4:
	* unix/tclLoadDyld.c: added support for [load]ing .bundle binaries in
	addition to .dylib's: .bundle's can be [unload]ed (unlike .dylib's),
	and can be [load]ed from memory, e.g. directly from VFS without needing
	to be written out to a temporary location first. [Bug 1202209]
	* unix/configure: autoconf-2.59
	* unix/tclConfig.h.in: autoheader-2.59

	* generic/tclCmdMZ.c (Tcl_TimeObjCmd): change [time] called with a
	count > 1 to return a string with a float value instead of a rounded
	off integer. [Bug 1202178]

	* doc/expr.n:
	* doc/string.n: fixed roff syntax complaints from 'make html'.

2005-05-20  Don Porter	<[email protected]>

	* generic/tclParseExpr.c:	Corrected parser to recognize all
	boolean literals accepted by Tcl_GetBoolean, including prefixes like
	"y" and "f", and to allow "eq" and "ne" as function names in the proper
	context. [Bug 1201589].

2005-05-19  Donal K. Fellows  <[email protected]>

	* generic/tclBasic.c (TclEvalObjvInternal): Rewrite for greater
	clarity; although 'goto' is Bad, the contortions you have to go through
	to avoid it can be worse...

2005-05-19  Daniel Steffen  <[email protected]>

	* macosx/tclMacOSXNotify.c (Tcl_InitNotifier): fixed crashing CFRelease
	of runLoopSource in Tcl_InitNotifier (reported by Zoran):
	CFRunLoopAddSource doesn't CFRetain, so can only CFRelease the
	runLoopSource in Tcl_FinalizeNotifier.

2005-05-18  Don Porter	<[email protected]>

	* generic/tclBasic.c (Tcl_ExprBoolean):	Rewrite as wrapper around
	Tcl_ExprBooleanObj.

	* generic/tclCmdMZ.c ([string is boolean/true/false]): Rewrite dropping
	string-based Tcl_GetBoolean call, so that internal reps are kept for
	subsequent quick boolean operations.

	* generic/tclExecute.c:	Dropped most special handling of the "boolean"
	Tcl_ObjType, since that type should now be rarely encountered.

	* doc/BoolObj.3:	Rewrite of documentation dropping many details
	about the internals of Tcl_Objs. Shorter documentation focuses on the
	function and use of the routines.

	* generic/tclInt.h:	Revision to the "boolean" Tcl_ObjType, so that
	* generic/tclObj.c:	only string values like "yes" and "false" are
	* tests/obj.test:	kept as the "boolean" Tcl_ObjType. The string
	values "0" and "1" are kept as "int" Tcl_ObjType, which also produce
	quick calls to Tcl_GetBooleanFromObj(). Since this internal change
	means a Tcl_ConvertToType to a "boolean" Tcl_ObjType might not produce
	a Tcl_Obj of type "boolean", the registration of the "boolean" type is
	also removed.
	***POTENTIAL INCOMPATIBILITY***
	For callers of Tcl_GetObjType on the type name "boolean".

2005-05-17  Don Porter	<[email protected]>

	* generic/tclObj.c (TclInitObjSubsystem):	Removed the
	* tests/listObj.test:	registration of the Tcl_ObjType's "list",
	* tests/obj.test:	"procbody", "index", "ensembleCommand",
	"localVarName", and "levelReference". The only reason to register a
	Tcl_ObjType is to have it returned by Tcl_GetObjType, and the only
	reason for that is to retrieve a (Tcl_ObjType *) to pass to
	Tcl_ConvertToType(). None of the types above can support a
	Tcl_ConvertToType() call; they panic. Better not to offer something
	than to lead users into a panic.
	***POTENTIAL INCOMPATIBILITY***
	For callers of Tcl_GetObjType on the type names listed above.

2005-05-15  Kevin Kenny  <[email protected]>

	* win/tclWin32Dll.c: conditioned definition of EXCEPTION_REGISTRATION
	structures on HAVE_NO_SEH, to fix a bug in buildability on MSVC.

2005-05-14  Daniel Steffen  <[email protected]>

	* generic/tclInt.decls:
	* generic/tclTest.c:
	* generic/tclUtil.c:
	* win/tclWin32Dll.c: fixed link error due to direct access by tclTest.c
	to the MODULE_SCOPE tclPlatform global: renamed existing
	TclWinGetPlatform() accessor to TclGetPlatform() and moved it to
	generic code so that it can be used by on all platforms where
	MODULE_SCOPE is enforced.

	* macosx/tclMacOSXBundle.c:
	* unix/tclUnixInit.c:
	* unix/tcl.m4 (Darwin): made use of CoreFoundation API configurable and
	added test of CoreFoundation availablility to allow building on ppc64,
	replaced HAVE_CFBUNDLE by HAVE_COREFOUNDATION; test for availability of
	Tiger or later OSSpinLockLock API.

	* unix/tclUnixNotfy.c:
	* unix/Makefile.in:
	* macosx/tclMacOSXNotify.c (new file): when CoreFoundation is
	available, use new CFRunLoop based notifier: allows easy integration
	with other event loops on Mac OS X, in particular the TkAqua Carbon
	event loop is now integrated via a standard tcl event source (instead
	of TkAqua upon loading having to finalize the exsting notifier and
	replace it with its custom version). [Patch 1202052]

	* tests/unixNotfy.test: don't run unthreaded tests on Darwin since
	notifier may be using threads even in unthreaded core.

	* unix/tclUnixPort.h:
	* unix/tcl.m4 (Darwin): test for thread-unsafe realpath during
	configure, as Darwin 7 and later realpath is threadsafe.

	* macosx/Makefile: enable configure caching.

	* unix/configure.in: wrap tclConfig.h header in #ifndef _TCLCONFIG so
	that it can be included more than once without warnings from gcc4.0 (as
	happens e.g. when including both tclInt.h and tclPort.h)

	* macosx/tclMacOSXBundle.c:
	* unix/tclUnixChan.c:
	* unix/tclLoadDyld.c:
	* unix/tclUnixInit.c: fixed gcc 4.0 warnings.

	* unix/configure: autoconf-2.59
	* unix/tclConfig.h.in: autoheader-2.59

	* generic/tclIntDecls.h:
	* generic/tclIntPlatDecls.h:
	* generic/tclStubInit.c: make genstubs

2005-05-13  Kevin Kenny  <[email protected]>

	* win/tclWin32Dll.c: Further rework of the SEH logic. All
	EXCEPTION_REGISTRATION records are now in the activation record rather
	than pushed on the stack.

2005-05-13  Don Porter	<[email protected]>

	* generic/tclBasic.c:	Dropped the TCL_NO_MATH configuration. It's
	* generic/tclBinary.c:	believed this has not been working in a long
	* generic/tclExecute.c: time. Tcl needs math.h. [RFE 1200680]
	* unix/Makefile.in:

2005-05-12  Kevin Kenny  <[email protected]>

	* doc/mathfunc.n: Changed NAME line to match the name of the page.

2005-05-11  Kevin Kenny  <[email protected]>

	[kennykb-numerics-branch] Resynchronized with the HEAD; at this
	checkpoint [-rkennykb-numerics-branch-20050511], the HEAD and
	kennykb-numerics-branch contain identical code.

2005-05-11  Kevin Kenny  <[email protected]>

	* generic/tclStrToD.c (TclStrToD, RefineResult, ParseNaN): Changed the
	code to cast 'char' to UCHAR explicitly when using ctype macros, to
	silence complaints from the Solaris compiler.

2005-05-10  Jeff Hobbs	<[email protected]>

	* unix/tclUnixFCmd.c: add lint attr to enum to satisfy strictly
	compliant compilers that don't like trailing ,s.

	* tests/string.test: string-10.[21-30]
	* generic/tclCmdMZ.c (Tcl_StringObjCmd): add extra checks to prevent
	possible UMR in unichar cmp function for string map.

2005-05-10  Kevin Kenny  <[email protected]>

	* generic/tclBinary.c (FormatNumber): Fixed a bug where NaN's resulted
	in reads of uninitialized memory when using 'd', 'q', or 'Q' format.
	* generic/tclStrToD.c (ParseNaN, TclFormatNaN): Added code to handle
	the peculiarities of HP's PA_RISC, which uses a different 'quiet' bit
	in NaN from everyone else.
	* libtommath/tommath_superclass.h: Corrected C++-style comment.

2005-05-10  Kevin Kenny  <[email protected]>

	Merged all changes on kennykb-numerics-branch back into the HEAD.
	TIP's 132 and 232 are now Final.

2005-05-10  Kevin Kenny  <[email protected]>

	[kennykb-numerics-branch] Merged changes from HEAD.

2005-05-10  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c (ExponLong, ExponWide):
	* tests/expr.test (expr-23.34/35): fixed special case 'i**0' for i>0
	[Bug 1198892]

2005-05-09  Kevin B. Kenny  <[email protected]>

	[kennykb-numerics-branch]
	* win/tclWin32Dll.c (TclpCheckStackSpace, TclWinCPUID): Reworked
	structured event handling to function even with -fomit-frame-pointers.

2005-05-08  Kevin B. Kenny  <[email protected]>

	[kennykb-numerics-branch]
	* generic/tclStrToD.c: Made code more portable by finding a workaround
	for MSVC's 'volatile' issue that does not require conditional
	compilation.
	* win/tclWin32Dll.c (TclWinCPUID): Removed structured event handling
	from the GCC code since (a) bad code is generated by the instruction
	scheduling with -O2, and (b) it's not needed on any reasonably modern
	CPU.

2005-05-07  Kevin B. Kenny  <[email protected]>

	[kennykb-numerics-branch]
	* generic/tclEvent.c:  Moved initialization of tclStrToD.c's
	* generic/tclInt.h:    static constants into a procedure called
	* generic/tclStrToD.c: from TclInitSubsystems to avoid double checked
	locking protocol. Cleaned up an issue where MSVC ignored the
	'volatile' specifier, causing incorrect comparison of an underflowed
	number against zero.

2005-05-06  Jeff Hobbs	<[email protected]>

	* unix/tcl.m4, unix/configure: correct Solaris 10 (5.10) check and add
	support for x86_64 Solaris cc builds.

2005-05-05  Kevin B. Kenny  <[email protected]>

	[kennykb-numerics-branch] Merged with HEAD.

2005-05-05  Kevin B. Kenny  <[email protected]>

	* win/tclWinThrd.c:  Corrected a compilation error on the
			     --enable-threads configuration.

2005-05-05  Don Porter	<[email protected]>

	* generic/tclInt.decls:	Converted TclMatchIsTrivial to a macro.
	* generic/tclInt.h:
	* generic/tclUtil.c:
	* generic/tclIntDecls.h:	`make genstubs`
	* generic/tclStubInit.c:
	* generic/tclBasic.c:	Added callers of TclMatchIsTrivial where a
	* generic/tclCmdIL.c:	search can be done more efficiently when it is
	* generic/tclCompCmds.c:recognized that a pattern match is really an
	* generic/tclDictObj.c:	exact match. [Patch 1076088]
	* generic/tclIO.c:
	* generic/tclNamesp.c:
	* generic/tclVar.c:

	* generic/tclCompCmds.c:	Factored common efficiency trick into a
	macro named CompileWord.

	* generic/tclCompCmds.c:	Replaced all instance of
	* generic/tclCompile.c:		TCL_OUT_LINE_COMPILE with TCL_ERROR.
	* generic/tclInt.h:		Now that we've eradicated the mistaken
	* tests/appendComp.test:	notion of a "compile-time error", we
	can use the TCL_ERROR return code to signal any failure to produce
	bytecode.

2005-05-03  Don Porter	<[email protected]>

	* doc/DString.3:	Eliminated use of identifier "string" in Tcl's
	* doc/Environment.3:	public C API to avoid conflict/confusion with
	* doc/Eval.3:		the std::string of C++.
	* doc/ExprLong.3, doc/ExprLongObj.3, doc/GetInt.3, doc/GetOpnFl.3:
	* doc/ParseCmd.3, doc/RegExp.3, doc/SetResult.3, doc/StrMatch.3:
	* doc/Utf.3, generic/tcl.decls, generic/tclBasic.c, generic/tclEnv.c:
	* generic/tclGet.c, generic/tclParse.c, generic/tclParseExpr.c:
	* generic/tclRegexp.c, generic/tclResult.c, generic/tclUtf.c:
	* generic/tclUtil.c, unix/tclUnixChan.c:

	* generic/tclDecls.h:	`make genstubs`

2005-05-02  Don Porter	<[email protected]>

	* generic/tcl.decls:
	* generic/tclBasic.c:	Simplified implementation of Tcl_ExprString.
	* tests/expr-old.test:

	* generic/tclDecls.h:	`make genstubs`

2005-04-30  Daniel Steffen  <[email protected]>

	* unix/tclUnixNotfy.c: applied dkf's tkMacOSXNotify.c cleanup changes.

2005-04-29  Don Porter	<[email protected]>

	TIP#176 IMPLEMENTATION	[Patch 1165695]

	* generic/tclUtil.c:	Extended TclGetIntForIndex to recognize index
	formats including end+integer and integer+/-integer.

	* generic/tclCmdMZ.c:	Extended the -start switch of [regexp] and
	[regsub] to accept all index formats known by TclGetIntForIndex.

	* doc/lindex.n:		Updated docs to note new index formats.
	* doc/linsert.n, doc/lrange.n, doc/lreplace.n, doc/lsearch.n:
	* doc/lset.n, doc/lsort.n, doc/regexp.n, doc/regsub.n, doc/string.n:

	* tests/cmdIL.test:	Updated tests.
	* tests/compile.test, tests/lindex.test, tests/linsert.test:
	* tests/lrange.test, tests/lreplace.test, tests/lsearch.test:
	* tests/lset.test, tests/regexp.test, tests/regexpComp.test:
	* tests/string.test, tests/stringComp.test, tests/util.test:

2005-04-28  Don Porter	<[email protected]>

	* tests/unixInit.test (7.1): Alternative fix for the 2004-11-11 commit.

2005-04-27  Don Porter	<[email protected]>

	* library/init.tcl:	Corrected flaw in interactive command
	* tests/main.test:	auto-completion. [Bug 1191409].

	TIP#183 IMPLEMENTATION	[Patch 577093]

	* generic/tclIOUtil.c (TclGetOpenModeEx):	New routine.
	* generic/tclInt.h:

	* generic/tclIO.c (Tcl_OpenObjCmd):	Support for "b" and
	* doc/open.n:		"BINARY" in "access" argument to [open].
	* tests/ioCmd.test:

2005-04-26  Kevin B. Kenny  <[email protected]>

	* generic/tclBinary.c (FormatNumber): Dredge the NaN out of the
	internal representation if Tcl_GetDoubleFromObj returns TCL_ERROR on a
	NaN.

	* generic/tclObj.c (Tcl_GetDoubleFromObj): Restored silent
	overflow/underflow behaviour that the merge of 2004-04-25 messed up.
	Thanks to Don Porter for calling attention to this bug. Also removed an
	uninitialised memory reference in this function that valgrind caught.
	Also changed to return TCL_ERROR on a pure NaN.

	* generic/tclStrToD.c (RefineResult): Added a test for the initial
	approximation being HUGE_VAL; this test avoids EDOM being returned from
	ldexp on some platforms on input values exceeding the floating point
	range.

	* tests/expr.test (expr-29.*, expr-30.*): Added further tests of
	overflow/underflow on input conversions.

2005-04-25  Kevin B. Kenny  <[email protected]>

	[kennykb-numerics-branch] Merged with HEAD.

	* doc/CrtMathFunc.n:		Revised documentation for TIP 232

2005-04-25  Daniel Steffen  <[email protected]>

	* compat/string.h: fixed memchr() protoype for __APPLE__ so that we
	build on Mac OS X 10.1 again.

	* generic/tclNotify.c (TclFinalizeNotifier): fixed notifier not being
	finalized in unthreaded core (was testing for notifier initialization
	in current thread by checking thread id != 0 but thread id is always 0
	in untreaded core).

	* win/tclWinNotify.c (Tcl_WaitForEvent):
	* unix/tclUnixNotfy.c (Tcl_WaitForEvent): don't call ScaleTimeProc for
	zero wait times (as specified in TIP 233).

	* unix/Makefile.in: added @PLAT_SRCS@ to SRCS and split out NOTIFY_SRCS
	from UNIX_SRCS for parity with UNIX_OBJS & NOTIFY_OBJS.

	* unix/tcl.m4 (Darwin): added configure checks for recently added
	linker flags -single_module and -search_paths_first to allow building
	with older tools (and on Mac OS X 10.1), use -single_module in SHLIB_LD
	and not just T{CL,K}_SHLIB_LD_EXTRAS, added unexporting from Tk of
	symbols from libtclstub to avoid duplicate symbol warnings, added
	PLAT_SRCS definition for Mac OS X, defined MODULE_SCOPE to
	__private_extern__.
	(SC_MISSING_POSIX_HEADERS): added caching of dirent.h check.

	* unix/configure: autoconf-2.59

2005-04-25  Kevin B. Kenny  <[email protected]>

	* library/tzdata/America/Boise:
	* library/tzdata/America/Chicago:
	* library/tzdata/America/Denver
	* library/tzdata/America/Indianapolis:
	* library/tzdata/America/Los_Angeles:
	* library/tzdata/America/Louisville:
	* library/tzdata/America/Managua:
	* library/tzdata/America/New_York:
	* library/tzdata/America/Phoenix:
	* library/tzdata/America/Port-au-Prince:
	* library/tzdata/America/Indiana/Knox:
	* library/tzdata/America/Indiana/Marengo:
	* library/tzdata/America/Indiana/Vevay:
	* library/tzdata/America/Kentucky/Monticello:
	* library/tzdata/America/North_Dakota/Center:
	* library/tzdata/Asia/Tehran:
	Olson's tzdata2005i. Corrects exact time at which Standard Time was
	adopted in the US (generally, noon, Standard Time, rather than noon,
	Local Mean Time). Adopts new civil rules for Nicaragua and Iran.

2005-04-25  Don Porter	<[email protected]>

	* library/init.tcl:	Use "ni" and "in" operators.

2005-04-25  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c: fix for [Bug 1189274].

2005-04-24  Don Porter	<[email protected]>

	* generic/tclLiteral.c:	Silence compiler warnings.
	* generic/tclObj.c:	[Bug 1188863].

2005-04-22  Don Porter	<[email protected]>

	The 2005-04-21 changes to Tcl_GetBooleanFromObj were done to bring it
	into agreement with its docs. Further investigation reveals it was the
	docs that were incorrect.

	* doc/BoolObj.3:	Corrections to the documentation of
	Tcl_GetBooleanFromObj to bring it into agreement with what this public
	interface has always done, including noting the difference in function
	between Tcl_GetBooleanFromObj and Tcl_GetBoolean.

	* generic/tclGet.c:	Revised Tcl_GetBoolean to no longer be a
	wrapper around Tcl_GetBooleanFromObj (different function!).

	* generic/tclObj.c:	Removed TclGetTruthValueFromObj routine that
	was added yesterday. Revisions so that only Tcl_GetBoolean-approved
	values get the "boolean" Tcl_ObjType. This retains the fix for [Bug
	1187123].
	* tests/string.test:	Test string-23.0 for Bug 1187123.

	* generic/tclInt.h:	Revert most recent change.
	* generic/tclBasic.c:
	* generic/tclCompCmds.c:
	* generic/tclDictObj.c:
	* generic/tclExecute.c:
	* tests/obj.test:

2005-04-21  Don Porter	<[email protected]>

	* doc/GetInt.3:	Convert argument "string" to "str" to agree with code.
	Also clarified a few details on int and double formats.
	* generic/tclGet.c:	Radical code simplification. Converted
	Tcl_GetFoo() routines into wrappers around Tcl_GetFooFromObj(). Reduces
	code duplication, and the resulting potential for inconsistency.

	* generic/tclObj.c:	Several changes:

	- Re-ordered error detection code so all values with trailing garbage
	  receive a "not an integer" message instead of an "integer too large"
	  message.
	- Removed inactive code meant to deal with strtoul* routines that fail
	  to parse leading signs. All of them do, and if any are detected that
	  do not, the correct fix is replacement with compat/strtoul*.c, not a
	  lot of special care by the callers.
	- Tcl_GetDoubleFromObj now avoids shimmering away a "wideInt" intrep.
	- Fixed Tcl_GetBooleanFromObj to agree with its documentation and with
	  Tcl_GetBoolean, accepting only "0" and "1" and not other numeric
	  strings. [Bug 1187123]
	- Added new private routine TclGetTruthValueFromObj to perform the more
	  permissive conversion of numeric values to boolean that is needed by
	  the [expr] machinery.

	* generic/tclInt.h (TclGetTruthValueFromObj):	New routine.
	* generic/tclExecute.c:	Updated callers to call new routine.
	* generic/tclBasic.c:	Updated callers to call new routine.
	* generic/tclCompCmds.c:	Updated callers to call new routine.
	* generic/tclDictObj.c:	Updated callers to call new routine.
	* tests/obj.test:	Corrected bad tests that actually expected
	values like "47" and "0xAC" to be accepted as booleans.

	* generic/tclLiteral.c: Disabled the code that forces some literals
	into the "int" Tcl_ObjType during registration. We can re-enable it if
	this change causes trouble, but it seems more sensible to let Tcl's
	"on-demand" shimmering rule, and not try to pre-guess things.

2005-04-20  Kevin B. Kenny  <[email protected]>

	[kennykb-numerics-branch]
	* doc/expr.n:
	* doc/mathfunc.n (new file):	Revised documentation for TIP 232

2005-04-20  Don Porter	<[email protected]>

	* generic/tclGet.c (Tcl_GetInt):	Corrected error that did not
	* generic/tclObj.c (Tcl_GetIntFromObj): permit 0x80000000 to be
	recognized as an integer on TCL_WIDE_INT_IS_LONG systems [Bug 1090869].

2005-04-20  Kevin B. Kenny  <[email protected]>

	* generic/tclFileName.c: Silenced a compiler warning about '/*' within
	a comment.

2005-04-19  Don Porter	<[email protected]>

	* generic/tclBasic.c:	Added unsupported command
	* generic/tclCmdAH.c:	[::tcl::unsupported::EncodingDirs] to permit
	* generic/tclInt.h:	query/set of the encoding search path at
	* generic/tclInterp.c:	the script level. Updated init.tcl to make
	* library/init.tcl:	use of the new command. Also updated several
	coding practices in init.tcl ("eq" for [string equal], etc.)

2005-04-19  Kevin B. Kenny  <[email protected]>

	* library/clock.tcl (Initialize): Put initialization code into a proc
	to avoid inadvertently clobbering global variables. [Bug 1185933]
	* tests/clock.test (clock-48.1): Added regression test for the above
	bug.
	Thanks to Ulrich Ring for reporting this bug.

2005-04-16  Miguel Sofer  <[email protected]>

	* generic/Var.c (Tcl_ArrayObjCmd - ARRAY_NAMES): fix Tcl_Obj leak. [Bug
	1084111]

2005-04-16  Zoran Vasiljevic  <[email protected]>

	* generic/tclIOUtil.c: force clenaup of the interp result in
	TclLoadFile(). Some implementations of TclpFindSymbol() will seed the
	interp result with error message when unable to find the requested
	symbol (this is not considered to be an error).

	Set of changes correcting huge memory waste (not a leak) when a thread
	exits. This has been introduced in 8.4.7 within an attempt to correctly
	cleanup after ourselves when Tcl library is being unloaded with the
	Tcl_Finalize() call.

	This fixes the [Bug 1178445]

	* generic/tclInt.h: added prototypes for TclpFreeAllocCache() and
	TclFreeAllocCache()

	* generic/tclThreadAlloc.c: modified TclFinalizeThreadAlloc() to
	explicitly call TclpFreeAllocCache with the NULL-ptr as argument
	signalling cleanup of private tsd key used only by the threading
	allocator.

	* unix/tclUnixThrd.c: fixed TclpFreeAllocCache() to recognize when
	being called with NULL argument. This is a signal for it to clean up
	the tsd key associated with the threading allocator.

	* win/tclWinThrd.c: renamed TclWinFreeAllocCache to TclpFreeAllocCache
	and fixed to recognize when being called with NULL argument. This is a
	signal for it to clean up the tsd key associated with the threading
	allocator.

2005-04-13  Don Porter	<[email protected]>

	* tests/unixInit.test:	Disabled obsolete tests and removed code
	* tests/encoding.test:	that supported them.
	* generic/tclInterp.c:

	* library/init.tcl:	Use auto-loading to bring in Tcl Module support
	* library/tclIndex:	as needed. This reduces startup time by
	* library/tm.tcl:	delaying this initialization to a later time.

2005-04-15  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c: missing semicolons caused failure to compile
	with TCL_COMPILE_DEBUG.

2005-04-13  David Gravereaux  <[email protected]>

	* generic/tclIO.c (Tcl_SetChannelBufferSize): Lowest size limit
	* tests/io.test:	changed from ten bytes to one byte. Need for
	* tests/iogt.test:	this change was proven by Ross Cartlidge
	<[email protected]> where [read stdin 1] was grabbing 10 bytes followed
	by starting a child process that was intended to continue reading from
	stdin. Even with -buffersize set to one, nine chars were getting lost
	by the buffersize over reading for the native read() caused by [read].

2005-04-13  Don Porter	<[email protected]>

	* unix/tclUnixInit.c (TclpGetEncodingNameFromEnvironment): Reversed
	order of verifying candidate [encoding system] value, checking against
	a table in memory first before calling Tcl_GetEncoding and potentially
	scanning through the filesystem. Also ordered the table so that a
	binary search could be used within it. Improves startup time a bit more
	on some systems.

2005-04-13  Kevin B. Kenny  <[email protected]>

	* library/clock.n: Added a missing '--' on several [switch] commands to
	improve performance of [clock format] and related operations. [FRQ
	1182459]

2005-04-13  Donal K. Fellows  <[email protected]>

	* doc/fcopy.n: Improved documentation on copying binary files, added an
	example and mentioned the use of [file copy].
	* doc/fconfigure.n: Improved documentation of -encoding binary option.
	This is all following comments from Steve Manning <[email protected]>
	on comp.lang.tcl that the current documentation was not clear.

2005-04-13  Miguel Sofer  <[email protected]>

	* generic/tclCompile.c:Commented out the functions
	TclPrintInstruction(), TclPrintObject() and TclPrintSource() when not
	debugging the compiler, as they are never called in that case.

2005-04-12  Don Porter	<[email protected]>

	* generic/tclInterp.c:	Corrected bad syntax of Tcl_Panic() call.

	* generic/tclUtil.c (TclGetProcessGlobalValue):	More robust handling
	of bad TclInitProcessGlobalValueProc behavior; an immediate panic
	rather than a mysterious crash later.

	* generic/tclEncoding.c:	Several changes to the way the
	encodingFileMap cache is maintained. Previously, it was attempted to
	keep the file map filled and up to date with changes in the encoding
	search path. This contributed to slow startup times since it required
	an expensive "glob" operation to fill the cache. Now the validity of
	items in the cache are checked at the time they are used, so the cache
	is permitted to fall out of sync with the encoding search path. Only
	[encoding names] and Tcl_GetEncodingNames() now pay the full expense.
	[Bug 1177363]

2005-04-12  Kevin B. Kenny  <[email protected]>

	* compat/strstr.c: Added default definition of NULL to accommodate
	building on systems with badly broken headers. [Bug 1175161]

2005-04-11  Donal K. Fellows  <[email protected]>

	* tools/tclZIC.tcl: Rewrote to take advantage of more features of Tcl
	8.5 (on which it was dependent anyway). Also added a [package require]
	line to formalize the relationship.

2005-04-11  Kevin Kenny  <[email protected]>

	[kennykb-numerics-branch] Merged with HEAD. Updated to libtommath 0.35.

	* generic/tclBasic.c: Attempted to repeat changes that applied to
	tclExecute.c in Miguel Sofer's commit of 2005-04-01, together with
	(possibly) a few more uses of his new object creation macros. Also
	plugged a memory leak in TclObjInvoke. [Bug 1180368]

2005-04-10  Kevin Kenny  <[email protected]>

	* library/tzdata/America/Montevideo:
	* library/tzdata/Asia/Almaty:
	* library/tzdata/Asia/Aqtau:
	* library/tzdata/Asia/Aqtobe:
	* library/tzdata/Asia/Baku:
	* library/tzdata/Asia/Jerusalem:
	* library/tzdata/Asia/Oral:
	* library/tzdata/Asia/Qyzylorda:
	* library/tzdata/Indian/Chagos:
	* library/tzdata/Indian/Cocos:		Olson's tzdata2005h

2005-04-10  Don Porter	<[email protected]>

	* generic/tclBasic.c (TclObjInvoke):	Plug memory leak. [Bug 1180368]

2005-04-09  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c: fix possible leak of expansion Tcl_Objs

2005-04-09  Daniel Steffen  <[email protected]>

	* macosx/README: updated requirements for OS & developer tool versions
	and other small fixes/cleanup.

	* generic/tclListObj.c (Tcl_ListObjIndex): added missing NULL return
	when getting index from an empty list.

	* unix/tcl.m4 (Darwin): added -single_module linker flag to
	TCL_SHLIB_LD_EXTRAS and TK_SHLIB_LD_EXTRAS.
	* unix/configure: autoconf-2.59

2005-04-08  Don Porter	<[email protected]>

	* generic/tclInt.h (TclGetEncodingFromObj):	 New function to
	* generic/tclEncoding.c (TclGetEncodingFromObj): retrieve a
	Tcl_Encoding value, as well as cache it in the internal rep of a new
	"encoding" Tcl_ObjType.
	* generic/tclCmdAH.c (Tcl_EncodingObjCmd):	Updated to call new
	function so that Tcl_Encoding's used by [encoding convert*] routines
	are not freed too quickly. [Bug 1077262]

2005-04-08  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmds.c (TclCompileSwitchCmd): Rewritten to be able to
	handle the other form of [switch] and generate slightly simpler (but
	longer) code.

2005-04-06  Donal K. Fellows  <[email protected]>

	* doc/upvar.n, doc/unset.n, doc/tell.n, doc/tclvars.n, doc/subst.n:
	* doc/seek.n, doc/scan.n, doc/regsub.n, doc/registry.n, doc/regexp.n:
	* doc/read.n, doc/puts.n, doc/pkgMkIndex.n, doc/open.n, doc/lreplace.n:
	* doc/lrange.n, doc/load.n, doc/llength.n, doc/linsert.n, doc/lindex.n:
	* doc/lappend.n, doc/info.n, doc/gets.n, doc/format.n, doc/flush.n:
	* doc/fileevent.n, doc/file.n, doc/fblocked.n, doc/close.n:
	* doc/array.n, doc/Utf.3, doc/TraceVar.3, doc/StrMatch.3, doc/RegExp.3:
	* doc/PrintDbl.3, doc/OpenTcp.3, doc/OpenFileChnl.3, doc/Object.3:
	* doc/Notifier.3, doc/LinkVar.3, doc/IntObj.3, doc/Interp.3:
	* doc/GetOpnFl.3, doc/GetIndex.3, doc/Eval.3, doc/CrtMathFnc.3:
	* doc/CrtFileHdlr.3, doc/CrtCommand.3, doc/CrtChannel.3:
	* doc/Backslash.3: Purge old .VS/.VE macro instances.

	* tools/man2html2.tcl (IPmacro): Rewrote to understand what .IP really
	is (.IP and .TP are really just two ways of doing the same thing).
	Change below made this relevant.
	* doc/re_syntax.n: Change some uses of .TP to .IP to work around bugs
	in various *roff implementations. Also reworded the atom descriptions
	slightly.

2005-04-05  Don Porter	<[email protected]>

	* generic/tclExecute.c (ExprSrandFunc):  Replaced incursions into the
	* generic/tclUtil.c (TclGetIntForIndex): intreps of numeric types with
	simpler calls of Tcl_GetIntFromObj and Tcl_GetLongFromObj, now that
	those routines are better behaved wrt shimmering. [Patch 1177219]

2005-04-05  Miguel Sofer  <[email protected]>

	* generic/tclInt.h:
	* generic/tclObj.c: Change in TclDecrRefCount and TclFreeObj, to speed
	up the freeing of simple Tcl_Obj [Patch 1174551]

2005-04-04  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c: small opts in obj handling

2005-04-02  Miguel Sofer  <[email protected]>

	* generic/tclVar.c: converted a few function calls to macros.

2005-04-01  Miguel Sofer  <[email protected]>

	* doc/ListObj.3:
	* generic/tclBasic.c:
	* generic/tclCmdIL.c:
	* generic/tclConfig.c:
	* generic/tclExecute.c:
	* generic/tclInt.decls:
	* generic/tclInt.h:
	* generic/tclIntDecls.h:
	* generic/tclListObj.c:
	* generic/tclStubInit.c:
	* generic/tclVar.c: Changed the internal representation of lists to
	(a) reduce the malloc/free calls at list creation (from 2 to 1), (b)
	reduce the cost of handling empty lists (we now never create a list
	internal rep for them), (c) allow refcounting of the list internal rep.
	The latter permits insuring that the pointers returned by
	Tcl_ListObjGetElements remain valid even if the object shimmers away
	from its original list type. This is [Patch 1158008]

	* generic/tclExecute.c:
	* generic/tclInt.h:
	* generic/tclObj.c:
	* generic/tclStringObj.c:
	(1) defined new internal macros for creating and setting frequently
	used obj types (int,long, wideInt, double, string). Changed TEBC to use
	eg 'TclNewIntObj(objPtr, i)' to avoid the function call in 'objPtr =
	Tcl_NewIntObj(i)'
	(2) ExecEnv now stores two Tcl_Obj* pointing to the constants "0" and
	"1", for use by TEBC.
	(3) slight reduction in cost of INST_START_CMD

2005-03-31  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c (INST_JUMP_TRUE/FALSE): replaced "test and
	branch" with "compute index into table"

2005-03-30  Donal K. Fellows  <[email protected]>

	* doc/FileSystem.3: Defined loadHandle argument. [Bug 1172401]

2005-03-29  Jeff Hobbs	<[email protected]>

	* win/tcl.m4, win/configure: do not require cygpath in macros to allow
	msys alone as an alternative.

2005-03-24  Don Porter	<[email protected]>

	* generic/tclCompile.h:	Move the TclInterpReady() declaration from
	* generic/tclInt.h:	tclCompile.h to tclInt.h. Should have been done
	as part of the 1115904 bug fix on 2005-03-18.

	* generic/tclThreadTest.c:	Stop providing the phony package
	"Thread 1.0" when the [::testthread] command is defined. It's never
	used by anything, and conflicts with loading the real "Thread" package.

2005-03-18  Don Porter	<[email protected]>

	* generic/tclCompCmds.c (TclCompileIncrCmd):	Corrected checks for
	immediate operand usage to permit leading space and sign characters.
	Restores more efficient bytecode for [incr x -1] that got lost in the
	CONST string reforms of Tcl 8.4. [Bug 1165671]

	* generic/tclBasic.c (Tcl_EvalEx):	Restored recursion limit
	* generic/tclParse.c (TclSubstTokens):	testing in nested command
	* tests/basic.test (basic-46.4):	substitutions within direct
	* tests/parse.test (parse-19.*):	script evaluation (Tcl_EvalEx)
	that got lost in the parser reforms of Tcl 8.1. Added tests for correct
	behavior. [Bug 1115904]

2005-03-15  Vince Darley  <[email protected]>

	* generic/tclFileName.c:
	* win/tclWinFile.c:
	* tests/winFCMd.test: fix to 'file pathtype' and 'file norm' failures
	on reserved filenames like 'COM1:', etc.

2005-03-15  Pat Thoyts	<[email protected]>

	* unix/tcl.m4:	  Updated the OpenBSD configuration and regenerated
	* unix/configure: the configure script.

2005-03-15  Kevin B. Kenny  <[email protected]>

	[kennykb-numerics-branch] Merged with HEAD.

	* generic/tclBasic.c (many):
	* generic/tclCompExpr.c (CompileMathFuncCall):
	* generic/tclCompile.h:
	* generic/tclExecute.c (many):
	* generic/tclParseExpr.c (ParsePrimaryExpr):
	* tests/compExpr-old.test:
	* tests/compExpr.test:
	* tests/compile.test:
	* tests/expr-old.test:
	* tests/expr.test:
	* tests/for.test:
	* tests/parseExpr.test: Initial implementation of TIP #232.

	* generic/tclObj.c (Tcl_DbNewBignumObj): Fixed typo that broke
	--enable-symbols=mem build
	* tests/binary.test (binary-40.3, binary-40.6): Corrected tests to
	allow NaN(7ffffffffffff).

2005-03-14  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c: fixed INST_PUSH1's debugging code (wrong obj
	ref passed to TRACE_WITH_OBJ).

2005-03-14  Miguel Sofer  <[email protected]>

	* generic/tclCompile.c: fixed INST_RETURN's stack effect in
	tclInstructionTable (-1 instead of -2)

2005-03-10  Miguel Sofer  <[email protected]>

	* generic/tclCompCmds.c: removed debugging line

2005-03-10  Don Porter	<[email protected]>

	* generic/tclTrace.c (TclCheckInterpTraces):	Corrected mistaken cast
	of ClientData to (TraceCommandInfo *) when not warranted. Thanks to
	Yuri Victorovich for the report. [Bug 1153871]
	* generic/tcl.h:	Moved flag values TCL_TRACE_ENTER_EXEC and
	* generic/tclInt.h:	TCL_TRACE_LEAVE_EXEC from public interface into
	private. Should be used only by internal workings of execution traces.

2005-03-09  Kevin B. Kenny  <[email protected]>

	[kennykb-numerics-branch] Merged from HEAD.

	* doc/PrintDbl.3:
	* doc/tclVars.n: Documented new semantics for tcl_precision.
	* generic/tclExecute.c (Tcl_ExecuteByteCode): Removed the check for
	division-by-zero on IEEE-754 machines.
	* generic/tclUtil.c (Tcl_PrintDouble): Corrected bug where numbers in
	the range [1e-4 .. 1.) were printed incorrectly.
	* tests/compExpr-old.test (compExpr-old-11.13): Revised test case for
	division by zero.
	* tests/expr-old.test (expr-34.11, expr-34.12): Revised test cases for
	overflow in pow() to deal with infinities.
	* tests/expr.test (expr-11.13, expr-29.1, expr-29.2): Revised test case
	for division by zero and for underflow on input conversions.
	* tests/parseExpr.test (parseExpr-16.11): Revised test case for
	overflow on input conversion.
	* tests/string.test (string-6.38 deleted): Removed test case for
	underflow on input conversion, which is no longer an error.
	* tests/util.test (util-10.*): Added test case for the bug in tclUtil.c

2005-03-08  Jeff Hobbs	<[email protected]>

	* win/makefile.vc: clarify necessary defined vars that can come from
	MSVC or the Platform SDK.

2005-03-07  Donal K. Fellows  <[email protected]>

	* doc/string.n: Minor typo. [Bug 1158247]

2005-03-07  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c: new peephole optimisation for INST_PUSH1; fixed
	the peephole opt in INST_POP so that it is not used when
	TCL_COMPILE_DEBUG is defined.

2005-03-04  Kevin B. Kenny  <[email protected]>

	[kennykb-numerics-branch]

	* generic/tclCmdMZ.c: Changed [scan] to treat out-of-range floating
	point values as infinities and zeroes.
	* generic/tclExecute.c: Changed [expr] to be permissive about
	infinities, allowing them to propagate.
	* generic/tclGet.c: Changed Tcl_GetDouble to be permissive about
	over/underflow.
	* generic/tclObj.c: Changed SetDoubleFromAny to be permissive about
	over/underflow.
	* generic/tclParseExpr.c: Made [expr] permissive about input numbers
	out of range.

2005-03-03  Kevin B. Kenny  <[email protected]>

	[kennykb-numerics-branch]

	* generic/tclInt.h:
	* generic/tclStrToD.c (Tcl_DoubleDigits, TclFormatNaN):
	* generic/tclUtil.c (Tcl_PrintDouble): Changed the signature of
	TclDoubleDigits so that it accepts a pointer to the signum of the
	argument, and returns the signum via that pointer. Added very hacky
	code to handle IEEE signed zeroes in Tcl_DoubleDigits. (It can't be
	done other than as a hack until C9x; C89 simply doesn't deal with the
	concept of -0.0). Added output conversion of tagged NaN values.
	* generic/tclBinary.c (FormatNumber): Changed to allow [binary format]
	to handle NaN.
	* tests/binary.test (binary-60.1): Added a quick-n-dirty test to make
	sure that NaN's can be scanned and formatted.
	* generic/tclParseExpr.c (GetLexeme, ParseMaxDoubleLength): Modified so
	that tagged NaN (e.g., NaN(DEADBEEF)) can be recognized.

2005-03-02  Kevin B. Kenny  <[email protected]>

	[kennykb-numerics-branch] Merged with HEAD as of 2005-02-23.

	* generic/tclExecute.c: Broadened test for NaN to work on Windows.
	* generic/tclInt.h:
	* generic/tclStrToD.c (Tcl_DoubleDigits):
	* generic/tclUtil.c (Tcl_PrintDouble, TclPrecTraceProc): Added
	Tcl_DoubleDigits to format 'double' numbers with the minimum number of
	significant digits to yield correct rounding. Modified tcl_precision
	to accept 0 as a precision (meaning "minimum digits"), and made 0 the
	default. [TIP #132]
	* generic/tclObj.c: Made NaN's throw an error in Tcl_GetDoubleFromObj.
	* unix/Makefile.in:
	* win/Makefile.in:
	* win/makefile.vc: Added libtommath/bn_mp_init_set.c to the build.
	* libtommath/tommath.h (mp_iseven): Fixed a bug that caused zero to
	test 'odd'.
	* generic/tommath.h: Regenerated.
	* tests/binary.test:
	* tests/expr-old.test:
	* tests/expr.test:
	* tests/scan.test: Corrected a number of tests that depended on
	tcl_precision, and removed the {eformat} condition from tests that no
	longer require it.
	* tests/util.test: Corrected a number of tests that depended on
	tcl_precision, and removed the {eformat} condition from tests that no
	longer require it. Added a series of tests for correct rounding in
	Tcl_PrintDouble. [TIP #132].

2005-03-01  David N. Welton  <[email protected]>

	* doc/CrtSlave.3: Changed to Tcl_Object to Tcl_Obj in the man page.

2005-02-24  Don Porter	<[email protected]>

	* library/tcltest/tcltest.tcl:	Better use of [glob -types] to avoid
	* tests/tcltest.test:	failed attempts to [source] a directory, and
	similar matters. Thanks to "mpettigr". [Bug 1119798]

	* library/tcltest/pkgIndex.tcl: Bump to tcltest 2.2.8
	* unix/Makefile.in:
	* win/Makefile.in:

2005-02-23  Donal K. Fellows  <[email protected]>

	* doc/CrtChannel.3 (THREADACTIONPROC): Formatting fix. [Bug 1149605]

2005-02-17  Jeff Hobbs	<[email protected]>

	* win/tclWinFCmd.c (TraverseWinTree): use wcslen on wchar, not
	Tcl_UniCharLen.

2005-02-16  Miguel Sofer  <[email protected]>

	* doc/variable.n: fix for [Bug 1124160], variables are detected by
	[info vars] but not by [info locals].

2005-02-11  Jeff Hobbs	<[email protected]>

	* unix/Makefile.in: remove SHLIB_LD_FLAGS (only for AIX, inlined into
	* unix/tcl.m4:	    SHLIB_LD). Combine AIX-* and AIX-5 branches in
	* unix/configure:   SC_CONFIG_CFLAGS. Correct gcc builds for AIX-4+
	and HP-UX-11. autoconf-2.59 gen'd.

2005-02-11  Miguel Sofer  <[email protected]>

	* tests/basic.test (basic-26.3): new test

2005-02-10  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c (Tcl_EvalObjEx):
	* tests/basic.test (basic-26.2): preserve the arguments passed to TEOV
	in the pure-list branch, in case the list shimmers away. Fix for [Bug
	1119369], reported by Peter MacDonald.

2005-02-10  Vince Darley  <[email protected]>

	* generic/tclFileName.c: fix for test failures introduced on 2005-01-17
	[Bug 1119092]

2005-02-10  Donal K. Fellows  <[email protected]>

	* doc/binary.n: Made the documentation of sign bit masking and [binary
	scan] consistent. [Bug 1117017]

2005-02-08  David N. Welton  <[email protected]>

	* doc/CrtChannel.3: Typo: return->returns.

2005-02-06  Kevin B. Kenny  <[email protected]>

	[kennykb-numerics-branch]

	* generic/tclStrToD.c (TclStrToD, SafeLdExp): Added code to manage the
	FPU precision on gcc+x86. Enabled fast conversion of floats with small
	exponents now that precision is correct.
	* tests/expr.test: Corrected test for the smallest representible value
	to the right IEEE values.

2005-02-06  David N. Welton  <[email protected]>

	* doc/Thread.3: One-word grammar fix.

2005-02-05  David N. Welton  <[email protected]>

	* doc/Thread.3: Fixed sentence describing flags for Tcl_CreateThread.

	* doc/FileSystem.3: Cleaned up typo in Tcl_FSNewNativePath
	documentation.

	* generic/tclPathObj.c: Cleaned up typo in comment.

2005-02-03  Kevin B. Kenny  <[email protected]>

	[kennykb-numerics-branch]

	* generic/tclStrToD.c (TclStrToD, RefineResult, SafeLdExp): Added code
	to ensure that 'ldexp' is never called with a value that will underflow
	* tests/expr.test: Added tests for the smallest representible value,
	and rounding between it and zero. (The tests reflect current
	behaviour; plan is to change the specification of Tcl so that input
	conversion of doubles underflows silently.)

2005-02-02  Mo DeJong  <[email protected]>

	* generic/tclProc.c (TclInitCompiledLocals): Add check for type of the
	framePtr->procPtr->bodyPtr passed to TclInitCompiledLocals and panic if
	it is not the correct type. If the body of the proc is not of the
	compiled byte code type then the code will crash. This was discovered
	while tracking down a crash in Itcl, that crash is fixed by Itcl patch
	1115085.

2005-02-01  Kevin B. Kenny  <[email protected]>

	[kennykb-numerics-branch]  Merged with HEAD as of today.

	* generic/tclInt.decls: Changed numbers of new stubs to resolve a
	conflict.
	* generic/tclInt.h: Added new TclStrToD routine that replaces the
	native 'strtod' throughout Tcl.
	* generic/tclCmdMZ (Tcl_StringObjCmd):
	* generic/tclGet.c (Tcl_GetDouble):
	* generic/tclObj.c (SetBooleanFromAny, SetDoubleFromAny):
	* generic/tclParseExpr.c (GetLexeme):
	* generic/tclScan.c (Tcl_ScanObjCmd): Replaced all uses of the native
	'strtod' with a TclStrToD routine that performs correct rounding and
	handles denormals.
	* generic/tclStrToD.c: (new file)
	New scanning function for extracting 'double' from a string that rounds
	correctly, and handles denormals and infinities.
	* unix/Makefile.in:
	* win/Makefile.in:
	* win/makefile.vc:
	Added tclStrToD.c and the tommath routines that support it.

	These changes represent a partial implementation of TIP #132. Output
	conversion of floating point numbers, and proper handling of infinities
	within expressions, still need to be addressed.

2005-02-01  Don Porter	<[email protected]>

	* generic/tclExecute.c (TclCompEvalObj): Removed stray statement left
	behind in prior code reorganization.

2005-01-31  Don Porter	<[email protected]>

	* unix/configure:	autoconf-2.57

2005-01-30  Joe English  <[email protected]>

	* unix/configure.in: Restored two double-evals that were removed in the
	DBGX purge; these are still needed on some platforms to account for
	TCL_TRIM_DOTS. [Bug 1112654]

	* unix/configure: NOT REGENERATED: only have autoconf 2.59 here, need
	to find someone with autoconf 2.57.

2005-01-28  Jeff Hobbs	<[email protected]>

	* unix/configure, unix/tcl.m4: add solaris 64-bit gcc build support.
	[Bug 1021871]

2005-01-28  Donal K. Fellows  <[email protected]>

	* tests/expr-old.test (expr-old-37.2): Added test for [Bug 1109484]

2005-01-27  Jeff Hobbs	<[email protected]>

	* generic/tclBasic.c (Tcl_ExprBoolean, Tcl_ExprDouble)
	(Tcl_ExprLong): Fix to recognize Tcl_WideInt type. [Bug 1109484]

2005-01-26  Andreas Kupries  <[email protected]>

	TIP#218 IMPLEMENTATION

	* generic/tclDecls.h:	Regenerated from tcl.decls.
	* generic/tclStubInit.c:

	* doc/CrtChannel.3:	Documentation of extended API,
	* generic/tcl.decls:	extended testsuite, and
	* generic/tcl.h:	implementation. Removal of old
	* generic/tclIO.c:	driver-specific TclpCut/Splice
	* generic/tclInt.h:	functions. Replaced with generic
	* tests/io.test:	thread-action calls through the
	* unix/tclUnixChan.c:	new hooks. Update of all builtin
	* unix/tclUnixPipe.c:	channel drivers to version 4.
	* unix/tclUnixSock.c:	Windows drivers extended to
	* win/tclWinChan.c:	manage thread state in a thread
	* win/tclWinConsole.c:	action handler.
	* win/tclWinPipe.c:
	* win/tclWinSerial.c:
	* win/tclWinSock.c:

2005-01-25  Don Porter	<[email protected]>

	* library/auto.tcl:	Updated [auto_reset] to clear auto-loaded
	commands in namespaces other than :: and to clear auto-loaded commands
	that do not happen to be procs. [Bug 1101670]
	***POTENTIAL INCOMPATIBILITY***

2005-01-25  Daniel Steffen  <[email protected]>

	* unix/tcl.m4 (Darwin): fixed bug with static build linking to dynamic
	library in /usr/lib etc instead of linking to static library earlier in
	search path. [Bug 956908] Removed obsolete references to Rhapsody.
	* unix/configure: autoconf-2.57

2005-01-21  Andreas Kupries  <[email protected]>

	* generic/tclStubInit.c: Regenerated the stubs support code from the
	* generic/tclDecls.h:	 modified tcl.decls (TIP #233, see below).

	* doc/GetTime.3:       Implemented TIP #233, i.e. the
	* generic/tcl.decls:   'Virtualization of Tcl's Sense of Time'.
	* generic/tcl.h:       Declared, implemented, and documented the
	* generic/tclInt.h:    specified new API functions. Moved the
	* unix/tclUnixEvent.c: native (OS) access to time information
	* unix/tclUnixNotfy.c: into standard handler functions. Inserted
	* unix/tclUnixTime.c:  hooks calling on the handlers where native
	* win/tclWinNotify.c:  access was done before, and where scaling
	* win/tclWinTime.c:    between domains (real/virtual) is required.

2005-01-21  Andreas Kupries  <[email protected]>

	* generic/tclThread.c: Typo police. Fixed some nits
	* generic/tclCmdAH.c:  in header comments of functions.
	* generic/tclBasic.c:  (Missing --).
	* generic/tclFileName.c:

2005-01-21  Donal K. Fellows  <[email protected]>

	* doc/FileSystem.3: Add missing ARGUMENTS section definitions for
	arguments to Tcl_FSLink. [Bug 1106272]

2005-01-21  Kevin B. Kenny  <[email protected]>

	[kennykb-numerics-branch]

	* unix/Makefile.in: Updated Makefile to build libtommath on Unix as
	well as Windows. [Bug 1106865]

	* generic/tclTestObj.c (TestbignumobjCmd): Silenced a compiler warning
	about a mismatched 'const'.

2005-01-20  Kevin B. Kenny  <[email protected]>

	[kennykb-numerics-branch] Development checkpoint.

	* compat/strtoll.c:	Reverted to HEAD.
	* compat/strtoull.c:
	* doc/Ensemble.3:
	* generic/tclBasic.c:
	* generic/tclCmdIL.c:
	* generic/tclNamesp.c:
	* generic/tclPathObj.c:
	* generic/tclPort.h:
	* unix/configure:
	* unix/configure.in:
	* unix/tcl.m4:
	* win/configure:
	* win/configure.in:
	* win/rules.vc:
	* win/tcl.m4:

	* generic/tcl.h: Added declarations for bignum types, and for a
	'bignumValue' in the Tcl_Obj structure.
	* generic/tclInt.h: Added declarations of interface procedures for
	memory allocation in libtommath.

	* generic/tcl.decls: Added new interface to bignum objects.
	* generic/tclInt.decls: Added internal stubs for bignum routines used
	by the test code in tclTestObj.c.

	* generic/tclDecls/h: Regen.
	* generic/tclIntDecls.h:
	* generic/tclStubInit.h:

	* tools/fix_tommath_h.tcl: (New file) Script to edit
	libtommath/tommath.h and produce generic/tommath.h so that storage
	classes, allocation routines, and data types conform to Tcl's
	conventions.
	* generic/tommath.h: (New file) Generated by the above.

	* generic/tclTomMath.h: (New file) Additional declarations to be
	included in tommath.h when building Tcl.

	* generic/tclTomMathInterface.c: (New file) Small 'glue' routines
	adapting tommath's API to Tcl.

	* libtommath/bn_fast_s_mp_mul_digs.c:
	* libtommath/bn_mp_mul_d.c:
	* libtommath/bn_mp_read_radix.c:
	* libtommath/tommath.h: Applied suggested changes from Tom St Denis
	that correct an off-by-one error in single-digit multiplication
	(leading to a pointer smash if uncorrected) and change the string
	argument to 'mp_read_radix' from 'char*' to 'const char*'.

	* libtommath/bn_mp_radix_size.c: Local patch to ensure that sufficient
	memory is requested even if the number has a single digit.

	* libtommath/bn_mp_read_radix.c: Local patch to return MP_VAL if the
	input string contains an invalid character.

	* generic/tclObj.c: Added accessor functions for bignums.
	* generic/tclTestObj.c: Added a 'testbignumobj' command to exercise the
	accessor functions for bignums.

	* win/Makefile.in: Added rules for making libtommath.

2005-01-19  Donal K. Fellows  <[email protected]>

	TIP#235 IMPLEMENTATION

	* doc/Ensemble.3: Documentation for the new public API.
	* generic/tclNamesp.c (Tcl_CreateEnsemble,...): Rename of
	* generic/tcl.decls:		existing API into TIPped form.

2005-01-19  Mo DeJong  <[email protected]>

	* win/tclWinChan.c (FileCloseProc): Invoke TclpCutFileChannel() to
	remove a FileInfo from the thread local list before deallocating it.
	This should have been done via an earlier call to Tcl_CutChannel, but I
	was running into a crash in the next call to Tcl_CutChannel during the
	I/O finalization stage.

2005-01-18  Kevin Kenny  <[email protected]>

	* library/tzdata/GMT+0:
	* library/tzdata/GMT-0:
	* library/tzdata/GMT0:
	* library/tzdata/Greenwich:
	* library/tzdata/Navajo:
	* library/tzdata/Universal:
	* library/tzdata/Zulu:
	* library/tzdata/America/Asuncion:
	* library/tzdata/America/Rosario:
	* library/tzdata/Asia/Jerusalem:
	* library/tzdata/Brazil/Acre:
	Routine update per Olson's tzdata2005c. Removed links to links
	(Greenwich in several aliases; Navajo; Acre). Updated Paraguayan DST
	rules and "best guess" at this year's Israeli rules.

2005-01-17  Vince Darley  <[email protected]>

	* generic/tclFileName.c: fix for glob failure on Windows shares [Bug
	1100542].

	* doc/pkgMkIndex.n: added documentation that 'pkg_mkIndex -lazy' is not
	a good idea. [Bug 1101678]

2005-01-14  Donal K. Fellows  <[email protected]>

	* tests/compile.test (compile-17.1): Document known issue with binding
	time of compiled command interpretations in [expr].

	* generic/tclIOUtil.c (TclFSFileAttrIndex): New helper function so that
	we don't need to hard-code attribute indexes. [Bug 1100671]

2005-01-13  Donal K. Fellows  <[email protected]>

	* doc/string.n: Removed the term 'set' from the documentation of the
	[string trim] commands, as it caused confusion.

2005-01-12  Donal K. Fellows  <[email protected]>

	* unix/tcl.m4 (SC_PATH_{TCL,TK}CONFIG): Added code to detect the case
	when the --with-tcl/--with-tk arguments point to the config scripts
	themselves and not their directory. If this is the case, they now
	complain but keep working. [FRQ 951247]
	* unix/configure:	autoconf-2.57

2005-01-10  Joe English  <[email protected]>

	* unix/Makefile.in, unix/configure.in, unix/tcl.m4,
	* unix/tclConfig.sh.in, unix/dltest/Makefile.in:
	Remove ${DBGX}, ${TCL_DBGX} from Tcl build system [Patch 1081595].
	* unix/configure: regenerated

2005-01-10  Donal K. Fellows  <[email protected]>

	* unix/tclUnixFCmd.c (TclUnixCopyFile): Convert u_int to unsigned to
	make clashes with types in standard C headers less of a problem. [Bug
	1098829]

2005-01-09  Joe English  <[email protected]>

	* unix/tclUnixThrd.c, unix/tclUnixPort.h: Remove readdir_r() and
	related #ifdeffery (see [Bug 1095909]).
	* unix/tcl.m4, unix/tclConfig.h.in: Don't check for HAVE_READDIR_R.
	* unix/configure: Regenerated.

2005-01-06  Donal K. Fellows  <[email protected]>

	* library/http/http.tcl (http::mapReply): Significant performance
	enhancement by using [string map] instead of [regsub]/[subst], and
	update version requirement to Tcl8.4. [Bug 1020491]

2005-01-05  Donal K. Fellows  <[email protected]>

	* doc/lsearch.n, doc/re_syntax.n: Convert to other form of emacs mode
	control comment to prevent problems with old versions of man. [Bug
	1085127]

2005-01-05  Pat Thoyts	<[email protected]>

	* tests/winDde.test: Fixed broken test result.

2005-01-05  Donal K. Fellows  <[email protected]>

	* generic/tclInt.h, generic/tclPort.h: Move the #include of tclConfig.h
	*first* before any reference to tcl.h so that the build configuration
	is loaded before the first reference to any system headers. Issue
	reported by Art Haas on tcl-core.

2005-01-04  Don Porter	<[email protected]>

	* tests/fCmd.test (fCmd-18.10):	Added notNetworkFilesystem constraint.
	[Bug 456665]

	******************************************************************
	*** CHANGELOG ENTRIES FOR 2004 IN "ChangeLog.2004"	       ***
	*** CHANGELOG ENTRIES FOR 2003 IN "ChangeLog.2003"	       ***
	*** CHANGELOG ENTRIES FOR 2002 IN "ChangeLog.2002"	       ***
	*** CHANGELOG ENTRIES FOR 2001 IN "ChangeLog.2001"	       ***
	*** CHANGELOG ENTRIES FOR 2000 IN "ChangeLog.2000"	       ***
	*** CHANGELOG ENTRIES FOR 1999 AND EARLIER IN "ChangeLog.1999" ***
	******************************************************************
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<




























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































Deleted ChangeLog.2007.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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
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
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
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
5805
5806
5807
5808
5809
5810
5811
5812
5813
5814
5815
5816
5817
5818
5819
5820
5821
5822
5823
5824
5825
5826
5827
5828
5829
5830
5831
5832
5833
5834
5835
5836
5837
5838
5839
5840
5841
5842
5843
5844
5845
5846
5847
5848
5849
5850
5851
5852
5853
5854
5855
5856
5857
5858
5859
5860
5861
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
2007-12-31  Donal K. Fellows  <[email protected]>

	* doc/dict.n: Clarified meaning of dictionary values following
	discussion on comp.lang.tcl.

2007-12-26  Miguel Sofer  <[email protected]>

	* generic/tclCmdIL.c: More [lsort] data handling streamlines. The
	function MergeSort is gone, essentially inlined into Tcl_LsortObjCmd.
	It is not a straight inlining, two loops over all lists elements where
	merged in the process: the linked list elements are now built and
	merged into the temporary sublists in the same pass.

2007-12-25  Miguel Sofer  <[email protected]>

	* generic/tclCmdIL.c: More [lsort] data handling streamlines. Extra
	mem reqs of latest patches removed, restored to previous mem profile.
	Improved -unique handling, now eliminating repeated elems immediately
	instead of marking them to avoid reinsertion at the end.

2007-12-23  Jeff Hobbs	<[email protected]>

	* generic/tclCompCmds.c (TclCompileRegexpCmd):	TCL_REG_NOSUB cannot
	* tests/regexp.test (regexp-22.2):		be used because it
	* tests/regexpComp.test:	[Bug 1857126]	disallows backrefs.

2007-12-21  Miguel Sofer  <[email protected]>

	* generic/tclCmdIL.c: Speed patch for lsort. [Patch 1856994]

2007-12-21  Miguel Sofer  <[email protected]>

	* generic/tclCmdIL.c (Tcl_LsortObjCmd, Tcl_LsearchObjCmd): Avoid
	calling SelectObjFromSublist when there are no sublists.

2007-12-21  Miguel Sofer  <[email protected]>

	* generic/tclCmdIL.c (Tcl_LsortObjCmd): Preallocate a listObj of
	sufficient length for the sorted list instead of growing it. Second
	commit replaces calls to Tcl_ListObjAppenElement with direct access to
	the internal rep.

2007-12-19  Don Porter	<[email protected]>

	*** 8.5.0 TAGGED FOR RELEASE ***

	* changes:		Updated for 8.5.0 release.

2007-12-19  Jeff Hobbs	<[email protected]>

	* generic/tclCompCmds.c (TclCompileSwitchCmd):	update switch -regexp
	* tests/switch.test-14.*:			compilation to pass
	the cflags to INST_REGEXP (changed on 12-07). Added tests for switch
	-regexp compilation (need more). [Bug 1854399]

2007-12-18  Don Porter	<[email protected]>

	* changes:		Updated for 8.5.0 release.

2007-12-18  Donal K. Fellows  <[email protected]>

	* generic/regguts.h, generic/regc_color.c, generic/regc_nfa.c:
	Fixes for problems created when processing regular expressions that
	generate very large automata. An enormous number of thanks to Will
	Drewry <wad_at_google.com>, Tavis Ormandy <taviso_at_google.com>,
	and Tom Lane <tgl_at_sss.pgh.pa.us> from the Postgresql crowd for
	their help in tracking these problems down. [Bug 1810264]

2007-12-17  Don Porter	<[email protected]>

	* changes:		Updated for 8.5.0 release.

2007-12-17  Miguel Sofer  <[email protected]>

	* generic/tclAlloc.c:
	* generic/tclExecute.c:
	* generic/tclInt.h:
	* generic/tclThreadAlloc.c: Fix alignment for memory returned by
	TclStackAlloc; insure that all memory allocators align to 16-byte
	boundaries on 64 bit platforms [Bug 1851832, 1851524]

2007-12-14  Jeff Hobbs	<[email protected]>

	* generic/tclIOUtil.c (FsAddMountsToGlobResult): fix the tail
	conversion of vfs mounts. [Bug 1602539]

	* win/README: updated notes

2007-12-14  Pat Thoyts	<[email protected]>

	* tests/winFile.test: Fixed tests for win2k with long machine name

2007-12-14  Pat Thoyts <[email protected]>

	* win/nmakehlp.c:  Support compilation with MSVC9 for AMD64.
	* win/makefile.vc:

2007-12-13  Donal K. Fellows  <[email protected]>

	* doc/trace.n: Clarified documentation of enterstep and leavestep
	traces, including adding example. [Bug 614282, 1701540, 1755984]

2007-12-12  Don Porter	<[email protected]>

	* doc/IntObj.3:	Update docs for the Tcl_GetBignumAndClearObj() ->
	Tcl_TakeBignumFromObj() revision [TIP 298]. Added docs for the
	Tcl_InitBignumFromDouble() routine. [Bug 1446971]

	* changes:		Updated for 8.5.0 release.

2007-12-10  Jeff Hobbs	<[email protected]>

	* generic/tclUtil.c (TclReToGlob): reduce escapes in conversion
	when not necessary

	* generic/tclInt.decls:	 move TclByteArrayMatch and TclReToGlob
	* generic/tclIntDecls.h: to tclInt.h from stubs.
	* generic/tclStubInit.c: Add flags var to TclByteArrayMatch for
	* generic/tclInt.h:	 future extensibility
	* generic/tcl.h:  define TCL_MATCH_EXACT doc for Tcl_StringCaseMatch.
	* doc/StrMatch.3: It is compatible with existing usage.
	* generic/tclExecute.c (INST_STR_MATCH): flag for TclByteArrayMatch
	* generic/tclUtil.c (TclByteArrayMatch, TclStringMatchObj):
	* generic/tclRegexp.c (Tcl_RegExpExecObj):
	* generic/tclCmdMZ.c (StringMatchCmd): Use TclStringMatchObj
	* tests/string.test (11.9.* 11.10.*): more tests

2007-12-10  Joe English	 <[email protected]>

	* doc/string.n, doc/UniCharIsAlpha.3: Fix markup errors.
	* doc/CrtCommand.3, doc/CrtMathFnc.3, doc/FileSystem.3,
	* doc/GetStdChan.3, doc/OpenFileChnl.3, doc/SetChanErr.3,
	* doc/eval.n, doc/filename.n: Consistency: Move "KEYWORDS" section
	after "SEE ALSO".

2007-12-10  Daniel Steffen  <[email protected]>

	* tools/genStubs.tcl:		fix numerous issues handling 'macosx',
					'aqua' or 'x11' entries interleaved
					with 'unix' entries [Bug 1834288]; add
					genStubs::export command
					[Tk FR 1716117]; cleanup formatting.

	* generic/tcl.decls:		use new genstubs 'export' command to
	* generic/tclInt.decls:		mark exported symbols not in stubs
	* generic/tclTomMath.decls:	table [Tk FR 1716117]; cleanup
					formatting.

	* generic/tclDecls.h:		regen with new genStubs.tcl.
	* generic/tclIntDecls.h:	[Bug 1834288]
	* generic/tclIntPlatDecls.h:
	* generic/tclPlatDecls.h:
	* generic/tclStubInit.c:

2007-12-09  Jeff Hobbs	<[email protected]>

	* tests/io.test, tests/chanio.test (io-73.1): Make sure to invalidate
	* generic/tclIO.c (SetChannelFromAny):	      internal rep only after
	validating channel rep. [Bug 1847044]

2007-12-08  Donal K. Fellows  <[email protected]>

	* doc/expr.n, doc/mathop.n: Improved the documentation of the
	operators. [Bug 1823622]

	* generic/tclBasic.c (builtInCmds): Corrected list of hidden and
	* doc/interp.n (SAFE INTERPRETERS): exposed commands so that the
	documentation and reality now match. [Bug 1662436]

2007-12-07  Jeff Hobbs	<[email protected]>

	* generic/tclExecute.c (TclExecuteByteCode INST_REGEXP):
	* generic/tclCompCmds.c (TclCompileRegexpCmd): Pass correct RE
	compile flags at compile time, and use TCL_REG_NOSUB.

	* generic/tclIOCmd.c (FinalizeIOCmdTSD, Tcl_PutsObjCmd): cache
	stdout channel object for [puts $str] calls.

2007-12-06  Don Porter	<[email protected]>

	* README:	Remove mention of dead comp.lang.tcl.announce
	newsgroup. [Bug 1846433]

	* unix/README:	Mention the stub library created by `make` and warn
	about the effect of embedded paths in the installed binaries.
	Thanks to Larry Virden. [Bug 1794084]

	* doc/AddErrInfo.3:	Documentation for the new routines in TIP 270.
	* doc/Interp.3:
	* doc/StringObj.3:

2007-12-06  Don Porter	<[email protected]>

	* doc/namespace.n:	Documentation for zero-argument form of
	[namespace import] (TIP 261) [Bug 1596416]

2007-12-06  Jeff Hobbs	<[email protected]>

	* generic/tclInt.h: add TclGetChannelFromObj decl
	(TclMatchIsTrivial): simplify TclMatchIsTrivial to remove ] check.

2007-12-06  Donal K. Fellows  <[email protected]>


	* generic/tclBasic.c (Tcl_CreateInterp): Simplify the setting up of
	* generic/tclIOCmd.c (TclInitChanCmd):	 the [chan] ensemble. This
	* library/init.tcl:			 gets rid of quite a bit of
	code and makes it possible to understand the whole with less effort.

	* generic/tclCompCmds.c (TclCompileEnsemble): Ensure that the right
	number of tokens are copied. [Bug 1845320]

	* generic/tclNamesp.c (TclMakeEnsemble): Added missing release of a
	DString. [Bug 1845397]

2007-12-05  Jeff Hobbs	<[email protected]>

	* generic/tclIO.h:    Create Tcl_Obj for Tcl channels to reduce
	* generic/tclIO.c:    overhead in lookup by Tcl_GetChannel. New
	* generic/tclIOCmd.c: TclGetChannelFromObj for internal use.
	* generic/tclIO.c (WriteBytes, WriteChars): add opt check to avoid
	EOL translation when not linebuffered or using lf. [Bug 1845092]

2007-12-05  Miguel Sofer  <[email protected]>

	* tests/stack.test: made the tests for stack overflow not care
	about which mechanism caused the error (interp's recursion limit
	or C-stack depth detector).

2007-12-05  Jeff Hobbs	<[email protected]>

	* win/configure, win/tcl.m4 (LIBS_GUI): mingw needs -lole32
	-loleaut32 but not msvc for Tk's [send]. [Bug 1844749]

2007-12-05  Donal K. Fellows  <[email protected]>

	* generic/tclCmdIL.c (Tcl_LsearchObjCmd): Prevent shimmering crash
	when -exact and -integer/-real are mixed. [Bug 1844789]

2007-12-03  Donal K. Fellows  <[email protected]>

	* unix/tclUnixChan.c (CreateSocketAddress): Add extra #ifdef-fery to
	make code compile on BSD 5. [Bug 1618235, again]

2007-12-03  Don Porter	<[email protected]>

	* library/tcltest/tcltest.tcl:	Bump tcltest to version 2.3.0 so that
	* library/tcltest/pkgIndex.tcl: we release a stable tcltest with a
	* unix/Makefile.in:	stable Tcl.
	* win/Makefile.in:

2007-12-03  Jeff Hobbs	<[email protected]>

	* win/configure, win/tcl.m4 (LIBS_GUI): remove ole32.lib oleaut32.lib

2007-12-03  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmds.c (TclCompileSwitchCmd): Adjusted the [switch]
	* generic/tclCmdMZ.c (Tcl_SwitchObjCmd):       command so that when
	passed two arguments, no check for options are performed. This is OK
	since in the two-arg case, detecting an option would definitely lead
	to a syntax error. [Patch 1836519]

2007-11-29  Jeff Hobbs	<[email protected]>

	* win/makefile.vc: add ws2_32.lib to baselibs
	* win/configure, win/tcl.m4: add ws2_32.lib / -lws2_32 to build.
	* win/tclWinSock.c: remove dyn loading of winsock, assume that it is
	always available now.

2007-11-29  Don Porter	<[email protected]>

	* generic/tclWinSock.c (InitializeHostName):	Correct error in
	buffer length tracking. After gethostname() writes into a buffer,
	convert only the written string to internal encoding, not the whole
	buffer.

2007-11-28  Don Porter	<[email protected]>

	* generic/tclConfig.c:	Corrected failure of the [::foo::pkgconfig]
	command to clean up registered configuration data when the query
	command is deleted from the interp. [Bug 983501]

	* generic/tclNamesp.c (Tcl_SetEnsembleMappingDict):	Added checks
	that the dict value passed in is in the format required to make the
	internals of ensembles work. [Bug 1436096]

	* generic/tclIO.c:	Simplify test and improve accuracy of error
	message in latest changes.

2007-11-28  Pat Thoyts	<[email protected]>

	* generic/tclIO.c: -eofchar must support no eofchar.

2007-11-27  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c: remove unneeded call in Tcl_CreateInterp, add
	comments.

2007-11-27  Don Porter	<[email protected]>

	* win/tclWinSock.c:	Add mising encoding conversion of the [info
	hostname] value from the system encoding to Tcl's internal encoding.

	* doc/chan.n:		"Fix" the limitation on channel -eofchar
	* doc/fconfigure.n:	values to single byte characters by
	* generic/tclIO.c:	documenting it and making it fail loudly.
	* tests/chan.test:	Thanks to Stuart Cassoff for contributing the
				fix. [Bug 800753]

2007-11-26  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c:
	* generic/tclInt.h:
	* unix/tclUnixInit.c:
	* unix/tclUnixThrd.c: Fix stack checking via workaround for bug in
	glibc's pthread_attr_get_np, patch from [Bug 1815573]. Many thanks to
	Sergei Golovan (aka Teo) for detecting the bug and helping diagnose
	and develop the fix.

2007-11-24  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmds.c (TclCompileDictAppendCmd): Fix bug in [dict
	append] compiler which caused strange stack corruption. [Bug 1837392]

2007-11-23  Andreas Kupries  <[email protected]>

	* generic/tclIORChan.c: Fixed a problem with reflected channels. 'chan
	postevent' is defined to work only from within the interpreter
	containing the handler command. Sensible, we want only handler
	commands to use it. It identifies the channel by handle. The channel
	moves to a different interpreter or thread. The interpreter containing
	the handler command doesn't know the channel any longer. 'chan
	postevent' fails, not finding the channel any longer. Uhm.

	Fixed by creating a second per-interpreter channel table, just for
	reflected channels, where each interpreter remembers for which
	reflected channels it has the handler command. This info does not move
	with the channel itself. The table is updated by 'chan create', and
	used by 'chan postevent'.

	* tests/ioCmd.test: Updated the testsuite.

2007-11-23  Jeff Hobbs	<[email protected]>

	* generic/tclVar.c (Tcl_ArrayObjCmd): handle the right data for
	* tests/var.test (var-14.2):	      [array names $var -glob $ptn]

2007-11-23  Donal K. Fellows  <[email protected]>

	* generic/tclCmdMZ.c (String*Cmd, TclInitStringCmd): Rebuilt [string]
	* generic/tclCompCmds.c (TclCompileString*Cmd): as an ensemble.

2007-11-22  Donal K. Fellows  <[email protected]>

	* generic/tclDictObj.c (Dict*Cmd,TclInitDictCmd): Rebuilt the [dict]
	* generic/tclCompCmds.c (TclCompileDict*Cmd): command as an ensemble.

2007-11-22  Donal K. Fellows  <[email protected]>

	* generic/tclCmdMZ.c (Tcl_StringObjCmd): Rewrote the [string] and
	* generic/tclDictObj.c (Tcl_DictObjCmd): [dict] implementations to be
	ready for conversion to ensembles.

	* tests/string.test (string-12.22): Flag shimmering bug found in
	[string range].

2007-11-21  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmds.c (TclCompileEnsemble): Rewrote the ensemble
	compiler to remove many of the limitations. Can now compile scripts
	that use unique prefixes of subcommands, and which have mappings of a
	command to multiple words (provided the first is a compilable command
	of course).

2007-11-21  Donal K. Fellows  <[email protected]>

	* generic/tclNamesp.c (TclMakeEnsemble): Factor out the code to set up
	a core ensemble from a table of information about subcommands, ready
	for reuse within the core.

	* generic/various: Start to return more useful Error codes, currently
	mainly on assorted lookup failures.

2007-11-20  Donal K. Fellows  <[email protected]>

	* generic/tclDictObj.c: Changed the underlying implementation of the
	hash table used in dictionaries to additionally keep all entries in
	the hash table in a linked list, which is only ever added to at the
	end. This makes iteration over all entries in the dictionary in
	key insertion order a trivial operation, and so cleans up a great deal
	of complexity relating to dictionary representation and stability of
	iteration order.

	***POTENTIAL INCOMPATIBILITY***
	For any code that depended on the (strange) old iteration order.

	* generic/tclConfig.c (QueryConfigObjCmd): Correct usage of
	Tcl_WrongNumArgs.

2007-11-19  Don Porter	<[email protected]>

	*** 8.5b3 TAGGED FOR RELEASE ***

	* README:		Bump version number to 8.5b3.
	* generic/tcl.h:
	* library/init.tcl:
	* tools/tcl.wse.in:
	* unix/configure.in:
	* unix/tcl.spec:
	* win/configure.in:

	* unix/configure:	autoconf (2.59)
	* win/configure:

	* changes:		Updated for 8.5b3 release.

2007-11-19  Kevin Kenny	 <[email protected]>

	* library/tzdata/Africa/Cairo:
	* library/tzdata/America/Campo_Grande:
	* library/tzdata/America/Caracas:
	* library/tzdata/America/Cuiaba:
	* library/tzdata/America/Havana:
	* library/tzdata/America/Sao_Paulo:
	* library/tzdata/Asia/Damascus:
	* library/tzdata/Asia/Gaza:
	* library/tzdata/Asia/Tehran:  Olson's tzdata2007i imported.

2007-11-18  Daniel Steffen  <[email protected]>

	* generic/tclExecute.c (TclExecuteByteCode:INST_EXIST_*): Fix read
	traces not firing on non-existent array elements. [Bug 1833522]

2007-11-16  Donal K. Fellows  <[email protected]>

	* generic/tclCmdIL.c (TclInitInfoCmd): Rename the implementation
	commands for [info] to be something more "expected".

	* generic/tclCompCmds.c (TclCompileInfoExistsCmd): Compiler for the
	[info exists] subcommand.
	(TclCompileEnsemble): Cleaned up version of ensemble compiler that was
	in TclCompileInfoCmd, but which is now much more generally applicable.

	* generic/tclInt.h (ENSEMBLE_COMPILE): Added flag to allow for cleaner
	turning on and off of ensemble bytecode compilation.

	* generic/tclCompile.c (TclCompileScript): Add the cmdPtr to the list
	of arguments passed to command compilers.

2007-11-15  Don Porter	<[email protected]>

	* generic/regc_nfa.c:	Fixed infinite loop in the regexp compiler.
	[Bug 1810038]

	* generic/regc_nfa.c:	Corrected looping logic in fixempties() to
	avoid wasting time walking a list of dead states. [Bug 1832612]

2007-11-15  Donal K. Fellows  <[email protected]>

	* generic/tclNamesp.c (NamespaceEnsembleCmd): Must pass a non-NULL
	interp to Tcl_SetEnsemble* functions.

	* doc/re_syntax.n: Try to make this easier to read. It's still a very
	difficult manual page!

	* unix/tcl.m4 (SC_CONFIG_CFLAGS): Allow people to turn off the -rpath
	option to their linker if they so desire. This is a configuration only
	recommended for (some) vendors. Relates to [Patch 1231022].

2007-11-15  Pat Thoyts	<[email protected]>

	* win/tclWin32Dll.c: Prefer UINT_PTR to DWORD_PTR when casting
	pointers to integer types for greater portability. [Bug 1831253]

2007-11-15  Daniel Steffen  <[email protected]>

	* macosx/Tcl.xcodeproj/project.pbxproj: add new chanio.test.
	* macosx/Tcl.xcode/project.pbxproj:

2007-11-14  Donal K. Fellows  <[email protected]>

	* generic/tclCompile.c (TclCompileScript): Ensure that we get our
	count in our INST_START_CMD calls right, even when there's a failure
	to compile a command directly.

	* generic/tclNamesp.c (Tcl_SetEnsembleSubcommandList)
	(Tcl_SetEnsembleMappingDict):		Special code to make sure that
	* generic/tclCmdIL.c (TclInitInfoCmd):	[info exists] is compiled
	right while not allowing changes to the ensemble to cause havok.

	* generic/tclCompCmds.c (TclCompileInfoCmd): Simple compiler for the
	[info] command that only handles [info exists].

	* generic/tclExecute.c (TclExecuteByteCode:INST_EXIST_*): New
	instructions to allow the testing of whether a variable exists.

2007-11-14  Andreas Kupries  <[email protected]>

	* tests/chanio.test: New file. This is essentially a duplicate of
	'io.test', with all channel commands converted to their 'chan xxx'
	notation.
	* tests/io.test: Fixed typo in test description.

2007-11-14  Donal K. Fellows  <[email protected]>

	* generic/regc*.c: Eliminate multi-char collating element code
	completely. Simplifies the code quite a bit. If people still want the
	full code, it will remain on the 8.4 branch. [Bug 1831425]

2007-11-13  Jeff Hobbs	<[email protected]>

	* generic/tclCompCmds.c (TclCompileRegexpCmd): clean up comments, only
	free dstring on OK from TclReToGlob.
	(TclCompileSwitchCmd): simplify TclReToGlob usage.

2007-11-14  Donal K. Fellows  <[email protected]>

	* generic/regc*.c: #ifdef/comment out the code that deals with
	multi-character collating elements, which have never been supported.
	Cuts the memory consumption of the RE compiler. [Bug 1831425]

2007-11-13  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmds.c (TclCompileSwitchCmd, TclCompileRegexpCmd):
	Extend [switch] compiler to handle regular expressions as long as
	things are not too complex. Fix [regexp] compiler so that non-trivial
	literal regexps get fed to INST_REGEXP.

	* doc/mathop.n: Clarify definitions of some operations.

2007-11-13  Miguel Sofer  <[email protected]>

	* unix/tclUnixInit.c: the TCL_NO_STACK_CHECK was being incorrectly
	undefined here; this should be set (or not) in the compile options, it
	is used elsewhere and needs to be consistent.

2007-11-13  Pat Thoyts	<[email protected]>

	* unix/tcl.m4:		Added autoconf goo to detect and make use of
	* unix/configure.in:	getaddrinfo and friends.
	* unix/configure:	(regenerated)

2007-11-13  Donal K. Fellows  <[email protected]>

	* unix/tclUnixCompat.c (TclpGetHostByName): The six-argument form of
	getaddressbyname_r() uses the fifth argument to indicate whether the
	lookup succeeded or not on at least one platform. [Bug 1618235]

2007-11-13  Don Porter	<[email protected]>

	* generic/regcomp.c:	Convert optst() from expensive no-op to a
	cheap no-op.

2007-11-13  Donal K. Fellows  <[email protected]>

	* unix/tclUnixChan.c (CreateSocketAddress): Rewrote to use the
	thread-safe version of gethostbyname() by forward-porting the code
	used in 8.4, and added rudimentary support for getaddrinfo() (not
	enabled by default, as no autoconf-ery written). Part of fix for [Bug
	1618235].

2007-11-12  Jeff Hobbs	<[email protected]>

	* generic/tclGet.c (Tcl_Get, Tcl_GetInt): revert use of TclGet* macros
	due to compiler warning. These cases won't save time either.

	* generic/tclUtil.c (TclReToGlob): add more comments, set interp
	result if specified on error.

2007-11-12  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c:		New macro TclResetResult, new iPtr
	* generic/tclExecute.c:		flag bit INTERP_RESULT_UNCLEAN:
	* generic/tclInt.h:		shortcut for Tcl_ResetResult for the
	* generic/tclProc.c:		"normal" case: TCL_OK, no return
	* generic/tclResult.c:		options, no errorCode nor errorInfo,
	* generic/tclStubLib.c:		return at normal level. [Patch
	* generic/tclUtil.c:		1830184]

	THIS PATCH WAS REVERTED: initial (mis)measurements overstated the
	perfomance wins, which turn out to be tiny. Not worth the
	complication.

2007-11-11  Jeff Hobbs	<[email protected]>

	* generic/tclCompCmds.c, generic/tclCompile.c, generic/tclCompile.h:
	* generic/tclExecute.c, generic/tclInt.decls, generic/tclIntDecls.h:
	* generic/tclRegexp.c, generic/tclRegexp.h: Add INST_REGEXP and fully
	* generic/tclStubInit.c, generic/tclUtil.c: compiled [regexp] for the
	* tests/regexpComp.test:     [Bug 1830166]  simple cases. Also added
	TclReToGlob function to convert RE to glob patterns and use these in
	the possible cases.

2007-11-11  Miguel Sofer  <[email protected]>

	* generic/tclResult.c (ResetObjResult): clarify the logic.

	* generic/tclBasic.c:		Increased usage of macros to detect
	* generic/tclBinary.c:		and take advantage of objTypes. Added
	* generic/tclClock.c:		macros TclGet(Int|Long)FromObj,
	* generic/tclCmdAH.c:		TclGetIntForIndexM & TclListObjLength,
	* generic/tclCmdIL.c:		modified TclListObjGetElements.
	* generic/tclCmdMZ.c:
	* generic/tclCompCmds.c:	The TclGetInt* macros are only a
	* generic/tclCompExpr.c:	shortcut on platforms where 'long' is
	* generic/tclCompile.c:		'int'; it may be worthwhile to extend
	* generic/tclDictObj.c:		their functionality to other cases.
	* generic/tclExecute.c:
	* generic/tclGet.c:		As this patch touches many files it
	* generic/tclIO.c:		has been recorded as [Patch 1830038]
	* generic/tclIOCmd.c:		in order to facilitate reviewing.
	* generic/tclIOGT.c:
	* generic/tclIndexObj.c:
	* generic/tclInt.h:
	* generic/tclInterp.c:
	* generic/tclListObj.c:
	* generic/tclLiteral.c:
	* generic/tclNamesp.c:
	* generic/tclObj.c:
	* generic/tclParse.c:
	* generic/tclProc.c:
	* generic/tclRegexp.c:
	* generic/tclResult.c:
	* generic/tclScan.c:
	* generic/tclStringObj.c:
	* generic/tclUtil.c:
	* generic/tclVar.c:

2007-11-11  Daniel Steffen  <[email protected]>

	* unix/tclUnixTime.c (TclpWideClicksToNanoseconds): Fix issues with
	* generic/tclInt.h:				    int64_t overflow.

	* generic/tclBasic.c:	Fix stack check failure case if stack grows up
	* unix/tclUnixInit.c:	Simplify non-crosscompiled case.

	* unix/configure:	autoconf-2.59
	* unix/tclConfig.h.in:	autoheader-2.59

2007-11-10  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c: Fast path for INST_LIST_INDEX when the index
	is not a list.

	* generic/tclBasic.c:
	* unix/configure.in:
	* unix/tclUnixInit.c: Detect stack grwoth direction at compile time,
	only fall to runtime detection when crosscompiling.

	* unix/configure: autoconf 2.61

	* generic/tclBasic.c:
	* generic/tclInt.h:
	* tests/interp.test:
	* unix/tclUnixInit.c:
	* win/tclWin32Dll.c: Restore simpler behaviour for stack checking, not
	adaptive to stack size changes after a thread is launched. Consensus
	is that "nobody does that", and so it is not worth the cost. Improved
	failure comments (mistachkin).

2007-11-10  Kevin Kenny	 <[email protected]>

	* win/tclWin32Dll.c: Rewrote the Windows stack checking algorithm to
	use information from VirtualQuery to determine the bound of the stack.
	This change fixes a bug where the guard page of the stack was never
	restored after an overflow. It also eliminates a nasty piece of
	assembly code for structured exception handling on mingw. It
	introduces an assumption that the stack is a single memory arena
	returned from VirtualAlloc, but the code in MSVCRT makes the same
	assumption, so it should be fairly safe.

2007-11-10  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c:
	* generic/tclInt.h:
	* unix/tclUnixInit.c:
	* unix/tclUnixPort.h:
	* win/tclWin32Dll.c: Modify the stack checking algorithm to recheck in
	case of failure. The working assumptions are now that (a) a thread's
	stack is never moved, and (b) a thread's stack can grow but not
	shrink. Port to windows - could be more efficient, but is already
	cheaper than it was.

2007-11-09  Miguel Sofer  <[email protected]>

	* generic/tclResult.c (ResetObjResult): new shortcut.

	* generic/tclAsync.c:
	* generic/tclBasic.c:
	* generic/tclExecute.c:
	* generic/tclInt.h:
	* generic/tclUnixInit.c:
	* generic/tclUnixPort.h: New fields in interp (ekeko!) to cache TSD
	data that is accessed at each command invocation, access macros to
	replace Tcl_AsyncReady and TclpCheckStackSpace by much faster variants
	[Patch 1829248]

2007-11-09  Jeff Hobbs	<[email protected]>

	* generic/tclInt.decls, generic/tclIntDecls.h: Use unsigned char for
	* generic/tclExecute.c, generic/tclUtil.c:     TclByteArrayMatch and
	don't allow a nocase option. [Bug 1828296]
	For INST_STR_MATCH, ignore pattern type for TclByteArrayMatch case.

	* generic/tclBinary.c (Tcl_GetByteArrayFromObj): check type before
	func jump (perf).

2007-11-07  Jeff Hobbs	<[email protected]>

	* generic/tclStubInit.c:		     Added TclByteArrayMatch
	* generic/tclInt.decls:			     for efficient glob
	* generic/tclIntDecls.h:		     matching of ByteArray
	* generic/tclUtil.c (TclByteArrayMatch):     Tcl_Objs, used in
	* generic/tclExecute.c (TclExecuteByteCode): INST_STR_MATCH. [Bug
						     1827996]

	* generic/tclIO.c (TclGetsObjBinary): Add an efficient binary path for
					      [gets].
	(DoWriteChars): Special case for 1-byte channel write.

2007-11-06  Miguel Sofer  <[email protected]>

	* generic/tclEncoding.c: Version of the embedded iso8859-1 encoding
	handler that is faster (functions to do the encoding know exactly what
	they're doing instead of pulling it from a table, though the table
	itself has to be retained for use by shift encodings that depend on
	iso8859-1). [Patch 1826906], committing for dkf.

2007-11-05  Andreas Kupries  <[email protected]>

	* generic/tclConfig.c (Tcl_RegisterConfig): Modified to not extend the
	config database if the encoding provided by the user is not found
	(venc == NULL). Scripts expecting the data will error out, however we
	neither crash nor provide bogus information. See [Bug 983509] for more
	discussion.

	* unix/tclUnixChan.c (TtyGetOptionProc): Accepted [Patch 1823576]
	provided by Stuart Cassof <[email protected]>. The patch adds
	the necessary utf/external conversions to the handling of the
	arguments of option -xchar which will allow the use of \0 and similar
	characters.

2007-11-03  Miguel Sofer  <[email protected]>

	* generic/tclTest.c (TestSetCmd2):
	* generic/tclVar.c (TclObjLookupVarEx):
	* tests/set.test (set-5.1): Fix error branch when array name looks
	like array element (code not normally exercised).

2007-11-01  Donal K. Fellows  <[email protected]>

	* tools/tcltk-man2html.tcl (output-directive): Convert .DS/.DE pairs
	into tables since that is now all that they are used for.

	* doc/RegExp.3: Clarified documentation of RE flags. [Bug 1167840]

	* doc/refchan.n: Adjust internal name to be consistent with the file
	name for reduced user confusion. After comment by Dan Steffen.

	* generic/tclCmdMZ.c (Tcl_StringObjCmd, UniCharIsAscii): Remember, the
	NUL character is in ASCII too. [Bug 1808258]

	* doc/file.n: Clarified use of [file normalize]. [Bug 1185154]

2007-10-30  Don Porter	<[email protected]>

	* generic/tcl.h:	Bump version number to 8.5b2.1 to distinguish
	* library/init.tcl:	CVS development snapshots from the 8.5b2
	* unix/configure.in:	release.
	* unix/tcl.spec:
	* win/configure.in:

	* unix/configure:	autoconf (2.59)
	* win/configure:

2007-10-30  Donal K. Fellows  <[email protected]>

	* doc/expr.n, doc/mathfunc.n: Improve documentation to try to make
	clearer what is going on.

	* doc/interp.n: Shorten the basic descriptive text for some interp
	subcommands so Solaris nroff doesn't truncate them. [Bug 1822268]

2007-10-30  Donal K. Fellows  <[email protected]>

	* tools/tcltk-man2html.tcl (output-widget-options): Enhance the HTML
	generator so that it can produce multi-line option descriptions.

2007-10-28  Miguel Sofer  <[email protected]>

	* generic/tclUtil.c (Tcl_ConcatObj): optimise for some of the
	concatenees being empty objs. [Bug 1447328]

2007-10-28  Donal K. Fellows  <[email protected]>

	* generic/tclEncoding.c (TclInitEncodingSubsystem): Hard code the
	iso8859-1 encoding, as it's needed for more than just text (especially
	binary encodings...) Note that other encodings rely on the encoding
	being a table encoding (!) so we can't use more efficient encoding
	mapping functions.

2007-10-27  Donal K. Fellows  <[email protected]>

	* generic/regc_lex.c (lexescape): Close off one of the problems
	mentioned in [Bug 1810264].

2007-10-27  Miguel Sofer  <[email protected]>

	* generic/tclNamesp.c (Tcl_FindCommand): insure that FQ command names
	are searched from the global namespace, ie, bypassing resolvers of the
	current namespace. [Bug 1114355]

	* doc/apply.n: fixed example [Bug 1811791]
	* doc/namespace.n: improved example [Bug 1788984]
	* doc/AddErrInfo.3: typo [Bug 1715087]
	* doc/CrtMathFnc.3: fixed Tcl_ListMathFuncs entry [Bug 1672219]

	* generic/tclCompile.h:
	* generic/tclInt.h: moved declaration of TclSetCmdNameObj from
	tclCompile.h to tclInt.h, reverting linker [Bug 1821159] caused by
	commit of 2007-10-11 (both I and gcc missed one dep).

	* generic/tclVar.c: try to preserve Tcl_Objs when doing variable
	lookups by name, partially addressing [Bug 1793601].

2007-10-27  Donal K. Fellows  <[email protected]>

	* tools/tcltk-man2html.tcl (make-man-pages, htmlize-text)
	(process-text): Make the man->HTML scraper work better.

2007-10-26  Don Porter	<[email protected]>

	*** 8.5b2 TAGGED FOR RELEASE ***

	* changes:		Updated for 8.5b2 release.

	* doc/*.1:		Revert doc changes that broke
	* doc/*.3:		`make html` so we can get the release
	* doc/*.n:		out the door.

	* README:		Bump version number to 8.5b2.
	* generic/tcl.h:
	* library/init.tcl:
	* tools/tcl.wse.in:
	* unix/configure.in:
	* unix/tcl.spec:
	* win/configure.in:

	* unix/configure:	autoconf (2.59)
	* win/configure:

2007-10-26  Donal K. Fellows  <[email protected]>

	* tools/man2help2.tcl, tools/man2tcl.c: Made some of the tooling code
	to do man->other formats work better with current manpage set. Long
	way still to go.

2007-10-25  Zoran Vasiljevic <[email protected]>

	* generic/tclThread.c: Added TclpMasterLock/Unlock arround calls to
	ForgetSyncObject in Tcl_MutexFinalize and Tcl_ConditionFinalize to
	prevent from garbling the internal lists that track sync objects. [Bug
	1726873]

2007-10-24  Donal K. Fellows  <[email protected]>

	* tools/man2html2.tcl (macro): Added support for converting the new
	macros into HTML.

	* doc/man.macros (QW,PQ,QR,MT): New macros that hide the ugly mess
	needed to get proper GOOBE quoting in the manual pages.
	* doc/*.n, doc/*.3, doc/*.1: Lots of changes to take advantage of the
	new macros.

2007-10-20  Miguel Sofer  <[email protected]>

	* generic/tclCompile.c:	  Fix comments.
	* generic/tclExecute.c:

2007-10-18  David Gravereaux <[email protected]>

	* tools/mkdepend.tcl: sort the dep list for a more humanly readable
	output.

2007-10-18  Don Porter	<[email protected]>

	* generic/tclResult.c (TclMergeReturnOptions):	Make sure any -code
	values get pulled out of the dictionary, even if they are integer
	valued.

	* generic/tclCompCmds.c (TclCompileReturnCmd):	Added code to more
	optimally compile [return -level 0 $x] to "push $x". [RFE 1794073]

	* compat/tmpnam.c (removed):	The routine tmpnam() is no longer
	* unix/Makefile.in:	called by Tcl source code. Remove autogoo the
	* unix/configure.in:	supplied a replacement version on systems
	* win/tcl.dsp:		where the routine was not available. [RFE
	1811848]

	* unix/configure:	autoconf-2.59

	* generic/tcl.h:	Remove TCL_LL_MODIFIER_SIZE. [RFE 1811837]

2007-10-17  David Gravereaux <[email protected]>

	* tools/mkdepend.tcl:	Improved defense from malformed object list
	infile.

2007-10-17  Donal K. Fellows  <[email protected]>

	* tools/man2html2.tcl: Convert .DS/.DE into HTML tables, not
	preformatted text.

2007-10-17  Kevin B. Kenny  <[email protected]>

	* generic/tclCompExpr.c: Moved a misplaced declaration that blocked
				 compilation on VC++.
	* generic/tclExecute.c: Silenced several VC++ compiler warnings about
				converting 'long' to 'unsigned short'.

2007-10-16  David Gravereaux <[email protected]>

	* win/makefile.vc: removed old dependency cruft that is no longer
	needed.

2007-10-15  Don Porter	<[email protected]>

	* generic/tclIOCmd.c:	Revise [open] so that it interprets leading
	zero strings passed as the "permissions" argument as octal numbers,
	even if Tcl itself no longer parses integers in that way.

	* unix/tclUnixFCmd.c:	Revise the "-permissions" [file attribute] so
	that it interprets leading zero strings as octal numbers, even if Tcl
	itself no longer parses integers in that way.

	* generic/tclCompExpr.c:	Corrections to code that produces
	* generic/tclUtil.c:		extended "bad octal" error messages.

	* tests/cmdAH.test:	Test revisions so that tests pass whether or
	* tests/cmdIL.test:	not Tcl parses leading zero strings as octal.
	* tests/compExpr-old.test:
	* tests/compExpr.test:
	* tests/compile.test:
	* tests/expr-old.test:
	* tests/expr.test:
	* tests/incr.test:
	* tests/io.test:
	* tests/lindex.test:
	* tests/link.test:
	* tests/mathop.test:
	* tests/parseExpr.test:
	* tests/set.test:
	* tests/string.test:
	* tests/stringComp.test:

2007-10-15  David Gravereaux <[email protected]>

	* tools/mkdepend.tcl:	Produces usable output. Include path problem
	* win/makefile.vc:	fixed. Never fight city hall when it comes to
	levels of quoting issues.

2007-10-15  Miguel Sofer  <[email protected]>

	* generic/tclParse.c (Tcl_ParseBraces): fix for possible read after
	the end of buffer. [Bug 1813528] (Joe Mistachkin)

2007-10-14  David Gravereaux <[email protected]>

	* tools/mkdepend.tcl (new):  Initial stab at generating automatic
	* win/makefile.vc:	     dependencies.

2007-10-12  Pat Thoyts	<[email protected]>

	* win/makefile.vc:  Mine all version information from headers.
	* win/rules.vc:	    Sync tcl and tk and bring extension versions
	* win/nmakehlp.c:   closer together. Try and avoid using tclsh to do
			    substitutions as we may cross compile.
	* win/coffbase.txt: Added offsets for snack dlls.

2007-10-11  David Gravereaux <[email protected]>

	* win/makefile.vc:  Fixed my bad spelling mistakes from years back.
	Dedependency, duh!  Rather funny.

2007-10-11  Don Porter	<[email protected]>

	* generic/tclCmdMZ.c:	Correct [string is (wide)integer] failure
	* tests/string.test:	to report correct failindex values for
	non-decimal integer strings. [Bug 1805887]

	* compat/strtoll.c (removed):	The routines strtoll() and strtoull()
	* compat/strtoull.c (removed):	are no longer called by the Tcl source
	* generic/tcl.h:	code. (Their functionality has been replaced
	* unix/Makefile.in:	by TclParseNumber().) Remove outdated comments
	* unix/configure.in:	and mountains of configury autogoo that
	* unix/tclUnixPort.h:	allegedly support the mythical systems where
	* win/Makefile.in:	these routines might not have been available.
	* win/makefile.bc:
	* win/makefile.vc:
	* win/tclWinPort.h:

	* unix/configure:	autoconf-2.59

2007-10-11  Miguel Sofer  <[email protected]>

	* generic/tclObj.c: remove superfluous #include of tclCompile.h

2007-10-08  George Peter Staplin <[email protected]>

	* doc/Hash.3: Correct the valid usage of the flags member for the
	Tcl_HashKeyType. It should be 0 or more of the flags mentioned.

2007-10-02  Jeff Hobbs	<[email protected]>

	* generic/tcl.h (Tcl_DecrRefCount): Update change from 2006-05-29 to
	make macro more warning-robust in unbraced if code.

2007-10-02  Don Porter	<[email protected]>

	[core-stabilizer-branch]

	* README:		Bump version number to 8.5.0
	* generic/tcl.h:
	* library/init.tcl:
	* tools/tcl.wse.in:
	* unix/configure.in:
	* unix/tcl.spec:
	* win/configure.in:

	* unix/configure:	autoconf (2.59)
	* win/configure:

2007-10-02  Andreas Kupries  <[email protected]>

	* library/tclIndex: Added 'tcl::tm::path' to the tclIndex. This fixes
	[Bug 1806422] reported by Don Porter.

2007-09-25  Donal K. Fellows  <[email protected]>

	* generic/tclProc.c (Tcl_DisassembleObjCmd): Define a command,
	::tcl::unsupported::disassemble, which can disassemble procedures,
	lambdas and general scripts.
	* generic/tclCompile.c (TclDisassembleByteCodeObj): Split apart the
	code to print disassemblies of bytecode so that there is reusable code
	that spits it out in a Tcl_Obj and then that code is used when doing
	tracing.

2007-09-20  Don Porter	<[email protected]>

	*** 8.5b1 TAGGED FOR RELEASE ***

	* changes: updates for 8.5b1 release.

2007-09-19  Don Porter	<[email protected]>

	* README:		Bump version number to 8.5b1
	* generic/tcl.h:	Merge from core-stabilizer-branch.
	* library/init.tcl:	Stabilizing toward 8.5b1 release now done on
	* tools/tcl.wse.in:	the HEAD. core-stabilizer-branch is now
	* unix/configure.in:	suspended.
	* unix/tcl.spec:
	* win/configure.in:

2007-09-19  Pat Thoyts	<[email protected]>

	* generic/tclStubLib.: Replaced isdigit with internal implementation.

2007-09-18  Don Porter	<[email protected]>

	* generic/tclStubLib.c:	Remove C library calls from Tcl_InitStubs() so
	* win/makefile.vc:	that we don't need the C library linked in to
	libtclStub.

2007-09-17  Pat Thoyts	<[email protected]>

	* win/makefile.vc: Add crt flags for tclStubLib now it uses C-library
			   functions.

2007-09-17  Joe English	 <[email protected]>

	* tcl.m4: use '${CC} -shared' instead of 'ld -Bshareable' to build
	shared libraries on current NetBSDs. [Bug 1749251]
	* unix/configure: regenerated (autoconf-2.59).

2007-09-17  Don Porter	<[email protected]>

	* unix/Makefile.in:	Update `make dist` so that tclDTrace.d is
	included in the source code distribution.

	* generic/tcl.h:	Revised Tcl_InitStubs() to restore Tcl 8.4
	* generic/tclPkg.c:	source compatibility with callers of
	* generic/tclStubLib.c:	Tcl_InitStubs(interp, TCL_VERSION, 1). [Bug
	1578344]

2007-09-17  Donal K. Fellows  <[email protected]>

	* generic/tclTrace.c (Tcl_TraceObjCmd, TraceExecutionObjCmd)
	(TraceCommandObjCmd, TraceVariableObjCmd):   Generate literal values
	* generic/tclNamesp.c (NamespaceCodeCmd):    more efficiently using
	* generic/tclFCmd.c (CopyRenameOneFile):     TclNewLiteralStringObj
	* generic/tclEvent.c (TclSetBgErrorHandler): macro.

2007-09-15  Daniel Steffen  <[email protected]>

	* unix/tcl.m4:	replace all direct references to compiler by ${CC} to
			enable CC overriding at configure & make time; run
			check for visibility "hidden" with all compilers;
			quoting fixes from TEA tcl.m4.
	(SunOS-5.1x):	replace direct use of '/usr/ccs/bin/ld' in SHLIB_LD by
			'cc' compiler driver.
	* unix/configure: autoconf-2.59

2007-09-14  Donal K. Fellows  <[email protected]>

	* generic/tclBasic.c (Tcl_CreateObjCommand): Only invalidate along the
	namespace path once; that is enough. [Bug 1519940]

2007-09-14  Daniel Steffen  <[email protected]>

	* generic/tclDTrace.d (new file): Add DTrace provider for Tcl; allows
	* generic/tclCompile.h:		  tracing of proc and command entry &
	* generic/tclBasic.c:		  return, bytecode execution, object
	* generic/tclExecute.c:		  allocation and more; with
	* generic/tclInt.h:		  essentially zero cost when tracing
	* generic/tclObj.c:		  is inactive; enable with
	* generic/tclProc.c:		  --enable-dtrace configure arg
	* unix/Makefile.in:		  (disabled by default, will only
	* unix/configure.in:		  enable if DTrace is present). [Patch
	1793984]

	* macosx/GNUmakefile:		  Enable DTrace support.
	* macosx/Tcl-Common.xcconfig:
	* macosx/Tcl.xcodeproj/project.pbxproj:

	* generic/tclCmdIL.c:	Factor out core of InfoFrameCmd() into
				internal TclInfoFrame() for use by DTrace
				probes.

	* unix/configure: autoconf-2.59
	* unix/tclConfig.h.in: autoheader-2.59

2007-09-12  Don Porter	<[email protected]>

	* unix/Makefile.in:	Perform missing updates of the tcltest Tcl
	* win/Makefile.in:	Module installed filename that should have
	been part of the bump to tcltest 2.3b1. Thanks Larry Virden.

2007-09-12  Pat Thoyts	<[email protected]>

	* win/makefile.vc, win/rules.vc, win/nmakehlp.c: Use nmakehlp to
	substitute values for tclConfig.sh (helps cross-compiling).

2007-09-11  Don Porter	<[email protected]>

	* library/tcltest/tcltest.tcl:	Accept underscores and colons in
	* library/tcltest/pkgIndex.tcl: constraint names. Properly handle
	constraint expressions that return non-numeric boolean results like
	"false". Bump to tcltest 2.3b1. [Bug 1772989; RFE 1071322]
	* tests/info.test:	Disable fragile tests.

	* doc/package.n:	Restored the functioning of [package require
	* generic/tclPkg.c:	-exact] to be compatible with Tcl 8.4. [Bug
	* tests/pkg.test:	1578344]

2007-09-11  Miguel Sofer  <[email protected]>

	* generic/tclCompCmds.c (TclCompileDictCmd-update):
	* generic/tclCompile.c (tclInstructionTable):
	* generic/tclExecute.c (INST_DICT_UPDATE_END): fix stack management in
	compiled [dict update]. [Bug 1786481]

	***POTENTIAL INCOMPATIBILITY***
	Scripts that were precompiled on earlier versions of 8.5 and use [dict
	update] will crash. Workaround: recompile.

2007-09-11  Kevin B. Kenny  <[email protected]>

	* generic/tclExecute.c: Corrected an off-by-one error in the setting
	of MaxBaseWide for certain powers. [Bug 1767293 - problem reported in
	comments when bug was reopened]

2007-09-10  Jeff Hobbs	<[email protected]>

	* generic/tclLink.c (Tcl_UpdateLinkedVar): guard against var being
	unlinked. [Bug 1740631] (maros)

2007-09-10  Miguel Sofer  <[email protected]>

	* generic/tclCompile.c: fix tclInstructionTable entry for
	dictUpdateEnd

	* generic/tclExecute.c: remove unneeded setting of 'cleanup' variable
	before jumping to checkForCatch.

2007-09-10  Don Porter	<[email protected]>

	* doc/package.n:	Restored the document parallel syntax of the
	* generic/tclPkg.c:	[package present] and [package require]
	* tests/pkg.test:	commands. [Bug 1723675]

2007-09-09  Don Porter	<[email protected]>

	* generic/tclInt.h:	Removed the "nsName" Tcl_ObjType from the
	* generic/tclNamesp.c:	registered set. Revised the management of the
	* generic/tclObj.c:	intrep of that Tcl_ObjType. Revised the
	* tests/obj.test:	TclGetNamespaceFromObj() routine to return
	TCL_ERROR and write a consistent error message when a namespace is not
	found. [Bug 1588842. Patch 1686862]

	***POTENTIAL INCOMPATIBILITY***
	For callers of Tcl_GetObjType() on the name "nsName".

	* generic/tclExecute.c: Update TclGetNamespaceFromObj() callers.
	* generic/tclProc.c:

	* tests/apply.test:		Updated tests to expect new consistent
	* tests/namespace-old.test:	error message when a namespace is not
	* tests/namespace.test:		found.
	* tests/upvar.test:

	* generic/tclCompCmds.c:	Use the new INST_REVERSE instruction
	* tests/mathop.test:	to correct the compiled versions of math
	operator commands. [Bug 1724437]

	* generic/tclCompile.c: New bytecode instruction INST_REVERSE to
	* generic/tclCompile.h: reverse the order of N items at the top of
	* generic/tclExecute.c: stack.

	* generic/tclCompCmds.c (TclCompilePowOpCmd):	Make a separate
	routine to compile ** to account for its different associativity.

2007-09-08  Miguel Sofer  <[email protected]>

	* generic/tclVar.c (Tcl_SetVar2, TclPtrSetVar): [Bug 1710710] fixed
	correctly, reverted fix of 2007-05-01.

2007-09-08  Donal K. Fellows  <[email protected]>

	* generic/tclDictObj.c (DictUpdateCmd, DictWithCmd): Plug a hole that
	* generic/tclExecute.c (TEBC,INST_DICT_UPDATE_END): allowed a careful
	* tests/dict.test (dict-21.16,21.17,22.11): attacker to craft a dict
	containing a recursive link to itself, violating one of Tcl's
	fundamental datatype assumptions and causing a stack crash when the
	dict was converted to a string. [Bug 1786481]

2007-09-07  Don Porter	<[email protected]>

	* generic/tclEvent.c ([::tcl::Bgerror]):	Corrections to Tcl's
	* tests/event.test:	default [interp bgerror] handler so that when
	it falls back to a hidden [bgerror] in a safe interp, it gets the
	right error context data. [Bug 1790274]

2007-09-07  Miguel Sofer  <[email protected]>

	* generic/tclProc.c (TclInitCompiledLocals): the refCount of resolved
	variables was being managed without checking if they were Var or
	VarInHash: itcl [Bug 1790184]

2007-09-06  Don Porter	<[email protected]>

	* generic/tclResult.c (Tcl_GetReturnOptions):	Take care that a
	* tests/init.test:	non-TCL_ERROR code doesn't cause existing
	-errorinfo, -errorcode, and -errorline entries to be omitted.
	* generic/tclEvent.c:	With -errorInfo no longer lost, generate more
	complete ::errorInfo when calling [bgerror] after a non-TCL_ERROR
	background exception.

2007-09-06  Don Porter	<[email protected]>

	* generic/tclInterp.c (Tcl_Init):	Removed constraint on ability
	to define a custom [tclInit] before calling Tcl_Init(). Until now the
	custom command had to be a proc. Now it can be any command.

	* generic/tclInt.decls: New internal routine TclBackgroundException()
	* generic/tclEvent.c:	that for the first time permits non-TCL_ERROR
	exceptions to trigger [interp bgerror] handling. Closes a gap in TIP
	221. When falling back to [bgerror] (which is designed only to handle
	TCL_ERROR), convert exceptions into errors complaining about the
	exception.

	* generic/tclInterp.c:	Convert Tcl_BackgroundError() callers to call
	* generic/tclIO.c:	TclBackgroundException().
	* generic/tclIOCmd.c:
	* generic/tclTimer.c:

	* generic/tclIntDecls.h:	make genstubs
	* generic/tclStubInit.c:

2007-09-06  Daniel Steffen  <[email protected]>

	* macosx/Tcl.xcode/project.pbxproj: discontinue unmaintained support
	* macosx/Tcl.xcode/default.pbxuser: for Xcode 1.5; replace by Xcode2
	project for use on Tiger (with Tcl.xcodeproj to be used on Leopard).

	* macosx/Tcl.xcodeproj/project.pbxproj: updates for Xcode 2.5 and 3.0.
	* macosx/Tcl.xcodeproj/default.pbxuser:
	* macosx/Tcl.xcode/project.pbxproj:
	* macosx/Tcl.xcode/default.pbxuser:
	* macosx/Tcl-Common.xcconfig:

	* macosx/README: document project changes.

2007-09-05  Don Porter	<[email protected]>

	* generic/tclBasic.c:	Removed support for the unmaintained
	* generic/tclExecute.c: -DTCL_GENERIC_ONLY configuration. [Bug
	* unix/Makefile.in:	1264623]

2007-09-04  Don Porter	<[email protected]>

	* unix/Makefile.in:	It's unreliable to count on the release
	manager to remember to `make genstubs` before `make dist`. Let the
	Makefile remember the dependency for us.

	* unix/Makefile.in:	Corrections to `make dist` dependencies to be
	sure that macosx/configure gets generated whenever it does not exist.

2007-09-03  Kevin B, Kenny  <[email protected]>

	* library/tzdata/Africa/Cairo:
	* library/tzdata/America/Grand_Turk:
	* library/tzdata/America/Port-au-Prince:
	* library/tzdata/America/Indiana/Petersburg:
	* library/tzdata/America/Indiana/Tell_City:
	* library/tzdata/America/Indiana/Vincennes:
	* library/tzdata/Antarctica/McMurdo:
	* library/tzdata/Australia/Adelaide:
	* library/tzdata/Australia/Broken_Hill:
	* library/tzdata/Australia/Currie:
	* library/tzdata/Australia/Hobart:
	* library/tzdata/Australia/Lord_Howe:
	* library/tzdata/Australia/Melbourne:
	* library/tzdata/Australia/Sydney:
	* library/tzdata/Pacific/Auckland:
	* library/tzdata/Pacific/Chatham: Olson's tzdata2007g.

	* generic/tclListObj.c (TclLindexFlat):
	* tests/lindex.test (lindex-17.[01]):	Added code to detect the error
	when a script does [lindex {} end foo]; an overaggressive optimisation
	caused this call to return an empty object rather than an error.

2007-09-03  Daniel Steffen  <[email protected]>

	* generic/tclObj.c (TclInitObjSubsystem): restore registration of the
	"wideInt" Tcl_ObjType for compatibility with 8.4 extensions that
	access the tclWideIntType Tcl_ObjType; add setFromAnyProc for
	tclWideIntType.

2007-09-02  Donal K. Fellows  <[email protected]>

	* doc/lsearch.n: Added note that order of results with the -all option
	is that of the input list. It always was, but this makes it crystal.

2007-08-30  Don Porter	<[email protected]>

	* generic/tclCompile.c: Added fflush() calls following all callers of
	* generic/tclExecute.c: TclPrintByteCodeObj() so that tcl_traceCompile
	output is less likely to get mangled when writes to stdout interleave
	with other code.

2007-08-28  Don Porter	<[email protected]>

	* generic/tclCompExpr.c:	Use a table lookup in ParseLexeme() to
	determine lexemes with single-byte representations.

	* generic/tclBasic.c:	Used unions to better clarify overloading of
	* generic/tclCompExpr.c:	the fields of the OpCmdInfo and
	* generic/tclCompile.h:		TclOpCmdClientData structs.

2007-08-27  Don Porter	<[email protected]>

	* generic/tclCompExpr.c:	Call TclCompileSyntaxError() when
	expression syntax errors are found when compiling expressions. With
	this in place, convert TclCompileExpr to return void, since there's no
	longer any need to report TCL_ERROR.
	* generic/tclCompile.c: Update callers.
	* generic/tclExecute.c:

	* generic/tclCompCmds.c:	New routine TclCompileSyntaxError()
	* generic/tclCompile.h: to directly compile bytecodes that report a
	* generic/tclCompile.c: syntax error, rather than (ab)use a call to
	TclCompileReturnCmd. Also, undo the most recent commit that papered
	over some issues with that (ab)use. New routine produces a new opcode
	INST_SYNTAX, which is a minor variation of INST_RETURN_IMM. Also a bit
	of constification.

	* generic/tclCompile.c: Move the deallocation of local LiteralTable
	* generic/tclCompExpr.c:	entries into TclFreeCompileEnv().
	* generic/tclExecute.c: Update callers.

	* generic/tclCompExpr.c:	Force numeric and boolean literals in
	expressions to register with their intreps intact, even if that means
	overwriting existing intreps in already registered literals.

2007-08-25  Kevin B. Kenny  <[email protected]>

	* generic/tclExecute.c (TclExecuteByteCode): Added code to handle
	* tests/expr.test (expr-23.48-53)	     integer exponentiation
	that results in 32- and 64-bit integer results, avoiding calls to wide
	integer exponentiation routines in this common case. [Bug 1767293]

	* library/clock.tcl (ParseClockScanFormat): Modified code to allow
	* tests/clock.test (clock-60.*):	    case-insensitive matching
	of time zone and month names. [Bug 1781282]

2007-08-24  Don Porter	<[email protected]>

	* generic/tclCompExpr.c:	Register literals found in expressions
	* tests/compExpr.test:	to restore literal sharing. Preserve numeric
	intreps when literals are created for the first time. Correct memleak
	in ExecConstantExprTree() and add test for the leak.

2007-08-24  Miguel Sofer  <[email protected]>

	* generic/tclCompile.c: replaced copy loop that tripped some compilers
	with memmove. [Bug 1780870]

2007-08-23  Don Porter	<[email protected]>

	* library/init.tcl ([auto_load_index]): Delete stray "]" that created
	an expr syntax error (masked by a [catch]).

	* generic/tclCompCmds.c (TclCompileReturnCmd):	Added crash protection
	to handle callers other than TclCompileScript() failing to meet the
	initialization assumptions of the TIP 280 code in CompileWord().

	* generic/tclCompExpr.c:	Suppress the attempt to convert to
	numeric when pre-compiling a constant expression indicates an error.

2007-08-22  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c (TEBC): disable the new shortcut to frequent
	INSTs for debug builds. REVERTED (collision with alternative fix)

2007-08-21  Don Porter	<[email protected]>

	* generic/tclMain.c:	Corrected the logic of dropping the last
	* tests/main.test:	newline from an interactively typed command.
	[Bug 1775878]

2007-08-21  Pat Thoyts	<[email protected]>

	* tests/thread.test: thread-4.4: clear ::errorInfo in the thread as a
	message is left here from init.tcl on windows due to no tcl_pkgPath.

2007-08-20  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c (INST_SUB): fix usage of the new macro for
	overflow detection in sums, adapt to subtraction. Lengthy comment
	added.

2007-08-19  Donal K. Fellows  <[email protected]>

	* generic/tclExecute.c (Overflowing, TclIncrObj, TclExecuteByteCode):
	Encapsulate Miguel's last change in a more mnemonic macro.

2007-08-19  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c: changed the check for overflow in sums,
	reducing objsize, number of branches and cache misses (according to
	cachegrind). Non-overflow for s=a+b:
	previous
	  ((a >= 0 || b >= 0 || s < 0) && (s >= 0 || b < 0 || a < 0))
	now
	  (((a^s) >= 0) || ((a^b) < 0))
	This expresses: "a and s have the same sign or else a and b have
	different sign".

2007-08-19  Donal K. Fellows  <[email protected]>

	* doc/interp.n (RESOURCE LIMITS): Added text to better explain why
	time limits are described using absolute times. [Bug 1752148]

2007-08-16  Miguel Sofer  <[email protected]>

	* generic/tclVar.c: improved localVarNameType caching to leverage
	the new availability of Tcl_Obj in variable names, avoiding string
	comparisons to verify that the cached value is usable.

	* generic/tclExecute.c: check the two most frequent instructions
	before the switch. Reduces both runtime and obj size a tiny bit.

2007-08-16  Don Porter	<[email protected]>

	* generic/tclCompExpr.c:	Added a "constant" field to the OpNode
	struct (again "free" due to alignment requirements) to mark those
	subexpressions that are completely known at compile time. Enhanced
	CompileExprTree() and its callers to precompute these constant
	subexpressions at compile time. This resolves the issue raised in [Bug
	1564517].

2007-08-15  Donal K. Fellows  <[email protected]>

	* generic/tclIOUtil.c (TclGetOpenModeEx): Only set the O_APPEND flag
	* tests/ioUtil.test (ioUtil-4.1):	  on a channel for the 'a'
	mode and not for 'a+'. [Bug 1773127]

2007-08-14  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c (INST_INVOKE*): peephole opt, do not get the
	interp's result if it will be pushed/popped.

2007-08-14  Don Porter	<[email protected]>

	* generic/tclBasic.c:	Use fully qualified variable names for
	* tests/thread.test:	::errorInfo and ::errorCode so that string
	* tests/trace.test:	reported to variable traces are fully
	qualified in agreement with Tcl 8.4 operations.

2007-08-14  Daniel Steffen  <[email protected]>

	* unix/tclLoadDyld.c: use dlfcn API on Mac OS X 10.4 and later; fix
	issues with loading from memory on intel and 64bit; add debug messages

	* tests/load.test: add test load-10.1 for loading from vfs.

	* unix/dltest/pkga.c:		whitespace & comment cleanup, remove
	* unix/dltest/pkgb.c:		unused pkgf.c.
	* unix/dltest/pkgc.c:
	* unix/dltest/pkge.c:
	* unix/dltest/pkgf.c (removed):
	* unix/dltest/pkgua.c:
	* macosx/Tcl.xcodeproj/project.pbxproj:

2007-08-13  Don Porter	<[email protected]>

	* generic/tclExecute.c: Provide DECACHE/CACHE protection to the
	* tests/trace.test:	Tcl_LogCommandInfo() call. [Bug 1773040]

2007-08-12  Miguel Sofer  <[email protected]>

	* generic/tclCmdMZ.c (Tcl_SplitObjCmd): use TclNewStringObj macro
	instead of calling the function.

	* generic/tcl_Obj.c (TclAllocateFreeObjects): remove unneeded memset
	to 0 of all allocated objects.

2007-08-10  Miguel Sofer  <[email protected]>

	* generic/tclInt.h: remove redundant ops in TclNewStringObj macro.

2007-08-10  Miguel Sofer  <[email protected]>

	* generic/tclInt.h: fix the TclSetVarNamespaceVar macro, was causing a
	leak.

2007-08-10  Don Porter	<[email protected]>

	* generic/tclCompExpr.c:	Revise CompileExprTree() to use the
	OpNode mark field scheme of tree traversal. This eliminates the need
	to use magic values in the left and right fields for that purpose.
	Also stop abusing the left field within ParseExpr() to store the
	number of arguments in a parsed function call. CompileExprTree() now
	determines that for itself at compile time. Then reorder code to
	eliminate duplication.

2007-08-09  Miguel Sofer  <[email protected]>

	* generic/tclProc.c (TclCreateProc): better comments on the required
	varflag values when loading precompiled procs.

	* generic/tclExecute.c (INST_STORE_ARRAY):
	* tests/trace.test (trace-2.6): whole array write traces on compiled
	local variables were not firing. [Bug 1770591]

2007-08-08  Jeff Hobbs	<[email protected]>

	* generic/tclProc.c (InitLocalCache): reference firstLocalPtr via
	procPtr. codePtr->procPtr == NULL exposed by tbcload.

2007-08-08  Don Porter	<[email protected]>

	* generic/tclExecute.c: Corrected failure to compile/link in the
	-DNO_WIDE_TYPE configuration.

	* generic/tclExecute.c: Corrected improper use of bignum arguments to
	* tests/expr.test:	*SHIFT operations. [Bug 1770224]

2007-08-07  Miguel Sofer  <[email protected]>

	* generic/tclInt.h: remove comments refering to VAR_SCALAR, as that
	flag bit does not exist any longer.
	* generic/tclProc.c (InitCompiledLocals): removed optimisation for
	non-resolved case, as the function is never called in that case.
	Renamed the function to InitResolvedLocals to calrify the point.

	* generic/tclInt.decls:	  Exporting via stubs to help xotcl adapt to
	* generic/tclInt.h:	  VarReform.
	* generic/tclIntDecls.h:
	* generic/tclStubInit.c:

2007-08-07  Daniel Steffen  <[email protected]>

	* generic/tclEnv.c:	improve environ handling on Mac OS X (adapted
	* unix/tclUnixPort.h:	from Apple changes in Darwin tcl-64).

	* unix/Makefile.in:	add support for compile flags specific to
				object files linked directly into executables.

	* unix/configure.in (Darwin): only use -seg1addr flag when prebinding;
	use -mdynamic-no-pic flag for object files linked directly into exes;
	support overriding TCL_PACKAGE_PATH/TCL_MODULE_PATH in environment.

	* unix/configure: autoconf-2.59

2007-08-06  Don Porter	<[email protected]>

	* tests/parseExpr.test: Update source file name of expr parser code.

	* generic/tclCompExpr.c:	Added a "mark" field to the OpNode
	struct, which is used to guide tree traversal. This field costs
	nothing since alignement requirements used the memory already.
	Rewrote ConvertTreeToTokens() to use the new field, which permitted
	consolidation of utility routines CopyTokens() and
	GenerateTokensForLiteral().

2007-08-06  Kevin B. Kenny  <[email protected]>

	* generic/tclGetDate.y: Added a cast to the definition of YYFREE to
				silence compiler warnings.
	* generic/tclDate.c:	Regenerated
	* win/tclWinTest.c:	Added a cast to GetSecurityDescriptorDacl call
				to silence compiler warnings.

2007-08-04  Miguel Sofer  <[email protected]>

	* generic/tclInt.decls:	  Exporting via stubs to help itcl adapt to
	* generic/tclInt.h:	  VarReform. Added localCache initialization
	* generic/tclIntDecls.h:  to TclInitCompiledLocals (which only exists
	* generic/tclProc.c:	  for itcl).
	* generic/tclStubInit.c:
	* generic/tclVar.c:

2007-08-01  Donal K. Fellows  <[email protected]>

	* library/word.tcl: Rewrote for greater efficiency. [Bug 1764318]

2007-08-01  Pat Thoyts	<[email protected]>

	* generic/tclInt.h:	Added a TclOffset macro ala Tk_Offset to
	* generic/tclVar.c:	abstract out 'offsetof' which may not be
	* generic/tclExceute.c: defined (eg: msvc6).

2007-08-01  Miguel Sofer  <[email protected]>

	* generic/tclVar.c (TclCleanupVar): fix [Bug 1765225], thx Larry
	Virden.

2007-07-31  Miguel Sofer  <[email protected]>

	* doc/Hash.3:
	* generic/tclHash.c:
	* generic/tclObj.c:
	* generic/tclThreadStorage.c: (changes part of the patch below)
	Stop Tcl_CreateHashVar from resetting hPtr->clientData to NULL after
	calling the allocEntryProc for a custom table.

	* generic/tcl.h:
	* generic/tclBasic.c:
	* generic/tclCmdIL.c:
	* generic/tclCompCmds.c:
	* generic/tclCompile.c:
	* generic/tclCompile.h:
	* generic/tclExecute.c:
	* generic/tclHash.c:
	* generic/tclInt.decls:
	* generic/tclInt.h:
	* generic/tclIntDecls.h:
	* generic/tclLiteral.c:
	* generic/tclNamesp.c:
	* generic/tclObj.c:
	* generic/tclProc.c:
	* generic/tclThreadStorage.c:
	* generic/tclTrace.c:
	* generic/tclVar.c: VarReform [Patch 1750051]

	*** POTENTIAL INCOMPATIBILITY *** (tclInt.h and tclCompile.h)
	Extensions that access internals defined in tclInt.h and/or
	tclCompile.h may lose both binary and source compatibility. The
	relevant changes are:
	1. 'struct Var' is completely changed, all acceses to its internals
	   (either direct or via the TclSetVar* and TclIsVar* macros) will
	   malfunction. Var flag values and semantics changed too.
	2. 'struct Bytecode' has an additional field that has to be
	   initialised to NULL
	3. 'struct Namespace' is larger, as the varTable is now one pointer
	   larger than a Tcl_HashTable. Direct access to its fields will
	   malfunction.
	4. 'struct CallFrame' grew one more field (the second such growth with
	   respect to Tcl8.4).
	5. API change for the functions TclFindCompiledLocal, TclDeleteVars
	   and many internal functions in tclVar.c

	Additionally, direct access to variable hash tables via the standard
	Tcl_Hash* interface is to be considered as deprecated. It still works
	in the present version, but will be broken by further specialisation
	of these hash tables. This concerns especially the table of array
	elements in an array, as well as the varTable field in the Namespace
	struct.

2007-07-31  Miguel Sofer  <[email protected]>

	* unix/configure.in: allow use of 'inline' in Tcl sources. [Patch
	* win/configure.in:  1754128]
	* win/makefile.vc:   Regen with autoconf 2.61

2007-07-31  Donal K. Fellows  <[email protected]>

	* unix/tclUnixInit.c (TclpSetVariables): Use the thread-safe getpwuid
	replacement to fill the tcl_platform(user) field as it is not subject
	to spoofing. [Bug 681877]

	* unix/tclUnixCompat.c: Simplify the #ifdef logic.

	* unix/tclUnixChan.c (FileWatchProc): Fix test failures.

2007-07-30  Donal K. Fellows  <[email protected]>

	* unix/tclUnixChan.c (SET_BITS, CLEAR_BITS): Added macros to make this
	file clearer.

2007-07-24  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c (TEOvI, GetCommandSource):
	* generic/tclExecute.c (TEBC, TclGetSrcInfoForCmd):
	* generic/tclInt.h:
	* generic/tclTrace.c (TclCheck(Interp|Execution)Traces):
	Removed the need for TEBC to inspect the command before calling TEOvI,
	leveraging the TIP 280 infrastructure. Moved the generation of a
	correct nul-terminated command string away from the trace code, back
	into TEOvI/GetCommandSource.

2007-07-20  Andreas Kupries  <[email protected]>

	* library/platform/platform.tcl: Fixed bug in 'platform::patterns'
	* library/platform/pkgIndex.tcl: where identifiers not matching
	* unix/Makefile.in: the special linux and solaris forms would not
	* win/Makefile.in: get 'tcl' as an acceptable platform added to
	* doc/platform.n: the result. Bumped package to version 1.0.3 and
	* doc/platform_shell.n: updated documentation and Makefiles. Also
	fixed bad version info in the documentation of platform::shell.

2007-07-19  Don Porter	<[email protected]>

	* generic/tclParse.c:	In contexts where interp and parsePtr->interp
	might be different, be sure to use the latter for error reporting.
	Also pulled the interp argument back out of ParseTokens() since we
	already had a parsePtr->interp to work with.

2007-07-18  Don Porter	<[email protected]>

	* generic/tclCompExpr.c:	Removed unused arguments and variables

2007-07-17  Don Porter	<[email protected]>

	* generic/tclCompExpr.c (ParseExpr):	While adding comments to
	explain the operations of ParseExpr(), made significant revisions to
	the code so it would be easier to explain, and in the process made the
	code simpler and clearer as well.

2007-07-15  Don Porter	<[email protected]>

	* generic/tclCompExpr.c:	More commentary.
	* tests/parseExpr.test:		Several tests of syntax error messages
	to check that when expression substrings are truncated they leave
	visible the context relevant to the reported error.

2007-07-12  Don Porter	<[email protected]>

	* generic/tclCompExpr.c:	Factored out, corrected, and commented
	common code for reporting syntax errors in LEAF elements.

2007-07-11  Miguel Sofer  <[email protected]>

	* generic/tclCompCmds.c (TclCompileWhileCmd):
	* generic/tclCompile.c (TclCompileScript):
	Corrected faulty avoidance of INST_START_CMD when the first opcode in
	a script is within a loop (as produced by 'while 1'), so that the
	corresponding command is properly counted. [Bug 1752146]

2007-07-11  Don Porter	<[email protected]>

	* generic/tclCompExpr.c:	Added a "parseOnly" flag argument to
	ParseExpr() to indicate whether the caller is Tcl_ParseExpr(), with an
	end goal of filling a Tcl_Parse with Tcl_Tokens representing the
	parsed expression, or TclCompileExpr() with the goal of compiling and
	executing the expression. In the latter case, more aggressive
	conversion of QUOTED and BRACED lexeme to literals is done. In the
	former case, all such conversion is avoided, since Tcl_Token
	production would revert it anyway. This enables simplifications to the
	GenerateTokensForLiteral() routine as well.

2007-07-10  Don Porter	<[email protected]>

	* generic/tclCompExpr.c:	Added a field for operator precedence
	to be stored directly in the parse tree. There's no memory cost to
	this addition, since that memory would have been lost to alignment
	issues anyway. Also, converted precedence definitions and lookup
	tables to use symbolic constants instead of raw number for improved
	readability, and continued extending/improving/correcting comments.
	Removed some unused counter variables. Renamed some variables for
	clarity and replaced some cryptic logic with more readable macros.

2007-07-09  Don Porter	<[email protected]>

	* generic/tclCompExpr.c:	Revision so that the END lexeme never
	gets inserted into the parse tree. Later tree traversal never reaches
	it since its location in the tree is not variable. Starting and
	stopping with the START lexeme (node 0) is sufficient. Also finished
	lexeme code commentary.

	* generic/tclCompExpr.c:	Added missing creation and return of
	the Tcl_Parse fields that indicate error conditions. [Bug 1749987]

2007-07-05  Don Porter	<[email protected]>

	* library/init.tcl (unknown):	Corrected inconsistent error message
	in interactive [unknown] when empty command is invoked. [Bug 1743676]

2007-07-05  Miguel Sofer  <[email protected]>

	* generic/tclNamesp.c (SetNsNameFromAny):
	* generic/tclObj.c (SetCmdNameFromAny): Avoid unnecessary
	ckfree/ckalloc when the old structs can be reused.

2007-07-04  Miguel Sofer  <[email protected]>

	* generic/tclNamesp.c: Fix case where a FQ cmd or ns was being cached
	* generic/tclObj.c:    in a different interp, tkcon. [Bug 1747512]

2007-07-03  Don Porter	<[email protected]>

	* generic/tclCompExpr.c:	Revised #define values so that there
	is now more expansion room to define more BINARY operators.

2007-07-02  Donal K. Fellows  <[email protected]>

	* generic/tclHash.c (CompareStringKeys): Always use the strcmp()
	version; the operation is functionally equivalent, the speed is
	identical (up to measurement limitations), and yet the code is
	simpler. [FRQ 951168]

2007-07-02  Don Porter	<[email protected]>

	* generic/tcl.h:	Removed TCL_PRESERVE_BINARY_COMPATIBILITY and
	* generic/tclHash.c:	any code enabled when it is set to 0. We will
	* generic/tclStubInit.c:	always want to preserve binary compat
	of the structs that appear in the interface through the 8.* series of
	releases, so it's pointless to drag around this never-enabled
	alternative.

	* generic/tclIO.c:	Removed dead code.
	* unix/tclUnixChan.c:

	* generic/tclCompExpr.c:	Removed dead code, old implementations
	* generic/tclEvent.c:	of expr parsing and compiling, including the
	* generic/tclInt.h:	routine TclFinalizeCompilation().

2007-06-30  Donal K. Fellows  <[email protected]>

	* generic/tclCmdIL.c (Tcl_LsortObjCmd): Plug a memory leak caused by a
	missing Tcl_DecrRefCount on an error path. [Bug 1717186]

2007-06-30  Zoran Vasiljevic <[email protected]>

	* generic/tclThread.c: Prevent RemeberSyncObj() from growing the sync
	object lists by reusing already free'd slots, if possible. See
	discussion on Bug 1726873 for more information.

2007-06-29  Donal K. Fellows  <[email protected]>

	* doc/DictObj.3 (Tcl_DictObjDone): Improved documentation of this
	function to make it clearer how to use it. [Bug 1710795]

2007-06-29  Daniel Steffen  <[email protected]>

	* generic/tclAlloc.c:		on Darwin, ensure memory allocated by
	* generic/tclThreadAlloc.c:	the custom TclpAlloc()s is aligned to
	16 byte boundaries (as is the case with the Darwin system malloc).

	* generic/tclGetDate.y: use ckalloc/ckfree instead of malloc/free.
	* generic/tclDate.c:	bison 1.875e

	* generic/tclBasic.c (TclEvalEx): fix warnings.

	* macosx/Tcl.xcodeproj/project.pbxproj: better support for renamed tcl
	* macosx/Tcl.xcodeproj/default.pbxuser: source dir; add 10.5 SDK build
	* macosx/Tcl-Common.xcconfig:		config; remove tclMathOp.c.

	* macosx/README: document Tcl.xcodeproj changes.

2007-06-28  Don Porter	<[email protected]>

	* generic/tclBasic.c:		Removed dead code, including the
	* generic/tclExecute.c:		entire file tclMathOp.c.
	* generic/tclInt.h:
	* generic/tclMathOp.c (removed):
	* generic/tclTestObj.c:
	* win/tclWinFile.c:

	* unix/Makefile.in:	Updated to reflect deletion of tclMathOp.c.
	* win/Makefile.in:
	* win/makefile.bc:
	* win/makefile.vc:

2007-06-28  Pat Thoyts	<[email protected]>

	* generic/tclBasic.c:	  Silence constness warnings for TclStackFree
	* generic/tclCompCmds.c:  when building with msvc.
	* generic/tclFCmd.c:
	* generic/tclIOCmd.c:
	* generic/tclTrace.c:

2007-06-28  Miguel Sofer  <[email protected]>

	* generic/tclVar.c (UnsetVarStruct): fix possible segfault.

2007-06-27  Don Porter	<[email protected]>

	* generic/tclTrace.c:	Corrected broken trace reversal logic in
	* generic/tclTest.c:	TclCheckInterpTraces that led to infinite loop
	* tests/trace.test:	when multiple Tcl_CreateTrace traces were set
	and one of them did not fire due to level restrictions. [Bug 1743931]

2007-06-26  Don Porter	<[email protected]>

	* generic/tclBasic.c (TclEvalEx):	Moved some arrays from the C
	stack to the Tcl stack.

2007-06-26  Miguel Sofer  <[email protected]>

	* generic/tclVar.c (UnsetVarStruct): more streamlining.

2007-06-25  Don Porter	<[email protected]>

	* generic/tclExecute.c: Safety checks to avoid crashes in the
	TclStack* routines when called with an incompletely initialized
	interp. [Bug 1743302]

2007-06-25  Miguel Sofer  <[email protected]>

	* generic/tclVar.c (UnsetVarStruct): fixing incomplete change, more
	streamlining.

2007-06-24  Miguel Sofer  <[email protected]>

	* generic/tclVar.c (TclDeleteCompiledLocalVars): removed inlining that
	ended up not really optimising (limited benchmarks). Now calling
	UnsetVarStruct (streamlined old code is #ifdef'ed out, in case better
	benchmarks do show a difference).

	* generic/tclVar.c (UnsetVarStruct): fixed a leak introduced in last
	commit.

2007-06-23  Miguel Sofer  <[email protected]>

	* generic/tclVar.c (UnsetVarStruct, TclDeleteVars): made the logic
	slightly clearer, eliminated some duplicated code.

	*** POTENTIAL INCOMPATIBILITY *** (tclInt.h and Var struct users)
	The core never builds VAR_LINK variable to have traces. Such a
	"monster", should one exist, will now have its unset traces called
	*before* it is unlinked.

2007-06-23  Daniel Steffen  <[email protected]>

	* macosx/tclMacOSXNotify.c (AtForkChild): don't call CoreFoundation
	APIs after fork() on systems where that would lead to an abort().

2007-06-22  Don Porter	<[email protected]>

	* generic/tclExecute.c: Revised TclStackRealloc() signature to better
	* generic/tclInt.h:	parallel (and fall back on) Tcl_Realloc.

	* generic/tclNamesp.c (TclResetShadowesCmdRefs):	Replaced
	ckrealloc based allocations with TclStackRealloc allocations.

	* generic/tclCmdIL.c:	More conversions to use TclStackAlloc.
	* generic/tclScan.c:

2007-06-21  Don Porter	<[email protected]>

	* generic/tclBasic.c:	 Move most instances of the Tcl_Parse struct
	* generic/tclCompExpr.c: off the C stack and onto the Tcl stack. This
	* generic/tclCompile.c:	 is a rather large struct (> 3kB).
	* generic/tclParse.c:

2007-06-21  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c (TEOvI):		Made sure that leave traces
	* generic/tclExecute.c (INST_INVOKE):	that were created during
	* tests/trace.test (trace-36.2):	execution of an originally
	untraced command do not fire [Bug 1740962], partial fix.

2007-06-21  Donal K. Fellows  <[email protected]>

	* generic/tcl.h, generic/tclCompile.h, generic/tclCompile.c: Remove
	references in comments to obsolete {expand} notation. [Bug 1740859]

2007-06-20  Miguel Sofer  <[email protected]>

	* generic/tclVar.c: streamline namespace vars deletion: only compute
	the variable's full name if the variable is traced.

2007-06-20  Don Porter	<[email protected]>

	* generic/tclInt.decls: Revised the interfaces of the routines
	* generic/tclExecute.c: TclStackAlloc and TclStackFree to make them
	easier for callers to use (or more precisely, harder to misuse).
	TclStackFree now takes a (void *) argument which is the pointer
	intended to be freed. TclStackFree will panic if that's not actually
	the memory the call will free. TSA/TSF also now tolerate receiving
	(interp == NULL), in which case they simply fall back to be calls to
	Tcl_Alloc/Tcl_Free.

	* generic/tclIntDecls.h:	make genstubs

	* generic/tclBasic.c:	Updated callers
	* generic/tclCmdAH.c:
	* generic/tclCmdIL.c:
	* generic/tclCompCmds.c:
	* generic/tclCompExpr.c:
	* generic/tclCompile.c:
	* generic/tclFCmd.c:
	* generic/tclFileName.c:
	* generic/tclIOCmd.c:
	* generic/tclIndexObj.c:
	* generic/tclInterp.c:
	* generic/tclNamesp.c:
	* generic/tclProc.c:
	* generic/tclTrace.c:
	* unix/tclUnixPipe.c:

2007-06-20  Jeff Hobbs	<[email protected]>

	* tools/tcltk-man2html.tcl: revamp of html doc output to use CSS,
	standardized headers, subheaders, dictionary sorting of names.

2007-06-18  Jeff Hobbs	<[email protected]>

	* tools/tcltk-man2html.tcl: clean up copyright merging and output.
	clean up coding constructs.

2007-06-18  Miguel Sofer  <[email protected]>

	* generic/tclCmdIL.c (InfoFrameCmd):
	* generic/tclCmdMZ.c (Tcl_SwitchObjCmd):
	* generic/tclCompile.c (TclInitCompileEnv):
	* generic/tclProc.c (Tcl_ProcObjCmd, SetLambdaFromAny): Moved the
	CmdFrame off the C stack and onto the Tcl stack.

	* generic/tclExecute.c (TEBC):	Moved the CmdFrame off the C stack and
	onto the Tcl stack, between the catch and the execution stacks

2007-06-18  Don Porter	<[email protected]>

	* generic/tclBasic.c (TclEvalEx,TclEvalObjEx):	Moved the CmdFrame off
	the C stack and onto the Tcl stack.

2007-06-17  Donal K. Fellows  <[email protected]>

	* generic/tclProc.c (TclObjInterpProcCore): Minor fixes to make
	* generic/tclExecute.c (TclExecuteByteCode): compilation debugging
	builds work again. [Bug 1738542]

2007-06-16  Donal K. Fellows  <[email protected]>

	* generic/tclProc.c (TclObjInterpProcCore): Use switch instead of a
	chain of if's for a modest performance gain and a little more clarity.

2007-06-15  Miguel Sofer  <[email protected]>

	* generic/tclCompCmds.c:  Simplified [variable] compiler and executor.
	* generic/tclExecute.c:	  Missed updates to "there is always a valid
	frame".

	* generic/tclCompile.c: reverted TclEvalObjvInternal and INST_INVOKE
	* generic/tclExecute.c: to essentially what they were previous to the
	* generic/tclBasic.c:	commit of 2007-04-03 [Patch 1693802] and the
	subsequent optimisations, as they break the new trace tests described
	below.

	* generic/trace.test: added tests 36 to 38 for dynamic trace creation
	and addition. These tests expose a change in dynamics due to a recent
	round of optimisations. The "correct" behaviour is not described in
	docs nor TIP 62.

2007-06-14  Miguel Sofer  <[email protected]>

	* generic/tclInt.decls:	  Modif to the internals of TclObjInterpProc
	* generic/tclInt.h:	  to reduce stack consumption and improve task
	* generic/tclIntDecls.h:  separation. Changes the interface of
	* generic/tclProc.c:	  TclObjInterpProcCore (patching TclOO
	simultaneously).

	* generic/tclProc.c (TclObjInterpProcCore): simplified obj management
	in wrongNumArgs calls.

2007-06-14  Don Porter	<[email protected]>

	* generic/tclCompile.c: SetByteCodeFromAny() can no longer return any
	* generic/tclExecute.c: code other than TCL_OK, so remove code that
	* generic/tclProc.c:	formerly handled exceptional codes.

2007-06-13  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c (TclCompEvalObj): missed update to "there is
	always a valid frame".

	* generic/tclProc.c (TclObjInterpProcCore): call TEBC directly instead
	of going through TclCompEvalObj - no need to check the compilation's
	freshness, this has already been done. This improves speed and should
	also provide some relief to [Bug 1066755].

2007-06-12  Donal K. Fellows  <[email protected]>

	* generic/tclBasic.c (Tcl_CreateInterp): Turn the [info] command into
	* generic/tclCmdIL.c (TclInitInfoCmd):	 an ensemble, making it easier
	for third-party code to plug into.

	* generic/tclIndexObj.c (Tcl_WrongNumArgs):
	* generic/tclNamesp.c, generic/tclInt.h (tclEnsembleCmdType): Make
	Tcl_WrongNumArgs do replacement correctly with ensembles and other
	sorts of complex replacement strategies.

2007-06-11  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c:	 comments added to explain iPtr->numLevels
	management.

	* generic/tclNamesp.c:	 tweaks to Tcl_GetCommandFromObj and
	* generic/tclObj.c:	 TclGetNamespaceFromObj; modified the usage of
	structs ResolvedCmdName and ResolvedNsname so that the field refNsPtr
	is NULL for fully qualified names.

2007-06-10  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c:	 Further TEOvI split, creating a new
	* generic/tclCompile.h:	 TclEvalObjvKnownCommand() function to handle
	* generic/tclExecute.c:	 commands that are already known and are not
	traced. INST_INVOKE now calls into this function instead of inlining
	parts of TEOvI. Same perf, better isolation.

	***POTENTIAL INCOMPAT*** There is a subtle issue with the timing of
	execution traces that is changed here - first change appeared in my
	commit of 2007-04-03 [Patch 1693802], which caused some divergence
	between compiled and non-compiled code.
	***THIS CHANGE IS UNDER REVIEW***

2007-06-10  Jeff Hobbs	<[email protected]>

	* README: updated links. [Bug 1715081]

	* generic/tclExecute.c (TclExecuteByteCode): restore support for
	INST_CALL_BUILTIN_FUNC1 and INST_CALL_FUNC1 bytecodes to support 8.4-
	precompiled sources (math functions). [Bug 1720895]

2007-06-10  Miguel Sofer  <[email protected]>

	* generic/tclInt.h:
	* generic/tclNamesp.c:
	* generic/tclObj.c:
	* generic/tclvar.c: new macros TclGetCurrentNamespace() and
	TclGetGlobalNamespace(); Tcl_GetCommandFromObj and
	TclGetNamespaceFromObj rewritten to make the logic clearer; slightly
	faster too.

2007-06-09  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c (INST_INVOKE): isolated two vars to the small
	block where they are actually used.

	* generic/tclObj.c (Tcl_GetCommandFromObj): rewritten to make the
	logic clearer; slightly faster too.

	* generic/tclBasic.c:	Split TEOv in two, by separating a processor
	for non-TCL_OK returns. Also split TEOvI in a full version that
	handles non-existing and traced commands, and a separate shorter
	version for the regular case.

	* generic/tclBasic.c:	Moved the generation of command strings for
	* generic/tclTrace.c:	traces: previously in Tcl_EvalObjv(), now in
	TclCheck[Interp|Execution]Traces(). Also insured that the strings are
	properly NUL terminated at the correct length. [Bug 1693986]

	***POTENTIAL INCOMPATIBILITY in internal API***
	The functions TclCheckInterpTraces() and TclCheckExecutionTraces() (in
	internal stubs) used to be noops if the command string was NULL, this
	is not true anymore: if the command string is NULL, they generate an
	appropriate string from (objc,objv) and use it to call the traces. The
	caller might as well not call them with a NULL string if he was
	expecting a noop.

	* generic/tclBasic.c:	Extend usage of TclLimitReady() and
	* generic/tclExecute.c: (new) TclLimitExceeded() macros.
	* generic/tclInt.h:
	* generic/tclInterp.c:

	* generic/tclInt.h:	New TclCleanupCommandMacro for core usage.
	* generic/tclBasic.c:
	* generic/tclExecute.c:
	* generic/tclObj.c:

2007-06-09 Daniel Steffen  <[email protected]>

	* macosx/Tcl.xcodeproj/project.pbxproj: add new Tclsh-Info.plist.in.

2007-06-08  Donal K. Fellows  <[email protected]>

	* generic/tclCmdMZ.c (Tcl_StringObjCmd): Changed [string first] and
	* doc/string.n: [string last] so that they have clearer descriptions
	for those people who know the adage about needles and haystacks. This
	follows suggestions on comp.lang.tcl...

2007-06-06  Miguel Sofer  <[email protected]>

	* generic/tclParse.c: fix for uninit read. [Bug 1732414]

2007-06-06  Daniel Steffen  <[email protected]>

	* macosx/Tcl.xcodeproj/project.pbxproj: add settings for Fix&Continue.

	* unix/configure.in (Darwin):		add plist for tclsh; link the
	* unix/Makefile.in  (Darwin):		Tcl and tclsh plists into
	* macosx/Tclsh-Info.plist.in (new):	their binaries in all cases.
	* macosx/Tcl-Common.xcconfig:

	* unix/tcl.m4 (Darwin): fix CF checks in fat 32&64bit builds.
	* unix/configure: autoconf-2.59

2007-06-05  Don Porter	<[email protected]>

	* generic/tclBasic.c:	Added interp flag value ERR_LEGACY_COPY to
	* generic/tclInt.h:	control the timing with which the global
	* generic/tclNamesp.c:	variables ::errorCode and ::errorInfo get
	* generic/tclProc.c:	updated after an error. This keeps more
	* generic/tclResult.c:	precise compatibility with Tcl 8.4.
	* tests/result.test (result-6.2):	[Bug 1649062]

2007-06-05  Miguel Sofer  <[email protected]>

	* generic/tclInt.h:
	* generic/tclExecute.c: Tcl-stack reform, [Patch 1701202]

2007-06-03  Daniel Steffen  <[email protected]>

	* unix/Makefile.in: add datarootdir to silence autoconf-2.6x warning.

2007-05-30  Don Porter	<[email protected]>

	* generic/tclBasic.c:	Removed code that dealt with
	* generic/tclCompile.c: TCL_TOKEN_EXPAND_WORD tokens representing
	* generic/tclCompile.h: expanded literal words. These sections were
	mostly in place to enable [info frame] to discover line information in
	expanded literals. Since the parser now generates a token for each
	post-expansion word referring to the right location in the original
	script string, [info frame] gets all the data it needs.

	* generic/tclInt.h:	Revised the parser so that it never produces
	* generic/tclParse.c:	TCL_TOKEN_EXPAND_WORD tokens when parsing an
	* tests/parse.test:	expanded literal word; that is, something like
	{*}{x y z}. Instead, generate the series of TCL_TOKEN_SIMPLE_WORD
	tokens to represent the words that expansion of the literal string
	produces. [RFE 1725186]

2007-05-29  Jeff Hobbs	<[email protected]>

	* unix/tclUnixThrd.c (Tcl_JoinThread): fix for 64-bit handling of
	pthread_join exit return code storage. [Bug 1712723]

2007-05-22  Don Porter	<[email protected]>

	[core-stabilizer-branch]

	* unix/configure:	autoconf-2.59 (FC6 fork)
	* win/configure:

	* README:		Bump version number to 8.5b1
	* generic/tcl.h:
	* library/init.tcl:
	* tools/tcl.wse.in:
	* unix/configure.in:
	* unix/tcl.spec:
	* win/configure.in:

2007-05-18  Don Porter	<[email protected]>

	* unix/configure:	autoconf-2.59 (FC6 fork)
	* win/configure:

	* README:		Bump version number to 8.5a7
	* generic/tcl.h:
	* library/init.tcl:
	* tools/tcl.wse.in:
	* unix/configure.in:
	* unix/tcl.spec:
	* win/configure.in:

	* generic/tclParse.c:	Disable and remove the ALLOW_EXPAND sections
	* tests/info.test:	that continued to support the deprecated
	* tests/mathop.test:	{expand} syntax. Updated the few remaining
	users of that syntax in the test suite.

2007-05-17  Donal K. Fellows  <[email protected]>

	* generic/tclExecute.c (TclLimitReady): Created a macro version of
	Tcl_LimitReady just for TEBC, to reduce the amount of times that the
	bytecode engine calls out to external functions on the critical path.
	* generic/tclInterp.c (Tcl_LimitReady): Added note to remind anyone
	doing maintenance that there is a macro version to update.

2007-05-17  Daniel Steffen  <[email protected]>

	* generic/tcl.decls: workaround 'make checkstubs' failures from
	tclStubLib.c MODULE_SCOPE revert. [Bug 1716117]

2007-05-16  Joe English	 <[email protected]>

	* generic/tclStubLib.c:	 Change Tcl_InitStubs(), tclStubsPtr, and the
	auxilliary stubs table pointers back to public visibility.

	These symbols need to be exported so that stub-enabled extensions may
	be statically linked into an extended tclsh or Big Wish with a
	dynamically-linked libtcl. [Bug 1716117]

2007-05-15  Don Porter	<[email protected]>

	* win/configure:	autoconf-2.59 (FC6 fork)

	* library/reg/pkgIndex.tcl:	Bump to registry 1.2.1 to account for
	* win/configure.in:		[Bug 1682211] fix.
	* win/makefile.bc:
	* win/tclWinReg.c:

2007-05-11  Pat Thoyts	<[email protected]>

	* generic/tclInt.h: Removed TclEvalObjEx and TclGetSrcInfoForPc from
	tclInt.h now they are in the internal stubs table.

2007-05-09  Don Porter	<[email protected]>

	* generic/tclInt.h:	TclFinalizeThreadAlloc() is always defined, so
	make sure it is also always declared (with MODULE_SCOPE).

2007-05-09  Daniel Steffen  <[email protected]>

	* generic/tclInt.h: fix warning when building threaded with -DPURIFY.

	* macosx/Tcl.xcodeproj/project.pbxproj: add 'DebugUnthreaded' &
	* macosx/Tcl.xcodeproj/default.pbxuser: 'DebugLeaks' configs and env
	var settings needed to run the 'leaks' tool.

2007-05-07  Don Porter	<[email protected]>

	[Tcl Bug 1706140]

	* generic/tclLink.c (LinkTraceProc):	Update Tcl_VarTraceProcs so
	* generic/tclNamesp.c (Error*Read):	they call Tcl_InterpDeleted()
	* generic/tclTrace.c (Trace*Proc):	for themselves, and do not
	* generic/tclUtil.c (TclPrecTraceProc): rely on (frequently buggy)
	setting of the TCL_INTERP_DESTROYED flag by the trace core.

	* generic/tclVar.c:	Update callers of TclCallVarTraces to not pass
	in the TCL_INTERP_DESTROYED flag. Also apply filters so that public
	routines only pass documented flag values down to lower level routines

	* generic/tclTrace.c (TclCallVarTraces):	The setting of the
	TCL_INTERP_DESTROYED flag is now done entirely within the
	TclCallVarTraces routine, the only place it can be done right.

2007-05-06  Donal K. Fellows  <[email protected]>

	* generic/tclInt.h (ExtraFrameInfo): Create a new mechanism for
	* generic/tclCmdIL.c (InfoFrameCmd): conveying what information needs
	to be added to the results of [info frame] to replace the hack that
	was there before.
	* generic/tclProc.c (Tcl_ApplyObjCmd): Use the new mechanism for the
	[apply] command, the only part of Tcl itself that needs it (so far).

	* generic/tclInt.decls (TclEvalObjEx, TclGetSrcInfoForPc): Expose
	these two functions through the internal stubs table, necessary for
	extensions that need to integrate deeply with TIP#280.

2007-05-05  Donal K. Fellows  <[email protected]>

	* win/tclWinFile.c (TclpGetUserHome):	Squelch type-pun warnings in
	* win/tclWinInit.c (TclpSetVariables):	Win-specific code not found
	* win/tclWinReg.c (AppendSystemError):	during earlier work on Unix.

2007-05-04  Kevin B. Kenny  <[email protected]>

	* generic/tclIO.c (TclFinalizeIOSubsystem): Added an initializer to
	silence a spurious gcc warning about use of an uninitialized
	variable.
	* tests/encoding.test: Modified so that encoding tests happen in a
	private namespace, to avoid polluting the global one. This problem was
	discovered when running the test suite '-singleproc 1 -skip exec.test'
	because the 'path' variable in encoding.test conflicted with the one
	in io.test.
	* tests/io.test: Made more of the working variables private to the
	namespace.

2007-05-02  Kevin B. Kenny  <[email protected]>

	* generic/tclTest.c (SimpleMatchInDirectory): Corrected a refcount
	imbalance that affected the filesystem-[147]* tests in the test suite.
	Thanks to Don Porter for the patch. [Bug 1710707]
	* generic/tclPathObj.c (Tcl_FSJoinPath, Tcl_FSGetNormalizedPath):
	Corrected several memory leaks that caused refcount imbalances
	resulting in memory leaks on Windows. Thanks to Joe Mistachkin for the
	patch.

2007-05-01  Miguel Sofer  <[email protected]>

	* generic/tclVar.c (TclPtrSetVar): fixed leak whenever newvaluePtr had
	refCount 0 and was used for appending (but not lappending). Thanks to
	mistachkin and kbk. [Bug 1710710]

2007-05-01  Kevin B. Kenny  <[email protected]>

	* generic/tclIO.c (DeleteChannelTable): Made changes so that
	DeleteChannelTable tries to close all open channels, not just the
	first. [Bug 1710285]
	* generic/tclThread.c (TclFinalizeSynchronization): Make sure that TSD
	blocks get freed on non-threaded builds. [Bug 1710825]
	* tests/utf.test (utf-25.1--utf-25.4): Modified tests to clean up
	after the 'testobj' extension to avoid spurious reports of memory
	leaks.

2007-05-01  Don Porter	<[email protected]>

	* generic/tclCmdMZ.c (STR_MAP): When [string map] has a pure dict map,
	a missing Tcl_DictObjDone() call led to a memleak. [Bug 1710709]

2007-04-30  Daniel Steffen  <[email protected]>

	* unix/Makefile.in: add 'tclsh' dependency to install targets that
	rely on tclsh, fixes parallel 'make install' from empty build dir.

2007-04-30  Andreas Kupries <[email protected]>

	* generic/tclIO.c (FixLevelCode): Corrected reference count
	mismanagement of newlevel, newcode. Changed to allocate the Tcl_Obj's
	as late as possible, and only when actually needed. [Bug 1705778, leak
	K29]

2007-04-30  Kevin B. Kenny  <[email protected]>

	* generic/tclProc.c (Tcl_ProcObjCmd, SetLambdaFromAny): Corrected
	reference count mismanagement on the name of the source file in the
	TIP 280 code. [Bug 1705778, leak K02 among other manifestations]

2007-04-25  Donal K. Fellows  <[email protected]>

	*** 8.5a6 TAGGED FOR RELEASE ***

	* generic/tclProc.c (TclObjInterpProcCore): Only allocate objects for
	error message generation when associated with argument names that are
	really used. [Bug 1705778, leak K15]

2007-04-25  Kevin B. Kenny  <[email protected]>

	* generic/tclIOUtil.c (Tcl_FSChdir): Changed the memory management so
	that the path returned from Tcl_FSGetNativePath is not duplicated
	before being stored as the current directory, to avoid a memory leak.
	[Bug 1705778, leak K01 among other manifestations]

2007-04-25  Don Porter	<[email protected]>

	* generic/tclCompExpr.c (ParseExpr):	Revised to be sure that an
	error return doesn't prevent all literals getting placed on the
	litList to be returned to the caller for freeing. Corrects some
	memleaks. [Bug 1705778, leak K23]

2007-04-25  Daniel Steffen  <[email protected]>

	* unix/Makefile.in (dist): add macosx/*.xcconfig files to src dist;
	copy license.terms to dist macosx dir; fix autoheader bits.

2007-04-24  Miguel Sofer  <[email protected]>

	* generic/tclListObj.c: reverting [Patch 738900] (committed on
	2007-04-20). Causes some Tk test breakage of unknown importance, but
	the impact of the patch itself is likely to be so small that it does
	not warrant investigation at this time.

2007-04-24  Donal K. Fellows  <[email protected]>

	* generic/tclDictObj.c (DictKeysCmd): Rewrote so that the lock on the
	internal representation of a dict is only set when necessary. [Bug
	1705778, leak K04]
	(DictFilterCmd): Added code to drop the lock in the trivial match
	case. [Bug 1705778, leak K05]

2007-04-24  Kevin B. Kenny  <[email protected]>

	* generic/tclBinary.c: Addressed several code paths where the error
	return from the 'binary format' command leaked the result buffer.
	* generic/tclListObj.c (TclLsetFlat): Fixed a bug where the new list
	under construction was leaked in the error case. [Bug 1705778, leaks
	K13 and K14]

2007-04-24  Jeff Hobbs	<[email protected]>

	* unix/Makefile.in (dist): add platform library package to src dist

2007-04-24  Don Porter	<[email protected]>

	* generic/tclCompExpr.c (ParseExpr): Memory leak in error case; the
	literal Tcl_Obj was not getting freed. [Bug 1705778, leak #1 (new)]

	* generic/tclNamesp.c (Tcl_DeleteNamespace):	Corrected flaw in the
	flag marking scheme to be sure that global namespaces are freed when
	their interp is deleted. [Bug 1705778]

2007-04-24  Kevin B. Kenny  <[email protected]>

	* generic/tclExecute.c (TclExecuteByteCode): Plugged six memory leaks
	in bignum arithmetic.
	* generic/tclIOCmd.c (Tcl_ReadObjCmd): Plugged a leak of the buffer
	object if the physical read returned an error and the bypass area had
	no message.
	* generic/tclIORChan.c (TclChanCreateObjCmd): Plugged a leak of the
	return value from the "initialize" method of a channel handler.
	(All of the above under [Bug 1705778])

2007-04-23  Daniel Steffen  <[email protected]>

	* generic/tclCkalloc.c: fix warnings from gcc build configured with
	* generic/tclCompile.c: --enable-64bit --enable-symbols=all.
	* generic/tclExecute.c:

	* unix/tclUnixFCmd.c: add workaround for crashing bug in fts_open()
	* unix/tclUnixInit.c: without FTS_NOSTAT on 64bit Darwin 8 or earlier.

	* unix/tclLoadDyld.c (TclpLoadMemory): fix (void*) arithmetic.

	* macosx/Tcl-Common.xcconfig: enable more warnings.

	* macosx/Tcl.xcodeproj/project.pbxproj: add 'DebugMemCompile' build
	configuration that calls configure with --enable-symbols=all; override
	configure check for __attribute__((__visibility__("hidden"))) in Debug
	configuration to restore availability of ZeroLink.

	* macosx/tclMacOSXNotify.c: fix warnings.

	* macosx/tclMacOSXFCmd.c: const fixes.

	* macosx/Tcl-Common.xcconfig:	fix whitespace.
	* macosx/Tcl-Debug.xcconfig:
	* macosx/Tcl-Release.xcconfig:
	* macosx/README:

	* macosx/GNUmakefile:		fix/add copyright and license refs.
	* macosx/tclMacOSXBundle.c:
	* macosx/Tcl-Info.plist.in:
	* macosx/Tcl.xcode/project.pbxproj:
	* macosx/Tcl.xcodeproj/project.pbxproj:

	* unix/configure.in: install license.terms into Tcl.framework.
	* unix/configure: autoconf-2.59

2007-04-23  Don Porter	<[email protected]>

	* generic/tclVar.c (UnsetVarStruct):	Make sure the
	TCL_INTERP_DESTROYED flags gets passed to unset trace routines so they
	can respond appropriately. [Bug 1705778, leak #9]

2007-04-23  Miguel Sofer  <[email protected]>

	* generic/tclCompile.c (TclFreeCompileEnv): Tip 280's new field
	extCmdMapPtr was not being freed. [Bug 1705778, leak #1]

2007-04-23  Kevin B. Kenny  <[email protected]>

	* generic/tclCompCmds.c (TclCompileUpvarCmd): Plugged a memory leak in
	'upvar' when compiling (a) upvar outside a proc, (b) upvar with a
	syntax error, or (c) upvar where the frame index is not known at
	compile time.
	* generic/tclCompExpr.c (ParseExpr): Plugged a memory leak when
	parsing expressions that contain syntax errors.
	* generic/tclEnv.c (ReplaceString): Clear memory correctly when
	growing the cache to avoid reads of uninitialised data.
	* generic/tclIORChan.c (TclChanCreateObjCmd, FreeReflectedChannel):
	Plugged two memory leaks.
	* generic/tclStrToD.c (AccumulateDecimalDigit): Fixed a mistake where
	we'd run beyond the end of the 'pow10_wide' array if a number begins
	with a string of more than 'maxpow10_wide' zeroes.
	* generic/tclTest.c (Testregexpobjcmd): Removed an invalid access
	beyond the end of 'objv' in 'testregexp -about'.
	All of these issues reported under [Bug 1705778] - detected with the
	existing test suite, no new regression tests required.

2007-04-22  Miguel Sofer  <[email protected]>

	* generic/tclVar.c (TclDeleteNamespaceVars): fixed access to freed
	memory detected by valgrind: Tcl_GetCurrentNamespace was being
	called after freeing root CallFrame (on interp deletion).

2007-04-20  Miguel Sofer  <[email protected]>

	* generic/tclListObj.c (SetListFromAny): avoid discarding internal
	reps of objects converted to singleton lists. [Patch 738900]

2007-04-20  Kevin B. Kenny  <[email protected]>

	* doc/clock.n: Corrected a silly error (transposed 'uppercase' and
	'lowercase' in clock.n. [Bug 1656002]
	Clarified that [clock scan] does not recognize a locale's alternative
	calendar.
	Deleted an entirely superfluous (and also incorrect) remark about the
	effect of Daylight Saving Time on relative times in [clock scan]. [Bug
	1582951]
	* library/clock.tcl: Corrected an error in skipping over the %Ey field
	on input.
	* library/msgs/ja.msg:
	* tools/loadICU.tcl: Corrected several localisation faults in the
	Japanese locale (most notably, incorrect dates for the Emperors'
	eras). Many thanks to SourceForge user 'nyademo' for pointing this out
	and developing a fix. [Bug 1637471]
	* generic/tclPathObj.c: Corrected a 'const'ness fault that caused
	bitter complaints from MSVC.
	* tests/clock.test (clock-40.1, clock-58.1, clock-59.1): Corrected a
	test case that depended on ":localtime" being able to handle dates
	prior to the Posix epoch. [Bug 1618445] Added a test case for the
	dates of the Japanese emperors. [Bug 1637471] Added a regression test
	for military time zone input conversion. [Bug 1586828]
	* generic/tclGetDate.y (MilitaryTable): Fixed an ancient bug where the
	military NZA time zones had the signs reversed. [Bug 1586828]
	* generic/tclDate.c: Regenerated.
	* doc/Notifier.3: Documented Tcl_SetNotifier and Tcl_ServiceModeHook.
	Quite against my better judgment. [Bug 414933]
	* generic/tclBasic.c, generic/tclCkalloc.c, generic/tclClock.c:
	* generic/tclCmdIL.c, generic/tclCmdMZ.c, generic/tclFCmd.c:
	* generic/tclFileName.c, generic/tclInterp.c, generic/tclIO.c:
	* generic/tclIOUtil.c, generic/tclNamesp.c, generic/tclObj.c:
	* generic/tclPathObj.c, generic/tclPipe.c, generic/tclPkg.c:
	* generic/tclResult.c, generic/tclTest.c, generic/tclTestObj.c:
	* generic/tclVar.c, unix/tclUnixChan.c, unix/tclUnixTest.c:
	* win/tclWinLoad.c, win/tclWinSerial.c: Replaced commas in varargs
	with string concatenation where possible. [Patch 1515234]
	* library/tzdata/America/Tegucigalpa:
	* library/tzdata/Asia/Damascus: Olson's tzdata 2007e.

2007-04-19  Donal K. Fellows  <[email protected]>

	* generic/regcomp.c, generic/regc_cvec.c, generic/regc_lex.c,
	* generic/regc_locale.c: Improve the const-correctness of the RE
	compiler.

2007-04-18  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c (INST_LSHIFT): fixed a mistake introduced in
	version 1.266 ('=' became '=='), which effectively turned the block
	that handles native shifts into dead code. This explains why the
	testsuite did not pick this mistake. Rewrote to make the intention
	clear.

	* generic/tclInt.h (TclDecrRefCount): change the order of the
	branches, use empty 'if ; else' to handle use in unbraced outer
	if/else conditions (as already done in tcl.h)

	* generic/tclExecute.c: slight changes in Tcl_Obj management.

2007-04-17  Kevin B. Kenny  <[email protected]>

	* library/clock.tcl: Fixed the naming of
	::tcl::clock::ReadZoneinfoFile because (yoicks!) it was in the global
	namespace.
	* doc/clock.n: Clarified the cases in which legacy time zone is
	recognized. [Bug 1656002]

2007-04-17  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c: fixed checkInterp logic [Bug 1702212]

2007-04-16  Donal K. Fellows  <[email protected]>

	* various (including generic/tclTest.c): Complete the purge of K&R
	function definitions from manually-written code.

2007-04-15  Kevin B. Kenny  <[email protected]>

	* generic/tclCompCmds.c: added a cast to silence a compiler error on
	VC2005.
	* library/clock.tcl: Restored unique-prefix matching of keywords on
	the [clock] command. [Bug 1690041]
	* tests/clock.test: Added rudimentary test cases for unique-prefix
	matching of keywords.

2007-04-14  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c: removed some code at INST_EXPAND_SKTOP that
	duplicates functionality already present at checkForCatch.

2007-04-12  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c: new macros OBJ_AT_TOS, OBJ_UNDER_TOS,
	OBJ_AT_DEPTH(n) and CURR_DEPTH that remove all direct references to
	tosPtr from TEBC (after initialisation and the code at the label
	cleanupV_pushObjResultPtr).

2007-04-11  Miguel Sofer  <[email protected]>

	* generic/tclCompCmds.c: moved all exceptDepth management to the
	macros - the decreasing half was managed by hand.

2007-04-10  Donal K. Fellows  <[email protected]>

	* generic/tclInt.h (TclNewLiteralStringObj): New macro to make
	allocating literal string objects (i.e. objects whose value is a
	constant string) easier and more efficient, by allowing the omission
	of the length argument. Based on [Patch 1529526] (afredd)
	* generic/*.c: Make use of this (in many files).

2007-04-08  Miguel Sofer  <[email protected]>

	* generic/tclCompile (tclInstructionTable): Fixed bugs in description
	of dict instructions.

2007-04-07  Miguel Sofer  <[email protected]>

	* generic/tclCompile (tclInstructionTable): Fixed bug in description
	of INST_START_COMMAND.

	* generic/tclExecute.c (TEBC): Small code reduction.

2007-04-06  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c (TEBC):
	* generic/tclNamespace.c (NsEnsembleImplementationCmd):
	* generic/tclProc.c (InitCompiledLocals, ObjInterpProcEx)
	(TclObjInterpProcCore, ProcCompileProc): Code reordering to reduce
	branching and improve branch prediction (assume that forward branches
	are typically not taken).

2007-04-03  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c: INST_INVOKE optimisation. [Patch 1693802]

2007-04-03  Don Porter	<[email protected]>

	* generic/tclNamesp.c:	Revised ErrorCodeRead and ErrorInfoRead trace
	routines so they guarantee the ::errorCode and ::errorInfo variable
	always appear to exist. [Bug 1693252]

2007-04-03  Miguel Sofer  <[email protected]>

	* generic/tclInt.decls:	 Moved TclGetNamespaceFromObj() to the
	* generic/tclInt.h:	 internal stubs table; regen.
	* generic/tclIntDecls.h:
	* generic/tclStubInit.c:

2007-04-02  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c:	  Added bytecode compilers for the variable
	* generic/tclCompCmds.c:  linking commands: 'global', 'variable',
	* generic/tclCompile.h:	  'upvar', 'namespace upvar' [Patch 1688593]
	* generic/tclExecute.c:
	* generic/tclInt.h:
	* generic/tclVar.c:

2007-04-02  Don Porter	<[email protected]>

	* generic/tclBasic.c:	Replace arrays on the C stack and ckalloc
	* generic/tclExecute.c: calls with TclStackAlloc calls to use memory
	* generic/tclFCmd.c:	on Tcl's evaluation stack.
	* generic/tclFileName.c:
	* generic/tclIOCmd.c:
	* generic/tclIndexObj.c:
	* generic/tclInterp.c:
	* generic/tclNamesp.c:
	* generic/tclTrace.c:
	* unix/tclUnixPipe.c:

2007-04-01  Donal K. Fellows  <[email protected]>

	* generic/tclCompile.c (TclCompileScript, TclPrintInstruction):
	* generic/tclExecute.c (TclExecuteByteCode): Changed the definition of
	INST_START_CMD so that it knows how many commands start at the current
	location. This makes the interpreter command counter correct without
	requiring a large number of instructions to be issued. (See my change
	from 2007-01-19 for what triggered this.)

2007-03-30  Don Porter	<[email protected]>

	* generic/tclCompile.c:
	* generic/tclCompExpr.c:
	* generic/tclCompCmds.c:	Replace arrays on the C stack and
	ckalloc calls with TclStackAlloc calls to use memory on Tcl's
	evaluation stack.

	* generic/tclCmdMZ.c:	Revised [string to* $s $first $last]
	implementation to reduce number of allocs/copies.

	* tests/string.test:  More [string reverse] tests.

2007-03-30  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c: optimise the lookup of elements of indexed
	arrays.

2007-03-29  Miguel Sofer  <[email protected]>

	* generic/tclProc.c (Tcl_ApplyObjCmd):
	* tests/apply.test (9.3): Fixed Tcl_Obj leak on error return; an
	unneeded ref to lambdaPtr was being set and not released on an error
	return path.

2007-03-28  Don Porter	<[email protected]>

	* generic/tclCmdMZ.c (STR_REVERSE):	Implement the actual [string
	reverse] command in terms of the new TclStringObjReverse() routine.

	* generic/tclInt.h (TclStringObjReverse):	New internal routine
	* generic/tclStringObj.c (TclStringObjReverse): that implements the
	[string reverse] operation, making use of knowledge/surgery of the
	String intrep to minimize the number of allocs and copies needed to do
	the job.

2007-03-27  Don Porter	<[email protected]>

	* generic/tclCmdMZ.c (STR_MAP): Replace ckalloc calls with
	TclStackAlloc calls.

2007-03-24  Zoran Vasiljevic <[email protected]>

	* win/tclWinThrd.c: Thread exit handler marks the current thread as
	un-initialized. This allows exit handlers that are registered later to
	re-initialize this subsystem in case they need to use some sync
	primitives (cond variables) from this file again.

2007-03-23  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c (DeleteInterpProc): pop the root frame pointer
	before deleting the global namespace [Bug 1658572]

2007-03-23  Kevin B. Kenny  <[email protected]>

	* win/Makefile.in: Added code to keep a Cygwin path name from leaking
	into LIBRARY_DIR when doing 'make test' or 'make runtest'.

2007-03-22  Don Porter	<[email protected]>

	* generic/tclCmdAH.c (Tcl_ForeachObjCmd):	Replaced arrays on the
	C stack and ckalloc calls with TclStackAlloc calls to use memory on
	Tcl's evaluation stack.

	* generic/tclExecute.c: Revised GrowEvaluationStack to take an
	argument specifying the growth required by the caller, so that a
	single reallocation / copy is the most that will ever be needed even
	when required growth is large.

2007-03-21  Don Porter	<[email protected]>

	* generic/tclExecute.c: More ckalloc -> ckrealloc conversions.
	* generic/tclLiteral.c:
	* generic/tclNamesp.c:
	* generic/tclParse.c:
	* generic/tclPreserve.c:
	* generic/tclStringObj.c:
	* generic/tclUtil.c:

2007-03-20  Don Porter	<[email protected]>

	* generic/tclEnv.c:	Some more ckalloc -> ckrealloc replacements.
	* generic/tclLink.c:

2007-03-20  Kevin B. Kenny  <[email protected]>

	* generic/tclDate.c: Rebuilt, despite Donal Fellows's comment when
	committing it that no rebuild was required.
	* generic/tclGetDate.y: According to Donal Fellows, "Introduce modern
	formatting standards; no need for rebuild of tclDate.c."

	* library/tzdata/America/Cambridge_Bay:
	* library/tzdata/America/Havana:
	* library/tzdata/America/Inuvik:
	* library/tzdata/America/Iqaluit:
	* library/tzdata/America/Pangnirtung:
	* library/tzdata/America/Rankin_Inlet:
	* library/tzdata/America/Resolute:
	* library/tzdata/America/Yellowknife:
	* library/tzdata/Asia/Choibalsan:
	* library/tzdata/Asia/Dili:
	* library/tzdata/Asia/Hovd:
	* library/tzdata/Asia/Jakarta:
	* library/tzdata/Asia/Jayapura:
	* library/tzdata/Asia/Makassar:
	* library/tzdata/Asia/Pontianak:
	* library/tzdata/Asia/Ulaanbaatar:
	* library/tzdata/Europe/Istanbul: Upgraded to Olson's tzdata2007d.

	* generic/tclListObj.c (TclLsetList, TclLsetFlat):
	* tests/lset.test: Changes to deal with shared internal representation
	for lists passed to the [lset] command. Thanks to Don Porter for
	fixing this issue. [Bug 1677512]

2007-03-19  Don Porter	<[email protected]>

	* generic/tclCompile.c: Revise the various expansion routines for
	CompileEnv fields to use ckrealloc() where appropriate.

	* generic/tclBinary.c (Tcl_SetByteArrayLength): Replaced ckalloc() /
	memcpy() sequence with ckrealloc() call.

	* generic/tclBasic.c (Tcl_CreateMathFunc):	Replaced some calls to
	* generic/tclEvent.c (Tcl_CreateThread):	Tcl_Alloc() with calls
	* generic/tclObj.c (UpdateStringOfBignum):	to ckalloc(), which
	* unix/tclUnixTime.c (SetTZIfNecessary):	better supports memory
	* win/tclAppInit.c (setargv):			debugging.

2007-03-19  Donal K. Fellows  <[email protected]>

	* doc/regsub.n: Corrected example so that it doesn't recommend
	potentially unsafe practice. Many thanks to Konstantin Kushnir
	<[email protected]> for reporting this.

2007-03-17  Kevin B. Kenny  <[email protected]>

	* win/tclWinReg.c (GetKeyNames): Size the buffer for enumerating key
	names correctly, so that Unicode names exceeding 127 chars can be
	retrieved without crashing. [Bug 1682211]
	* tests/registry.test (registry-4.9): Added test case for the above
	bug.

2007-03-15  Mo DeJong  <[email protected]>

	* generic/tclIOUtil.c (Tcl_Stat): Reimplement workaround to avoid gcc
	warning by using local variables. When the macro argument is of type
	long long instead of long, the incorrect warning is not generated.

2007-03-15  Mo DeJong  <[email protected]>

	* win/Makefile.in: Fully qualify LIBRARY_DIR so that `make test` does
	not depend on working dir.

2007-03-15  Mo DeJong  <[email protected]>

	* tests/parse.test: Add two backslash newline parse tests.

2007-03-12  Don Porter	<[email protected]>

	* generic/tclExecute.c (INST_FOREACH_STEP4):	Make private copy of
	* tests/foreach.test (foreach-10.1):	value list to be assigned to
	variables so that shimmering of that list doesn't lead to invalid
	pointers. [Bug 1671087]

	* generic/tclEvent.c (HandleBgErrors):	Make efficient private copy
	* tests/event.test (event-5.3): of the command prefix for the interp's
	background error handling command to avoid panics due to pointers to
	memory invalid after shimmering. [Bug 1670155]

	* generic/tclNamesp.c (NsEnsembleImplementationCmd):	Make efficient
	* tests/namespace.test (namespace-42.8):	private copy of the
	command prefix as we invoke the command appropriate to a particular
	subcommand of a particular ensemble to avoid panic due to shimmering
	of the List intrep. [Bug 1670091]

	* generic/tclVar.c (TclArraySet):	Make efficient private copy of
	* tests/var.test (var-17.1):	the "list" argument to [array set] to
	avoid crash due to shimmering invalidating pointers. [Bug 1669489]

2007-03-12  Donal K. Fellows  <[email protected]>

	* generic/tclCmdIL.c (Tcl_LsortObjCmd): Fix problems with declaration
	positioning and memory leaks. [Bug 1679072]

2007-03-11  Donal K. Fellows  <[email protected]>

	* generic/tclCmdIL.c (Tcl_LreverseObjCmd): Ensure that a list is
	correctly reversed even if its internal representation is shared
	without the object itself being shared. [Bug 1675044]

2007-03-10  Miguel Sofer  <[email protected]>

	* generic/tclCmdIL (Tcl_LsortObjCmd): changed fix to [Bug 1675116] to
	use the cheaper TclListObjCopy() instead of Tcl_DuplicateObj().

2007-03-09  Andreas Kupries  <[email protected]>

	* library/platform/shell.tcl: Made more robust if an older platform
	* library/platform/pkgIndex.tcl: package is present in the inspected
	* unix/Makefile.in: shell. Package forget it to prevent errors. Bumped
	* win/Makefile.in: package version to 1.1.3, and updated the Makefiles
	installing it as Tcl Module.

2007-03-09  Donal K. Fellows  <[email protected]>

	* generic/tclCmdIL.c (Tcl_LsortObjCmd): Handle tricky case with loss
	* tests/cmdIL.test (cmdIL-1.29):	of list rep during sorting due
	to shimmering. [Bug 1675116]

2007-03-09  Kevin B. Kenny  <[email protected]>

	* library/clock.tcl (ReadZoneinfoFile): Added Y2038 compliance to the
	code for version-2 'zoneinfo' files.
	* tests/clock.test (clock-56.3): Added a test case for Y2038 and
	'zoneinfo'. Modified test initialisation to use the
	'loadTestedCommands' function of tcltest to bring in the correct path
	for the registry library.

2007-03-08  Don Porter	<[email protected]>

	* generic/tclListObj.c (TclLsetList):	Rewrite so that the routine
	itself does not do any direct intrep surgery. Better isolates those
	things into the implementation of the "list" Tcl_ObjType.

2007-03-08  Donal K. Fellows  <[email protected]>

	* generic/tclListObj.c (TclLindexList, TclLindexFlat): Moved these
	functions to tclListObj.c from tclCmdIL.c to mirror the way that the
	equivalent functions for [lset]'s guts are arranged.

2007-03-08  Kevin B. Kenny  <[email protected]>

	* library/clock.tcl: Further tweaks to the Windows time zone table
	(restoring missing Mexican time zones). Added rudimentary handling of
	version-2 'zoneinfo' files. Update US DST rules so that zones such as
	'EST5EDT' get the correct transition dates.
	* tests/clock.test: Added rudimentary test cases for 'zoneinfo'
	parsing. Adjusted several tests that depended on obsolete US DST
	transition rules.

2007-03-07  Daniel Steffen  <[email protected]>

	* macosx/tclMacOSXNotify.c: add spinlock debugging and sanity checks.

	* macosx/Tcl.xcodeproj/project.pbxproj: ensure gcc version used by
	* macosx/Tcl.xcodeproj/default.pbxuser: Xcode and configure/make are
	* macosx/Tcl-Common.xcconfig:		consistent and independent of
	gcc_select default and CC env var; fixes for Xcode 3.0.

	* unix/tcl.m4 (Darwin): s/CFLAGS/CPPFLAGS/ in macosx-version-min check
	* unix/configure: autoconf-2.59

2007-03-07  Don Porter	<[email protected]>

	* generic/tclCmdIL.c (TclLindex*):	Rewrites to make efficient
	private copies of the list and indexlist arguments, so we can operate
	on the list elements directly with no fear of shimmering effects.
	Replaces defensive coding schemes that are otherwise required. End
	result is that TclLindexList is entirely a wrapper around
	TclLindexFlat, which is now the core engine of all [lindex]
	operations.

	* generic/tclObj.c (Tcl_AppendAllObjTypes):	Converted to simpler
	list validity test.

2007-03-07  Donal K. Fellows  <[email protected]>

	* generic/tclRegexp.c (TclRegAbout): Generate information about a
	regexp as a Tcl_Obj instead of as a string, which is more efficient.

2007-03-07  Kevin B. Kenny  <[email protected]>

	* library/clock.tcl: Adjusted Windows time zone table to handle new US
	DST rules by locale rather than as Posix time zone spec.
	* tests/clock.test (clock-39.6, clock-49.2, testclock::registry):
	Adjusted tests to simulate new US rules.
	* library/tzdata/America/Indiana/Winamac:
	* library/tzdata/Europe/Istanbul:
	* library/tzdata/Pacific/Easter:
	Olson's tzdata2007c.

2007-03-05  Andreas Kupries  <[email protected]>

	* library/platform/shell.tcl (::platform::shell::RUN): In the case of
	* library/platform/pkgIndex.tcl: a failure put the captured stderr
	* unix/Makefile.in: into the error message to aid in debugging. Bumped
	* win/Makefile.in: package version to 1.1.2, and updated the makefiles
	installing it as Tcl Module.

2007-03-03  Donal K. Fellows  <[email protected]>

	* generic/tclLink.c (LinkedVar): Added macro to conceal at least some
	of the pointer hackery.

2007-03-02  Don Porter	<[email protected]>

	* generic/tclCmdIL.c (Tcl_LreverseObjCmd):	Added missing
	TclInvalidateStringRep() call when we directly manipulate the intrep
	of an unshared "list" Tcl_Obj. [Bug 1672585]

	* generic/tclCmdIL.c (Tcl_JoinObjCmd):	Revised [join] implementation
	to append Tcl_Obj's instead of strings. [RFE 1669420]

	* generic/tclCmdIL.c (Info*Cmd):	Code simplifications and
	optimizations.

2007-03-02  Donal K. Fellows  <[email protected]>

	* generic/tclCompile.c (TclPrintInstruction): Added a scheme to allow
	* generic/tclCompile.h (AuxDataPrintProc):    aux-data to be printed
	* generic/tclCompCmds.c (Print*Info):	      out for debugging. For
	this to work, immediate operands referring to aux-data must be
	identified as such in the instruction descriptor table using
	OPERAND_AUX4 (all are always 4 bytes).

	* generic/tclExecute.c (TclExecuteByteCode): Rewrote the compiled
	* generic/tclCompCmds.c (TclCompileDictCmd): [dict update] so that it
	* generic/tclCompile.h (DictUpdateInfo):     stores critical
	* tests/dict.test (dict-21.{14,15}):	     non-varying data in an
	aux-data value instead of a (shimmerable) literal. [Bug 1671001]

2007-03-01  Don Porter	<[email protected]>

	* generic/tclCmdIL.c (Tcl_LinsertObjCmd):	Code simplifications
	and optimizations.

	* generic/tclCmdIL.c (Tcl_LreplaceObjCmd):	Code simplifications
	and optimizations.

	* generic/tclCmdIL.c (Tcl_LrangeObjCmd):	Rewrite in the same
	spirit; avoid shimmer effects rather than react to them.

	* generic/tclCmdAH.c (Tcl_ForeachObjCmd):	Stop throwing away
	* tests/foreach.test (foreach-1.14):	useful error information when
	loop variable sets fail.

	* generic/tclCmdIL.c (Tcl_LassignObjCmd):	Rewrite to make an
	efficient private copy of the list argument, so we can operate on the
	list elements directly with no fear of shimmering effects. Replaces
	defensive coding schemes that are otherwise required.

	* generic/tclCmdAH.c (Tcl_ForeachObjCmd):	Rewrite to make
	efficient private copies of the variable and value lists, so we can
	operate on them without any special shimmer defense coding schemes.

2007-03-01  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmds.c (TclCompileForeachCmd): Prevent an unexpected
	* tests/foreach.test (foreach-9.1):		infinite loop when the
	variable list is empty and the foreach is compiled. [Bug 1671138]

2007-02-26  Andreas Kupries  <[email protected]>

	* generic/tclIORChan.c (FreeReflectedChannel): Added the missing
	refcount release between NewRC and FreeRC for the channel handle
	object, spotted by Don Porter. [Bug 1667990]

2007-02-26  Don Porter	<[email protected]>

	* generic/tclCmdAH.c (Tcl_ForeachObjCmd):	Removed surplus
	copying of the objv array that used to be a workaround for [Bug
	404865]. That bug is long fixed.

2007-02-24  Don Porter	<[email protected]>

	* generic/tclBasic.c:	Use new interface in Tcl_EvalObjEx so that the
	recounting logic of the List internal rep need not be repeated there.
	Better encapsulation of internal details.

	* generic/tclInt.h:	New internal routine TclListObjCopy() used
	* generic/tclListObj.c: to efficiently do the equivalent of [lrange
	$list 0 end]. After some experience with this, might be a good
	candidate for exposure as a public interface. It's useful for callers
	of Tcl_ListObjGetElements() who want to control the ongoing validity
	of the returned objv pointer.

2007-02-22  Andreas Kupries  <[email protected]>

	* tests/pkg.test: Added tests for the case of an alpha package
	satisfying a require for the regular package, demonstrating a corner
	case specified in TIP#280. More notes in the comments to the test.

2007-02-20  Jan Nijtmans  <[email protected]>

	* generic/tclInt.decls: Added "const" specifiers in TclSockGetPort
	* generic/tclIntDecls.h: regenerated
	* generic/*.c:
	* unix/tclUnixChan.c
	* unix/tclUnixPipe.c
	* win/tclWinPipe.c
	* win/tclWinSock.c: Added many "const" specifiers in implementation.

2007-02-20  Don Porter	<[email protected]>

	* doc/tcltest.n:	Typo fix. [Bug 1663539]

2007-02-20  Pat Thoyts	<[email protected]>

	* generic/tclFileName.c:  Handle extended paths on Windows NT and
	* generic/tclPathObj.c:	  above. These have a \\?\ prefix. [Bug
	* win/tclWinFile.c:	  1479814]
	* tests/winFCmd.test:	  Tests for extended path handling.

2007-02-19  Jeff Hobbs	<[email protected]>

	* unix/tcl.m4: use SHLIB_SUFFIX=".so" on HP-UX ia64 arch.
	* unix/configure: autoconf-2.59

	* generic/tclIOUtil.c (Tcl_FSEvalFileEx): safe incr of objPtr ref.

2007-02-18  Donal K. Fellows  <[email protected]>

	* doc/chan.n, doc/clock.n, doc/eval.n, doc/exit.n, doc/expr.n:
	* doc/interp.n, doc/open.n, doc/platform_shell.n, doc/pwd.n:
	* doc/refchan.n, doc/regsub.n, doc/scan.n, doc/tclvars.n, doc/tm.n:
	* doc/unload.n: Apply [Bug 1610310] to fix typos. Thanks to Larry
	Virden for spotting them.

	* doc/interp.n: Partial fix of [Bug 1662436]; rest requires some
	policy decisions on what should and shouldn't be safe commands from
	the "new in 8.5" set.

2007-02-13  Kevin B. Kenny  <[email protected]>

	* tools/fix_tommath_h.tcl: Further tweaking for the x86-64. The change
	is to make 'mp_digit' be an 'unsigned int' on that platform; since
	we're using only 32 bits of it, there's no reason to make it a 64-bit
	'unsigned long.'
	* generic/tclTomMath.h: Regenerated.

2007-02-13  Donal K. Fellows  <[email protected]>

	* doc/re_syntax.n: Corrected description of 'print' class [Bug
	1614687] and enhanced description of 'graph' class.

2007-02-12  Kevin B. Kenny  <[email protected]>

	* tools/fix_tommath_h.tcl: Added code to patch out a check for
	__x86_64__ that caused Tommath to use __attributes(TI)__ for the
	mp_word type. Tetra-int's simply fail on too many gcc-glibc-OS
	combinations to be ready for shipment today, even if they work for
	some of us. This change allows reversion of das's change of 2006-08-18
	that accomplised the same thing on Darwin. [Bugs 1601380, 1603737,
	1609936, 1656265]
	* generic/tclTomMath.h: Regenerated.
	* library/tzdata/Africa/Asmara:
	* library/tzdata/Africa/Asmera:
	* library/tzdata/America/Nassau:
	* library/tzdata/Atlantic/Faeroe:
	* library/tzdata/Atlantic/Faroe:
	* library/tzdata/Australia/Eucla:
	* library/tzdata/Pacific/Easter: Rebuilt from Olson's tzdata2007b.

2007-02-09  Joe Mistachkin  <[email protected]>

	* win/nmakehlp.c: Properly cleanup after nmakehlp, including the
	* win/makefile.vc: vcX0.pch file.

2007-02-08  Jeff Hobbs	<[email protected]>

	* unix/tclUnixInit.c (TclpCheckStackSpace): do stack size checks with
	unsigned size_t to correctly validate stackSize in the 2^31+ range.
	[Bug 1654104]

2007-02-08  Don Porter	<[email protected]>

	* generic/tclNamesp.c:	Corrected broken logic in Tcl_DeleteNamespace
	* tests/namespace.test: introduced in Patch 1577278 that caused
	[namespace delete ::] to be effective only at level #0. New test
	namespace-7.7 should prevent similar error in the future [Bug 1655305]

2007-02-06  Don Porter	<[email protected]>

	* generic/tclNamesp.c:	Corrected broken implementation of the
	* tests/namespace.test: TclMatchIsTrivial optimization on [namespace
	children $namespace $pattern].

2007-02-04  Daniel Steffen  <[email protected]>

	* unix/tcl.m4: use gcc4's __attribute__((__visibility__("hidden"))) if
	available to define MODULE_SCOPE effective on all platforms.
	* unix/configure.in: add caching to -pipe and zoneinfo checks.
	* unix/configure: autoconf-2.59
	* unix/tclConfig.h.in: autoheader-2.59

2007-02-03  Joe Mistachkin  <[email protected]>

	* win/rules.vc: Fix platform specific file copy macros for downlevel
	Windows.

2007-01-29  Don Porter	<[email protected]>

	* generic/tclResult.c: Added optimization case to TclTransferResult to
	cover common case where there's big savings over the fully general
	path. Thanks to Peter MacDonald. [Bug 1626518]

	* generic/tclLink.c:	Broken linked float logic corrected. Thanks to
	Andy Goth. [Bug 1602538]

	* doc/fcopy.n:	Typo fix. [Bug 1630627]

2007-01-28  Daniel Steffen  <[email protected]>

	* macosx/Tcl.xcodeproj/project.pbxproj:	  extract build settings that
	* macosx/Tcl.xcodeproj/default.pbxuser:	  were common to multiple
	* macosx/Tcl-Common.xcconfig (new file):  configurations into external
	* macosx/Tcl-Debug.xcconfig (new file):	  xcconfig files; add extra
	* macosx/Tcl-Release.xcconfig (new file): configurations for building
	with SDKs and 64bit; convert legacy jam-based 'Tcl' target to native
	target with single script phase; correct syntax of build setting
	references to use $() throughout.

	* macosx/README: document new Tcl.xcodeproj configurations; other
	minor updates/corrections.

	* generic/tcl.h: update location of version numbers in macosx files.

	* macosx/Tcl.xcode/project.pbxproj: restore 'tcltest' target to
	* macosx/Tcl.xcode/default.pbxuser: working order by replicating
	applicable changes to Tcl.xcodeproj since 2006-07-20.

2007-01-25  Daniel Steffen  <[email protected]>

	* unix/tcl.m4: integrate CPPFLAGS into CFLAGS as late as possible and
	move (rather than duplicate) -isysroot flags from CFLAGS to CPPFLAGS
	to avoid errors about multiple -isysroot flags from some older gcc
	builds.

	* unix/configure: autoconf-2.59

2007-01-22  Donal K. Fellows  <[email protected]>

	* compat/memcmp.c (memcmp): Reworked so that arithmetic is never
	performed upon void pointers, since that is illegal. [Bug 1631017]

2007-01-19  Donal K. Fellows  <[email protected]>

	* generic/tclCompile.c (TclCompileScript): Reduce the frequency with
	which we issue INST_START_CMD, making bytecode both more compact and
	somewhat faster. The optimized case is where we would otherwise be
	issuing a sequence of those instructions; in those cases, it is only
	ever the first one encountered that could possibly trigger.

2007-01-19  Joe Mistachkin  <[email protected]>

	* tools/man2tcl.c: Include stdlib.h for exit() and improve comment
	detection.
	* win/nmakehlp.c: Update usage.
	* win/makefile.vc: Properly build man2tcl.c for MSVC8.

2007-01-19  Daniel Steffen  <[email protected]>

	* macosx/tclMacOSXFCmd.c (TclMacOSXSetFileAttribute): on some versions
	of Mac OS X, truncate() fails on resource forks, in that case use
	open() with O_TRUNC instead.

	* macosx/tclMacOSXNotify.c: accommodate changes to prototypes of
	OSSpinLock(Un)Lock API.

	* macosx/Tcl.xcodeproj/project.pbxproj: ensure HOME and USER env vars
	* macosx/Tcl.xcodeproj/default.pbxuser: are defined when running
						testsuite from Xcode.

	* tests/env.test: add extra system env vars that need to be preserved
	on some Mac OS X versions for testsuite to work.

	* unix/Makefile.in:  Move libtommath defines into configure.in to
	* unix/configure.in: avoid replicating them across multiple
	* macosx/Tcl.xcodeproj/project.pbxproj: buildsystems.

	* unix/tcl.m4: ensure CPPFLAGS env var is used when set. [Bug 1586861]
	(Darwin): add -isysroot and -mmacosx-version-min flags to CPPFLAGS
	when present in CFLAGS to avoid discrepancies between what headers
	configure sees during preprocessing tests and compiling tests.

	* unix/configure: autoconf-2.59
	* unix/tclConfig.h.in: autoheader-2.59

2007-01-18  Donal K. Fellows  <[email protected]>

	* generic/tclCompile.c (TclCompileScript): Make sure that when parsing
	an expanded literal fails, a correct bytecode sequence is still
	issued. [Bug 1638414]. Also make sure that the start of the expansion
	bytecode sequence falls inside the span of bytecodes for a command.
	* tests/compile.test (compile-16.24): Added test for [Bug 1638414]

2007-01-17  Donal K. Fellows  <[email protected]>

	* generic/tclIO.c: Added macros to make usage of ChannelBuffers
	clearer.

2007-01-11  Joe English	 <[email protected]>

	* win/tcl.m4(CFLAGS_WARNING): Remove "-Wconversion". This was removed
	from unix/tcl.m4 2004-07-16 but not from here.
	* win/configure: Regenerated.

2007-01-11  Pat Thoyts	<[email protected]>

	* win/makefile.vc: Fixes to work better on Win98. Read version numbers
	* win/nmakehlp.c:  from package index file to avoid keeping numbers in
	* win/rules.vc:	   the makefile where they may become de-synchronized.

2007-01-10  Donal K. Fellows  <[email protected]>

	* generic/regcomp.c (compile, freev):	     Define a strategy for
	* generic/regexec.c (exec):		     managing the internal
	* generic/regguts.h (AllocVars, FreeVars):   vars of the RE engine to
	* generic/regcustom.h (AllocVars, FreeVars): reduce C stack usage.
	This will make Tcl as a whole much less likely to run out of stack
	space...

2007-01-09  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmds.c (TclCompileLindexCmd):
	* tests/lindex.test (lindex-9.2): Fix silly bug that ended up
	sometimes compiling list arguments in the wrong order. [Bug 1631364]

2007-01-03  Kevin B. Kenny  <[email protected]>

	* generic/tclDate.c: Regenerated to recover a lost fix from patthoyts.
	[Bug 1618523]

2006-12-26  Mo DeJong  <[email protected]>

	* generic/tclIO.c (Tcl_GetsObj): Avoid checking for for the LF in a
	possible CRLF sequence when EOF has already been found.

2006-12-26  Mo DeJong  <[email protected]>

	* generic/tclEncoding.c (EscapeFromUtfProc): Clear the
	TCL_ENCODING_END flag when end bytes are written. This fix keep this
	method from writing escape bytes for an encoding like iso2022-jp
	multiple times when the escape byte overlap with the end of the IO
	buffer.
	* tests/io.test: Add test for escape byte overlap issue.

2006-12-19  Donal K. Fellows  <[email protected]>

	* unix/tclUnixThrd.c (Tcl_GetAllocMutex, TclpNewAllocMutex): Add
	intermediate variables to shut up unwanted warnings. [Bug 1618838]

2006-12-19  Daniel Steffen  <[email protected]>

	* unix/tclUnixThrd.c (TclpInetNtoa): fix for 64 bit.

	* unix/tcl.m4 (Darwin): --enable-64bit: verify linking with 64bit
	-arch flag succeeds before enabling 64bit build.
	* unix/configure: autoconf-2.59

2006-12-17  Daniel Steffen  <[email protected]>

	* tests/macOSXLoad.test (new file): add testing of .bundle loading and
	* tests/load.test:		    unloading on Darwin (in addition
	* tests/unload.test:		    to existing tests of .dylib
	loading).
	* macosx/Tcl.xcodeproj/project.pbxproj: add building of dltest
	binaries so that testsuite run from Xcode can use them; fix testsuite
	run script
	* unix/configure.in:	   add support for building dltest binaries as
	* unix/dltest/Makefile.in: .bundle (in addition to .dylib) on Darwin.
	* unix/Makefile.in: add stub lib dependency to dltest target.
	* unix/configure: autoconf-2.59

	* tests/append.test: fix cleanup failure when all tests are skipped.

	* tests/chan.test (chan-16.9): cleanup chan event handler to avoid
	causing error in event.test when running testsuite with -singleproc 1.

	* tests/info.test: add !singleTestInterp constraint to tests that fail
	when running testsuite with -singleproc 1. [Bug 1605269]

2006-12-14  Donal K. Fellows  <[email protected]>

	* doc/string.n: Fix example. [Bug 1615277]

2006-12-12  Don Porter	<[email protected]>

	* generic/tclCompExpr.c:	Now that the new internal structs are
	in use to support operator commands, might as well make them the
	default for [expr] as well and avoid passing every parsed expression
	through the inefficient Tcl_Token array format. This addresses most
	issues in [RFE 1517602]. Assuming no performance disasters result from
	this, much dead code supporting the other implementation might now be
	removed.

	* generic/tclBasic.c:	Final step routing all direct evaluation forms
	* generic/tclCompExpr.c: of the operator commands through TEBC,
	* generic/tclCompile.h: dropping all the routines in tclMathOp.c.
	* generic/tclMathOp.c:	Still needs Engineering Manual attention.

2006-12-11  Don Porter	<[email protected]>

	* generic/tclBasic.c:	Another step with all sorting operator
	* generic/tclCompExpr.c: commands now routing through TEBC via
	* generic/tclCompile.h: TclSortingOpCmd().

2006-12-08  Don Porter	<[email protected]>

	* generic/tclBasic.c:	 Another step down the path of re-using
	* generic/tclCompExpr.c: TclExecuteByteCode to implement the TIP 174
	* generic/tclCompile.h: commands instead of using a mass of code
	* generic/tclMathOp.c:	duplication. Now all operator commands that
	* tests/mathop.test:	demand exactly one operation are implemented
	via TclSingleOpCmd and a call to TEBC.

	* generic/tclCompExpr.c: Revised implementation of TclInvertOpCmd to
	* generic/tclMathOp.c:	perform a bytecode compile / execute sequence.
	This demonstrates a path toward avoiding mountains of code duplication
	in tclMathOp.c and tclExecute.c.

	* generic/tclCompile.h: Change TclExecuteByteCode() from static to
	* generic/tclExecute.c: MODULE_SCOPE so all files including
	tclCompile.h may call it.

	* generic/tclMathOp.c:	More revisions to make tests pass.
	* tests/mathop.test:

2006-12-08  Donal K. Fellows  <[email protected]>

	* generic/tclNamesp.c (TclTeardownNamespace): Ensure that dying
	namespaces unstitch themselves from their referents. [Bug 1571056]
	(NsEnsembleImplementationCmd): Silence GCC warning.

	* tests/mathop.test: Full tests for & | and ^ operators

2006-12-08  Daniel Steffen  <[email protected]>

	* library/tcltest/tcltest.tcl: use [info frame] for "-verbose line".

2006-12-07  Don Porter	<[email protected]>

	* generic/tclCompCmds.c:	Additional commits correct most
	* generic/tclExecute.c:		failing tests illustrating bugs
	* generic/tclMathOp.c:		uncovered in [Patch 1578137].

	* generic/tclBasic.c:	Biggest source of TIP 174 failures was that
	the commands were not [namespace export]ed from the ::tcl::mathop
	namespace. More bits from [Patch 1578137] correct that.

	* tests/mathop.test:	Commmitted several new tests from Peter Spjuth
	found in [Patch 1578137]. Many failures now demonstrate issues to fix
	in the TIP 174 implementation.

2006-12-07  Donal K. Fellows  <[email protected]>

	* tests/mathop.test: Added tests for ! ~ eq operators.
	* generic/tclMathOp.c (TclInvertOpCmd): Add in check for non-integral
	numeric values.
	* generic/tclCompCmds.c (CompileCompareOpCmd): Factor out the code
	generation for the chained comparison operators.

2006-12-07  Pat Thoyts	<[email protected]>

	* tests/exec.test: Fixed line endings (caused win32 problems).

2006-12-06  Don Porter	<[email protected]>

	* generic/tclCompCmds.c:	Revised and consolidated into utility
	* tests/mathop.test:		routines some of routines that compile
	the new TIP 174 commands. This corrects some known bugs. More to come.

2006-12-06  Kevin B. Kenny  <[email protected]>

	* tests/expr.test (expr-47.12): Improved error reporting in hopes of
	having more information to pursue [Bug 1609936].

2006-12-05  Andreas Kupries  <[email protected]>

	TIP#291 IMPLEMENTATION

	* generic/tclBasic.c: Define tcl_platform element for pointerSize.
	* doc/tclvars.n:

	* win/Makefile.in: Added installation instructions for the platform
	* win/makefile.vc: package. Added the platform package.
	* win/makefile.bc:
	* unix/Makefile.in:

	* tests/platform.test:
	* tests/safe.test:

	* library/platform/platform.tcl:
	* library/platform/shell.tcl:
	* library/platform/pkgIndex.tcl:

	* doc/platform.n:
	* doc/platform_shell.n:

2006-12-05  Don Porter	<[email protected]>

	* generic/tclPkg.c:	When no requirements are supplied to a
	* tests/pkg.test:	[package require $pkg] and [package unknown]
	is invoked to find a satisfying package, pass the requirement argument
	"0-" (which means all versions are acceptable). This permits a
	registered [package unknown] command to call [package vsatisfies
	$testVersion {*}$args] without any special handling of the empty $args
	case. This fixes/avoids a bug in [::tcl::tm::UnknownHandler] that was
	causing old TM versions to be provided in preference to newer TM
	versions. Thanks to Julian Noble for discovering the issue.

2006-12-04  Donal K. Fellows  <[email protected]>

	TIP#267 IMPLEMENTATION

	* generic/tclIOCmd.c (Tcl_ExecObjCmd): Added -ignorestderr option,
	* tests/exec.test, doc/exec.n:	       loosely from [Patch 1476191]

2006-12-04  Don Porter	<[email protected]>

	* generic/tclCompExpr.c:	Added implementation for the
	CompileExprTree() routine that can produce expression bytecode
	directly from internal structures with no need to pass through the
	Tcl_Token array representation. Still disabled by default. #undef
	USE_EXPR_TOKENS to try it out.

2006-12-03  Don Porter	<[email protected]>

	* generic/tclCompExpr.c:	Added expr parsing routines that
	produce a different set of internal structures representing the parsed
	expression, as well as routines that go on to convert those structures
	into the traditional Tcl_Token array format. Use of these routines is
	currently disabled. #undef PARSE_DIRECT_EXPR_TOKENS to enable them.
	These routines will only become really useful when more routines that
	compile directly from the new internal structures are completed.

2006-12-02  Donal K. Fellows  <[email protected]>

	* doc/file.n: Clarification of [file pathtype] docs. [Bug 1606454]

2006-12-01  Kevin B. Kenny	 <[email protected]>

	* libtommath/bn_mp_add.c:	Corrected the effects of a
	* libtommath/bn_mp_div.c:	bollixed 'cvs merge' operation
	* libtommath/bncore.c:		that inadvertently committed some
	* libtommath/tommath_class.h:	half-developed code.

	TIP#299 IMPLEMENTATION

	* doc/mathfunc.n:	Added isqrt() function to docs
	* generic/tclBasic.c:	Added isqrt() math function (ExprIsqrtFunc)
	* tests/expr.test (expr-47.*): Added tests for isqrt()
	* tests/info.test (info-20.2): Added isqrt() to expected math funcs.

2006-12-01  Don Porter	<[email protected]>

	* tests/chan.test:	Correct timing sensitivity in new test. [Bug
	1606860]

	TIP#287 IMPLEMENTATION

	* doc/chan.n:		New subcommand [chan pending].
	* generic/tclBasic.c:	Thanks to Michael Cleverly for proposal
	* generic/tclInt.h:	and implementation.
	* generic/tclIOCmd.c:
	* library/init.tcl:
	* tests/chan.test:
	* tests/ioCmd.test:

	TIP#298 IMPLEMENTATION

	* generic/tcl.decls: Tcl_GetBignumAndClearObj -> Tcl_TakeBignumFromObj
	* generic/tclObj.c:

	* generic/tclDecls.h:	make genstubs
	* generic/tclStubInit.c:

	* generic/tclExecute.c: Update callers.
	* generic/tclMathOp.c:

2006-11-30  Kevin B. Kenny  <[email protected]>

	* library/tzdata: Olson's tzdata2006p.
	* libtommath/bn_mp_sqrt.c: Fixed a bug where the initial approximation
	to the square root could be on the wrong side, causing failure of
	convergence.

2006-11-29  Don Porter	<[email protected]>

	* generic/tclBasic.c (Tcl_AppendObjToErrorInfo):  Added
	Tcl_DecrRefCount() on the objPtr argument to plug memory leaks. This
	makes the routine a consumer, which makes it easiest to use.

2006-11-28  Andreas Kupries  <[email protected]>

	* generic/tclBasic.c: TIP #280 implementation.
	* generic/tclCmdAH.c:
	* generic/tclCmdIL.c:
	* generic/tclCmdMZ.c:
	* generic/tclCompCmds.c:
	* generic/tclCompExpr.c:
	* generic/tclCompile.c:
	* generic/tclCompile.h:
	* generic/tclExecute.c:
	* generic/tclIOUtil.c:
	* generic/tclInt.h:
	* generic/tclInterp.c:
	* generic/tclNamesp.c:
	* generic/tclObj.c:
	* generic/tclProc.c:
	* tests/compile.test:
	* tests/info.test:
	* tests/platform.test:
	* tests/safe.test:

2006-11-27  Kevin B. Kenny  <[email protected]>

	* unix/tclUnixChan.c (TclUnixWaitForFile):
	* tests/event.test (event-14.*): Corrected a bug where
	TclUnixWaitForFile would present select() with the wrong mask on an
	LP64 machine if a fd number exceeds 32. Thanks to Jean-Luc Fontaine
	for reporting and diagnosing. [Bug 1602208]

2006-11-27  Don Porter	<[email protected]>

	* generic/tclExecute.c (TclIncrObj):	Correct failure to detect
	floating-point increment values. Thanks to William Coleda [Bug
	1602991]

2006-11-26  Donal K. Fellows  <[email protected]>

	* tests/mathop.test, doc/mathop.n: More bits and pieces of the TIP#174
	implementation. Note that the test suite is not yet complete.

2006-11-26  Daniel Steffen  <[email protected]>

	* unix/tcl.m4 (Linux): --enable-64bit support.	[Patch 1597389]
	* unix/configure: autoconf-2.59			[Bug 1230558]

2006-11-25  Donal K. Fellows  <[email protected]>

	TIP#174 IMPLEMENTATION

	* generic/tclMathOp.c (new file): Completed the implementation of the
	interpreted versions of all the tcl::mathop commands. Moved to a new
	file to make tclCompCmds.c more focused in purpose.

2006-11-23  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmds.c (Tcl*OpCmd, TclCompile*OpCmd):
	* generic/tclBasic.c (Tcl_CreateInterp): Partial implementation of
	TIP#174; the commands are compiled, but (mostly) not interpreted yet.

2006-11-22  Donal K. Fellows  <[email protected]>

	TIP#269 IMPLEMENTATION

	* generic/tclCmdMZ.c (Tcl_StringObjCmd): Implementation of the [string
	* tests/string.test (string-25.*):	 is list] command, based on
	* doc/string.n:				 work by Joe Mistachkin, with
	enhancements by Donal Fellows for better failindex behaviour.

2006-11-22  Don Porter	<[email protected]>

	* tools/genWinImage.tcl (removed):	Removed two files used in
	* win/README.binary (removed):	production of binary distributions
	for Windows, a task we no longer perform. [Bug 1476980]
	* generic/tcl.h:	Remove mention of win/README.binary in comment

	* generic/tcl.h:	Moved TCL_REG_BOSONLY #define from tcl.h to
	* generic/tclInt.h:	tclInt.h. Only know user is Expect, which
	already #include's tclInt.h. No need to continue greater exposure.
	[Bug 926500]

2006-11-20  Donal K. Fellows  <[email protected]>

	* generic/tclBasic.c (Tcl_CreateInterp, TclHideUnsafeCommands):
	* library/init.tcl: Refactored the [chan] command's guts so that it
	does not use aliases to global commands, making the code more robust.

2006-11-17  Don Porter	<[email protected]>

	* generic/tclExecute.c (INST_EXPON):	Corrected crash on
	[expr 2**(1<<63)]. Was operating on cleared bignum Tcl_Obj.

2006-11-16  Donal K. Fellows  <[email protected]>

	* doc/apply.n, doc/chan.n: Added examples.

2006-11-15  Don Porter	<[email protected]>

	TIP#270 IMPLEMENTATION

	* generic/tcl.decls:		New public routines Tcl_ObjPrintf,
	* generic/tclStringObj.c:	Tcl_AppendObjToErrorInfo, Tcl_Format,
	* generic/tclInt.h:		Tcl_AppendLimitedToObj,
	Tcl_AppendFormatToObj and Tcl_AppendPrintfToObj. Former internal
	versions removed.

	* generic/tclDecls.h:		make genstubs
	* generic/tclStubInit.c:

	* generic/tclBasic.c:		Updated callers.
	* generic/tclCkalloc.c:
	* generic/tclCmdAH.c:
	* generic/tclCmdIL.c:
	* generic/tclCmdMZ.c:
	* generic/tclCompExpr.c:
	* generic/tclCompile.c:
	* generic/tclDictObj.c:
	* generic/tclExecute.c:
	* generic/tclIORChan.c:
	* generic/tclIOUtil.c:
	* generic/tclMain.c:
	* generic/tclNamesp.c:
	* generic/tclObj.c:
	* generic/tclPkg.c:
	* generic/tclProc.c:
	* generic/tclStrToD.c:
	* generic/tclTimer.c:
	* generic/tclUtil.c:
	* unix/tclUnixFCmd.c:

	* tools/genStubs.tcl:	Updated script to no longer produce the
	_ANSI_ARGS_ wrapper in generated declarations. Also revised to accept
	variadic prototypes with more than one fixed argument. (This is
	possible since TCL_VARARGS and its limitations are no longer in use).
	* generic/tcl.h:	Some reordering so that macro definitions do
	not interfere with the now _ANSI_ARGS_-less stub declarations.

	* generic/tclDecls.h:		make genstubs
	* generic/tclIntDecls.h:
	* generic/tclIntPlatDecls.h:
	* generic/tclPlatDecls.h:
	* generic/tclTomMathDecls.h:

2006-11-15  Donal K. Fellows  <[email protected]>

	* doc/ChnlStack.3, doc/CrtObjCmd.3, doc/GetIndex.3, doc/OpenTcp.3:
	* doc/chan.n, doc/fconfigure.n, doc/fcopy.n, doc/foreach.n:
	* doc/history.n, doc/http.n, doc/library.n, doc/lindex.n:
	* doc/lrepeat.n, doc/lreverse.n, doc/pkgMkIndex.n, doc/re_syntax.n:
	Convert \fP to \fR so that man-page scrapers have an easier time.

2006-11-14  Don Porter	<[email protected]>

	TIP#261 IMPLEMENTATION

	* generic/tclNamesp.c:	[namespace import] with 0 arguments
	introspects the list of imported commands.

2006-11-13  Kevin B. Kenny  <[email protected]>

	* generic/tclThreadStorage.c (Tcl_InitThreadStorage):
	(Tcl_FinalizeThreadStorage): Silence a compiler warning about
	presenting a volatile pointer to 'memset'.

2006-11-13  Don Porter	<[email protected]>

	* generic/tclIO.c:	When [gets] on a binary channel needs to use
	the "iso8859-1" encoding, save a copy of that encoding per-thread to
	avoid repeated freeing and re-loading of it from the file system. This
	replaces the cached copy of this encoding that the platform
	initialization code used to keep in pre-8.5 releases.

2006-11-13  Daniel Steffen  <[email protected]>

	* generic/tclCompExpr.c:	Fix gcc warnings about 'cast to/from
	* generic/tclEncoding.c:	pointer from/to integer of different
	* generic/tclEvent.c:		size' on 64-bit platforms by casting
	* generic/tclExecute.c:		to intermediate types
	* generic/tclHash.c:		intptr_t/uintptr_t via new PTR2INT(),
	* generic/tclIO.c:		INT2PTR(), PTR2UINT() and UINT2PTR()
	* generic/tclInt.h:		macros. [Patch 1592791]
	* generic/tclProc.c:
	* generic/tclTest.c:
	* generic/tclThreadStorage.c:
	* generic/tclTimer.c:
	* generic/tclUtil.c:
	* unix/configure.in:
	* unix/tclUnixChan.c:
	* unix/tclUnixPipe.c:
	* unix/tclUnixPort.h:
	* unix/tclUnixTest.c:
	* unix/tclUnixThrd.c:

	* unix/configure: autoconf-2.59
	* unix/tclConfig.h.in: autoheader-2.59

2006-11-12  Donal K. Fellows  <[email protected]>

	* generic/tclInt.h, generic/tclInt.decls: Transfer TclPtrMakeUpvar and
	TclObjLookupVar to the internal stubs table.

2006-11-10  Daniel Steffen  <[email protected]>

	* tests/fCmd.test (fCmd-6.26): fix failure when env(HOME) path
	contains symlinks.

	* macosx/Tcl.xcodeproj/project.pbxproj: remove tclParseExpr.c; when
	running testsuite from inside Xcdoe, skip stack-3.1 (it only fails
	under those circumstances).

	* unix/tcl.m4 (Darwin): suppress linker arch warnings when building
	universal for both 32 & 64 bit and no 64bit CoreFoundation is
	available; sync with tk tcl.m4 change.
	* unix/configure.in: whitespace.
	* unix/configure: autoconf-2.59

2006-11-09  Don Porter	<[email protected]>

	* generic/tclParseExpr.c (removed):	Moved all the code of
	* generic/tclCompExpr.c:	tclParseExpr.c into tclCompExpr.c.
	* unix/Makefile.in:	This sets the stage for expr compiling to work
	* win/Makefile.in:	directly with the full parse tree structures,
	* win/makefile.bc:	and not have to pass through the information
	* win/makefile.vc:	lossy format of an array of Tcl_Tokens.
	* win/tcl.dsp:

2006-11-09  Donal K. Fellows  <[email protected]>

	TIP#272 IMPLEMENTATION

	* generic/tclCmdMZ.c (Tcl_StringObjCmd):    Implementation of the
	* tests/string.test, tests/stringComp.test: [string reverse] command
	* doc/string.n:				    from TIP#272.

	* generic/tclCmdIL.c (Tcl_LreverseObjCmd): Implementation of the
	* generic/tclBasic.c, generic/tclInt.h:	   [lreverse] command from
	* tests/cmdIL.test (cmdIL-7.*):		   TIP#272.
	* doc/lreverse.n:

2006-11-08  Donal K. Fellows  <[email protected]>

	* generic/tclIO.c, generic/tclPkg.c: Style & clarity rewrites.

2006-11-07  Andreas Kupries  <[email protected]>

	* unix/tclUnixFCmd.c (CopyFile): Added code to fall back to a
	hardwired default block size should the filesystem report a bogus
	value. [Bug 1586470]

2006-11-04  Don Porter	<[email protected]>

	* generic/tclStringObj.c:	Changed Tcl_ObjPrintf() response to an
	invalid format specifier string. No longer panics; now produces an
	error message as output.

	TIP#274 IMPLEMENTATION

	* generic/tclParseExpr.c:	Exponentiation operator is now right
	* tests/expr.test:		associative. [Patch 1556802]

2006-11-03  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c (TEOVI): fix por possible leak of a Command in
	the presence of execution traces that delete it.

	* generic/tclBasic.c (TEOVI):
	* tests/trace.test (trace-21.11): fix for [Bug 1590232], execution
	traces may cause a second command resolution in the wrong namespace.

2006-11-03  Donal K. Fellows  <[email protected]>

	* tests/event.test (event-11.5):	Rewrote tests to stop Tcl from
	* tests/io.test (multiple tests):	opening sockets that are
	* tests/ioCmd.test (iocmd-15.1,16,17):	reachable from outside hosts
	* tests/iogt.test (__echo_srv__.tcl):	where not necessary. This is
	* tests/socket.test (multiple tests):	noticably annoying on some
	* tests/unixInit.test (unixInit-1.2):	systems (e.g., Windows).

2006-11-02  Daniel Steffen  <[email protected]>

	* macosx/Tcl.xcodeproj/project.pbxproj: check autoconf/autoheader exit
	status and stop build if they fail.

2006-11-02  Jeff Hobbs	<[email protected]>

	* doc/ParseCmd.3, doc/Tcl.n, doc/eval.n, doc/exec.n:
	* doc/fconfigure.n, doc/interp.n, doc/unknown.n:
	* library/auto.tcl, library/init.tcl, library/package.tcl:
	* library/safe.tcl, library/tm.tcl, library/msgcat/msgcat.tcl:
	* tests/all.tcl, tests/basic.test, tests/cmdInfo.test:
	* tests/compile.test, tests/encoding.test, tests/execute.test:
	* tests/fCmd.test, tests/http.test, tests/init.test:
	* tests/interp.test, tests/io.test, tests/ioUtil.test:
	* tests/iogt.test, tests/namespace-old.test, tests/namespace.test:
	* tests/parse.test, tests/pkg.test, tests/pkgMkIndex.test:
	* tests/proc.test, tests/reg.test, tests/trace.test:
	* tests/upvar.test, tests/winConsole.test, tests/winFCmd.test:
	* tools/tclZIC.tcl:
	* generic/tclParse.c (Tcl_ParseCommand): Replace {expand} with {*}
	officially (TIP #293). Leave -DALLOW_EXPAND=0|1 option to keep
	{expand} syntax for transition users. [Bug 1589629]

2006-11-02  Donal K. Fellows  <[email protected]>

	* generic/tclBasic.c, generic/tclInterp.c, generic/tclProc.c: Silence
	warnings from gcc over signed/unsigned and TclStackAlloc().
	* generic/tclCmdMZ.c: Update to more compact and clearer coding style.

2006-11-02  Don Porter	<[email protected]>

	* generic/tclCmdAH.c:	Further revisions to produce the routines
	* generic/tclInt.h:	TclFormat() and TclAppendFormatToObj() that
	* generic/tclNamesp.c:	accept (objc, objv) arguments rather than
	* generic/tclStringObj.c:	any varargs stuff.

	* generic/tclBasic.c:	Further revised TclAppendPrintToObj() and
	* generic/tclCkalloc.c: TclObjPrintf() routines to panic when unable
	* generic/tclCmdAH.c:	to complete their formatting operations,
	* generic/tclCmdIL.c:	rather than report an error message. This
	* generic/tclCmdMZ.c:	means an interp argument for error message
	* generic/tclDictObj.c: recording is no longer needed, further
	* generic/tclExecute.c: simplifying the interface for callers.
	* generic/tclIORChan.c:
	* generic/tclIOUtil.c:
	* generic/tclInt.h:
	* generic/tclMain.c:
	* generic/tclNamesp.c:
	* generic/tclParseExpr.c:
	* generic/tclPkg.c:
	* generic/tclProc.c:
	* generic/tclStringObj.c:
	* generic/tclTimer.c:
	* generic/tclUtil.c:
	* unix/tclUnixFCmd.c:

2006-11-02  Donal K. Fellows  <[email protected]>

	* tests/winPipe.test (winpipe-4.[2345]): Made robust when run in
	directory with spaces in its name.

	* generic/tclCmdAH.c: Clean up uses of cast NULLs.

	* generic/tclInterp.c (AliasObjCmd): Added more explanatory comments.

	* generic/tclBasic.c (TclEvalObjvInternal): Rewrote so that comments
	are relevant and informative once more. Also made the unknown handler
	processing use the Tcl execution stack for working space, and not the
	general heap.

2006-11-01  Daniel Steffen  <[email protected]>

	* unix/tclUnixPort.h: ensure MODULE_SCOPE is defined before use, so
	that tclPort.h can once again be included without tclInt.h.

	* generic/tclEnv.c (Darwin): mark _environ symbol as unexported even
	when MODULE_SCOPE != __private_extern__.

2006-10-31  Don Porter	<[email protected]>

	* generic/tclBasic.c:	Refactored and renamed the routines
	* generic/tclCkalloc.c: TclObjPrintf, TclFormatObj, and
	* generic/tclCmdAH.c:	TclFormatToErrorInfo to a new set of routines
	* generic/tclCmdIL.c:	TclAppendPrintfToObj, TclAppendFormatToObj,
	* generic/tclCmdMZ.c:	TclObjPrintf, and TclObjFormat, with the
	* generic/tclDictObj.c: intent of making the latter list, plus
	* generic/tclExecute.c: TclAppendLimitedToObj and
	* generic/tclIORChan.c: TclAppendObjToErrorInfo, public via a revised
	* generic/tclIOUtil.c:	TIP 270.
	* generic/tclInt.h:
	* generic/tclMain.c:
	* generic/tclNamesp.c:
	* generic/tclParseExpr.c:
	* generic/tclPkg.c:
	* generic/tclProc.c:
	* generic/tclStringObj.c:
	* generic/tclTimer.c:
	* generic/tclUtil.c:
	* unix/tclUnixFCmd.c:

2006-10-31  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c, generic/tcl.h, generic/tclInterp.c:
	* generic/tclNamesp.c: removing the flag bit TCL_EVAL_NOREWRITE, the
	last remnant of the callObjc/v fiasco. It is not needed, as it is now
	always set and checked or'ed with TCL_EVAL_INVOKE.

2006-10-31  Pat Thoyts	<[email protected]>

	* win/rules.vc: Fix for [Bug 1582769] - options conflict with VC2003.

2006-10-31  Donal K. Fellows  <[email protected]>

	* generic/tclBasic.c, generic/tclNamesp.c, generic/tclProc.c:
	* generic/tclInt.h: Removed the callObjc and callObjv fields from the
	Interp structure. They did not function correctly and made other parts
	of the core amazingly complex, resulting in a substantive change to
	[info level] behaviour. [Bug 1587618]
	* library/clock.tcl: Removed use of [info level 0] for calculating the
	command name as used by the user and replace with a literal. What's
	there now is sucky, but at least appears to be right to most users.
	* tests/namespace.test (namespace-42.7,namespace-47.1): Reverted
	changes to these tests.
	* tests/info.test (info-9.11,info-9.12): Added knownBug constraint
	since these tests require a different behaviour of [info level] than
	is possible because of other dependencies.

2006-10-30  Jeff Hobbs	<[email protected]>

	* tools/tcltk-man2html.tcl (option-toc): handle any kind of options
	defined toc section (needed for ttk docs)

2006-10-30  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c (TEOVI): insured that the interp's callObjc/v
	fields are restored after traces run, as they be spoiled. This was
	causing a segfault in tcllib's profiler tests.

2006-10-30  Don Porter	<[email protected]>

	* generic/tclExecute.c (INST_MOD): Corrected improper testing of the
	* tests/expr.test:		   sign of bignums when applying Tcl's
	division rules. Thanks to Peter Spjuth. [Bug 1585704]

2006-10-29  Miguel Sofer  <[email protected]>

	* generic/tclNamesp.c (EnsembleImplementationCmd):
	* tests/namespace.test (47.7-8): reverted a wrong "optimisation" that
	completely broke snit; added two tests.

2006-10-28  Donal K. Fellows  <[email protected]>

	* generic/tclProc.c (ObjInterpProcEx, TclObjInterpProcCore): Split the
	core of procedures to make it easier to build procedure-like code
	without going through horrible contortions. This is the last critical
	component to make advanced OO systems workable as simple loadable
	extensions. TOIPC is now in the internal stub table.
	(MakeProcError, MakeLambdaError): Refactored ProcessProcResultCode to
	be simpler, some of which goes to TclObjInterpProcCore, and the rest
	of which is now in these far simpler routines which just do errorInfo
	stack generation for different types of procedure-like entity.
	* tests/apply.test (apply-5.1): Updated to expect the more informative
	form of message.

2006-10-27  Donal K. Fellows  <[email protected]>

	* generic/tclVar.c (HasLocalVars): New macro to make various bits and
	pieces cleaner.

	* generic/tclNamesp.c (TclSetNsPath): Expose SetNsPath() through
	internal stubs table with semi-external name.

	* generic/tclInt.h (CallFrame): Add a field for handling context data
	for extensions (like object systems) that should be tied to a call
	frame (and not a command or interpreter).

	* generic/tclBasic.c (TclRenameCommand): Change to take CONST args;
	they were only ever used in a constant way anyway, so this appears to
	be a spot that was missed during TIP#27 work.

2006-10-26  Miguel Sofer  <[email protected]>

	* generic/tclProc.c (SetLambdaFromAny): minor change, eliminate
	redundant call to Tcl_GetString (thanks aku).

	* generic/tclInterp.c (ApplyObjCmd):
	* generic/tclNamesp.c (EnsembleImplementationCmd): replaced ckalloc
	(heap) with TclStackAlloc (execution stack).

2006-10-24  Miguel Sofer  <[email protected]>

	* tests/info.test (info-9.11-12): tests for [Bug 1577492]
	* tests/apply.test (apply-4.3-5): tests for [Bug 1574835]

	* generic/tclProc.c (ObjInterpProcEx): disable itcl hacks for calls
	from ApplyObjCmd (islambda==1), as they mess apply's error messages
	[Bug 1583266]

2006-10-23  Miguel Sofer  <[email protected]>

	* generic/tclProc.c (ApplyObjCmd): fix wrong#args for apply by using
	the ensemble rewrite engine. [Bug 1574835]
	* generic/tclInterp.c (AliasObjCmd): previous commit missed usage of
	TCL_EVAL_NOREWRITE for aliases.

	* generic/tclBasic.c (TclEvalObjvInternal): removed redundant check
	for ensembles. [Bug 1577628]

	* library/clock.tcl (format, scan): corrected wrong # args messages to
	* tests/clock.test (3.1, 34.1):	    make use of the new rewrite
	capabilities of [info level]

	* generic/tcl.h:	   Lets TEOV update the iPtr->callObj[cv] new
	* generic/tclBasic.c:	   fields, except when the flag bit
	* generic/tclInt.h:	   TCL_EVAL_NOREWRITE is present. These values
	* generic/tclNamesp.c:	   are used by Tcl_PushCallFrame to initialise
	* generic/tclProc.c:	   the frame's obj[cv] fields, and allows
	* tests/namespace.test:	   [info level] to know and use ensemble
	rewrites. [Bug 1577492]

	***POTENTIAL INCOMPATIBILITY***
	The return value from [info level 0] on interp alias calls is changed:
	previously returned the target command (including curried values), now
	returns the source - what was actually called.

2006-10-23  Miguel Sofer  <[email protected]>

	* generic/tcl.h:	   Modified the Tcl call stack so there is
	* generic/tclBasic.c:	   always a valid CallFrame, even at level 0
	* generic/tclCmdIL.c:	   [Patch 1577278]. Most of the changes
	* generic/tclInt.h:	   involve removing tests for a NULL
	* generic/tclNamesp.c:	   iPtr->(var)framePtr. There is now a
	* generic/tclObj.c:	   CallFrame pushed at interp creation with a
	* generic/tclProc.c:	   pointer to it stored in iPtr->rootFramePtr.
	* generic/tclTrace.c:	   A second unused field in Interp is
	* generic/tclVar.c:	   hijacked to enable further functionality,
	currently unused (but with several FRQs depending on it).

	***POTENTIAL INCOMPATIBILITY***
	Any user that includes tclInt.h and needs to determine if it is
	running at level 0 should change (iPtr->varFramePtr == NULL) to
	(iPtr->varFramePtr == iPtr->rootFramePtr).

2006-10-23  Don Porter	<[email protected]>

	* README:		Bump version number to 8.5a6
	* generic/tcl.h:
	* tools/tcl.wse.in:
	* unix/configure.in:
	* unix/tcl.spec:
	* win/README.binary:
	* win/configure.in:

	* unix/configure:	autoconf-2.59
	* win/configure:

2006-10-21  Miguel Sofer  <[email protected]>

	* generic/tcl.h, generic/tclHash.c: Tcl_FindHashEntry now calls
	Tcl_CreateHashEntry with a newPtr set to NULL: this would have caused
	a segfault previously and eliminates duplicated code. A macro has been
	added to tcl.h (only used when TCL_PRESERVE_BINARY_COMPATABALITY is
	not set - i.e., not by default).

2006-10-20  Reinhard Max  <[email protected]>

	* unix/configure.in: Added autodetection for OS-supplied timezone
	* unix/Makefile.in:  files and configure switches to override the
	* unix/configure:    detected default.

2006-10-20  Daniel Steffen  <[email protected]>

	*** 8.5a5 TAGGED FOR RELEASE ***

	* tools/tcltk-man2html.tcl: add support for alpha & beta versions to
	useversion glob pattern. [Bug 1579941]

2006-10-18  Don Porter	<[email protected]>

	* changes:		8.5a5 release date set

	* doc/Encoding.3:	Missing doc updates (mostly Table of
	* doc/Ensemble.3:	Contents) exposed by `make checkdoc`
	* doc/FileSystem.3:
	* doc/GetTime.3:
	* doc/PkgRequire.3:

2006-10-17  Miguel Sofer  <[email protected]>

	* generic/tclInterp.c (ApplyObjCmd): fixed bad error in 2006-10-12
	commit: interp released too early. Spotted by mistachkin.

2006-10-16  Miguel Sofer  <[email protected]>

	* tclProc.c (SetLambdaFromAny):
	* tests/apply.test (9.1-9.2): plugged intrep leak [Bug 1578454],
	found by mjanssen.

2006-10-16  Andreas Kupries  <[email protected]>

	* generic/tclBasic.c: Moved TIP#219 cleanup to DeleteInterpProc.

2006-10-16  Daniel Steffen  <[email protected]>

	* changes: updates for 8.5a5 release.

	* unix/tclUnixThrd.c (TclpThreadGetStackSize): Darwin: fix for main
	thread, where pthread_get_stacksize_np() returns incorrect info.

	* macosx/GNUmakefile: don't redo prebinding of non-prebound binaires.

2006-10-16  Don Porter	<[email protected]>

	* generic/tclPkg.c (ExactRequirement):	Plugged memory leak. Also
	changed Tcl_Alloc()/Tcl_Free() calls to ckalloc()/ckfree() for easier
	memory debugging in the future. [Bug 1568373]

	* library/tcltest/tcltest.tcl:	Revise tcltest bump to 2.3a1.
	* library/tcltest/pkgIndex.tcl: This permits more features to be
	* unix/Makefile.in:	added to tcltest before we reach version 2.3.0
	* win/Makefile.in:	best timed to match the release of Tcl 8.5.0.
	* win/makefile.vc:	This also serves as a demo of TIP 268 features

2006-10-13  Colin McCormack <[email protected]>

	* win/tclWinFile.c: corrected erroneous attempt to protect against
	NULL return from Tcl_FSGetNormalizedPath per [Bug 1548263] causing
	[Bug 1575837].
	* win/tclWinFile.c: alfredd supplied patch to fix [Bug 1575837]

2006-10-13  Daniel Steffen  <[email protected]>

	* unix/tclUnixThrd.c (TclpThreadGetStackSize): on Darwin, use
	* unix/tcl.m4: pthread_get_stacksize_np() API to get thread stack size
	* unix/configure: autoconf-2.59
	* unix/tclConfig.h.in: autoheader-2.59

2006-10-12  Miguel Sofer  <[email protected]>

	* generic/tclInterp.c (ApplyObjCmd):
	* tests/interp.test (interp-14.5-10): made [interp alias] use the
	ensemble rewrite machinery to produce better error messages [Bug
	1576006]

2006-10-12  David Gravereaux <[email protected]>

	* win/nmakehlp.c: Replaced all wnsprintf() calls with snprintf().
	wnsprintf was not in my shwlapi header file (VC++6)

2006-10-11  Don Porter	<[email protected]>

	* generic/tclPkg.c (Tcl_PackageRequireEx):	Corrected crash when
	argument version=NULL passed in.

2006-10-10  Don Porter	<[email protected]>

	* changes:	Updates for 8.5a5 release.

	* generic/tclNamespace.c (TclTeardownNamespace):  After the
	commandPathSourceList of a namespace is cleared, set the
	commandPathSourceList to NULL so we don't try to walk the list a
	second time, possibly after it is freed. [Bug 1566526]
	* tests/namespace.test (namespace-51.16):	Added test.

2006-10-09  Miguel Sofer  <[email protected]>

	* doc/UpVar.3: brough the docs in accordance to the code. Ever since
	8.0, Tcl_UpVar(2)? accepts TCL_NAMESPACE_ONLY as a flag value, and
	var-3.4 tests for proper behaviour. The docs only allowed 0 and
	TCL_GLOBAL_ONLY. [Bug 1574099]

2006-10-09  Miguel Sofer  <[email protected]>

	* tests/*.test: updated all tests to refer explicitly to the global
	variables ::errorInfo, ::errorCode, ::env and ::tcl_platform: many
	were relying on the alternative lookup in the global namespace, that
	feature is tested specifically in namespace and variable tests.

	The modified testfiles are: apply.test, basic.test, case.test,
	cmdIL.test, cmdMZ.test, compExpr-old.test, error.test, eval.test,
	event.test, expr.test, fileSystem.test, for.test, http.test, if.test,
	incr-old.test, incr.test, interp.test, io.test, ioCmd.test, load.test,
	misc.test, namespace.test, parse.test, parseOld.test, pkg.test,
	proc-old.test, set.test, switch.test, tcltest.test, thread.test,
	var.test, while-old.test, while.test.

2006-10-06  Pat Thoyts	<[email protected]>

	* win/rules.vc: [Bug 1571954] avoid /RTCc flag with MSVC8

2006-10-06  Pat Thoyts	<[email protected]>

	* doc/binary.n:	       TIP #275: Support unsigned values in binary
	* generic/tclBinary.c: command. Tests and documentation updated.
	* tests/binary.test:

2006-10-05  Andreas Kupries  <[email protected]>

	* library/tm.tcl: Fixed bug in TIP #189 implementation, now allowing
	'_' in module names.

2006-10-05  Jeff Hobbs	<[email protected]>

	* library/http/http.tcl (http::geturl): only do geturl url rfc 3986
	validity checking if $::http::strict is true (default true for 8.5).
	[Bug 1560506]

	* generic/tcl.h: note limitation on changing Tcl_UniChar size
	* generic/tclEncoding.c (UtfToUnicodeProc, UnicodeToUtfProc):
	* tests/encoding.test (encoding-16.1): fix alignment issues in
	unicode <> utf conversion procs. [Bug 1122671]

2006-10-05  Miguel Sofer  <[email protected]>

	* generic/tclVar.c (Tcl_LappendObjCmd):
	* tests/append.test(4.21-22): fix for longstanding [Bug 1570718],
	lappending nothing to non-list. Reported by lvirden

2006-10-04  Kevin B. Kenny  <[email protected]>

	* tzdata/: Olson's tzdata2006m.

2006-10-01  Kevin B. Kenny  <[email protected]>

	* tests/clock.test (clock-49.2): Removed a locale dependency that
	caused a spurious failure in the German locale. [Bug 1567956]

2006-10-01  Miguel Sofer  <[email protected]>

	* doc/Eval.3 (TclEvalObjv): added note on refCount management for the
	elements of objv. [Bug 730244]

2006-10-01  Pat Thoyts	<[email protected]>

	* win/tclWinFile.c: Handle possible missing define.

	* win/tclWinFile.c (TclpUtime): [Bug 1420432] file mtime fails for
	* tests/cmdAH.test:		directories on windows

	* tests/winFile.test: Handle Msys environment a little differently in
	getuser function. [Bug 1567956]

2006-09-30  Miguel Sofer  <[email protected]>

	* generic/tclUtil.c (Tcl_SplitList): optimisation, [Patch 1344747] by
	dgp.

	* generic/tclInt.decls:
	* generic/tclInt.h:
	* generic/tclIntDecls.h:
	* generic/tclObj.c:
	* generic/tclStubInit.c: added an internal function TclObjBeingDeleted
	to provide info as to the reason for the loss of an internal rep. [FR
	1512138]

	* generic/tclCompile.c:
	* generic/tclHistory.c:
	* generic/tclInt.h:
	* generic/tclProc.c: made Tcl_RecordAndEvalObj not call "history" if
	it has been redefined to an empty proc, in order to reduce the noise
	when debugging [FR 1190441]. Moved TclCompileNoOp from tclProc.c to
	tclCompile.c

2006-09-28  Andreas Kupries  <[email protected]>

	* generic/tclPkg.c (CompareVersions): Bugfix. Check string lengths
	* tests/pkg.test: before comparison. The shorter string is the smaller
	number. Added testcases as well. Interestingly all existing test cases
	for vcompare compared numbers of the same length with each other. [Bug
	1563836]

2006-09-28  Miguel Sofer  <[email protected]>

	* generic/tclIO.c (Tcl_GetsObj): added two test'n'panic guards for
	possible NULL derefs, [Bug 1566382] and coverity #33.

2006-09-27  Don Porter	<[email protected]>

	* generic/tclExecute.c: Corrected error in INST_LSHIFT in the
	* tests/expr.test:	calculation done to determine whether a shift
	in the (long int) type is possible. The calculation had literal value
	"1" where it needed a value "1L" to compute the correct result. Error
	detected via testing with the math::bigfloat package [Bug 1567222]

	* generic/tclPkg.c (CompareVersion):	Flatten strcmp() results to
	{-1, 0, 1} to match expectations of CompareVersion() callers.

2006-09-27  Miguel Sofer  <[email protected]>

	* generic/regc_color.c (singleton):
	* generic/regc_cvec.c (addmcce):
	* generic/regcomp.c (compile, dovec): the static function addmcce does
	nothing when called with two NULL pointers; the only call is by
	compile with two NULL pointers (regcomp.c #includes regc_cvec.c).
	Large parts (all?) the code for mcce (multi character collating
	element) that we do not use is ifdef'ed out with the macro
	REGEXP_MCCE_ENABLE.
	This silences coverity bugs 7, 16, 80

	* generic/regc_color.c (uncolorchain):
	* generic/regc_nfa.c (freearc): changed tests and asserts to
	equivalent formulation, designed to avoid an explicit comparison to
	NULL and satisfy coverity that 6 and 9 are not bugs.

2006-09-27  Andreas Kupries  <[email protected]>

	* tests/pkg.test: Added test for version comparison at the 32bit
	boundary. [Bug 1563836]

	* generic/tclPkg.c: Rewrote CompareVersion to perform string
	comparison instead of numeric. This breaks through the 32bit limit on
	version numbers. See code for details (handling of leading zeros,
	signs, etc.). un-CONSTed some arguments of CompareVersions,
	RequirementSatisfied, and AllRequirementsSatisfied. The new compare
	modifies the string (temporary string terminators). All callers use
	heap-allocated ver-intreps, so we are good with that. [Bug 1563836]

2006-09-27  Miguel Sofer  <[email protected]>

	* generic/tclFileName.c (TclGlob): added a panic for a call with
	TCL_GLOBMODE_TAILS and pathPrefix==NULL. This would cause a segfault,
	as found by coverity #26.

2006-09-26  Kevin B. Kenny  <[email protected]>

	* doc/Encoding.3:	 Added covariant 'const' qualifier for the
	* generic/tcl.decls:	 Tcl_EncodingType argument to
	* generic/tclEncoding.c: Tcl_CreateEncoding. [Further TIP#27 work.]
	* generic/tclDecls.h:	 Reran 'make genstubs'.

2006-09-26  Pat Thoyts	<[email protected]>

	* win/makefile.vc:  Additional compiler flags and amd64 support.
	* win/nmakehlp.c:
	* win/rules.vc:

2006-09-26  Don Porter	<[email protected]>

	* generic/tcl.h:	As 2006-09-22 commit from Donal K. Fellows
	demonstrates, "#define NULL 0" is just wrong, and as a quotable chat
	figure observed, "If NULL isn't defined, we're not using a C compiler"
	Improper fallback definition of NULL removed.

2006-09-25  Pat Thoyts	<[email protected]>

	* generic/tcl.h:	More fixing which struct stat to refer to.
	* generic/tclGetDate.y: Some casts from time_t to int required.
	* generic/tclTimer.c:	Tcl_Time structure members are longs.
	* win/makefile.vc:	Support for varying compiler options
	* win/rules.vc:		and build to platform-specific subdirs.

2006-09-25  Andreas Kupries  <[email protected]>

	* generic/tclIO.c (Tcl_StackChannel): Fixed [Bug 1564642], aka
	coverity #51. Extended loop condition, added checking for NULL to
	prevent seg.fault.

2006-09-25  Andreas Kupries  <[email protected]>

	* doc/package.n: Fixed nits reported by Daniel Steffen in the TIP#268
	changes.

2006-09-25  Kevin B. Kenny   <[email protected]>

	* generic/tclNotify.c (Tcl_DeleteEvents): Simplified the code in hopes
	of making the invariants clearer and proving to Coverity that the
	event queue memory is managed correctly.

2006-09-25  Donal K. Fellows  <[email protected]>

	* generic/tclNotify.c (Tcl_DeleteEvents): Make it clear what happens
	when the event queue is mismanaged. [Bug 1564677], coverity bug #10.

2006-09-24  Miguel Sofer  <[email protected]>

	* generic/tclParse.c (Tcl_ParseCommand): also return an error if
	start==NULL and numBytes<0. This is coverity's bug #20

	* generic/tclStringObj.c (STRING_SIZE): fix allocation for 0-length
	strings. This is coverity's bugs #54-5

2006-09-22  Andreas Kupries  <[email protected]>

	* generic/tclInt.h: Moved TIP#268's field 'packagePrefer' to the end
	of the structure, for better backward compatibility.

2006-09-22  Andreas Kupries  <[email protected]>

	TIP#268 IMPLEMENTATION

	* generic/tclDecls.h:	 Regenerated from tcl.decls.
	* generic/tclStubInit.c:

	* doc/PkgRequire.3: Documentation of extended API, extended testsuite.
	* doc/package.n:
	* tests/pkg.test:

	* generic/tcl.decls: Implementation.
	* generic/tclBasic.c:
	* generic/tclConfig.c:
	* generic/tclInt.h:
	* generic/tclPkg.c:
	* generic/tclTest.c:
	* generic/tclTomMathInterface.c:
	* library/init.tcl:
	* library/package.tcl:
	* library/tm.tcl:

2006-09-22  Donal K. Fellows  <[email protected]>

	* generic/tclThreadTest.c (TclCreateThread): Use NULL instead of 0 as
	end-of-strings marker to Tcl_AppendResult; the difference matters on
	64-bit machines. [Bug 1562528]

2006-09-21  Don Porter	<[email protected]>

	* generic/tclUtil.c:	Dropped ParseInteger() routine. TclParseNumber
	covers the task just fine.

2006-09-19  Donal K. Fellows  <[email protected]>

	* generic/tclEvent.c (Tcl_VwaitObjCmd): Rewrite so that an exceeded
	limit trapped in a vwait cannot cause a dangerous dangling trace.

2006-09-19  Don Porter	<[email protected]>

	* generic/tclExecute.c (INST_EXPON):	Native type overflow detection
	* tests/expr.test:	was completely broken. Falling back on use of
	bignums for all non-trivial ** calculations until
	native-type-constrained special cases can be done carefully and
	correctly. [Bug 1561260]

2006-09-15  Jeff Hobbs	<[email protected]>

	* library/http/http.tcl:      Change " " -> "+" url encoding mapping
	* library/http/pkgIndex.tcl:  to " " -> "%20" as per RFC 3986.
	* tests/http.test (http-5.1): bump http to 2.5.3
	* unix/Makefile.in:
	* win/Makefile.in:

2006-09-12  Andreas Kupries  <[email protected]>

	* unix/configure.in (HAVE_MTSAFE_GETHOST*): Modified to recognize
	HP-UX 11.00 and beyond as having mt-safe implementations of the
	gethost functions.
	* unix/configure: Regenerated, using autoconf 2.59

	* unix/tclUnixCompat.c (PadBuffer): Fixed bug in calculation of the
	increment needed to align the pointer, and added documentation
	explaining why the macro is implemented as it is.

2006-09-11  Pat Thoyts	<[email protected]>

	* win/rules.vc:	   Updated to install http, tcltest and msgcat as
	* win/makefile.vc: Tcl Modules (as per Makefile.in).
	* win/makefile.vc: Added tommath_(super)class headers.

2006-09-11  Andreas Kupries  <[email protected]>

	* unix/Makefile.in (install-libraries): Fixed typo tcltest 2.3.9 ->
	2.3.0.

2006-09-11  Daniel Steffen  <[email protected]>

	* unix/tclUnixCompat.c: make compatLock static and only declare it
	when it will actually be used; #ifdef parts of TSD that are not always
	needed; adjust #ifdefs to cover all possible cases; fix whitespace.

2006-09-11  Andreas Kupries  <[email protected]>

	* tests/msgcat.test: Bumped version in auxiliary files as well.
	* doc/msgcat.n:

2006-09-11  Kevin B. Kenny  <[email protected]>

	* unix/Makefile.in:	Bumped msgcat version to 1.4.2 to be
	* win/Makefile.in:	consistent with dgp's commits of 2006-09-10.

2006-09-11  Don Porter	<[email protected]>

	* library/msgcat/msgcat.tcl:	Removed some unneeded [uplevel]s.

2006-09-10  Don Porter	<[email protected]>

	* generic/tclExecute.c:		Corrected INST_EXPON flaw that treated
	* tests/expr.test:		$x**1 as $x**3. [Bug 1555371]

	* doc/tcltest.n:		Bump to version tcltest 2.3.0 to
	* library/tcltest/pkgIndex.tcl: account for new "-verbose line"
	* library/tcltest/tcltest.tcl:	feature.
	* unix/Makefile.in:
	* win/Makefile.in:
	* win/makefile.bc:
	* win/makefile.vc:

	* library/msgcat/msgcat.tcl:	Bump to version msgcat 1.4.2 to
	* library/msgcat/pkgIndex.tcl:	account for modifications.

2006-09-10  Daniel Steffen  <[email protected]>

	* library/msgcat/msgcat.tcl (msgcat::Init): on Darwin, add fallback of
	* tests/msgcat.test:			    default msgcat locale to
	* unix/tclUnixInit.c (TclpSetVariables):    current CFLocale
	identifier if available (via private ::tcl::mac::locale global, set at
	interp init when on Mac OS X 10.3 or later with CoreFoundation).

	* library/tcltest/tcltest.tcl: add 'line' verbose level: prints source
	* doc/tcltest.n:	       file line information of failing tests.

	* macosx/Tcl.xcodeproj/project.pbxproj: add new tclUnixCompat.c file;
	revise tests target to use new tcltest 'line' verbose level.

	* unix/configure.in: add descriptions to new AC_DEFINEs for MT-safe.
	* unix/tcl.m4: add caching to new SC_TCL_* macros for MT-safe wrappers
	* unix/configure: autoconf-2.59
	* unix/tclConfig.h.in: autoheader-2.59

2006-09-08  Zoran Vasiljevic <[email protected]>

	* unix/tclUnixCompat.c: Added fallback to gethostbyname() and
	gethostbyaddr() if the implementation is known to be MT-safe
	(currently for Darwin 6 or later only).

	* unix/configure.in: Assume gethostbyname() and gethostbyaddr() are
	MT-safe starting with Darwin 6 (Mac OSX 10.2).

	* unix/configure: Regenerated with autoconf V2.59

2006-09-08  Andreas Kupries  <[email protected]>

	* unix/tclUnixCompat.c: Fixed conditions for CopyArray/CopyString, and
	CopyHostent. Also fixed bad var names in TclpGetHostByName.

2006-09-07  Zoran Vasiljevic <[email protected]>

	* unix/tclUnixCompat.c: Added fallback to MT-unsafe library calls if
	TCL_THREADS is not defined.
	Fixed alignment of arrays copied by CopyArray() to be on the
	sizeof(char *) boundary.

2006-09-07  Zoran Vasiljevic <[email protected]>

	* unix/tclUnixChan.c:	Rewritten MT-safe wrappers to return ptrs to
	* unix/tclUnixCompat.c: TSD storage making them all look like their
	* unix/tclUnixFCmd.c:	MT-unsafe pendants API-wise.
	* unix/tclUnixPort.h:
	* unix/tclUnixSock.c:

2006-09-06  Zoran Vasiljevic <[email protected]>

	* unix/tclUnixChan.c: Added TCL_THREADS ifdef'ed usage of MT-safe
	* unix/tclUnixFCmd.c: calls like: getpwuid, getpwnam, getgrgid,
	* unix/tclUnixSock.c: getgrnam, gethostbyname and gethostbyaddr.
	* unix/tclUnixPort.h: See [Bug 999544]
	* unix/Makefile.in:
	* unix/configure.in:
	* unix/tcl.m4:
	* unix/configure: Regenerated.

	* unix/tclUnixCompat.c: New file containing MT-safe implementation of
	some library calls.

2006-09-04  Don Porter	<[email protected]>

	* generic/tclCompExpr.c:	Removed much complexity that is no
	longer needed.

	* tests/main.text (Tcl_Main-4.4):	Test corrected to not be
	timing sensitive to the Bug 1481986 fix. [Bug 1550858]

2006-09-04  Jeff Hobbs	<[email protected]>

	* doc/package.n: correct package example

2006-08-31  Don Porter	<[email protected]>

	* generic/tclCompExpr.c:	Corrected flawed logic for disabling
	the INST_TRY_CVT_TO_NUMERIC instruction at the end of an expression
	when function arguments contain operators. [Bug 1541274]

	* tests/expr-old.test:	The remaining failing tests reported in
	* tests/expr.test:	[Bug 1381715] are all new in Tcl 8.5, so
	there's really no issue of compatibility with Tcl 8.4 result to deal
	with. Fixed by updating tests to expect 8.5 results.

2006-08-29  Don Porter	<[email protected]>

	* generic/tclParseExpr.c:	Dropped the old expr parser.

2006-08-30  Jeff Hobbs	<[email protected]>

	* generic/tclBasic.c (Tcl_CreateInterp): init iPtr->threadId

	* win/tclWinChan.c [Bug 819667] Improve logic for identifying COM
	ports.

	* generic/tclIOGT.c (ExecuteCallback):
	* generic/tclPkg.c (Tcl_PkgRequireEx): replace Tcl_GlobalEval(Obj)
	with more efficient Tcl_Eval(Obj)Ex

	* unix/Makefile.in (valgrindshell): add valgrindshell target and
	update default VALGRINDARGS. User can override, or add to it with
	VALGRIND_OPTS env var.

	* generic/tclFileName.c (DoGlob): match incrs with decrs.

2006-08-29  Don Porter	<[email protected]>

	* generic/tclParseExpr.c:	Use the "parent" field of orphan
	ExprNodes to store the closure of left pointers. This lets us avoid
	repeated re-scanning leftward for the left boundary of subexpressions,
	which in worst case led to near O(N^2) runtime.

2006-08-29  Joe Mistachkin  <[email protected]>

	* unix/tclUnixInit.c: Fixed the issue (typo) that was causing
	* unix/tclUnixThrd.c (TclpThreadGetStackSize): stack.test to fail on
	FreeBSD (and possibly other Unix platforms).

2006-08-29  Colin McCormack  <[email protected]>

	* generic/tclIOUtil.c:	Added test for NULL return from
	* generic/tclPathObj.c: Tcl_FSGetNormalizedPath which was causing
	* unix/tclUnixFile.c:	segv's per [Bug 1548263]
	* win/tclWinFCmd.c:
	* win/tclWinFile.c:

2006-08-28  Kevin B. Kenny  <[email protected]>

	* library/tzdata/America/Havana:      Regenerated from Olson's
	* library/tzdata/America/Tegucigalpa: tzdata2006k.
	* library/tzdata/Asia/Gaza:

2006-08-28  Don Porter	<[email protected]>

	* generic/tclStringObj.c:	Revised ObjPrintfVA to take care to
	* generic/tclParseExpr.c:	copy only whole characters when doing
	%s formatting. This relieves callers of TclObjPrintf() and
	TclFormatToErrorInfo() from needing to fix arguments to character
	boundaries. Tcl_ParseExpr() simplified by taking advantage. [Bug
	1547786]

	* generic/tclStringObj.c:	Corrected TclFormatObj's failure to
	count up the number of arguments required by examining the format
	string. [Bug 1547681]

2006-08-27  Joe Mistachkin  <[email protected]>

	* generic/tclClock.c (ClockClicksObjCmd): Fix nested macro breakage
	with TCL_MEM_DEBUG enabled. [Bug 1547662]

2006-08-26  Miguel Sofer  <[email protected]>

	* doc/namespace.n:
	* generic/tclNamesp.c:
	* tests/upvar.test: bugfix, docs clarification and new tests for
	[namespace upvar] as follow up to [Bug 1546833], reported by Will
	Duquette.

2006-08-24  Kevin B. Kenny  <[email protected]>

	* library/tzdata: Regenerated, including several new files, from
	Olson's tzdata2006j.
	* library/clock.tcl:
	* tests/clock.test: Removed an early testing hack that allowed loading
	'registry' from the build tree rather than an installed one. This is a
	workaround for [Bug 15232730], which remains open because it's a
	symptom of a deeper underlying problem.

2006-08-23  Don Porter	<[email protected]>

	* generic/tclParseExpr.c:	Minimal collection of new tests
	* tests/parseExpr.test:		testing the error messages of the new
	expr parser. Several bug fixes and code simplifications that appeared
	during that effort.

2006-08-21  Don Porter	<[email protected]>

	* generic/tclIOUtil.c:	Revisions to complete the thread finalization
	of the cwdPathPtr. [Bug 1536142]

	* generic/tclParseExpr.c:	Revised mistaken call to
	TclCheckBadOctal(), so both [expr 08] and [expr 08z] have same
	additional info in error message.

	* tests/compExpr-old.test:	Update existing tests to not fail with
	* tests/compExpr.test:		the new expr parser.
	* tests/compile.test:
	* tests/expr-old.test:
	* tests/expr.test:
	* tests/for.test:
	* tests/if.test:
	* tests/parseExpr.test:
	* tests/while.test:

2006-08-21  Donal K. Fellows  <[email protected]>

	* win/Makefile.in (gdb): Make this target work so that debugging an
	msys build is possible.

2006-08-21  Daniel Steffen  <[email protected]>

	* macosx/tclMacOSXNotify.c (Tcl_WaitForEvent): if the run loop is
	already running (e.g. if Tcl_WaitForEvent was called recursively),
	re-run it in a custom run loop mode containing only the source for the
	notifier thread, otherwise wakeups from other sources added to the
	common run loop modes might get lost.

	* unix/tclUnixNotfy.c (Tcl_WaitForEvent): 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 on that platform. [Bug 1457797]

	* generic/tclClock.c (ClockClicksObjCmd): add support for Darwin
	* generic/tclCmdMZ.c (Tcl_TimeObjCmd):	  nanosecond resolution timer
	* generic/tclInt.h:			  to [clock clicks] and [time]
	* unix/configure.in (Darwin):		  when TCL_WIDE_CLICKS defined
	* unix/tclUnixTime.c (TclpGetWideClicks, TclpWideClicksToNanoseconds):
	* unix/configure: autoconf-2.59
	* unix/tclConfig.h.in: autoheader-2.59

	* unix/tclUnixPort.h (Darwin): override potentially faulty configure
	detection of termios availability in all cases, since termios is known
	to be present on all Mac OS X releases since 10.0. [Bug 497147]

2006-08-18  Daniel Steffen  <[email protected]>

	* unix/tcl.m4 (Darwin): add support for --enable-64bit on x86_64, for
	universal builds including x86_64, for 64-bit CoreFoundation on
	Leopard and for use of -mmacosx-version-min instead of
	MACOSX_DEPLOYMENT_TARGET
	* unix/configure: autoconf-2.59
	* unix/tclConfig.h.in: autoheader-2.59

	* generic/tcl.h:	  add fixes for building on Leopard and
	* unix/tclUnixPort.h:	  support for 64-bit CoreFoundation on Leopard
	* macosx/tclMacOSXFCmd.c:

	* unix/tclUnixPort.h: on Darwin x86_64, disable use of vfork as it
	causes execve to fail intermittently. (rdar://4685553)

	* generic/tclTomMath.h: on Darwin 64-bit, for now disable use of
	128-bit arithmetic through __attribute__ ((mode(TI))), as it leads to
	link errors due to missing fallbacks. (rdar://4685527)

	* macosx/Tcl.xcodeproj/project.pbxproj: add x86_64 to universal build,
	switch native release targets to use DWARF with dSYM, Xcode 3.0
	changes
	* macosx/README: updates for x86_64 and Xcode 2.4.

	* macosx/Tcl.xcodeproj/default.pbxuser: add test suite target that
	* macosx/Tcl.xcodeproj/project.pbxproj: runs the tcl test suite at
	build time and shows clickable test suite errors in the GUI build
	window.

	* tests/macOSXFCmd.test: fix use of deprecated resource fork paths.

	* unix/tclUnixInit.c (TclpInitLibraryPath): move code that is only
	needed when TCL_LIBRARY is defined to run only in that case.

	* generic/tclLink.c (LinkTraceProc): fix 64-bit signed-with-unsigned
	comparison warning from gcc4 -Wextra.

	* unix/tclUnixChan.c (TclUnixWaitForFile): with timeout < 0, if
	select() returns early (e.g. due to a signal), call it again instead
	of returning a timeout result. Fixes intermittent event-13.8 failures.

2006-08-17  Don Porter	<[email protected]>

	* generic/tclCompile.c:		Revised the new set of expression
	* generic/tclParseExpr.c:	parse error messages.

2006-08-16  Don Porter	<[email protected]>

	* generic/tclParseExpr.c:	Replace PrecedenceOf() function with
	prec[] static array.

2006-08-14  Donal K. Fellows  <[email protected]>

	* library/clock.tcl (::tcl::clock::add): Added missing braces to
	clockval validation code. Pointed out on comp.lang.tcl.

2006-08-11  Donal K. Fellows  <[email protected]>

	* generic/tclNamesp.c: Improvements in buffer management to make
	namespace creation faster. Plus selected other minor improvements to
	code quality. [Patch 1352382]

2006-08-10  Donal K. Fellows  <[email protected]>

	Misc patches to make code more efficient. [Bug 1530474] (afredd)
	* generic/*.c, macosx/tclMacOSXNotify.c, unix/tclUnixNotfy.c,
	* win/tclWinThrd.c: Tidy up invokations of Tcl_Panic() to promote
	string constant sharing and consistent style.
	* generic/tclBasic.c (Tcl_CreateInterp): More efficient handling of
	* generic/tclClock.c (TclClockInit):	 registration of commands not
						 in global namespace.
	* generic/tclVar.c (Tcl_UnsetObjCmd): Remove unreachable clause.

2006-08-09  Don Porter	<[email protected]>

	* generic/tclEncoding.c:	Replace buffer copy in for loop with
	call to memcpy(). Thanks to afredd. [Patch 1530262]

2006-08-09  Donal K. Fellows  <[email protected]>

	* generic/tclCmdIL.c (Tcl_LassignObjCmd): Make the wrong#args message
	a bit more consistent with those used elsewhere. [Bug 1534628]

	* generic/tclDictObj.c (DictForCmd): Stop crash when attempting to
	iterate over an invalid dictionary. [Bug 1531184]

	* doc/ParseCmd.3, doc/expr.n, doc/set.n, doc/subst.n, doc/switch.n:
	* doc/tclvars.n: Ensure that uses of [expr] in documentation examples
	are also good style (with braces) unless otherwise necessary. [Bug
	1526581]

2006-08-03  Daniel Steffen  <[email protected]>

	* unix/tclUnixPipe.c (TclpCreateProcess): for USE_VFORK: ensure
	standard channels are initialized before vfork() so that the child
	doesn't potentially corrupt global state in the parent's address space

	* tests/compExpr-old.test: add 'oldExprParser' constraint to all tests
	* tests/compExpr.test:	   that depend on the exact format of the
	* tests/compile.test:	   error messages of the pre-2006-07-05
	* tests/expr-old.test:	   expression parser. The constraint is on by
	* tests/expr.test:	   default (i.e those tests still fail), but
	* tests/for.test:	   can be turned off by passing '-constraints
	* tests/if.test:	   newExprParser' to tcltest, which will skip
	* tests/parseExpr.test:	   the 196 failing tests in the testsuite that
	* tests/while.test:	   are caused by the new expression parser
	error messages.

2006-07-31  Kevin B. Kenny  <[email protected]>

	* generic/tclClock.c (ConvertLocalToUTCUsingC): Corrected a regression
	that caused dates before 1969 to be one day off in the :localtime time
	zone if TZ is not set. [Bug 1531530]

2006-07-30  Kevin B. Kenny  <[email protected]>

	* generic/tclClock.c (GetJulianDayFromEraYearMonthDay): Corrected
	several errors in converting dates before the Common Era [Bug 1426279]
	* library/clock.tcl: Corrected syntax errors in generated code for %EC
	%Ey, and %W format groups [Bug 1505383]. Corrected a bug in cache
	management for format strings containing [glob] metacharacters [Bug
	1494664]. Corrected several errors in formatting/scanning of years
	prior to the Common Era, and added the missing %EE format group to
	indicate the era.
	* tools/makeTestCases.tcl: Added code to make sure that %U and %V
	format groups are included in the tests. (The code depends on %U and
	%V formatting working correctly when 'makeTestCases.tcl' is run,
	rather than making a completely independent check.) Added tests for
	[glob] metacharacters in strings. Added tests for years prior to the
	Common Era.
	* tests/clock.test: Rebuilt with new test cases for all the above.

2006-07-30  Joe English	 <[email protected]>

	* doc/AppInit.3: Fix typo [Bug 1496886]

2006-07-26  Don Porter	<[email protected]>

	* generic/tclExecute.c: Corrected flawed overflow detection in
	* tests/expr.test:	INST_EXPON that caused [expr 2**64] to return
	0 instead of the same value as [expr 1<<64].

2006-07-24  Don Porter	<[email protected]>

	* win/tclWinSock.c:	Correct un-initialized Tcl_DString. Thanks to
	afredd. [Bug 1518166]

2006-07-21  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c:
	* tests/execute.test (execute-9.1): dgp's fix for [Bug 1522803].

2006-07-20  Daniel Steffen  <[email protected]>

	* macosx/tclMacOSXNotify.c (Tcl_InitNotifier, Tcl_WaitForEvent):
	create notifier thread lazily upon first call to Tcl_WaitForEvent()
	rather than in Tcl_InitNotifier(). Allows calling exeve() in processes
	where the event loop has not yet been run (Darwin's execve() fails in
	processes with more than one thread), in particular allows embedders
	to call fork() followed by execve(), previously the pthread_atfork()
	child handler's call to Tcl_InitNotifier() would immediately recreate
	the notifier thread in the child after a fork.

	* macosx/tclMacOSXFCmd.c (TclMacOSXCopyFileAttributes):	   add support
	* macosx/tclMacOSXNotify.c (Tcl_InitNotifier):		   for weakly
	* unix/tclUnixInit.c (Tcl_GetEncodingNameFromEnvironment): importing
	symbols not available on OSX 10.2 or 10.3, enables binaires built on
	later OSX versions to run on earlier ones.
	* macosx/Tcl.xcodeproj/project.pbxproj: enable weak-linking; turn on
						extra warnings.
	* macosx/README: document how to enable weak-linking; cleanup.
	* unix/tclUnixPort.h: add support for weak-linking; conditionalize
	AvailabilityMacros.h inclusion; only disable realpath on 10.2 or
	earlier when threads are enabled.
	* unix/tclLoadDyld.c (TclpLoadMemoryGetBuffer): change runtime Darwin
	* unix/tclUnixInit.c (TclpInitPlatform):	release check to use
							global initialized
							once
	* unix/tclUnixFCmd.c (DoRenameFile, TclpObjNormalizePath): add runtime
	Darwin release check to determine if realpath is threadsafe.
	* unix/configure.in: add check on Darwin for compiler support of weak
	* unix/tcl.m4:	     import and for AvailabilityMacros.h header; move
	Darwin specific checks & defines that are only relevant to the tcl
	build out of tcl.m4; restrict framework option to Darwin; clean up
	quoting and help messages.
	* unix/configure: autoconf-2.59
	* unix/tclConfig.h.in: autoheader-2.59

	* generic/regc_locale.c (cclass):
	* generic/tclExecute.c (TclExecuteByteCode):
	* generic/tclIOCmd.c (Tcl_ExecObjCmd):
	* generic/tclListObj.c (NewListIntRep):
	* generic/tclObj.c (Tcl_GetLongFromObj, Tcl_GetWideIntFromObj)
	(FreeBignum, Tcl_SetBignumObj):
	* generic/tclParseExpr.c (Tcl_ParseExpr):
	* generic/tclStrToD.c (TclParseNumber):
	* generic/tclStringObj.c (TclAppendFormattedObjs):
	* unix/tclLoadDyld.c (TclpLoadMemory):
	* unix/tclUnixPipe.c (TclpCreateProcess): fix signed-with-unsigned
	comparison and other warnings from gcc4 -Wextra.

2006-07-13  Andreas Kupries <[email protected]>

	* unix/tclUnixPort.h: Added the inclusion of <AvailabilityMacros.h>.
	The missing header caused the upcoming #if conditions to wrongly
	exclude realpath, causing file normalize to ignore symbolic links in
	the path.

2006-07-11  Zoran Vasiljevic <[email protected]>

	* generic/tclAsync.c: Made Tcl_AsyncDelete() more tolerant when called
	after all thread TSD has been garbage-collected.

2006-07-05  Don Porter	<[email protected]>

	* generic/tclParseExpr.c:	Completely new expression parser that
	builds a parse tree instead of operating with deep recursion. This
	corrects reports of stack-blowing crashes parsing long expressions
	[Bug 906201] and replaces a fundamentally O(N^2) algorithm with an
	O(N) one [RFE 903765]. The new parser is better able to generate error
	messages that clearly report both the nature and context of the syntax
	error [Bugs 1029267, 1381715]. For now, the code for the old parser is
	still present and can be activated with a "#define OLD_EXPR_PARSER
	1". This is for the sake of a clean implementation patch, and for ease
	of benchmarking. The new parser is non-recursive, so much lighter in
	stack consumption, but it does use more heap, so there may be cases
	where parsing of long expressions that succeeded with the old parser
	will lead to out of memory panics with the new one. There are still
	more improvements possible on that point, though significant progress
	may require changes to the Tcl_Token specifications documented for the
	public Tcl_Parse*() routines.
	***POTENTIAL INCOMPATIBILITY*** for any callers that rely on the exact
	(usually terrible) error messages generated by the old parser. This
	includes a large number of tests in the test suite.

	* generic/tclInt.h:		Replaced TclParseWhiteSpace() with
	* generic/tclParse.c:		TclParseAllWhiteSpace() which is what
	* generic/tclParseExpr.c:	all the callers really needed.
	Breaking whitespace runs at newlines is useful only to the command
	parsing function, and it can call the file scoped routine
	ParseWhiteSpace() to do that.

	* tests/expr-old.test:	Removed knownBug constraints that masked
	* tests/expr.test:	failures due to revised error messages.
	* tests/parseExpr.test:

2006-06-20  Don Porter	<[email protected]>

	* generic/tclIOUtil.c:	Changed default configuration to
	* generic/tclInt.decls: #undef USE_OBSOLETE_FS_HOOKS which disables
	* generic/tclTest.c:	access to the Tcl 8.3 internal routines for
	hooking into filesystem operations. Everyone ought to have migrated to
	Tcl_Filesystems by now.
	***POTENTIAL INCOMPATIBILITY*** for any code still stuck in the
	pre-Tcl_Filesystem era.

	* generic/tclIntDecls.h:	make genstubs
	* generic/tclStubInit.c:

	* generic/tclStrToD.c:	Removed dead code that permitted disabling of
	recognition of the new 0b and 0o numeric formats.

	* generic/tclExecute.c: Removed dead code that implemented alternative
	* generic/tclObj.c:	design where numeric values did not
	automatically narrow to the smallest Tcl_ObjType required to hold them

	* generic/tclCmdAH.c:	Removed dead code that was old implementation
	of [format].

2006-06-14  Daniel Steffen  <[email protected]>

	* unix/tclUnixPort.h (Darwin): support MAC_OS_X_VERSION_MAX_ALLOWED
	define from AvailabilityMacros.h: override configure detection and
	only use API available in the indicated OS version or earlier.

2006-06-14  Donal K. Fellows  <[email protected]>

	* doc/format.n, doc/scan.n: Added examples for converting between
	characters and their numeric interpretations following user prompting.

2006-06-13  Donal K. Fellows  <[email protected]>

	* unix/tclLoadDl.c (TclpDlopen): Workaround for a compiler bug in Sun
	Forte 6. [Bug 1503729]

2006-06-06  Don Porter	<[email protected]>

	* doc/GetStdChan.3:	Added recommendation that each call to
	Tcl_SetStdChannel() be accompanied by a call to Tcl_RegisterChannel().

2006-06-05  Donal K. Fellows  <[email protected]>

	* doc/Alloc.3: Added documentation of promise that Tcl_Realloc(NULL,x)
	is the same as Tcl_Alloc(x), as discussed in comp.lang.tcl. Also fixed
	nonsense sentence to say something meaningful.

2006-05-29  Jeff Hobbs	<[email protected]>

	* generic/tcl.h (Tcl_DecrRefCount): use if/else construct to allow
	placement in unbraced outer if/else conditions. (jcw)

2006-05-27  Daniel Steffen  <[email protected]>

	* macosx/tclMacOSXNotify.c: implemented pthread_atfork() handler that
	* unix/tcl.m4 (Darwin):	    recreates CoreFoundation state and
	notifier thread in the child after a fork(). Note that pthread_atfork
	is available starting with Tiger only. Because vfork() is used by the
	core on Darwin, [exec]/[open] are not affected by this fix, only
	extensions or embedders that call fork() directly (such as TclX).
	However, this only makes fork() safe from corefoundation tcl with
	--disable-threads; as on all platforms, forked children may deadlock
	in threaded tcl due to the potential for stale locked mutexes in the
	child. [Patch 923072]

	* unix/configure: autoconf-2.59
	* unix/tclConfig.h.in: autoheader-2.59

2006-05-24  Donal K. Fellows  <[email protected]>

	* unix/tcl.m4 (SC_CONFIG_SYSTEM): Fixed quoting of command script to
	awk; it was a rarely used branch, but it was wrong. [Bug 1494160]

2006-05-23  Donal K. Fellows  <[email protected]>

	* doc/chan.n, doc/refchan.n: Tighten up the documentation to follow a
	slightly more consistent style with regard to argument capitalization.

2006-05-13  Don Porter	<[email protected]>

	* generic/tclProc.c (ProcCompileProc): When a bump of the compile
	epoch forces the re-compile of a proc body, take care not to overwrite
	any Proc struct that may be referred to on the active call stack. Note
	that the fix will not be effective for code that calls the private
	routine TclProcCompileProc() directly. [Bug 1482718]

2006-05-13  Daniel Steffen  <[email protected]>

	* generic/tclEvent.c (HandleBgErrors): fix leak. [Coverity issue 86]

2006-05-05  Don Porter	<[email protected]>

	* generic/tclMain.c (Tcl_Main):		Corrected flaw that required
	* tests/main.test: (Tcl_Main-4.5):	processing of one interactive
	command before passing control to the loop routine registered with
	Tcl_SetMainLoop(). [Bug 1481986]

2006-05-04  Don Porter	<[email protected]>

	* README:		Bump version number to 8.5a5
	* generic/tcl.h:
	* tools/tcl.wse.in:
	* unix/configure.in:
	* unix/tcl.spec:
	* win/README.binary:
	* win/configure.in:

	* unix/configure:	autoconf-2.59
	* win/configure:

	* generic/tclBasic.c (ExprSrandFunc): Restore acceptance of wide/big
	* doc/mathfunc.n: integer values by srand(). [Bug 1480509]

2006-04-26  Don Porter	<[email protected]>

	*** 8.5a4 TAGGED FOR RELEASE ***

	* changes:	Updates for another RC.

	* generic/tclBinary.c:	Revised the handling of the Q and q format
	* generic/tclInt.h:	specifiers for [binary] to account for the
	* generic/tclStrToD.c:	"middle endian" floating point format used in
	Nokia N770.

2006-04-25  Don Porter	<[email protected]>

	* doc/DoubleObj.3:	More doc updates for TIP 237.
	* doc/expr.n:
	* doc/format.n:
	* doc/mathfunc.n:
	* doc/scan.n:
	* doc/string.n:

	* generic/tclScan.c:	[scan $s %u] is documented to accept only
	* tests/scan.test:	decimal formatted integers. Fixed to match.

2006-04-19  Kevin B. Kenny  <[email protected]>

	* generic/tclStrToD.c: Added code to support the "middle endian"
	floating point format used in the Nokia N770's software-based floating
	point. Thanks to Bruce Johnson for reporting this bug, originally on
	https://wiki.tcl-lang.org/page/Nokia+770.
	* library/clock.tcl: Fixed a bug with Daylight Saving Time and Posix
	time zone specifiers reported by Martin Lemburg in
	http://groups.google.com/group/comp.lang.tcl/browse_thread/thread/9a8b15a4dfc0b7a0
	(and not at SourceForge).
	* tests/clock.test: Added test case for the above bug.

2006-04-18  Donal K. Fellows  <[email protected]>

	* doc/IntObj.3: Minor review fixes, including better documentation of
	the behaviour of Tcl_GetBignumAndClearObj.

2006-04-17  Don Porter	<[email protected]>

	* doc/IntObj.3: Documentation changes to account for TIP 237 changes.
	* doc/Object.3: [Bug 1446971]

2006-04-12  Donal K. Fellows  <[email protected]>

	* generic/regc_locale.c (cclass): Redefined the meaning of [:print:]
	to be exactly UNICODE letters, numbers, punctuation, symbols and
	spaces (*not* whitespace). [Bug 1376892]

2006-04-11  Don Porter	<[email protected]>

	* generic/tclTrace.c:	Stop some interference between enter traces
	* tests/trace.test:	and enterstep traces. [Bug 1458266]

2006-04-07  Don Porter	<[email protected]>

	* generic/tclPathObj.c: Yet another revised fix for the [Bug 1379287]
	* tests/fileSystem.test:	family of path normalization bugs.

2006-04-06  Jeff Hobbs	<[email protected]>

	* generic/tclRegexp.c (FinalizeRegexp): full reset data to indicate
	readiness for reinitialization.

2006-04-06  Don Porter	<[email protected]>

	* generic/tclIndexObj.c (Tcl_GetIndexFromObjStruct):	It seems there
	* tests/indexObj.test:	are extensions that rely on the prior behavior
	* doc/GetIndex.3:	that the empty string cannot succeed as a
	unique prefix matcher, so I'm restoring Donal Fellows's solution.
	Added mention of this detail to the documentation. [Bug 1464039]

	* tests/compExpr-old.test:	Updated testmathfunctions constraint
	* tests/compExpr.test:		to post-TIP-232 world.
	* tests/expr-old.test:
	* tests/expr.test:
	* tests/info.test:

	* tests/indexObj.test:	Corrected other test errors revealed by
	* tests/upvar.test:	testing outside the tcltest application.

	* generic/tclPathObj.c: Revised fix for the [Bug 1379287] family of
	path normalization bugs.

2006-04-06  Daniel Steffen  <[email protected]>

	* unix/tcl.m4: removed TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
	define on Darwin. [Bug 1457515]
	* unix/configure: autoconf-2.59
	* unix/tclConfig.h.in: autoheader-2.59

2006-04-05  Don Porter	<[email protected]>

	* win/tclWinInit.c:	More careful calls to Tcl_DStringSetLength()
	* win/tclWinSock.c:	to avoid creating invalid DString states. Bump
	* win/tclWinDde.c:	to version 1.3.2. [RFE 1366195]
	* library/dde/pkgIndex.tcl:

	* library/reg/pkgIndex.tcl:	Bump to registry 1.2 because
	* win/tclWinReg.c:	Registry_Unload() is a new public routine
	* win/Makefile.in:	compared to the 1.1.* releases.

	* win/configure.in:	Bump package version numbers.
	* win/configure:	autoconf 2.59

2006-04-05  Donal K. Fellows  <[email protected]>

	* generic/tclIndexObj.c (Tcl_GetIndexFromObjStruct): Allow empty
	strings to be matched by the Tcl_GetIndexFromObj machinery, in the
	same manner as any other key. [Bug 1464039]

2006-04-03  Andreas Kupries <[email protected]>

	* generic/tclIO.c (ReadChars): Added check, panic and commentary to a
	piece of code which relies on BUFFER_PADDING to create enough space at
	the beginning of each buffer for the insertion of partial multibyte
	data at the beginning of a buffer. Commentary explains why this code
	is OK, and the panic is as a precaution if someone twiddled the
	BUFFER_PADDING into uselessness.

	* generic/tclIO.c (ReadChars): Temporarily suppress the use of
	TCL_ENCODING_END set when EOF was reached while the buffer we are
	converting is not truly the last buffer in the queue. Together with
	the Utf bug below it was possible to completely wreck the buffer data
	structures, eventually crashing Tcl. [Bug 1462248]

	* generic/tclEncoding.c (UtfToUtfProc): Stop accessing memory beyond
	the end of the input buffer when TCL_ENCODING_END is set and the last
	bytes of the buffer start a multi-byte sequence. This bug contributed
	to [Bug 1462248].

2006-03-30  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c: remove unused var and silence gcc warning

2006-03-29  Jeff Hobbs	<[email protected]>

	* win/Makefile.in: convert _NATIVE paths to use / to avoid ".\"
	path-as-escape issue.

2006-03-29  Don Porter	<[email protected]>

	* changes:	Updates for another RC.

	* generic/tclPathObj.c:	 More fixes for path normalization when /../
	* tests/fileSystem.test: tries to go beyond root.[Bug 1379287]

	* generic/tclExecute.c: Revised INST_MOD implementation to do
	calculations in native types as much as possible, moving to mp_ints
	only when necessary.

2006-03-28  Jeff Hobbs	<[email protected]>

	* win/tclWinPipe.c (TclpCreateProcess): change panics to Tcl errors
	and do proper refcounting of noe objPtr. [Bug 1194429]

	* unix/tcl.m4, win/tcl.m4: []-quote AC_DEFUN functions.

2006-03-28  Daniel Steffen  <[email protected]>

	* macosx/Tcl.xcode/default.pbxuser:	add '-singleproc 1' cli arg to
	* macosx/Tcl.xcodeproj/default.pbxuser: tcltest to ease test debugging

	* macosx/Tcl.xcode/project.pbxproj:	removed $prefix/share from
	* macosx/Tcl.xcodeproj/project.pbxproj: TCL_PACKAGE_PATH as per change
	to unix/configure.in of 2006-03-13.

	* unix/tclUnixFCmd.c (TclpObjNormalizePath): deal with *BSD/Darwin
	realpath() converting relative paths into absolute paths [Bug 1064247]

2006-03-28  Vince Darley  <[email protected]>

	* generic/tclIOUtil.c: fix to nativeFilesystemRecord comparisons
	(lesser part of [Bug 1064247])

2006-03-27  Pat Thoyts	<[email protected]>

	* win/tclWinTest.c:	Fixes for [Bug 1456373] (mingw-gcc issue)

2006-03-27  Andreas Kupries <[email protected]>

	* doc/CrtChannel.3:    Added TCL_CHANNEL_VERSION_5, made it the
	* generic/tcl.h:       version where the "truncateProc" is defined at,
	* generic/tclIO.c:     and moved all channel drivers of Tcl to v5.
	* generic/tclIOGT.c, generic/tclIORChan.c, unix/tclUnixChan.c:
	* unix/tclUnixPipe.c, win/tclWinChan.c, win/tclWinConsole.c:
	* win/tclWinPipe.c, win/tclWinSerial.c, win/tclWinSock.c:

2006-03-27  Don Porter	<[email protected]>

	* generic/tclExecute.c: Merge INST_MOD computation in with the
	INST_?SHIFT instructions, which also operate only on two integral
	values. Also corrected flaw that made INST_BITNOT of wide values
	require mp_int calculations. Also corrected type that missed optimized
	handling of the tclBooleanType by the TclGetBooleanFromObj macro.

	* changes:	Updates for another RC.

2006-03-25  Don Porter	<[email protected]>

	* generic/tclExecute.c: Corrections to INST_EXPON detection of
	overflow to use mp_int calculations.

2006-03-24  Kevin B. Kenny  <[email protected]>

	* generic/tclExecute.c (TclExecuteByteCode): Added a couple of missing
	casts to 'int' that were affecting compilablity on VC6.

2006-03-24  Don Porter	<[email protected]>

	* generic/tclEncoding.c: Reverted latest change [Bug 506653] since it
	reportedly killed test performance on Windows.

	* generic/tclExecute.c: Revised INST_EXPON implementation to do
	calculations in native types as much as possible, moving to mp_ints
	only when necessary.

2006-03-23  Don Porter	<[email protected]>

	* generic/tclExecute.c: Merged INST_EXPON handling in with the other
	binary operators that operate on all number types (INST_ADD, etc.).

	* tests/env.test: With case preserved (see 2006-03-21 commit) be sure
	to do case-insensitive filtering. [Bug 1457065]

2006-03-23  Reinhard Max  <[email protected]>

	* unix/tcl.spec: Cleaned up and completed the spec file. An RPM can
	now be built from the tcl source distribution with "rpmbuild -tb
	<tarball>"

2006-03-22  Reinhard Max  <[email protected]>

	* tests/stack.test: Run the stack tests in subshells, so that they are
	reported as failed tests rather than bugs in the test suite if the
	recursion causes a segfault.

2006-03-21  Don Porter	<[email protected]>

	* changes:	Updates for another RC.

	* generic/tclStrToD.c:	One of the branches of AccumulateDecimalDigit
	* tests/parseExpr.test: did not. [Bug 1451233]

	* tests/env.test:	Preserve case of saved env vars. [Bug 1409272]

2006-03-21  Daniel Steffen  <[email protected]>

	* generic/tclInt.decls:	 implement globbing for HFS creator & type
	* macosx/tclMacOSXFCmd.c:codes and 'hidden' flag, as documented in
	* tests/macOSXFCmd.test: glob.n; objectified OSType handling in [glob]
	* unix/tclUnixFile.c:	 and [file attributes]; fix globbing for
	hidden files with pattern==NULL arg. [Bug 823329]
	* generic/tclIntPlatDecls.h:
	* generic/tclStubInit.c: make genstubs

2006-03-20  Andreas Kupries <[email protected]>

	* win/Makefile.in (install-libraries): Generate tcl8/8.4 directory
	under Windows as well (cygwin Makefile). Related entry: 2006-03-07,
	dgp. This moved the installation of http from 8.2 to 8.4, partially. A
	fix of the required directory creation was done for unix on Mar 10,
	without entry in the Changelog. This entry is for the fix of the
	directory creation under Windows.

	* unix/installManPage: There is always one even more broken "sed".
	Moved the # comment starting character in the sed script to the
	beginning of their respective lines. The AIX sed will not recognize
	them as comments otherwise :( The actual text stays indented for
	better association with the commands they belong to.

2006-03-20  Donal K. Fellows  <[email protected]>

	* tests/cmdAH.test, tests/fCmd.test, tests/unixFCmd.test:
	* tests/winFCmd.test: Cleanup of some test constraint handling, and a
	few other minor issues.

2006-03-18  Vince Darley  <[email protected]>

	* generic/tclFileName.c:
	* doc/FileSystem.3:
	* tests/fileName.test: Fix to [Bug 1084705] so that 'glob -nocomplain'
	finally agrees with its documentation and doesn't swallow genuine
	errors.

	***POTENTIAL INCOMPATIBILITY*** for scripts that assumed '-nocomplain'
	removes the need for 'catch' to deal with non-understood path names.

	Small optimisation to implementation of pattern==NULL case of TclGlob,
	and clarification to the documentation. [Tclvfs bug 1405317]

2006-03-18  Vince Darley  <[email protected]>

	* tests/fCmd.test: added knownBug test case for [Bug 1394972]

	* tests/winFCmd.test:
	* tests/tcltest.test: corrected tests to better account for behaviour
	of writable/non-writable directories on Windows 2000/XP. This, with
	the previous patches, closes [Bug 1193497]

2006-03-17  Andreas Kupries <[email protected]>

	* doc/chan.n: Updated with documentation for the commands 'chan
	create' and 'chan postevent' (TIP #219).

	* doc/refchan.n: New file. Documentation of the command handler API
	for reflected channels (TIP #219).

2006-03-17  Joe Mistachkin <[email protected]>

	* unix/tclUnixPort.h: Include pthread.h prior to pthread_np.h [Bug
	1444692]

	* win/tclWinTest.c: Corrected typo of 'initializeMutex' that prevented
	successful compilation.

2006-03-16  Andreas Kupries <[email protected]>

	* doc/open.n: Documented the changed behaviour of 'a'ppend mode.

	* tests/io.test (io-43.1 io-44.[1234]): Rewritten to be self-contained
	with regard to setup and cleanup. [Bug 681793]

	* generic/tclIOUtil.c (TclGetOpenMode): Added the flag O_APPEND to the
	list of POSIX modes used when opening a file for 'a'ppend. This
	enables the proper automatic seek-to-end-on-write by the OS. See [Bug
	680143] for longer discussion.

	* tests/ioCmd.test (iocmd-13.7.*): Extended the testsuite to check the
	new handling of 'a'.

2006-03-15  Andreas Kupries <[email protected]>

	* tests/socket.test: Extended the timeout in socket-11.11 from 10 to
	40 seconds to allow for really slow machines. Also extended
	actual/expected results with value of variable 'done' to make it
	clearer when a test fails due to a timeout. [Bug 792159]

2006-03-15  Vince Darley  <[email protected]>

	* win/fCmd.test: add proper test constraints so the new tests don't
	run on Unix.

2006-03-14  Andreas Kupries <[email protected]>

	* generic/tclPipe.c (TclCreatePipeline): Modified the processing of
	pipebars to fail if the last bar is followed only by redirections.
	[Bug 768659]

2006-03-14  Andreas Kupries <[email protected]>

	* doc/fconfigure.n: Clarified that -translation is binary is reported
	as lf when queried, because it is identical to lf, except for the
	special additional behaviour when setting it. [Bug 666770]

2006-03-14  Andreas Kupries <[email protected]>

	* doc/clock.n: Removed double-quotes around section title NAME; not
	needed.
	* unix/installManpage: Reverted part to handle double-quotes in
	section NAME, chokes older sed installations.

2006-03-14  Andreas Kupries <[email protected]>

	* library/tm.tcl (::tcl::tm::Defaults): Fixed handling of environment
	variable TCLX.y_TM_PATH, bad variable reference. Thanks to Julian
	Noble. [Bug 1448251]

2006-03-14  Vince Darley  <[email protected]>

	* win/tclWinFile.c: updated patch to deal with 'file writable' issues
	on Windows XP/2000.
	* generic/tclTest.c:
	* unix/tclUnixTest.c:
	* win/tclWinTest.c:
	* tests/fCmd.test: updated test suite to deal with correct permissions
	setting and differences between XP/2000 and 95/98 3 tests still fail;
	to be dealt with shortly

2006-03-13  Don Porter	<[email protected]>

	* generic/tclEncoding.c: Report error when an escape encoding is
	missing one of its sub-encodings. [Bug 506653]

	* unix/configure.in:	Revert change from 2005-07-26 that sometimes
	* unix/configure:	added $prefix/share to the tcl_pkgPath. See
	[Patch 1231015]. autoconf-2.59.

2006-03-10  Miguel Sofer  <[email protected]>

	* generic/tclProc.c (ObjInterpProcEx):
	* tests/apply.test (apply-5.1): Fix [apply] error messages so that
	they quote the lambda expression. [Bug 1447355]

2006-03-10  Zoran Vasiljevic  <[email protected]>

	-- Summary of changes fixing [Bug 1437595] --

	* generic/tclEvent.c: Cosmetic touches and identation
	* generic/tclInt.h: Added TclpFinalizeSockets() call.

	* generic/tclIO.c: Calls TclpFinalizeSockets() as part of the
	TclFinalizeIOSubsystem().

	* unix/tclUnixSock.c: Added no-op TclpFinalizeSockets().

	* win/tclWinPipe.c, win/tclWinSock.c: Finalization of sockets/pipes is
	now solely done in TclpFinalizeSockets() and TclpFinalizePipes() and
	not over the thread-exit handler, because the order of actions the Tcl
	generic core will impose may result in cores/hangs if the thread exit
	handler tears down corresponding subsystem(s) too early.

2006-03-10  Vince Darley  <[email protected]>

	* win/tclWinFile.c: previous patch breaks tests, so removed.

2006-03-09  Vince Darley  <[email protected]>

	* win/tclWinFile.c: fix to 'file writable' in certain XP directories.
	Thanks to fvogel and jfg. [Patch 1344540] Modified patch to make use
	of existing use of getSecurityProc.

2006-03-08  Don Porter	<[email protected]>

	* generic/tclExecute.c: Complete missing bit of TIP 215 implementation
	* tests/incr.test:

2006-03-07  Joe English	 <[email protected]>

	* unix/tcl.m4: Set SHLIB_LD_FLAGS='${LIBS}' on NetBSD, as per the
	other *BSD variants. [Bug 1334613]
	* unix/configure: Regenerated.

2006-03-07  Don Porter	<[email protected]>

	* changes:	Update in prep. for 8.5a4 release.

	* unix/Makefile.in:	Package http 2.5.2 requires Tcl 8.4, so the
	* win/Makefile.in:	*.tm installation has to be placed in an "8.4"
	directory, not an "8.2" directory.

2006-03-06  Don Porter	<[email protected]>

	* generic/tclBasic.c:	Revised handling of TCL_EVAL_* flags to
	* tests/parse.test:	simplify TclEvalObjvInternal and to correct
	the auto-loading of alias targets (parse-8.12). [Bug 1444291]

2006-03-03  Don Porter	<[email protected]>

	* generic/tclPathObj.c: Revised yesterday's fix for [Bug 1379287] to
	work on Windows.

	* generic/tclObj.c:	Compatibility support for existing code that
	calls Tcl_GetObjType("boolean").

2006-03-02  Don Porter	<[email protected]>

	* generic/tclPathObj.c:		Fix for failed normalization of paths
	* tests/fileSystem.test:	with /../ that lead back to the root
	of the filesystem, like /foo/.. [Bug 1379287]

2006-03-01  Reinhard Max  <[email protected]>

	* unix/installManPage: Fix the script for manpages that have quotes
	around the .SH arguments, as doctools produces them. [Bug 1292145]
	Some minor cleanups and improvements.

2006-02-28  Don Porter	<[email protected]>

	* generic/tclBasic.c:	Corrections to be sure that TCL_EVAL_GLOBAL
	* tests/namespace.test: evaluations act the same as [uplevel #0]
	* tests/parse.test:	evaluations, even when execution traces or
	* tests/trace.test:	invocations of [::unknown] are present. [Bug
	1439836]

2006-02-22  Don Porter	<[email protected]>

	* generic/tclBasic.c:	Corrected a few bugs in how [namespace
	* tests/namespace.test: unknown] interacts with TCL_EVAL_* flags.
	[Patch 958222]

2006-02-17  Don Porter	<[email protected]>

	* generic/tclIORChan.c: Revised error message generation and handling
	* tests/ioCmd.test:	of exceptional return codes in the channel
	reflection layer. [Bug 1372348]

2006-02-16  Don Porter	<[email protected]>

	* generic/tclIndexObj.c:	Disallow the "ambiguous" error message
	* tests/indexObj.test:		when TCL_EXACT matching is requested.
	* tests/ioCmd.test:

2006-02-15  Don Porter	<[email protected]>

	* generic/tclIO.c:	Made several routines tolerant of
	* generic/tclIORChan.c: interp == NULL arguments. [Bug 1380662]
	* generic/tclIOUtil.c:

2006-02-09  Don Porter	<[email protected]>

	TIP#215 IMPLEMENTATION

	* doc/incr.n:		Revised [incr] to auto-initialize when varName
	* generic/tclExecute.c: argument is unset. [Patch 1413115]
	* generic/tclVar.c:
	* tests/compile.test:
	* tests/incr-old.test:
	* tests/incr.test:
	* tests/set.test:

	* tests/main.test (Tcl_Main-6.7):	Improved robustness of
	command auto-completion test. [Bug 1422736]

2006-02-08  Donal K. Fellows  <[email protected]>

	* doc/Encoding.3, doc/encoding.n: Updates due to review at request of
	Don Porter. Mostly minor changes.

2006-02-08  Don Porter	<[email protected]>

	TIP#258 IMPLEMENTATION

	* doc/Encoding.3:	New subcommand [encoding dirs].
	* doc/encoding.n:	New routine Tcl_GetEncodingNameFromEnvironment
	* generic/tcl.decls:	Made public:
	* generic/tclBasic.c:	TclGetEncodingFromObj
	* generic/tclCmdAH.c:		-> Tcl_GetEncodingFromObj
	* generic/tclEncoding.c:TclGetEncodingSearchPath
	* generic/tclInt.decls:		-> Tcl_GetEncodingSearchPath
	* generic/tclInt.h:	TclSetEncodingSearchPath
	* generic/tclTest.c:		-> Tcl_SetEncodingSearchPath
	* library/init.tcl:	Removed commands:
	* tests/cmdAH.test:		[tcl::unsupported::EncodingDirs]
	* tests/encoding.test:		[testencoding path] (Tcltest)
	* unix/tclUnixInit.c:	[Patch 1413934]
	* win/tclWinInit.c:

	* generic/tclDecls.h:	make genstubs
	* generic/tclIntDecls.h:
	* generic/tclStubInit.c:

2006-02-01  Miguel Sofer  <[email protected]>

	* generic/tclProc.c: minor improvements to [apply]
	* tests/apply.test: new tests; apply-5.1 currently fails to indicate
	missing work in error reporting

2006-02-01  Don Porter	<[email protected]>

	TIP#194 IMPLEMENTATION

	* doc/apply.n:	(New file)	New command [apply]. [Patch 944803]
	* doc/uplevel.n:
	* generic/tclBasic.c:
	* generic/tclInt.h:
	* generic/tclProc.c:
	* tests/apply.test: (New file)
	* tests/proc-old.test:
	* tests/proc.test:

	TIP#181 IMPLEMENTATION

	* doc/Namespace.3:	New command [namespace unknown]. New public C
	* doc/namespace.n:	routines Tcl_(Get|Set)NamespaceUnknownHandler.
	* doc/unknown.n:	[Patch 958222]
	* generic/tcl.decls:
	* generic/tclBasic.c:
	* generic/tclInt.h:
	* generic/tclNamesp.c:
	* tests/namespace.test:

	* generic/tclDecls.h:	make genstubs
	* generic/tclStubInit.c:

	TIP#250 IMPLEMENTATION

	* doc/namespace.n:	New command [namespace upvar]. [Patch 1275435]
	* generic/tclInt.h:
	* generic/tclNamesp.c:
	* generic/tclVar.c:
	* tests/namespace.test:
	* tests/upvar.test:

2006-01-26  Donal K. Fellows  <[email protected]>

	* doc/dict.n: Fixed silly bug in example. Thanks to Heiner Marxen
	<[email protected]> for catching this! [Bug 1415725]

2006-01-26  Donal K. Fellows  <[email protected]>

	* unix/tclUnixChan.c (TclpOpenFileChannel): Tidy up and comment the
	mess to do with setting up serial channels. This (deliberately) breaks
	a broken FreeBSD port, indicates what we're really doing, and reduces
	the amount of conditional compilation sections for better maintenance.

2006-01-25  Donal K. Fellows  <[email protected]>

	* unix/tclUnixInit.c (TclpInitPlatform): Improved conditions on when
	to update the FP rounding mode on FreeBSD, taken from FreeBSD port.

2006-01-23  Donal K. Fellows  <[email protected]>

	* tests/string.test (string-12.21): Added test for [Bug 1410553] based
	on original bug report.

2006-01-23  Miguel Sofer  <[email protected]>

	* generic/tclStringObj.c: fixed incorrect handling of internal rep in
	Tcl_GetRange. Thanks to twylite and Peter Spjuth. [Bug 1410553]

	* generic/tclProc.c: fixed args handling for precompiled bodies [Bug
	1412695]; thanks to Uwe Traum.

2006-01-16  Reinhard Max  <[email protected]>

	* generic/tclPipe.c (FileForRedirect): Prevent nameString from being
	freed without having been initialized.
	* tests/exec.test: Added a test for the above.

2006-01-12  Zoran Vasiljevic  <[email protected]>

	* generic/tclPathObj.c (Tcl_FSGetInternalRep): backported patch from
	core-8-4-branch. A freed pointer has been overwritten causing all
	sorts of coredumps.

2006-01-12  Vince Darley  <[email protected]>

	* win/tclWinFile.c: fix to sharing violation [Bug 1366227]

2006-01-11  Don Porter	<[email protected]>

	* generic/tclBasic.c:	Moved Tcl_LogCommandInfo from tclBasic.c to
	* generic/tclNamesp.c:	tclNamesp.c to get access to identifier with
	* tests/error.test (error-7.0): file scope. Added check for traces on
	::errorInfo, and when present fall back to contruction of the stack
	trace in the variable so that write trace notification timings are
	compatible with earlier Tcl releases. This reduces, but does not
	completely eliminate the ***POTENTIAL INCOMPATIBILITY*** created by
	the 2004-10-15 commit. [Bug 1397843]

2006-01-10  Daniel Steffen  <[email protected]>

	* unix/configure:    add caching, use AC_CACHE_CHECK instead of
	* unix/configure.in: AC_CACHE_VAL where possible, consistent message
	* unix/tcl.m4:	     quoting, sync relevant tclconfig/tcl.m4 changes
	and gratuitous formatting differences, fix SC_CONFIG_MANPAGES with
	default argument, Darwin improvements to SC_LOAD_*CONFIG.

2006-01-09  Don Porter	<[email protected]>

	* generic/tclNamesp.c (NamespaceInscopeCmd):	[namespace inscope]
	* tests/namespace.test: commands were not reported by [info level].
	[Bug 1400572]

2006-01-09  Donal K. Fellows  <[email protected]>

	* generic/tclTrace.c: Stop exporting the guts of the trace command;
	nothing outside this file needs to see it. [Bug 971336]

2006-01-05  Donal K. Fellows  <[email protected]>

	* unix/tcl.m4 (TCL_CONFIG_SYSTEM): Factor out the code to determine
	the operating system version number, as it was replicated in several
	places.

2006-01-04  David Gravereaux  <[email protected]>

	* win/tclAppInit.c: WIN32 native console signal handler removed. This
	was found to be interfering with TWAPI extension one. IMO, special
	services such as signal handlers should best be done with extensions
	to the core after discussions on c.l.t. about Roy Terry's tclsh
	children of a real windows service shell.

	******************************************************************
	*** CHANGELOG ENTRIES FOR 2005 IN "ChangeLog.2005"	       ***
	*** CHANGELOG ENTRIES FOR 2004 IN "ChangeLog.2004"	       ***
	*** CHANGELOG ENTRIES FOR 2003 IN "ChangeLog.2003"	       ***
	*** CHANGELOG ENTRIES FOR 2002 IN "ChangeLog.2002"	       ***
	*** CHANGELOG ENTRIES FOR 2001 IN "ChangeLog.2001"	       ***
	*** CHANGELOG ENTRIES FOR 2000 IN "ChangeLog.2000"	       ***
	*** CHANGELOG ENTRIES FOR 1999 AND EARLIER IN "ChangeLog.1999" ***
	******************************************************************
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<


































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































Deleted ChangeLog.2008.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
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
2008-12-31  Don Porter  <[email protected]>

	* unix/Makefile.in:	Set TCLLIBPATH in SHELL_ENV so that targets
	like `make shell` have access to builds of bundled packages.

2008-12-28  Donal K. Fellows  <[email protected]>

	* generic/tclZlib.c (Tcl_ZlibStreamPut): Plug a memory leak.

2008-12-27  Donal K. Fellows  <[email protected]>

	* generic/tclZlib.c (ZlibStreamCmd): Fix compilation consistency. [Bug
	* generic/tcl.decls:		     2470237]

	* generic/tclZlib.c (Tcl_ZlibStreamGet): Corrected the semantics of
	this function to be useful to the PNG implementation. If the argument
	object is empty, this gives the previous semantics.
	(Tcl_ZlibStreamChecksum): Corrected name to be less misleading; it
	only produced Adler-32 checksums when the stream was processing the
	right type of compressed data format.
	(Tcl_ZlibAdler32, Tcl_ZlibCRC32): Corrected types so that they work
	naturally with the results of Tcl_GetByteArrayFromObj().
	*** POTENTIAL INCOMPATIBILITY *** for all above changes, but very
	unlikely to be difficult for anyone to deal with.

2008-12-26  Donal K. Fellows  <[email protected]>

	* generic/tcl.decls: Tidy up the commenting style, adding markers for
	each of the big release points under TCT stewardship and noting the
	general purpose of each TIP that added C API. Overall effect is to
	make this file much more informative to read without having to spend
	effort correlating with TIPs and ChangeLogs.

2008-12-23  Jan Nijtmans  <[email protected]>

	* win/Makefile.in:	Fix build of zlib objects with msvc
	* win/tcl.m4:
	* win/configure:	autoconf-2.59

2008-12-23  Donal K. Fellows  <[email protected]>

	* win/Makefile.in: Handle file extensions correctly. [Bug 2459725]

2008-12-22  Pat Thoyts  <[email protected]>

	*** 8.6b1 TAGGED FOR RELEASE ***

	* win/makefile.vc: Ensure pkgs directories are suitable and quote the
			   paths. [Bug 2458395]

2008-12-22  Joe Mistachkin  <[email protected]>

	* tools/man2help2.tcl: Added support for "\(mi" nroff macro. [Bug
	2330040]

2008-12-22  Pat Thoyts  <[email protected]>

	* win/makefile.vc: Support the pkgs tree in the NMAKE builds.

2008-12-21  Daniel Steffen  <[email protected]>

	* unix/Makefile.in:	Fix broken build of bundled packages when path
				to build dir contains spaces by switching to
				relative paths to toplevel build dir.

	* unix/configure.in:	Preserve configure environment variables for
				sub-configures of bundled packages; reuse
				configure cache file for sub-configures.

	* unix/configure:	autoconf-2.59

2008-12-21  Donal K. Fellows  <[email protected]>

	* doc/TclZlib.3: Fix minor typo. [Bug 2455165]

2008-12-20  Kevin B. Kenny  <[email protected]>

	* win/Makefile.in:	Renamed the static library libtcl86s.a to
	* win/configure.in:	have a name distinct from the import library
				libtcl86.a. This renaming dodges an ancient
				bug in the Makefile revealed by the last
				commit where the $(TCL_LIB_FILE) rule can
				fire to try to build the static library in a
				--enable-shared build (and create a static
				library that subsequently fails to link).
				Revised the zlib objects so that they are
				built directly into the build dir, without
				building an intermediate static library.
				*** POTENTIAL INCOMPATIBILITY *** for
				embedders who link to the static library, but
				I couldn't figure out how to sort this out
				any other way.
	* win/configure:	Autoconf 2.59

2008-12-20  Donal K. Fellows  <[email protected]>

	* win/Makefile.in: Minor updates to make building work better with
	msys on Windows. (Apparently the gcc used doesn't like a / at the end
	of a -I argument...)

2008-12-20  Don Porter  <[email protected]>

	* changes:	Updates for 8.6b1 release.

2008-12-20  Daniel Steffen  <[email protected]>

	* unix/Makefile.in:	Make package install directory of bundled
	* unix/configure.in:	packages configurable via PACKAGE_DIR makefile
				variable (set to platform-specific default).

	* unix/Makefile.in (*-packages): Ensure toplevel targets fail if
				sub-make/configure fails; fix quoting when
				builddir path contains spaces.

	* macosx/GNUmakefile:	Add install-packages to install targets.

	* unix/configure:	autoconf-2.59

2008-12-19  Don Porter  <[email protected]>

	* doc/NRE.3:		Formatting errors found by `make html`
	* doc/Tcl_Main.3:
	* doc/zlib.n:

	* tests/chanio.test:	Add missing [removeFile] cleanups.
	* tests/io.test:	Add missing [close $f] to io-73.2.

	* unix/Makefile.in:	Update `make dist' target to include the files
	from the compat/zlib directory as well as all the bundled packages
	found under the pkgs directory, according to their individual `make
	dist' targets. Change includes breaking a `configure-packages' target
	out of the `packages` target.

	* README:		Bump version number to 8.6b1
	* generic/tcl.h:
	* library/init.tcl:
	* tools/tcl.wse.in:
	* unix/configure.in:
	* unix/tcl.spec:
	* win/configure.in:

	* unix/configure:	autoconf-2.59
	* win/configure:

2008-12-19  Jan Nijtmans  <[email protected]>

	* generic/tclInt.decls: CONSTify TclGetLoadedPackages second param
	* generic/tclLoad.c
	* generic/tclIntDecls.h (regenerated)

2008-12-19  Kevin Kenny  <[email protected]>

	* generic/tclExecute.c:	Fix compile warnings when --enable-symbols=all

	* win/configure.in:
	* win/Makefile.in: Added build of packages in the 'pkgs/' directory.
	* win/configure: Autoconf 2.59

2008-12-19  Pat Thoyts  <[email protected]>

	* win/makefile.vc: Added build of compat/zlib

2008-12-18  Andreas Kupries  <[email protected]>

	* generic/tclIO.c (Tcl_CloseEx, CloseWrite, CloseChannelPart)
	(ChanCloseHalf): Rewrite the half-close to properly flush the channel,
	like is done for a full close, going through FlushChannel, and using
	the flag BG_FLUSH_SCHEDULED (async flush during close). New functions
	CloseWrite, CloseChannelPart, new flag CHANNEL_CLOSEDWRITE.

	* tests/chanio.test (chanio-28.[67]): Reactivated these tests.
	Replaced tclsh -> [interpreter] to get correct executable for the pipe
	process, and added after cancel to kill the fail timers when we are
	done. Removed the explicits calls to [flush], now that [close] handles
	this correctly.

2008-12-18  Don Porter  <[email protected]>

	* tests/chanio.test:	Replaced [chan event] handlers that returned
	TCL_RETURN return code, with more conventional ones that return TCL_OK
	to suppress otherwise strange writes of outdated $::errorInfo values
	to stderr. [Bug 2444274]

	* generic/tclExecute.c:	Disabled apparently faulty assertion. [Bug
	2415422]

2008-12-18  Donal K. Fellows  <[email protected]>

	* unix/configure.in, unix/Makefile.in: Autoconf wizardry.
	* compat/zlib/*: Import of zlib 1.2.3. The license is directly
	compatible with Tcl's. This import omits the obsolete and contributed
	parts (i.e. selected directories) and the supplied examples.

	* generic/tclZlib.c:	First implementation of the compressing and
	* doc/zlib.n:		decompressing channel transformations.
	* tests/zlib.test (zlib-8.*):

2008-12-18  Jan Nijtmans  <[email protected]>

	* generic/tcl.decls:	VOID -> void
	* generic/tclInt.decls:
	* compat/dlfcn.h:
	* generic/tclDecls.h:	(regenerated)
	* generic/tclIntDecls.h:

2008-12-18  Alexandre Ferrieux  <[email protected]>

	TIP #332 IMPLEMENTATION - Half-Close for Bidirectional Channels

	* doc/close.n, generic/tclIO.c, generic/tclIOCmd.c:
	* unix/tclUnixChan.c, unix/tclUnixPipe.c, win/tclWinSock.c:
	* generic/tcl.decls, generic/tclDecls.h, generic/tclStubInit.c:
	* tests/chan.test, tests/chanio.test, tests/ioCmd.test:

2008-12-17  Donal K. Fellows  <[email protected]>

	* doc/SetChanErr.3: General improvements in nroff rendering and some
	corrections to language issues.

2008-12-17  Jan Nijtmans  <[email protected]>

	* generic/tclResult.c:	   Move variable "length" inside if()
	* generic/tclStringObj.c:  Don't use ckfree((void *)...) but
	* generic/tclVar.c:	   ckfree((char *)...)
	* generic/tclZlib.c
	* generic/tclBasic.c

2008-12-17  Donal K. Fellows  <[email protected]>

	* tests/namespace.test (namespace-28.1):	Make tests not
	* tests/namespace-old.test (namespace-old-9.5): dependent on the
	global namespace's particular imports. [Bug 2433936]

2008-12-17  Don Porter  <[email protected]>

	* unix/Makefile.in:	Modify the distclean-packages target so that
	empty build directories are deleted.

	* unix/Makefile.in:	Add build support for collections of TEA
	* unix/configure.in:	packages found under the pkgs directory.
	[Patch 1163406]. Still needs porting to Windows.

	* unix/configure:	autoconf-2.59

2008-12-17  Donal K. Fellows  <[email protected]>

	* generic/tcl.h, generic/tclZlib.c: Removed undocumented flag.

2008-12-16  Jan Nijtmans  <[email protected]>

	* generic/tclThreadTest.c: Eliminate -Wwrite-strings warnings in
				   --enable-threads build.
	* generic/tclExecute.c:	   Use TclNewLiteralStringObj()
	* unix/tclUnixFCmd.c:	   Use TclNewLiteralStringObj()
	* win/tclWinFCmd.c:	   Use TclNewLiteralStringObj()

2008-12-16  Donal K. Fellows  <[email protected]>

	TIP #329 IMPLEMENTATION

	* tests/error.test: Tests for the new commands.
	* doc/throw.n, doc/try.n: Documentation of the new commands.
	* library/init.tcl (throw, try): Implementation of commands documented
	in TIP. This implementation is in Tcl and is a stop-gap until
	higher-performance ones can be written.

2008-12-16  Don Porter  <[email protected]>

	* generic/tcl.h:	Add TIP 338 routines to stub table.
	* generic/tcl.decls:	[Bug 2431338]

	* generic/tclDecls.h:	make genstubs
	* generic/tclStubInit.c:

2008-12-15  Donal K. Fellows  <[email protected]>

	* generic/tclExecute.c (TEBC:INST_DICT_GET): Make sure that the result
	is empty when generating an error message. [Bug 2431847]

2008-12-15  Alexandre Ferrieux  <[email protected]>

	* generic/tclBinary.c:	Redefine non-strict decoding to ignore only
	* doc/binary.n:		whitespace. [Bug 2380293]
	* tests/binary.test:

2008-12-15  Don Porter  <[email protected]>

	* doc/AddErrInfo.3:	Documented Tcl_(Set|Get)ErrorLine (TIP 336).
	* doc/CrtCommand.3:	Various other documentation updates to
	* doc/CrtInterp.3:	reflect the lack of access to Tcl_Interp
	* doc/Interp.3:		fields by default.
	* doc/SetResult.3:
	* doc/tcl.decls:

	TIP #338 IMPLEMENTATION

	* doc/AppInit.c:	Made routines Tcl_SetStartupScript and
	* doc/Tcl_Main.3:	Tcl_GetStartupScript public. Removed all
	* generic/tcl.h:	internal stub access to Tcl*Startup* routines,
	* generic/tclInt.decls:	and removed their implementations. Their
	* generic/tclMain.c:	function can now be completely performed with
				the new public interface.
	*** POTENTIAL INCOMPATIBILITY for callers of the internal
	    Tcl*Startup* routines. ***

	* generic/tclIntDecls.h:	make genstubs
	* generic/tclStubInit.c:
	* generic/tclDecls.h:

2008-12-14  Donal K. Fellows  <[email protected]>

	* tests/zlib.test: Added constraint so that tests don't fail where
	they cannot work due to zlib support being missing.

	* unix/configure.in, win/configure.in: Improve the autodetection code.
	* win/tcl.m4 (SC_CONFIG_CFLAGS): Remove the assumption of the presence
	of zlib library on Windows.
	* win/makefile.vc, win/makefile.bc: Add support for building tclZlib.o
	but only in stubbed-out mode for now.

2008-12-13  Donal K. Fellows  <[email protected]>

	* doc/TclZlib.3: Basic documentation of the C-level API.
	* doc/zlib.n: Substantially improve documentation of Tcl-level API.
	* generic/tclZlib.c (ZlibCmd): Flesh out the argument parsing for the
	command to integrate with channels.

2008-12-12  Jan Nijtmans  <[email protected]>

	* generic/tclZlib.c (Tcl_ZlibInflate): Change PATH_MAX to MAXPATHLEN,
	since MSVC doesn't have PATH_MAX.

	* doc/clock.n:	Document new DST fallback rules.
	* library/clock.tcl (ProcessPosixTimeZone): Fix time change in Eastern
	Europe (not 3:00 but 4:00 local time). [Bug 2207436]

2008-12-12  Donal K. Fellows  <[email protected]>

	* generic/tclZlib.c, unix/configure.in: Added stubs to use when the
	version of zlib is not capable enough, and automagic to detect when
	that is the case. [Bug 2421265]

2008-12-12  Alexandre Ferrieux  <[email protected]>

	* unix/tclUnixNotfy.c: Fix missing CLOEXEC on internal pipes [2417695]
	* unix/tclUnixPipe.c:  Fix missing CLOEXEC on [chan pipe] fds.

2008-12-12  Donal K. Fellows  <[email protected]>

	* generic/tclZlib.c (Tcl_ZlibDeflate): Add a bit of extra space for
	the gzip header. [Bug 2419061]
	(Tcl_ZlibInflate): Ensure that gzip header extraction is done
	correctly.

2008-12-12  Kevin Kenny  <[email protected]>

	TIP #322 IMPLEMENTATION

	* doc/NRE.3 (new file): Added documentation of the published API for
	Non-Recursive Evaluation (NRE).

2008-12-11  Jan Nijtmans  <[email protected]>

	* generic/tclZlib.c: Eliminate warning: different 'const' qualifiers
	with msvc compiler. A few more 'const' optimizations.
	* win/tcl.m4: Fix Windows build (msvc) for TIP #234 implementation
	* win/Makefile.in:
	* win/configure:

2008-12-11  Andreas Kupries  <[email protected]>

	* generic/tclIO.c (SetChannelFromAny and related): Modified the
	* tests/io.test: internal representation of the tclChannelType to
	contain not only the ChannelState pointer, but also a reference to
	the interpreter it was made in. Invalidate and recompute the
	internal representation when it is used in a different interpreter,
	like cmdName intrep's. Added testcase. [Bug 2407783]

2008-12-11  Donal K. Fellows  <[email protected]>

	* generic/tclZlib.c (ConvertError): Factor out code to turn zlib
	errors into Tcl errors.

	* doc/zlib.n: Added a start at the documentation. Still very rough.

2008-12-11  Jan Nijtmans  <[email protected]>

	* win/Makefile.in: Fix Windows build (mingw) for TIP #234
	implementation (additionally, first make sure that zlib is available,
	and rename the standard zdll.lib to libz.a, but at least this works so
	far).

2008-12-11  Donal K. Fellows  <[email protected]>

	* tests/zlib.test: Start of test suite for zlib command.

2008-12-11  Jan Nijtmans  <[email protected]>

	* library/clock.tcl (ProcessPosixTimeZone): Fallback to European time
	zone DST rules, when the timezone is between 0 and -12. [Bug 2207436]
	* tests/clock.test (clock-52.[23]): Test cases for [Bug 2207436]

2008-12-11  Donal K. Fellows  <[email protected]>

	TIP #234 IMPLEMENTATION

	* generic/tclZlib.c: A very preliminary hack at an interface to the
	zlib library, based on code from Pascal Scheffers.
	WARNING! The C API may be subect to change without much warning! USE
	AT YOUR OWN RISK!

2008-12-10  Kevin B. Kenny  <[email protected]>

	* library/tzdata/*: Update from Olson's tzdata2008i.

2008-12-10  Alexandre Ferrieux  <[email protected]>

	TIP #343 IMPLEMENTATION - A Binary Specifier for [format/scan]

	* doc/format.n
	* doc/scan.n
	* generic/tclInt.h
	* generic/tclScan.c
	* generic/tclStrToD.c
	* generic/tclStringObj.c
	* tests/format.test
	* tests/scan.test

2008-12-10  Donal K. Fellows  <[email protected]>

	TIP #341 IMPLEMENTATION

	* generic/tclDictObj.c (DictFilterCmd): Made key and value filtering
	* tests/dict.test, doc/dict.n:		accept arbitrary numbers of
						glob arguments.

2008-12-09  Jan Nijtmans  <[email protected]>

	* generic/tclInt.decls: Restore source and binary compatibility for
				TIP #337 implementation. (When it is _that_
				simple, there is no excuse not to do it! :-))
	* generic/tclIntDecls.h:	make genstubs
	* generic/tclStubInit.c:

2008-12-09  Don Porter  <[email protected]>

	TIP #337 IMPLEMENTATION

	* doc/BackgdErr.3:	Converted internal routine
	* doc/interp.n:		TclBackgroundException() into public routine
	* generic/tcl.decls:	Tcl_BackgroundException().
	* generic/tclEvent.c:
	* generic/tclInt.decls:

	* generic/tclDecls.h:	make genstubs
	* generic/tclIntDecls.h:
	* generic/tclStubInit.c:

	* generic/tclIO.c:	Update callers.
	* generic/tclIOCmd.c:
	* generic/tclInterp.c:
	* generic/tclTimer.c:
	*** POTENTIAL INCOMPATIBILITY only for extensions using the converted
	    internal routine ***

2008-12-09  Donal K. Fellows  <[email protected]>

	* generic/tclIO.c (ChanClose,ChanRead,...): Factored out some of the
	code to connect to channel drivers that was common in multiple
	locations so as to make code more readable.

2008-12-06  Donal K. Fellows  <[email protected]>

	* generic/tclCmdAH.c (FileTempfileCmd): Force temporary files to be
	created in the native filesystem. Attempting to provide a template
	that puts it elsewhere will result in the directory part of the
	template being ignored. Partial address of [Bug 2388866] concerns.

2008-12-05  Donal K. Fellows  <[email protected]>

	TIP #335 IMPLEMENTATION

	* generic/tclBasic.c (Tcl_InterpActive): Added function for working
	* doc/CrtInterp.3:			 out if an interp is in use.

	TIP #307 IMPLEMENTATION

	* generic/tclResult.c (Tcl_TransferResult): Renamed function from
	* generic/tcl.decls:			    TclTransferResult. Added
	* doc/SetResult.3:			    to public stubs table.

2008-12-04  Don Porter  <[email protected]>

	* generic/tclPathObj.c (Tcl_FSGetNormalizedPath):	Added another
	flag value TCLPATH_NEEDNORM to mark those intreps which need more
	complete normalization attention for correct results. [Bug 2385549]

2008-12-03  Donal K. Fellows  <[email protected]>

	* win/tclWinPipe.c (TclpOpenTemporaryFile): Avoid an infinite loop due
	to GetTempFileName/CreateFile interaction. [Bug 2380318]

2008-12-03  Don Porter  <[email protected]>

	* generic/tclFileName.c (DoGlob):    One of the Tcl_FSMatchInDirectory
	calls did not have its return code checked. This caused error messages
	returned by some Tcl_Filesystem drivers to be swallowed.

2008-12-02  Don Porter  <[email protected]>

	TIP #336 IMPLEMENTATION

	* generic/tcl.decls:	New routines Tcl_(Get|Set)ErrorLine.
	* generic/tcl.h:	Dropped default access to interp->errorLine.
	* generic/tclCmdAH.c:	Restore it with -DUSE_INTERP_ERRORLINE.
	* generic/tclCmdMZ.c:	Updated callers.
	* generic/tclDictObj.c:
	* generic/tclIOUtil.c:
	* generic/tclNamesp.c:
	* generic/tclOOBasic.c:
	* generic/tclOODefinedCmds.c:
	* generic/tclOOMethod.c:
	* generic/tclProc.c:
	* generic/tclResult.c:
	*** POTENTIAL INCOMPATIBILITY for C code directly using the
	    interp->errorLine field ***

	* generic/tclDecls.h:	make genstubs
	* generic/tclStubInit.c:

2008-12-02  Andreas Kupries  <[email protected]>

	* generic/tclIO.c (TclFinalizeIOSubsystem): Replaced Alexandre
	Ferrieux's first patch for [Bug 2270477] with a gentler version, also
	supplied by him.

2008-12-01  Don Porter  <[email protected]>

	* generic/tclParse.c:  Coding standards fixups.

2008-12-01  Donal K. Fellows  <[email protected]>

	* tests/cmdAH.test (cmdAH-32.6): Test was not portable; depended on a
	C API function not universally available. [Bug 2371623]

2008-11-30  Kevin B. Kenny  <[email protected]>

	* library/clock.tcl (format, ParseClockScanFormat): Added a [string
	map] to get rid of namespace delimiters before caching a scan or
	format procedure. [Bug 2362156]
	* tests/clock.test (clock-64.[12]): Added test cases for the bug that
	was tickled by a namespace delimiter inside a format string.

2008-11-29  Donal K. Fellows  <[email protected]>

	TIP #210 IMPLEMENTATION

	* generic/tclCmdAH.c (FileTempfileCmd):
	* unix/tclUnixFCmd.c (TclpOpenTemporaryFile, DefaultTempDir):
	* win/tclWinPipe.c (TclpOpenTemporaryFile):
	* doc/file.n, tests/cmdAH.test: Implementation of [file tempfile]. I
	do not claim that this is a brilliant implementation, especially on
	Windows, but it covers the main points.

	* generic/tclThreadStorage.c: General revisions to make code clearer
	and more like the style used in the rest of the core. Includes adding
	more comments and explanation of what is going on. Reduce the amount
	of locking required.

2008-11-27  Alexandre Ferrieux  <[email protected]>

	* generic/tcl.h:	Alternate fix for [Bug 2251175]: missing
	* generic/tclCompile.c:	backslash substitution on expanded literals.
	* generic/tclParse.c:
	* generic/tclTest.c:
	* tests/parse.test:

2008-11-26  Jan Nijtmans  <[email protected]>

	* generic/tclIndexObj.c:   Eliminate warning: unused variable
	* generic/tclTest.c:	   A few more (harmless) Tcl_SetResult
				   eliminations.

2008-11-26  Kevin B. Kenny  <[email protected]>

	* library/tclIndex: Removed reference to no-longer-extant procedure
			    'tclLdAout'.
	* doc/library.n: Corrected mention of 'auto_exec' to 'auto_execok'.
	[Patch 2114900] thanks to Stuart Cassoff <[email protected]>

2008-11-25  Jan Nijtmans  <[email protected]>

	* generic/tclIndexObj.c: Eliminate 3 calls to Tcl_SetResult, as
	* generic/tclIO.c:	 examples how it should have been done.
	* generic/tclTestObj.c:	 purpose: contribute in the TIP #340
				 discussion.

2008-11-25  Andreas Kupries  <[email protected]>

	* generic/tclIO.c (TclFinalizeIOSubsystem): Applied Alexandre
	Ferrieux's patch for [Bug 2270477] to prevent infinite looping during
	finalization of channels not bound to interpreters.

2008-11-25  Jan Nijtmans  <[email protected]>

	* generic/tclTest.c: Don't assume that Tcl_SetResult sets
	interp->result, especially not in a DString test, in preparation for
	TIP #340

2008-11-24  Donal K. Fellows  <[email protected]>

	* tools/tcltk-man2html.tcl: Improvements to tackle tricky aspects of
	cross references and new entities to map. [Bug 2330040]

2008-11-19  Jan Nijtmans  <[email protected]>

	* generic/tclThreadTest.c: Convert Tcl_SetResult(......, TCL_DYNAMIC)
	to Tcl_SetResult(......, TCL_VOLATILE), in preparation for TIP #340

2008-11-17  Jan Nijtmans  <[email protected]>

	* generic/tcl.decls:	Fix signature and implementation of
	* generic/tclDecls.h:	Tcl_HashStats, such that it conforms to the
	* generic/tclHash.c:	documentation. [Bug 2308236]
	* generic/tclVar.c:
	* doc/Hash.3:
	* generic/tclDictObj.c: Convert Tcl_SetResult call to
	Tcl_SetObjResult.

2008-11-17  Alexandre Ferrieux  <[email protected]>

	* tests/for.test: Check for uncompiled-for-continue [Bug 2186888]
	fixed earlier.

	* generic/tcl.h:	 Fix [Bug 2251175]: missing backslash
	* generic/tclCompCmds.c: substitution on expanded literals.
	* generic/tclCompile.c
	* generic/tclParse.c
	* generic/tclTest.c
	* tests/compile.test
	* tests/parse.test

2008-11-16  Jan Nijtmans  <[email protected]>

	* generic/tclTest.c: Replace two times Tcl_SetResult with
	Tcl_SetObjResult, a little simplification in preparation for the TIP
	#340 patch.

2008-11-13  Jan Nijtmans  <[email protected]>

	* generic/tclInt.h:	Rename static function FSUnloadTempFile to
	* generic/tclIOUtil.c:	TclFSUnloadTempFile, needed in tclLoad.c

	* generic/tclLoad.c:	Fixed [Bug 2269431]: Load of shared
				objects leaves temporary files on windows.

2008-11-12  Pat Thoyts  <[email protected]>

	* tests/registry.test: Use HKCU to avoid requiring admin access for
	registry testing on Vista/Server2008

2008-11-11  Jan Nijtmans  <[email protected]>

	* generic/tclNamesp.c:	Eliminate warning: passing arg 4 of
				Tcl_SplitList from incompatible pointer type.
	* win/tcl.m4:	Reverted change from 2008-11-06 (was under the
			impression that "-Wno-implicit-int" added an extra
			warning)
	* win/configure: (regenerated)
	* unix/tcl.m4:	Use -O2 as gcc optimization compiler flag, and get rid
			of -Wno-implicit-int for UNIX.
	* unix/configure: (regenerated)

2008-11-10  Andreas Kupries  <[email protected]>

	* doc/platform_shell.n: Fixed [Bug 2255235], reported by Ulrich
	* library/platform/pkgIndex.tcl: Ring <[email protected]>.
	* library/platform/shell.tcl: Updated the LOCATE command in the
	* library/tm.tcl:   package 'platform::shell' to handle the new form
	* unix/Makefile.in: of 'provide' commands generated by tm.tcl. Bumped
	* win/Makefile.in:  package to version 1.1.4. Added cross-references
	to the relevant parts of the code to avoid future desynchronization.

2008-11-07  Pat Thoyts  <[email protected]>

	* generic/tclInt.h:    Applied [Patch 2215022] from Duoas to clean up
	* generic/tclBinary.c: the binary ensemble initiailization code.
	* generic/tclNamesp.c: Extends the TclMakeEnsemble to do
	* doc/ByteArrObj.3:    sub-ensembles from tables.

2008-11-06  Jan Nijtmans  <[email protected]>

	* win/tcl.m4:	    Add "-Wno-implicit-int" flag for gcc, as on UNIX
	* win/configure:    (regenerated)
	* generic/tclIO.c:  Eliminate an 'array index out of bounds' warning
			    on HP-UX.

2008-11-04  Jeff Hobbs  <[email protected]>

	* generic/tclPort.h: Remove the ../win/ header dir as the build system
	already has it, and it confuses builds when used with private headers
	installed.

2008-11-01  Donal K. Fellows  <[email protected]>

	* generic/tclOO.h (TCLOO_VERSION): Bump version of TclOO.

2008-10-31  Donal K. Fellows  <[email protected]>

	* generic/tclOOBasic.c (TclOONRUpcatch): Reworked the code that does
	* generic/tclOO.c (InitFoundation):	 class constructor handling so
	that it is more robust and runs the constructor call in the context of
	the caller of the class's constructor method. Needed because the
	previously used code did not work at all after applying the fix below;
	no Tcl existing command could reliably do what was needed any more.

	* generic/tclOODefineCmds.c (GetClassInOuterContext): Rework and
	factor out the code to resolve class names in definitions so that
	classes are resolved from the perspective of the caller of the
	[oo::define] command, rather than from the oo::define namespace! This
	makes much code simpler by reducing how often fully-qualified names
	are required (previously always in practice, so no back-compat issues
	exist). [Bug 2200824]

2008-10-28  Jan Nijtmans  <[email protected]>

	* generic/tclCompile.h: CONSTify TclDTraceInfo
	* generic/tclBasic.c:
	* generic/tclProc.c:
	* generic/tclEnv.c:	Eliminate some -Wwrite-strings warnings
	* generic/tclLink.c:

2008-10-27  Don Porter  <[email protected]>

	* generic/tclEncoding.c:	Use "iso8859-1" and not "identity" as
	the default and original [encoding system] value. Since "iso8859-1" is
	built in to the C source code for Tcl now, there's no availability
	issue, and it has the good feature of "identity" that we must have
	("bytes in" == "bytes out") without the bad feature of "identity"
	("broken as designed") that makes us want to abandon it. [RFE 2008609]
	*** POTENTIAL INCOMPATIBILITY for older releases of Tclkit and any
	other code expecting a particular value for Tcl's default system
	encoding ***

2008-10-24  Pat Thoyts  <[email protected]>

	* library/http/http.tcl: Fixed a failure to read SHOUTcast streams
	with the new 2.7 package. Introduced a new intial state as the first
	response may not be HTTP*.

2008-10-23  Miguel Sofer  <[email protected]>

	* generic/tclCmdAH.c (ForNextCallback): handle TCL_CONTINUE in the for
	body. [Bug 2186888]

2008-10-22  Jan Nijtmans  <[email protected]>

	* generic/tcl.h:	      CONST -> const and white-spacing
	* generic/tclCompile.h:
	* generic/tclEncoding.c:
	* generic/tclStubInit.c:
	* generic/tclStubLib.c:
	* generic/tcl.decls
	* generic/tclInt.decls
	* generic/tclTomMath.decls
	* generic/tclDecls.h:	      (regenerated)
	* generic/tclIntDecls.h:      (regenerated)
	* generic/tclIntPlatDecls.h:  (regenerated)
	* generic/tclOODecls.h:	      (regenerated)
	* generic/tclOOIntDecls.h:    (regenerated)
	* generic/tclPlatDecls.h:     (regenerated)
	* generic/tclTomMathDecls.h:  (regenerated)
	* generic/tclIntDecls.h:      (regenerated)
	* tools/genStubs.tcl:	      CONST -> const and white-spacing

2008-10-19  Don Porter  <[email protected]>

	* generic/tclProc.c:	Reset -level and -code values to defaults
	after they are used. [Bug 2152286]

2008-10-19  Donal K. Fellows  <[email protected]>

	* generic/tclBasic.c (TclInfoCoroutineCmd): Added code to make this
	check for being invoked in a syntactically correct way.

	* doc/info.n: Added documentation of [info coroutine].

	* doc/prefix.n: Improved the documentation by fixing formatting,
	adding good-practice recommendations and cross-references, etc.

2008-10-17  Jan Nijtmans  <[email protected]>

	* generic/tclOO.decls:		CONST -> const.
	* generic/tclOODecls.h:		(regenerated)
	* generic/tclOOIntDecls.h:	(regenerated)

2008-10-17  Andreas Kupries  <[email protected]>

	* generic/tclIORTrans.c (DeleteReflectedTransformMap): Removed debug
	output in C++ comment.

2008-10-17  Don Porter  <[email protected]>

	* generic/tclCompile.h:	Declare the internal tclInstructionTable to
	* generic/tclExecute.c:	simply be "const", not CONST86.

	* generic/tclCmdAH.c:	whitespace.
	* generic/tclCmdIL.c:	Uninitialized variable warning.
	* generic/tclTest.c:	const correctness warning.

2008-10-17  Donal K. Fellows  <[email protected]>

	* doc/*: Many very small formatting fixes.
	* doc/{glob,http,if}.n: More substantial reformatting for clarity.
	* doc/split.n: Remove mention of defunct c.l.t.announce

2008-10-16  Jan Nijtmans  <[email protected]>

	* generic/regc_locale.c: Add "const" to many internal const tables.
	* generic/tclClock.c:	 No functional or API change.
	* generic/tclCmdIL.c
	* generic/tclConfig.c
	* generic/tclDate.c
	* generic/tclEncoding.c
	* generic/tclEvent.c
	* generic/tclExecute.c
	* generic/tclFileName.c
	* generic/tclGetDate.y
	* generic/tclInterp.c
	* generic/tclIO.c
	* generic/tclIOCmd.c
	* generic/tclIORChan.c
	* generic/tclIORTrans.c
	* generic/tclLoad.c
	* generic/tclObj.c
	* generic/tclOOBasic.c
	* generic/tclOOCall.c
	* generic/tclOOInfo.c
	* generic/tclPathObj.c
	* generic/tclPkg.c
	* generic/tclResult.c
	* generic/tclStringObj.c
	* generic/tclTest.c
	* generic/tclTestObj.c
	* generic/tclThreadTest.c
	* generic/tclTimer.c
	* generic/tclTrace.c
	* macosx/tclMacOSXFCmd.c
	* win/cat.c
	* win/tclWinInit.c
	* win/tclWinTest.c

2008-10-16  Don Porter  <[email protected]>

	* library/init.tcl:	Revised [unknown] so that it carefully
	preserves the state of the ::errorInfo and ::errorCode variables at
	the start of auto-loading and restores that state before the
	autoloaded command is evaluated. [Bug 2140628]

2008-10-15  Jan Nijtmans  <[email protected]>

	* generic/tclInt.h:	Add "const" to many internal const tables, so
	* generic/tclBinary.c:	those will be put by the C-compiler in the
	* generic/tclCompile.c:	TEXT segment in stead of the DATA segment.
	* generic/tclDictObj.c: This makes those tables sharable in shared
	* generic/tclHash.c:	libraries.
	* generic/tclListObj.c:
	* generic/tclNamesp.c:
	* generic/tclObj.c:
	* generic/tclProc.c:
	* generic/tclRegexp.c:
	* generic/tclStringObj.c:
	* generic/tclUtil.c:
	* generic/tclVar.c:

2008-10-14  Jan Nijtmans  <[email protected]>

	* generic/tclCmdAH.c:	Fix minor compiler warnings when compiling
	* generic/tclCmdMZ.c:	with -Wwrite-strings.
	* generic/tclIndexObj.c:
	* generic/tclProc.c:
	* generic/tclStubLib.c:
	* generic/tclUtil.c:
	* win/tclWinChan.c:
	* win/tclWinDde.c:
	* win/tclWinInit.c:
	* win/tclWinReg.c:
	* win/tclWinSerial.c:

2008-10-14  Donal K. Fellows  <[email protected]>

	* doc/binary.n: Formatting fix.

2008-10-14  Don Porter  <[email protected]>

	* README:		Bump version number to 8.6a4
	* generic/tcl.h:
	* library/init.tcl:
	* tools/tcl.wse.in:
	* unix/configure.in:
	* unix/tcl.spec:
	* win/configure.in:

	* unix/configure:	autoconf-2.59
	* win/configure:

	* generic/tclExecute.c:	Fix compile warnings when --enable-symbols=all

	* generic/tclCmdIL.c:	Fix write to unallocated memory whenever
	[lrepeat] returns an empty list.

2008-10-14  Donal K. Fellows  <[email protected]>

	* doc/chan.n, doc/fconfigure.n: Added even more emphatic text to
	direct people to the correct manual pages for specific channel types,
	suitable for the hard-of-reading. Following discussion on tcl-core.

2008-10-13  Pat Thoyts  <[email protected]>

	* win/tclWinThrd.c (TclpThreadCreate): We need to initialize the
	thread id variable to 0 as on 64 bit windows this is a pointer sized
	field while windows only fills it with a 32 bit value. The result is
	an inability to join the threads as the ids cannot be matched.

	* generic/tclTest.c (TestNRELevels): Set array to the right size.

2008-10-13  Donal K. Fellows  <[email protected]>

	* generic/tclOOInfo.c (InfoClassDestrCmd): Handle error case.

	* generic/tclOOInt.h: Added macro magic to make things work with
	Objective C. [Bug 2163447]

2008-10-12  Miguel Sofer  <[email protected]>

	* generic/tclCompile.c: Fix bug in srcDelta encoding within ByteCodes.
	The bug can only be triggered under conditions that cannot happen in
	Tcl, but were met during development of L. Thanks go to Robert Netzer
	for diagnosis and fix.

2008-10-10  Don Porter  <[email protected]>

	*** 8.6a3 TAGGED FOR RELEASE ***

	* changes:	Updates for 8.6a3 release.

2008-10-10  Donal K. Fellows  <[email protected]>

	* generic/tclOODefineCmds.c (TclOODefineUnexportObjCmd)
	(TclOODefineExportObjCmd): Corrected export/unexport record synthesis.
	[Bug 2155658]

2008-10-08  Jan Nijtmans  <[email protected]>

	* unix/tclUnixChan.c:	Fix minor compiler warning.
	* unix/tcl.m4:		Fix for [Bug 2073255]
	* unix/configure:	Regenerated

2008-10-08  Miguel Sofer  <[email protected]>

	* generic/tclBasic (TclInfoCoroutineCmd):
	* tests/unsupported.test: Arrange for [info coroutine] to return {}
	when a coroutine is running but the resume command has been deleted.
	[Bug 2153080]

2008-10-08  Don Porter  <[email protected]>

	* generic/tclTrace.c:	Corrected handling of errors returned by
	variable traces so that the errorInfo value contains the original
	error message. [Bug 2151707]

	* generic/tclVar.c:	Revised implementation of TclObjVarErrMsg so
	that error message construction does not disturb an existing
	iPtr->errorInfo that may be in progress.

2008-10-07  Donal K. Fellows  <[email protected]>

	* doc/binary.n: Added better documentation of the [binary encode] and
	[binary decode] subcommands.

2008-10-07  Miguel Sofer  <[email protected]>

	TIP #327,#328 IMPLEMENTATIONS

	* generic/tclBasic.c:	   Move [tailcall], [coroutine] and
	* generic/tclCmdIL.c:	   [yield] out of ::tcl::unsupported
	* tclInt.h:
	* tests/info.test:	   and into global scope: TIPs #327
	* tests/unsupported.test:  and #328

2008-10-07  Donal K. Fellows  <[email protected]>

	* doc/chan.n, doc/transchan.n: Documented the channel transformation
	API of TIP #230.

2008-10-06  Pat Thoyts  <[email protected]>

	* tests/winFCmd.test: Fixed some erroneous tests on Vista+.
	* generic/tclFCmd.c: Fix constness for msvc of last commit

2008-10-06  Joe Mistachkin  <[email protected]>

	* tools/man2tcl.c: Added missing line from patch by Harald Oehlmann.
	[Bug 1934200]

2008-10-05  Jan Nijtmans  <[email protected]>

	* doc/FileSystem.3:	CONSTified Tcl_FSFileAttrStringsProc
	* generic/tclFCmd.c:	and tclpFileAttrStrings. This allows
	* generic/tclIOUtil.c:	FileSystems to report their attributes
	* generic/tclTest.c:	as const strings, without worrying that
	* unix/tclUnixFCmd.c:	Tcl modifies them (which Tcl should not
	* win/tclWinFCmd.c:	do anyway, but the API didn't indicate that)
	* generic/tcl.decls
	* generic/tclDecls.h:	regenerated
	* generic/tcl.h:	Make sure that if CONST84 is defined as empty,
				CONST86 should be defined as empty as well
				(unless overridden). This change complies with
				TIP #27
	*** POTENTIAL INCOMPATIBILITY ***

2008-10-05  Kevin B, Kenny  <[email protected]>

	* libtommath/bn_mp_sqrt.c (bn_mp_sqrt): Handle the case where a
	* tests/expr.test (expr-47.13):		number's square root is
	between n<<DIGIT_BIT and n<<DIGIT_BIT+1. [Bug 2143288]
	Thanks to Malcolm Boffey ([email protected]) for the patch.

	TIP #331 IMPLEMENTATION

	* doc/lset.n:
	* generic/tclListObj.c (TclLsetFlat):
	* tests/lset.test: Modified the [lset] command so that it allows for
	an index of 'end+1', which has the effect of appending an element to
	the list.

2008-10-05  Jan Nijtmans  <[email protected]>

	* generic/tclInt.decls:	 CONSTified the AuxDataType argument
	* generic/tclCompCmds.c: of TclCreateAuxData and
	* generic/tclCompile.c:	 TclRegisterAuxDataType and the return
	* generic/tclCompile.h:	 values of TclGetAuxDataType and
	* generic/tclExecute.c:	 TclGetInstructionTable
	* generic/tclIntDecls.h:		regenerated
	This change complies with TIP #27 (even though it only involves
	internal function, so this is not even necessary).

2008-10-05  Donal K. Fellows  <[email protected]>

	* generic/tclIndexObj.c (TclInitPrefixCmd): Make the [tcl::prefix]
	into an exported command. [Bug 2144595]

2008-10-04  Donal K. Fellows  <[email protected]>

	* generic/tclCmdIL.c (InfoFrameCmd):	Improved hygiene of result
	* generic/tclRegexp.c (TclRegAbout):	handling.

2008-10-04  Jan Nijtmans  <[email protected]>

	* generic/tclLoad.c: Make sure that any library which doesn't have an
	unloadproc is only really unloaded when no library code is executed
	yet. [Bug 2059262]

2008-10-04  Donal K. Fellows  <[email protected]>

	* generic/tclOOInfo.c (GetClassFromObj): Factor out the code to parse
	a Tcl_Obj and get a class. Also make result handling hygienic.
	* generic/tclOOBasic.c (TclOOSelfObjCmd): Better hygiene of results,
	and stop allocating quite so much memory by sharing special "method"
	names.

2008-10-04  Jan Nijtmans  <[email protected]>

	* doc/ChnlStack.3:	CONSTified the typePtr argument
	* doc/CrtChannel.3:	of Tcl_CreateChannel and Tcl_StackChannel
	* generic/tcl.decls:	and the return value of Tcl_GetChannelType
	* generic/tcl.h
	* generic/tclIO.h
	* generic/tclIO.c
	* generic/tclDecls.h:	regenerated
	This change complies with TIP #27.

	* doc/Hash.3:		CONSTified the typePtr argument
	* generic/tcl.decls:	of Tcl_InitCustomHashTable.
	* generic/tcl.h
	* generic/tclHash.c
	* generic/tclDecls.h:	regenerated
	This change complies with TIP #27.

	* doc/RegConfig.3:	CONSTified the configuration argument
	* generic/tcl.decls:	of Tcl_RegisterConfig.
	* generic/tcl.h
	* generic/tclConfig.c
	* generic/tclPkgConfig.c
	* generic/tclDecls.h:	regenerated
	This change complies with TIP #27.

	* doc/GetIndex.3:	CONSTified the tablePtr argument
	* generic/tcl.decls:	of Tcl_GetIndexFromObj.
	* generic/tclIndexObj.c
	* generic/tclDecls.h:	regenerated
	This change complies with TIP #27.

2008-10-03  Miguel Sofer  <[email protected]>

	* tests/stack.test:
	* unix/tclUnixTest.c: Removed test command teststacklimit and the
	corresponding constraint: it is not needed with NRE

2008-10-03  Donal K. Fellows  <[email protected]>

	TIP #195 IMPLEMENTATION

	* generic/tclIndexObj.c (TclGetIndexFromObjList, PrefixMatchObjCmd)
	* doc/prefix.n, tests/string.test: Added [tcl::prefix] command for
	working with prefixes of strings at the Tcl level. [Patch 1040206]

	TIP #265 IMPLEMENTATION

	* generic/tclIndexObj.c (Tcl_ParseArgsObjv, PrintUsage):
	* generic/tcl.h (Tcl_ArgvInfo):	Added function for simple parsing of
	* doc/ParseArgs.3 (new file):	optional arguments to commands. Still
	needs tests and the like. [FRQ 1446696] Note that some of the type
	signatures are changed a bit from the proposed implementation so that
	they better reflect codified good practice for argument order.

2008-10-02  Andreas Kupries  <[email protected]>

	* tests/info.test (info-23.3): Updated output of the test to handle
	the NRE-enabled eval and the proper propagation of location
	information through it. [Bug 2017632]

	* doc/info.n: Rephrased the documentation of 'info frame' for positive
	numbers as level argument. [Bug 2134049]

	* tests/info.test (info-22.8): Made pattern for file containing
	tcltest less specific to accept both .tcl and .tm variants of the file
	during matching. [Bug 2129828]

2008-10-02  Don Porter  <[email protected]>

	TIP #330 IMPLEMENTATION

	* generic/tcl.h:	Remove the "result" and "freeProc" fields
	* generic/tclBasic.c:	from the default public declaration of the
	* generic/tclResult.c:	Tcl_Interp struct. Code should no longer
	* generic/tclStubLib.c:	be accessing these fields. Access can be
	* generic/tclTest.c:	restored by defining USE_INTERP_RESULT, but
	* generic/tclUtil.c:	that should only be a temporary migration aid.
	*** POTENTIAL INCOMPATIBILITY ***

2008-10-02  Joe Mistachkin  <[email protected]>

	* doc/info.n: Fix unmatched font change.
	* doc/tclvars.n: Fix unmatched font change.
	* doc/variable.n: Fix unmatched font change.
	* tools/man2help2.tcl: Integrated patch from Harald Oehlmann.
	[Bug 1934272]
	* tools/man2tcl.c: Increase MAX_LINE_SIZE to fix "Too long line" error.
	* win/buildall.vc.bat: Prefer the HtmlHelp target over the WinHelp
	target. [Bug 2072891]
	* win/makefile.vc: Fix the HtmlHelp and WinHelp targets to not be
	mutually exclusive.

2008-09-29  Don Porter  <[email protected]>

	TIP #323 IMPLEMENTATION (partial)

	* doc/glob.n:		Revise [glob] to accept zero patterns.
	* generic/tclFileName.c:
	* tests fileName.test:

	* doc/linsert.n:	Revise [linsert] to accept zero elements.
	* generic/tclCmdIL.c:
	* tests/linsert.test:

2008-09-29  Donal K. Fellows  <[email protected]>

	TIP #326 IMPLEMENTATION

	* generic/tclCmdIL.c (Tcl_LsortObjCmd): Added -stride option to carry
	* doc/lsort.n, tests/cmdIL.test:	out sorting of lists where the
	elements are grouped. Adapted from [Patch 2082681]

	TIP #313 IMPLEMENTATION

	* generic/tclCmdIL.c (Tcl_LsearchObjCmd): Added -bisect option to
	* doc/lsearch.n, tests/lsearch.test:	  allow the finding of the
	place to insert an element in a sorted list when that element is
	not already there. [Patch 1894241]

	TIP #318 IMPLEMENTATION

	* generic/tclCmdMZ.c (StringTrimCmd,StringTrimLCmd,StringTrimRCmd):
	Update the default set of trimmed characters to include some from the
	larger UNICODE space. Factor out the default trim set into a macro so
	that it is easier to keep them in synch.

2008-09-28  Donal K. Fellows  <[email protected]>

	TIP #314 IMPLEMENTATION

	* generic/tclCompCmds.c (TclCompileEnsemble)
	* generic/tclNamesp.c (NamespaceEnsembleCmd)
	(Tcl_SetEnsembleParameterList, Tcl_GetEnsembleParameterList)
	(NsEnsembleImplementationCmdNR):
	* generic/tcl.decls, doc/Ensemble.3, doc/namespace.n
	* tests/namespace.test: Allow the handling of a (fixed) number of
	formal parameters between an ensemble's command and subcommand at
	invokation time. [Patch 1901783]

2008-09-28  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c:	   Fix the numLevels computations on
	* generic/tclInt.h:	   coroutine yield/resume
	* tests/unsupported.test:

2008-09-27  Donal K. Fellows  <[email protected]>

	* generic/tclFileName.c (Tcl_GetBlock*FromStat): Made this work
	acceptably when working with OSes that don't support reporting the
	block size from the stat() call. [Bug 2130726]

	* generic/tclCmdIL.c (Tcl_LrepeatObjCmd): Improve the handling of the
	case where the combination of number of elements and repeat count
	causes the resulting list to be too large. [Bug 2130992]

2008-09-26  Don Porter  <[email protected]>

	TIP #323 IMPLEMENTATION (partial)

	* doc/lrepeat.n:	Revise [lrepeat] to accept both zero
	* generic/tclCmdIL.c:	repetitions and zero elements to be repeated.
	* tests/lrepeat.test:

	* doc/object.n:		Revise standard oo method [my variable] to
	* generic/tclOOBasic.c:	accept zero variable names.
	* tests/oo.test:

	* doc/tm.n:		Revise [tcl::tm::path add] and
	* library/tm.tcl:	[tcl::tm::path remove] to accept zero paths.
	* tests/tm.test:

	* doc/namespace.n:	Revise [namespace upvar] to accept zero
	* generic/tclNamesp.c:	variable names.
	* tests/upvar.test:

	* doc/lassign.n:	Revise [lassign] to accept zero variable names.
	* generic/tclCmdIL.c:
	* tests/cmdIL.test:

2008-09-26  Donal K. Fellows  <[email protected]>

	* generic/tclOO.h (TCLOO_VERSION): Bump the version.

2008-09-25  Don Porter  <[email protected]>

	TIP #323 IMPLEMENTATION (partial)

	* doc/global.n:		Revise [global] to accept zero variable names.
	* doc/variable.n:	Revise [variable] likewise.
	* generic/tclVar.c:
	* tests/proc-old.test:
	* tests/var.test:

	* doc/global.n: Correct false claim about [info locals].

2008-09-25  Donal K. Fellows  <[email protected]>

	TIP #315 IMPLEMENTATION

	* tests/platform.test:	Update tests to expect revised results
	* tests/safe.test:	corresponding to the TIP 315 change.

	* unix/tclUnixInit.c, win/tclWinInit.c (TclpSetVariables):
	* doc/tclvars.n (tcl_platform): Define what character is used for
	separating PATH-like lists. Forms part of the tcl_platform array.

	* generic/tclOOCall.c (InitCallChain, IsStillValid):
	* tests/oo.test (oo-25.2): Revise call chain cache management so that
	it takes into account class-wide caching correctly. [Bug 2120903]

2008-09-24  Don Porter  <[email protected]>

	TIP #323 IMPLEMENTATION (partial)

	* doc/file.n:		Revise [file delete] and [file mkdir] to
	* generic/tclCmdAH.c:	accept zero "pathname" arguments (the
	* generic/tclFCmd.c:	no-op case).
	* tests/cmdAH.test:
	* tests/fCmd.test:

2008-09-24  Donal K. Fellows  <[email protected]>

	* generic/tclOOMethod.c (DBPRINT): Remove obsolete debugging macro.
	[Bug 2124814]

	TIP #316 IMPLEMENTATION

	* generic/tcl.decls, generic/tclFileName.c (Tcl_GetSizeFromStat, etc):
	* doc/FileSystem.3: Added reader functions for Tcl_StatBuf.

2008-09-23  Donal K. Fellows  <[email protected]>

	* doc/Method.3: Corrected documentation. [Patch 2082450]

	* doc/lreverse.n, mathop.n, regexp.n, regsub.n: Make sure that the
	initial line of the manpage includes nothing that chokes old versions
	of man. [Bug 2118123]

2008-09-22  Donal K. Fellows  <[email protected]>

	TIP #320 IMPLEMENTATION

	* generic/tclOODefineCmds.c (TclOODefineVariablesObjCmd):
	* generic/tclOOInfo.c (InfoObjectVariablesCmd, InfoClassVariablesCmd):
	* generic/tclOOMethod.c (TclOOSetupVariableResolver, etc):
	* doc/define.n, doc/ooInfo.n, benchmarks/cps.tcl:
	* tests/oo.test (oo-26.*): Allow the declaration of the common
	variables used in methods of a class or object. These are then mapped
	in using a variable resolver. This makes many class declarations much
	simpler overall, encourages good usage of variable names, and also
	boosts speed a bit.

	* generic/tclOOMethod.c (TclOOGetMethodBody): Factor out the code to
	get the body of a procedure-like method. Reduces the amount of "poking
	inside the abstraction" that is done by the introspection code.

2008-09-22  Alexandre Ferrieux  <[email protected]>

	* doc/chan.n: Clean up paragraph order.

2008-09-18  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c (NEXT_INST_F):
	* generic/tclInt.h (TCL_CT_ASSERT): New compile-time assertions,
	adapted from www.pixelbeat.org/programming/gcc/static_assert.html

2008-09-17  Don Porter  <[email protected]>

	* generic/tclInt.h: Correct the TclGetLongFromObj, TclGetIntFromObj,
	and TclGetIntForIndexM macros so that they retrieve the longValue
	field from the internalRep instead of casting the otherValuePtr field
	to type long.

2008-09-17  Miguel Sofer  <[email protected]>

	* library/init.tcl: Export min and max commands from the mathfunc
	namespace. [Bug 2116053]

2008-09-16  Joe Mistachkin  <[email protected]>

	* generic/tclParse.c: Move TclResetCancellation to be called on
	returning to level 0, as opposed to it being called on starting a
	substitution at level 0.

2008-09-16  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c: Move TclResetCancellation to be called on
	returning to level 0, as opposed to it being called on starting a
	command at level 0. Add a call on returning via Tcl_EvalObjEx to fix
	[Bug 2114165].

2008-09-10  Donal K. Fellows  <[email protected]>

	* doc/binary.n: Added partial documentation of [binary encode] and
	[binary decode].

	* tests/binary.test,cmdAH.test,cmdIL.test,cmdMZ.test,fileSystem.test:
	More use of tcltest2 to simplify the tests as exposed to people.
	* tests/compile.test (compile-18.*): Added *some* tests of the
	disassmbler, though not of its output format.

2008-09-10  Miguel Sofer  <[email protected]>

	* tests/nre.test: Add missing constraints; enable test of foreach
	recursion.

	* generic/tclBasic.c:
	* generic/tclCompile.h:
	* generic/tclExecute.c (INST_EVAL_STK): Wrong numLevels when evaling a
	canonical list. [Bug 2102930]

2008-09-10  Donal K. Fellows  <[email protected]>

	* generic/tclListObj.c (Tcl_ListObjGetElements): Make this list->dict
	transformation - encountered when using [foreach] with dicts - not as
	expensive as it was before. Spotted by Kieran Elby and reported on
	tcl-core.

2008-09-08  Donal K. Fellows  <[email protected]>

	* tests/append.test, appendComp.test, cmdAH.test: Use the powers of
	tcltest2 to make these files simpler.

2008-09-07  Miguel Sofer  <[email protected]>

	* generic/tclCompile.c (TclCompileTokens):
	* generic/tclExecute.c (CompileExprObj): Fix a perf bug (found by Alex
	Ferrieux) where some variables in the LVT where not being accessed by
	index. Fix missing localCache management in compiled expressions found
	while analyzing the bug.

2008-09-07  Miguel Sofer  <[email protected]>

	* doc/namespace.n: Fix [Bug 2098441]

2008-09-04  Miguel Sofer  <[email protected]>

	* generic/tclTrace.test (TraceVarProc):
	* generic/unsupported.test: Insure that unset traces are run even when
	the coroutine is unwinding. [Bug 2093947]

	* generic/tclExecute.c (CACHE_STACK_INFO):
	* tests/unsupported.test: Restore execEnv's bottomPtr. [Bug 2093188]

2008-09-02  Don Porter  <[email protected]>

	* generic/tcl.h:	Stripped "callers" of the _ANSI_ARGS_ macro
	* compat/dirent2.h:	to support a TCL_NO_DEPRECATED build.
	* compat/dlfcn.h:
	* unix/tclUnixPort.h:

	* generic/tcl.h:	Removed the conditional #define of
	_ANSI_ARGS_ that would support pre-prototype C compilers. Since
	_ANSI_ARGS_ is no longer used in tclDecls.h, it's clear no one
	compiling against Tcl 8.5 headers is making use of a -DNO_PROTOTYPES
	configuration.

2008-09-02  Donal K. Fellows  <[email protected]>

	* tests/socket.test: Rewrote so as to use tcltest2 better.

2008-09-01  Miguel Sofer  <[email protected]>

	* generic/tclCmdAH.c:	   NRE-enabling [eval]; eval scripts are now
	* generic/tclOOBasic.c:	   bytecompiled. Adapted recursion limit tests
	* tests/interp.test:	   that were relying on eval not being
	* tests/nre.test:	   compiled. Part of the [Bug 2017632] project.
	* tests/unsupported.test:

2008-09-01  Donal K. Fellows  <[email protected]>

	* generic/tclOOMethod.c (InvokeProcedureMethod):
	* generic/tclOO.c (ObjectRenamedTrace): Arrange for only methods that
	involve callbacks into the Tcl interpreter to be skipped when the
	interpreter is being torn down. Allows the semantics of destructors in
	a dying interpreter to be more useful when they're implemented in C.

2008-08-29  Donal K. Fellows  <[email protected]>

	* unix/Makefile.in: Ensure that all TclOO headers get installed.
	* win/Makefile.in:  [Bug 2082299]
	* win/makefile.bc:
	* win/makefile.vc:

2008-08-28  Don Porter  <[email protected]>

	* README:		Bump version number to 8.6a3
	* generic/tcl.h:
	* library/init.tcl:
	* tools/tcl.wse.in:
	* unix/configure.in:
	* unix/tcl.spec:
	* win/configure.in:

	* unix/configure:	autoconf-2.59
	* win/configure:

2008-08-27  Donal K. Fellows  <[email protected]>

	* doc/tclvars.n, doc/library.n: Ensured that these two manual pages
	properly cross-reference each other. Issue reported on Tcler's Chat.

2008-08-26  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c (InfoCoroutine):
	* tests/unsupported.test: New command that returns the FQN of the
	currently executing coroutine. Lives as infoCoroutine under
	unsupported, but is designed to become a subcommand of [info]

2008-08-23  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c (NRInterpCoroutine): Store the caller's eePtr,
	stop assuming the coroutine is invoked from the same execEnv where it
	was created.

2008-08-24  Donal K. Fellows  <[email protected]>

	* generic/tclCmdAH.c (TclNRForeachCmd): Converted the [foreach]
	command to have an NRE-aware non-compiled implementation. Part of the
	[Bug 2017632] project. Also restructured the code so as to manage its
	temporary memory more efficiently.

2008-08-23  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c:	  Removed unused var; fixed function pointer
	* generic/tclOOInt.h:	  declarations (why did gcc start complaining
	* generic/tclOOMethod.c:  all of a sudden?)
	* generic/tclProc.c:

2008-08-23  Donal K. Fellows  <[email protected]>

	* generic/tclInt.h (EnsembleImplMap): Added extra field to make it
	* generic/tclNamesp.c (TclMakeEnsemble): easier to build non-recursive
	ensembles in the core.

	* generic/tclDictObj.c (DictForNRCmd): Converted the [dict for]
	command to have an NRE-aware non-compiled implementation. Part of the
	[Bug 2017632] project.

2008-08-22  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c:
	* generic/tclExecute.c: Set special errocodes: COROUTINE_BUSY,
	COROUTINE_CANT_YIELD, COROUTINE_ILLEGAL_YIELD.

2008-08-22  Don Porter  <[email protected]>

	*** 8.6a2 TAGGED FOR RELEASE ***

	* changes:	Updates for 8.6a2 release.

	* generic/tcl.h:	Drop use of USE_COMPAT85_CONST. That added
	indirection without value. Use -DCONST86="" to engage source compat
	support for code written for 8.5 headers.

	* generic/tclUtil.c (TclReToGlob):	Added missing set of the
	*exactPtr value to really fix [Bug 2065115]. Also avoid possible
	DString overflow.
	* tests/regexpComp.test:	Correct duplicate test names.

2008-08-21  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c:	  Previous fix, now done right.
	* generic/tclCmdIL.c:
	* generic/tclInt.h:
	* tests/unsupported.test:

2008-08-21  Jeff Hobbs  <[email protected]>

	* tests/regexp.test, tests/regexpComp.test: Correct re2glob ***=
	* generic/tclUtil.c (TclReToGlob):	    translation from exact
	to anywhere-in-string match. [Bug 2065115]

2008-08-21  Don Porter  <[email protected]>

	* generic/tcl.h:	Reduced the use of CONST86 and eliminated
	* generic/tcl.decls:	the use of CONST86_RETURN to support source
	code compatibility with Tcl 8.5 on those public routines passing
	(Tcl_Filesystem *), (Tcl_Timer *), and (Tcl_Objtype *) values which
	have been const-ified. What remains is the minimum configurability
	needed to support code written for pre-8.6 headers via the new
	-DUSE_COMPAT85_CONST compiler directive.
	*** POTENTIAL INCOMPATIBILITY ***

	* generic/tclDecls.h:	make genstubs

2008-08-21  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c:	Fix the cmdFrame level count in
	* generic/tclCmdIL.c:	coroutines. Fix small bug on coroutine
	* generic/tclInt.h:	rewind.

2008-08-21  Donal K. Fellows  <[email protected]>

	* generic/tclProc.c (Tcl_DisassembleObjCmd): Added ability to
	disassemble TclOO methods. The code to do this is very ugly.

2008-08-21  Pat Thoyts  <[email protected]>

	* generic/tclOOMethod.c: Added casts to make MSVC happy
	* generic/tclBasic.c:

2008-08-20  Donal K. Fellows  <[email protected]>

	* generic/tclOO.c (AllocObject): Suppress compilation of commands in
	the namespace allocated for each object.
	* generic/tclOOMethod.c (PushMethodCallFrame): Restore some of the
	hackery that makes calling methods of classes fast. Fixes performance
	problem introduced by the fix of [Bug 2037727].

	* generic/tclCompile.c (TclCompileScript):    Allow the suppression of
	* generic/tclInt.h (NS_SUPPRESS_COMPILATION): compilation of commands
	* generic/tclNamesp.c (Tcl_CreateNamespace):  from a namespace or its
	children.

2008-08-20  Daniel Steffen  <[email protected]>

	* generic/tclTest.c (TestconcatobjCmd):	Fix use of internal-only
	TclInvalidateStringRep macro. [Bug 2057479]

2008-08-17  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c:	   Implementation of [coroutine] and [yield]
	* generic/tclCmdAH.c:	   commands (in tcl::unsupported).
	* generic/tclCompile.h:
	* generic/tclExecute.c:
	* generic/tclInt.h:
	* tests/unsupported.test:

	* generic/tclTest.c (TestconcatobjCmd):
	* generic/tclUtil.c (Tcl_ConcatObj):
	* tests/util.test (util-4.7):
	Fix [Bug 1447328]; the original "fix" turned Tcl_ConcatObj() into a
	hairy monster. This was exposed by [Bug 2055782]. Additionally,
	Tcl_ConcatObj could corrupt its input under certain conditions!

	*** NASTY BUG FIXED ***

2008-08-16  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c: Better cmdFrame management

2008-08-14  Don Porter  <[email protected]>

	* tests/fileName.test:	Revise new tests for portability to case
	insensitive filesystems.

2008-08-14  Daniel Steffen  <[email protected]>

	* generic/tclBasic.c (TclNREvalObjv, Tcl_NRCallObjProc):
	* generic/tclProc.c (TclNRInterpProcCore, InterpProcNR2):
	DTrace probes for NRE. [Bug 2017160]

	* generic/tclBasic.c (TclDTraceInfo):	Add two extra arguments to
	* generic/tclCompile.h:			DTrace 'info' probes for tclOO
	* generic/tclDTrace.d:			method & class/object info.

	* generic/tclCompile.h:	Add support for debug logging of DTrace
	* generic/tclBasic.c:	'proc', 'cmd' and 'inst' probes (does _not_
				require a platform with DTrace).

	* generic/tclCmdIL.c (TclInfoFrame):	Check fPtr->line before
						dereferencing as line info may
						not exists when TclInfoFrame()
						is called from a DTrace probe.

	* tests/fCmd.test (fCmd-6.23):	Made result matching robust when test
					workdir and /tmp are not on same FS.

	* unix/tclUnixThrd.c:		Remove unused TclpThreadGetStackSize()
	* generic/tclInt.h:		and related ifdefs and autoconf tests.
	* unix/tclUnixPort.h:		[Bug 2017264] (jenglish)
	* unix/tcl.m4:

	* unix/Makefile.in:		Ensure Makefile shell is /bin/bash for
	* unix/configure.in (SunOS):	DTrace-enabled build on Solaris.
					(followup to 2008-06-12) [Bug 2016584]

	* unix/tcl.m4 (SC_PATH_X):	Check for libX11.dylib in addition to
					libX11.so et al.

	* unix/configure:		autoconf-2.59
	* unix/tclConfig.h.in:		autoheader-2.59

2008-08-13  Miguel Sofer  <[email protected]>

	* tests/nre.test: Added test for large {*}-expansion effects

2008-08-13  Don Porter  <[email protected]>

	* generic/tclFileName.c:	Fix for errors handling -types {}
	* tests/fileName.test:		option to [glob]. [Bug 1750300]
	Thanks to Matthias Kraft and George Peter Staplin.

2008-08-12  Jeff Hobbs  <[email protected]>

	* generic/tclOOInfo.c (InfoObjectDefnCmd, InfoObjectMixinsCmd):
	Fix # args displayed. [Bug 2048676]

2008-08-08  Don Porter  <[email protected]>

	* generic/tclOOMethod.c (PushMethodCallFrame):	Added missing check
	for bytecode validity. [Bug 2037727]

	* generic/tclProc.c (TclProcCompileProc):	On recompile of a
	proc, clear away any entries on the CompiledLocal list from the
	previous compile. This will prevent compile of temporary variables in
	the proc body from growing the localCache arbitrarily large.

	* README:		Bump version number to 8.6a2
	* generic/tcl.h:
	* library/init.tcl:
	* tools/tcl.wse.in:
	* unix/configure.in:
	* unix/tcl.spec:
	* win/configure.in:

	* unix/configure:	autoconf-2.59
	* win/configure:

	* changes:	Updates for 8.6a2 release.

2008-08-11  Pat Thoyts  <[email protected]>

	* library/http/http.tcl: Remove 8.5 requirement.
	* library/http/pkgIndex.tcl:
	* unix/Makefile.in:
	* win/Makefile.in:
	* win/makefile.vc:

2008-08-11  Andreas Kupries  <[email protected]>

	* library/tm.tcl: Added a 'package provide' command to the generated
	ifneeded scripts of Tcl Modules, for early detection of conflicts
	between the version specified through the file name and a 'provide'
	command in the module implementation, if any. Note that this change
	also now allows Tcl Modules to not provide a 'provide' command at all,
	and declaring their version only through their filename.

	* generic/tclProc.c (Tcl_ProcObjCmd): Fixed memory leak triggered by
	* tests/proc.test: procbody::test::proc. See [Bug 2043636]. Added a
	test case demonstrating the leak before the fix. Fixed a few spelling
	errors in test descriptions as well.

2008-08-11  Don Porter  <[email protected]>

	* library/http/http.tcl:	Bump http version to 2.7.1 to account
	* library/http/pkgIndex.tcl:	for [Bug 2046486] bug fix. This
	* unix/Makefile.in:		release of http now requires a
	* win/Makefile.in:		dependency on Tcl 8.5 to be able to
	* win/makefile.bc:		use the unsigned formats in the
	* win/makefile.vc:		[binary scan] command.

2008-08-11  Pat Thoyts  <[email protected]>

	* library/http/http.tcl: CRC field from zlib data should be treated as
	unsigned for 64bit support. [Bug 2046846]

2008-08-10  Miguel Sofer  <[email protected]>

	* generic/tclProc.c: Completely removed ProcCompileProc, which was a
	fix for [Bug 1482718]. This is not needed at least since varReform,
	where the local variable data at runtime is read from the CallFrame
	and/or the LocalCache.

2008-08-09  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c:	Slight cleanup
	* generic/tclCompile.h:
	* generic/tclExecute.c:

2008-08-09  Daniel Steffen  <[email protected]>

	* generic/tclExecute.c:	Fix warnings.

	* generic/tclOOMethod.c (PushMethodCallFrame):	Fix uninitialized efi
							name field.

	* tests/lrange.test (lrange-1.17):	Add test cleanup; whitespace.

2008-08-08  Don Porter  <[email protected]>

	* changes:	Updates for 8.6a2 release.

2008-08-08  Kevin Kenny  <[email protected]>

	* library/tzdata/CET:
	* library/tzdata/MET:
	* library/tzdata/Africa/Casablanca:
	* library/tzdata/America/Eirunepe:
	* library/tzdata/America/Rio_Branco:
	* library/tzdata/America/Santarem:
	* library/tzdata/America/Argentina/San_Luis:
	* library/tzdata/Asia/Karachi:
	* library/tzdata/Europe/Belgrade:
	* library/tzdata/Europe/Berlin:
	* library/tzdata/Europe/Budapest:
	* library/tzdata/Europe/Sofia:
	* library/tzdata/Indian/Mauritius:  Olson's tzdata2008e.

2008-08-07  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c:	Fix tailcalls falling out of tebc into
	* generic/tclExecute.c: Tcl_EvalEx. [Bug 2017946]
	* generic/tclInt.h:

2008-08-06  Don Porter  <[email protected]>

	* generic/tclOO.c:	Revised TclOO's check for an interp being
	deleted during handling of object command deletion. The old code was
	relying on documented features of command delete traces that do not in
	fact work. [Bug 2039178]

	* tests/oo.test (oo-26.*):	Added tests that demonstrate failure
	of TclOO to check for various kinds of invalid bytecode during method
	dispatch. [Bug 2037727]

2008-08-06  Miguel Sofer  <[email protected]>

	* generic/tclVar.c (TclLookupSimpleVar): Fix bug that the core could
	not trigger before TclOO: the number of locals was being read from the
	Proc, which can under some circumstance be out of sync with the
	localCache's. Found by dgp while investigating [Bug 2037727].

	* library/init.tcl (::unknown): Removed the [namespace inscope]
	hack that was maintained for Itcl

	*** POTENTIAL INCOMPATIBILITY *** for Itcl
	Itcl users will need a new release with Itcl's [Patch 2040295], or
	else load the tiny script in that patch by themselves (rewrite
	::unknown). Note that it is a script-only patch.

2008-08-05  Joe English  <[email protected]>

	* unix/tclUnixChan.c: Streamline async connect logic [Patch 1994512]

2008-08-05  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c: Fix for [Bug 2038069] by dgp.
	* tests/execute.test:

2008-08-04  Miguel Sofer  <[email protected]>

	* tests/nre.test: Added tests for [if], [while] and [for]. A test
	for [foreach] has been added and marked as knownbug, awaiting for it
	to be NR-enabled.

	* generic/tclBasic.c:	   Made atProcExit commands run
	* generic/tclCompile.h:	   unconditionally, streamlined
	* generic/tclExecute.c:	   atProcExit/tailcall processing in TEBC.
	* generic/tclProc.c:
	* tests/unsupported.test:

2008-08-04  Don Porter  <[email protected]>

	* generic/tclExecute.c: Stopped faulty double-logging of errors to
	* tests/execute.test:	stack trace when a compile epoch bump triggers
	fallback to direct evaluation of commands in a compiled script.
	[Bug 2037338]

2008-08-03  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c:	   New unsupported command atProcExit that
	* generic/tclCompile.h:	   shares the implementation with tailcall.
	* generic/tclExecute.c:	   Fixed a segfault in tailcalls. Tests added.
	* generic/tclInt.h:
	* generic/tclInterp.c:
	* generic/tclNamesp.c:
	* tests/unsupported.test:

2008-08-02  Miguel Sofer  <[email protected]>

	* tests/NRE.test (removed):	Migrated tests to standard locations,
	* tests/nre.test (new):		separating core functionality from the
	* tests/unsupported.test (new):	experimental commands.

2008-08-01  Jeff Hobbs  <[email protected]>

	* doc/Exit.3:			Do not call Tcl_Finalize implicitly
	* generic/tclEvent.c:		on DLL_PROCESS_DETACH as it may lead
	* win/tclWin32Dll.c (DllMain):	to issues and the user should be
	explicitly calling Tcl_Finalize before unloading regardless. Clarify
	the docs to note the explicit need in embedded use.

2008-08-01  Don Porter  <[email protected]>

	* generic/tclBasic.c:	Revised timing of the CmdFrame stack
	* tests/info.test:	management in TclEvalEx so that the CmdFrame
	will still be on the stack at the time Tcl_LogCommandInfo is called to
	append another level of -errorinfo information. Sets the stage to add
	file and line data to the stack trace. Added test to check that [info
	frame] functioning remains unchanged by the revision.

2008-07-31  Miguel Sofer  <[email protected]>

	* tests/NRE.test:  Replaced all deep-recursing tests by shallower
	tests that actually measure the C-stack depth. This makes them
	bearable again (even under memdebug) and avoid crashing on failure.

	* generic/tclBasic.c:	NR-enabling [catch], [if] and [for] and
	* generic/tclCmdAH.c:	[while] (the script, not the tests)
	* generic/tclCmdIL.c:
	* generic/tclCmdMZ.c:
	* generic/tclInt.h:
	* tests/NRE.test:

	* generic/tclBasic.c:	Moved the few remaining defs from tclNRE.h to
	* generic/tclDictObj.c: tclInt.h, eliminated inclusion of tclNRE.h
	* generic/tclExecute.c: everywhere.
	* generic/tclInt.h:
	* generic/tclInterp.c:
	* generic/tclNRE.h (removed):
	* generic/tclNamesp.c:
	* generic/tclOOBasic.c:
	* generic/tclOOInt.h:
	* generic/tclProc.c:
	* generic/tclTest.c:
	* unix/Makefile.in:

2008-07-30  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c:	 Improved tailcalls.
	* generic/tclCompile.h:
	* generic/tclExecute.c:
	* generic/tclTest.c:
	* tests/NRE.test:

	* generic/tclBasic.c (TclNREvalObjEx): New comments and code reorg
	to clarify what is happening.

	* generic/tclBasic.c: Guard against the value of iPtr->evalFlags
	changing between the times where TEOV and TEOV_exception run. Thanks
	dgp for catching this.

2008-07-29  Miguel Sofer  <[email protected]>

	* tests/NRE.test: New tests that went MIA in the NRE revamping

	* generic/tclBasic.c:	Clean up
	* generic/tclNRE.h:
	* generic/tclExecute.c:

	* generic/tclBasic.c:	Made use of the thread's alloc cache stored in
	* generic/tclInt.h:	the ekeko at interp creation to avoid hitting
	* generic/tclNRE.h:	the TSD each time an NRE callback is pushed or
	* generic/tclThreadAlloc.c: pulled; the approach is suitably general
	to extend to every other obj allocation where an interp is know; this
	is left for some other time, requires a lot of grunt work.

	* generic/tclExecute.c:	 Fix [Bug 2030670] that cause TclStackRealloc
	to panic on rare corner cases. Thx ajpasadyn for diagnose and patch.

	* generic/tcl.decls:	 Completely revamped NRE implementation, with
	* generic/tclBasic.c:	 (almost) unchanged API.
	* generic/tclCompile.h:
	* generic/tclExecute.c:	 TEBC will require a bit of a facelift, but
	* generic/tclInt.decls:	 TEOV at least looks great now. There are new
	* generic/tclInt.h:	 tests (incomplete!) to verify that execution
	* generic/tclInterp.c:	 is indeed in the same TEBC instance, at the
	* generic/tclNRE.h:	 same level in all stacks involved. Tailcalls
	* generic/tclNamesp.c:	 are still a bit leaky, still deserving to be
	* generic/tclOOBasic.c:	 in tcl::unsupported.
	* generic/tclOOMethod.c:
	* generic/tclProc.c:	 Uninit'd var warnings in TEBC with -O2, no
	* generic/tclTest.c:	 warnings otherwise.

2008-07-28  Jan Nijtmans  <[email protected]>

	* doc/FileSystem.3:		CONSTified many functions using
	* generic/tcl.decls:		Tcl_FileSystem which all are supposed
	* generic/tclDecls.h:		to be a constant, but this was not
	* generic/tclFileSystem.h:	reflected in the API: Tcl_FSData,
	* generic/tclIOUtil.c:		Tcl_FSGetInternalRep, Tcl_FSRegister,
	* generic/tclPathObj.c:		Tcl_FSNewNativePath, Tcl_FSUnregister,
	* generic/tclTest.c:		Tcl_FSGetFileSystemForPath ...
	This change complies with TIP #27.
	***POTENTIAL INCOMPATIBILITY***

2008-07-28  Andreas Kupries  <[email protected]>

	* generic/tclBasic.c: Added missing ref count when creating an empty
	string as path (TclEvalEx). In 8.4 the missing code caused panics in
	the testsuite. It doesn't in 8.5. I am guessing that the code path
	with the missing the incr-refcount is not invoked any longer. Because
	the bug in itself is certainly the same.

2008-07-27  Donal K. Fellows  <[email protected]>

	* generic/tclOOMethod.c (PushMethodCallFrame): Remove hack that should
	have gone when this code was merged into Tcl.

2008-07-27  Jan Nijtmans  <[email protected]>

	* doc/Object.3:		CONSTified 3 functions using Tcl_ObjType
	* doc/ObjectType.3:	which all are supposed to be a constant, but
	* generic/tcl.decls:	this was not reflected in the API:
	* generic/tcl.h:	Tcl_RegisterObjType, Tcl_ConvertToType,
	* generic/tclDecls.h:	Tcl_GetObjType
	* generic/tclObj.c:	Introduced a CONST86_RETURN, so extensions
	* generic/tclCompCmds.c: which use Tcl_ObjType directly can be
	* generic/tclOOMethod.c: modified to compile against both Tcl 8.5 and
	* generic/tclTestobj.c:	Tcl 8.6. tclDecls.h regenerated
	This change complies with TIP #27.
	***POTENTIAL INCOMPATIBILITY***

2008-07-25  Andreas Kupries  <[email protected]>

	* test/info.test: More work on singleTestInterp usability. [1605269]

	* tests/info.test: Tests 38.* added, exactly testing the tracking of
	location for uplevel scripts. Resolved merge conflict on info-37.0,
	switched !singleTestInterp constraint to glob matching instead. Ditto
	info-22.8, removed constraint, more glob matching, and reduced the
	depth of the stack we check. More is coming, right now I want to
	commit the bug fixes.

	* tests/oo.test: Updated oo-22.1 for expanded location tracking.

	* generic/tclCompile.c (TclInitCompileEnv): Reorganized the
	initialization of the #280 location information to match the flow in
	TclEvalObjEx to get more absolute contexts.

	* generic/tclBasic.c (TclEvalObjEx): Added missing cleanup of extended
	location information.

2008-07-25  Daniel Steffen  <[email protected]>

	* tests/info.test (info-37.0): Add !singleTestInterp constraint;
	(info-22.8, info-23.0): switch to glob matching to avoid sensitivity
	to tcltest.tcl line number changes, remove knownBug constraint, fix
	expected result. [Bug 1605269]

2008-07-24  Jan Nijtmans  <[email protected]>

	* doc/Notifier.3:      CONSTified 4 functions in the Notifier which
	* doc/Thread.3:	       all have a Tcl_Time* in it which is supposed
	* generic/tcl.decls:   to be a constant, but this was not reflected
	* generic/tcl.h:       reflected in the API:
	* generic/tclDecls.h:	    Tcl_SetTimer, Tcl_WaitForEvent,
	* generic/tclNotify.c:	    Tcl_ConditionWait, Tcl_SetMaxBlockTime
	* macosx/tclMacOSXNotify.c:
	* generic/tclThread.c: Introduced a CONST86, so extensions which have
	* unix/tclUnixNotfy.c: have their own Notifier (are there any?) can
	* unix/tclUnixThrd.c:  can be modified to compile against both Tcl
	* win/tclWinNotify.c:  Tcl 8.5 and Tcl 8.6
	* win/tclWinThrd.c:    Regenerated tclDecls.h with "make stubs".
	This change complies with TIP #27
	***POTENTIAL INCOMPATIBILITY***

2008-07-23  Alexandre Ferrieux  <[email protected]>

	* tests/lrange.test: Added relative speed test to check for lrange
	in-place optimization committed 2008-06-30.
	* tests/binary.test: Added relative speed test to check for pure byte
	array CONCAT1 optimization committed 2008-06-30.

2008-07-23  Andreas Kupries  <[email protected]>

	* tests/info.test: Reordered the tests to have monotonously increasing
	numbers.

	* generic/tclBasic.c: Modified TclArgumentGet to reject pure lists
	* generic/tclCmdIL.c: immediately, without search. Reworked setup of
	* generic/tclCompile.c: eoFramePtr, doesn't need the line information,
	* tests/info.test: more sensible to have everything on line 1 when
	eval'ing a pure list. Updated the users of the line information to
	special case this based on the frame type (i.e.
	TCL_LOCATION_EVAL_LIST). Added a testcase demonstrating the new
	behaviour.

2008-07-23  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c (GetCommandSource): Added comment with
	explanation and warning for waintainers.

2008-07-22  Andreas Kupries  <[email protected]>

	* generic/tclCompile.c: Made the new TclEnterCmdWordIndex static, and
	* generic/tclCompile.h: ansified.

	* generic/tclBasic.c: Ansified the new functions. Added missing
	function comments.

	* generic/tclBasic.c: Reworked the handling of bytecode literals for
	* generic/tclCompile.c: #280 to fix the abysmal performance for deep
	* generic/tclCompile.h: recursion, replaced the linear search through
	* generic/tclExecute.c: the whole stack with another hashtable and
	* generic/tclInt.h: simplified the data structure used by the compiler
	by using an array instead of a hashtable. Incidentially this also
	fixes the memory leak reported via [Bug 2024937].

2008-07-22  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c:	 Added numLevels field to CommandFrame, let
	* generic/tclExecute.c:	 GetCommandSource use it. This solves [Bug
	* generic/tclInt.h:	 2017146]. Thx dgp for the analysis.

2008-07-21  Andreas Kupries  <[email protected]>

	* generic/tclBasic.c: Extended the existing TIP #280 system (info
	* generic/tclCmdAH.c: frame), added the ability to track the absolute
	* generic/tclCompCmds.c: location of literal procedure arguments, and
	* generic/tclCompile.c: making this information available to uplevel
	* generic/tclCompile.h: eval, and siblings. This allows proper
	* generic/tclInterp.c: tracking of absolute location through custom
	* generic/tclInt.h: (Tcl-coded) control structures based on uplevel,
	* generic/tclNamesp.c: etc.
	* generic/tclProc.c:
	* tests/info.test:

2008-07-21  Jan Nijtmans  <[email protected]>

	* generic/*.c: Fix [2021443] inconsistant "wrong # args" messages
	* win/tclWinReg.c
	* win/tclWinTest.c
	* tests/*.test

2008-07-21  Alexandre Ferrieux  <[email protected]>

	TIP #304 IMPLEMENTATION

	* generic/tcl.decls:	Public API
	* generic/tclIOCmds.c:	Generic part
	* unix/tclUnixPipe.c:	OS part
	* win/tclWinPipe.c:	OS part
	* tests/chan.test:	[chan pipe] tests
	* tests/ioCmd.test:	Modernized checks
	* tests/ioTrans.test:

2008-07-21  Pat Thoyts  <[email protected]>

	* generic/tclFCmd.c:  Inodes on windows are unreliable. [Bug 2015723]
	* tests/winFCmd.test: test rename with inode collision

2008-07-21  Miguel Sofer  <[email protected]>

	* generic/tcl.decls:	  Changed the implementation of
	* generic/tclBasic.c:	  [namespace import]; removed
	* generic/tclDecls.h:	  Tcl_NRObjProc, replaced with
	* generic/tclExecute.c:	  Tcl_NRCmdSwap (proposed public
	* generic/tclInt.h:	  NRE API). This should fix
	* generic/tclNRE.h:	  [Bug 582506].
	* generic/tclNamesp.c:
	* generic/tclStubInit.c:

	* generic/tclBasic.c:	 NRE: enabled calling NR commands
	* generic/tclExecute.c:	 from the callbacks. Completely
	* generic/tclInt.h:	 redone tailcall implementation
	* generic/tclNRE.h:	 using the new feature. [Bug 2021489]
	* generic/tclProc.c:
	* tests/NRE.test:

2008-07-20  Kevin B. Kenny  <[email protected]>

	* tests/fileName.test: Repaired the failing test fileName-15.7 from
	dkf's commit earlier today.

2008-07-20  Donal K. Fellows  <[email protected]>

	* generic/tclDictObj.c (SetDictFromAny): Make the list->dict
	transformation a bit more efficient; modern dicts are ordered and so
	we can round-trip through lists without needing the string rep at all.
	* generic/tclListObj.c (SetListFromAny): Make the dict->list
	transformation not lossy of internal representations and hence more
	efficient. [Bug 2008248] (ajpasadyn) but using a more efficient patch.

	* tests/fileName.test: Revise to reduce the obscurity of tests. In
	particular, all tests should now produce informative messages on
	failure and the quantity of [catch]-based obscurity is now greatly
	reduced; non-erroring is now checked for directly.

2008-07-19  Donal K. Fellows  <[email protected]>

	* tests/env.test: Add LANG to the list of variables that are not
	touched by the environment variable tests, so that subprocesses can
	get their system encoding correct.

	* tests/exec.test, tests/env.test: Rewrite so that non-ASCII
	characters are not used in the final comparison. Part of fixing [Bug
	1513659].

2008-07-18  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c:	 Optimization: replace calls to
	* generic/tclDictObj.c:	 Tcl_NRAddCallback with the macro
	* generic/tclExecute.c:	 TclNRAddCallback.
	* generic/tclInterp.c:
	* generic/tclNRE.h:
	* generic/tclNamesp.c:
	* generic/tclOO.c:
	* generic/tclOOBasic.c:
	* generic/tclOOCall.c:
	* generic/tclOOInt.h:
	* generic/tclOOMethod.c:
	* generic/tclProc.c:

2008-07-18  Donal K. Fellows  <[email protected]>

	* generic/tclOO.c (TclNRNewObjectInstance, FinalizeAlloc):
	* generic/tclOOBasic.c (TclOO_Class_Create, TclOO_Class_CreateNs)
	(TclOO_Class_New, FinalizeConstruction, AddConstructionFinalizer):
	NRE-enablement of the class construction methods.

2008-07-18  Miguel Sofer  <[email protected]>

	* tests/NRE.test:  Added basic tests for deep TclOO calls

	* generic/tcl.decls:	   Change the public api prefix from
	* generic/tcl.h:	   TclNR_foo to Tcl_NRfoo
	* generic/tclBasic.c:
	* generic/tclDecls.h:
	* generic/tclDictObj.c:
	* generic/tclExecute.c:
	* generic/tclInterp.c:
	* generic/tclNRE.h:
	* generic/tclNamesp.c:
	* generic/tclOO.c:
	* generic/tclOOBasic.c:
	* generic/tclOOCall.c:
	* generic/tclOOMethod.c:
	* generic/tclProc.c:
	* generic/tclStubInit.c:

2008-07-18  Donal K. Fellows  <[email protected]>

	* generic/tclOOBasic.c (TclOO_Object_Eval, FinalizeEval): NRE-enable
	the oo::object.eval method.

2008-07-18  Miguel Sofer  <[email protected]>

	* generic/tclDictObj.c (DictWithCmd, DictUpdateCmd): Fix refcounting
	bugs that caused crashes [Bug 2017857].

	* generic/tclBasic.c (TclNREvalObjEx): Streamline the management of
	the command frame (opt).

2008-07-17  Donal K. Fellows  <[email protected]>

	* generic/tclDictObj.c (DictWithCmd, FinalizeDictWith): Split the
	implementation of [dict with] so that it works with NRE.
	(DictUpdateCmd, FinalizeDictUpdate): Similarly for the non-compiled
	version of [dict update].

2008-07-16  George Peter Staplin  <[email protected]>

	* win/tclWinThrd.c: Test for TLS_OUT_OF_INDEXES to make certain that
	thread key creation is successful.

2008-07-16  Donal K. Fellows  <[email protected]>

	* generic/tclOO.c, generic/tclOOInt.h, generic/tclOOBasic.c:
	* generic/tclOOCall.c, generic/tclOOMethod.c: NRE-enable the TclOO
	implementation in Tcl. No change to public APIs, except that method
	implementations can now be NRE-aware if they choose (which normal
	methods and forwards are). On the other hand, callers of
	TclOOInvokeObject (which is only in the internal stub table) will need
	to deal with the fact that it's only safe to call inside an NRE-aware
	context.
	***POTENTIAL INCOMPATIBILITY***

2008-07-15  Miguel Sofer  <[email protected]>

	* tests/NRE.test:	Better constraint for testing the existence of
	* tests/stack.test:	teststacklimit, to insure that the test suite
				runs under tclsh.

	* generic/tclParse.c: Fixing incomplete reversion of "fix" for [Bug
	2017583], missing TclResetCancellation call.

2008-07-15  Donal K. Fellows  <[email protected]>

	* generic/tclBasic.c (Tcl_CancelEval): Fix blunder. [Bug 2018603]

	* doc/DictObj.3: Fix error in example. [Bug 2016740]

	* generic/tclNamesp.c (EnsembleUnknownCallback): Factor out some of
	the more complex parts of the ensemble code to make it easier to
	understand and hence to permit tighter compilation of code on the
	critical path.

2008-07-14  Miguel Sofer  <[email protected]>

	* generic/tclParse.c: Reverting the "fix" for [Bug 2017583], numLevel
	* tests/parse.test:   management and TclInterpReady check seems to be
			      necessary after all.

2008-07-14  Donal K. Fellows  <[email protected]>

	* generic/tclProc.c (TclNRApplyObjCmd, TclObjInterpProcCore):
	* generic/tclBasic.c (TclNR_AddCallback, TclEvalObjv_NR2):
	* generic/tclNRE.h (TEOV_callback): Change the callback storage type
	to use an array, so guaranteeing correct inter-member spacing and
	memory layout.

2008-07-14  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c:	 Remove unneeded TclInterpReady calls
	* generic/tclParse.c:

	* generic/tclBasic.c.:	 Embedded Tcl_Canceled() calls into
	* generic/tclExecute.c:	 TclInterpReady().
	* generic/tclParse.c:

	* generic/tclVar.c: Fix error message

	* generic/tclParse.c: Remove unnecessary numLevel management
	* tests/parse.test:   [Bug 2017583]

	* generic/tclBasic.c.:	 NRE left too many calls to
	* generic/tclExecute.c:	 TclResetCancellation lying around: it
	* generic/tclProc.c:	 only needs to be called prior to any
				 iPtr->numLevels++. Thanks mistachkin.

	* generic/tclBasic.c: TclResetCancellation() calls were misplaced
	(merge mishap); stray //. Thanks patthoyts.

	* generic/tclInt.h: The new macros TclSmallAlloc and TclSmallFree
	were badly defined under mem debugging [Bug 2017240] (thx das)

2008-07-13  Miguel Sofer  <[email protected]>

	NRE implementation [Patch 2017110]

	* generic/tcl.decls:	 The NRE infrastructure
	* generic/tcl.h:
	* generic/tclBasic.c:
	* generic/tclCmdAH.c:
	* generic/tclCompile.h:
	* generic/tclDecls.h:
	* generic/tclExecute.c:
	* generic/tclHistory.c:
	* generic/tclInt.decls:
	* generic/tclInt.h:
	* generic/tclIntDecls.h:
	* generic/tclNRE.h:
	* generic/tclStubInit.c:
	* unix/Makefile.in:

	* generic/tclInterp.c:	 NRE-enabling: procs, lambdas, uplevel,
	* generic/tclNamesp.c:	 same-interp aliases, ensembles, imports
	* generic/tclProc.c:	 and namespace_eval.

	* generic/tclTestProcBodyObj.c: New NRE specific tests (few, but
	* tests/NRE.test:		note that the thing is actually
					tested by the whole testsuite.

	* tests/interp.test:	 Fixed numLevel counting.
	* tests/parse.test:
	* tests/stack.test:

	* unix/configure:	 Removing support for the hacky nonportable
	* unix/configure.in:	 stack check: it is not needed anymore, Tcl
	* unix/tclConfig.h.in:	 is very thrifty on the C stack.
	* unix/tclUnixInit.c:
	* unix/tclUnixTest.c:
	* win/tclWin32Dll.c:

2008-07-08  Don Porter  <[email protected]>

	* generic/tclGet.c:	Corrected out of date comments and removed
	* generic/tclInt.decls:	internal routine TclGetLong() that's no
	longer used. If an extension is using this from the internal stubs
	table, it can shift to the public routine Tcl_GetLongFromObj() or
	can request addition of a public Tcl_GetLong().
	***POTENTIAL INCOMPATIBILITY***

	* generic/tclIntDecls.h:	make genstubs
	* generic/tclStubInit.c:

2008-07-08  Donal K. Fellows  <[email protected]>

	* doc/CrtInterp.3: Tighten up the descriptions of behaviour to make
	this page easier to read for a "Tcl 8.6" audience.

2008-07-07  Andreas Kupries  <[email protected]>

	* generic/tclCmdIL.c (InfoFrameCmd): Fixed unsafe idiom of setting
	the interp result found by Don Porter.

2008-07-07  Donal K. Fellows  <[email protected]>

	* doc/regexp.n, doc/regsub.n: Correct examples. [Bug 1982642]

2008-07-06  Donal K. Fellows  <[email protected]>

	* doc/lindex.n: Improve examples.

2008-07-03  Andreas Kupries  <[email protected]>

	* generic/tclIORChan.c (InvokeTclMethod): Fixed the memory leak
	reported in [Bug 1987821]. Thanks to Miguel for the report and Don
	Porter for tracking the cause down.

2008-07-03  Don Porter  <[email protected]>

	* library/package.tcl:	Removed [file readable] testing from
	[tclPkgUnknown] and friends. We find out soon enough whether a file is
	readable when we try to [source] it, and not testing before allows us
	to workaround the bugs on some common filesystems where [file
	readable] lies to us. [Patch 1969717]

2008-07-01  Donal K. Fellows  <[email protected]>

	* generic/regc_nfa.c (duptraverse): Impose a maximum stack depth on
	the single most recursive part of the RE engine. The actual maximum
	may need tuning, but that needs a system with a small stack to carry
	out. [Bug 1905562]

	* tests/string.test: Eliminate non-ASCII characters from the actual
	test script. [Bug 2006884]

2008-06-30  Donal K. Fellows  <[email protected]>

	* doc/ObjectType.3: Clean up typedef formatting.

2008-06-30  Don Porter  <[email protected]>

	* doc/ObjectType.3:	Updated documentation of the Tcl_ObjType
	struct to match expectations of Tcl 8.5. [Bug 1917650]

2008-06-30  Alexandre Ferrieux  <[email protected]>

	* generic/tclCmdIL.c: Lrange cleanup and in-place optimization. [Patch
	1890831]

	* generic/tclExecute.c: Avoid useless String conversion for CONCAT1 of
	pure byte arrays. [Patch 1953758]

2008-06-29  Donal K. Fellows  <[email protected]>

	* doc/*.1, doc/*.3, doc/*.n: Many small updates, purging out of date
	change bars and cleaning up the formatting of typedefs. Added a few
	missing bits of documentation in the process.

2008-06-29  Don Porter  <[email protected]>

	* generic/tclPathObj.c:	 Plug memory leak in [Bug 1999176] fix. Thanks
	to Rolf Ade for detecting.

2008-06-29  Donal K. Fellows  <[email protected]>

	* doc/interp.n: Corrected order of subcommands. [Bug 2004256]
	Removed obsolete (i.e. 8.5) .VS/.VE pairs.

	* doc/object.n (EXAMPLES): Fix incorrect usage of oo::define to be
	done with oo::objdefine instead. [Bug 2004480]

2008-06-28  Don Porter  <[email protected]>

	* generic/tclPathObj.c:	 Plug memory leak in [Bug 1972879] fix. Thanks
	to Rolf Ade for detecting and Dan Steffen for the fix. [Bug 2004654]

2008-06-26  Andreas Kupries  <[email protected]>

	* unix/Makefile.in: Followup to my change of 2008-06-25, make code
	generated by the Makefile and put into the installed tm.tcl
	conditional on interpreter safeness as well. Thanks to Daniel Steffen
	for reminding me of that code.

2008-06-25  Don Porter  <[email protected]>

	*** 8.6a1 TAGGED FOR RELEASE ***

	* changes:	Updates for 8.6a1 release.

	* generic/tclOO.h:	Bump to TclOO 0.5.

2008-06-25  Andreas Kupries  <[email protected]>

	* library/tm.tcl:   Modified the handling of Tcl Modules and of the
	* library/safe.tcl: Safe Base to interact nicely with each other,
	* library/init.tcl: enabling requiring Tcl Modules in safe
	* tests/safe.test:  interpreters. [Bug 1999119]

2008-06-25  Pat Thoyts  <[email protected]>

	* win/rules.vc: Fix versions of dde and registry dlls
	* win/makefile.vc: Fix problem building with staticpkg option

2008-06-24  Don Porter  <[email protected]>

	* generic/tclPathObj.c: Fixed some internals management in the "path"
	Tcl_ObjType for the empty string value. Problem led to a crash in the
	command [glob -dir {} a]. [Bug 1999176]

2008-06-24  Pat Thoyts  <[email protected]>

	* doc/fileevent.n: Fix examples and comment on eof use. [Bug 1995063]

2008-06-23  Don Porter  <[email protected]>

	* generic/tclPathObj.c: Fixed bug in Tcl_GetTranslatedPath() when
	operating on the "Special path" variant of the "path" Tcl_ObjType
	intrep. A full normalization was getting done, in particular, coercing
	relative paths to absolute, contrary to what the function of producing
	the "translated path" is supposed to do. [Bug 1972879]

2008-06-20  Don Porter  <[email protected]>

	* changes:	Updates for 8.6a1 release.

	* generic/tclInterp.c:	Fixed completely boneheaded mistake that
	* tests/interp.test:	[interp bgerror $slave] and [$slave bgerror]
	would always act like [interp bgerror {}]. [Bug 1999035]

	* tests/chanio.test:	Corrected flawed tests revealed by a -debug 1
	* tests/cmdAH.test:	-singleproc 1 test suite run.
	* tests/event.test:
	* tests/interp.test:
	* tests/io.test:
	* tests/ioTrans.test:
	* tests/namespace.test:

	* tests/encoding.test:	Make failing tests pass again. [Bug 1972867]

2008-06-19  Donal K. Fellows  <[email protected]>

	* generic/tclOO.c (Tcl_ObjectContextInvokeNext): Corrected 'next' (at
	* tests/oo.test (oo-7.8):	end of a call chain) to make it
	* doc/next.n:			consistent with the TIP. [Bug 1998244]

	* generic/tclOOCall.c (AddSimpleClassChainToCallContext): Make sure
	* tests/oo.test (oo-14.8): that class mixins are processed in the
	documented order. [Bug 1998221]

2008-06-19  Don Porter  <[email protected]>

	* changes:	Updates for 8.6a1 release.

	* README:		Bump version number to 8.6a1
	* generic/tcl.h:
	* library/init.tcl:
	* tools/tcl.wse.in:
	* unix/configure.in:
	* unix/tcl.spec:
	* win/configure.in:

	* unix/configure:	autoconf-2.59
	* win/configure:

2008-06-17  Andreas Kupries  <[email protected]>

	* generic/tclClock.c (ClockConvertlocaltoutcObjCmd): Removed left
	over debug output.

2008-06-17  Andreas Kupries  <[email protected]>

	* doc/tm.n: Followup to changelog entry 2008-03-18 regarding
	::tcl::tm::Defaults. Updated the documentation to not only mention the
	new (underscored) form of environment variable names, but make it the
	encouraged form as well. [Bug 1914604]

2008-06-17  Kevin Kenny  <[email protected]>

	* generic/tclClock.c (ConvertLocalToUTC):
	* tests/clock.test (clock-63.1): Fixed a bug where the internal
	ConvertLocalToUTC command segfaulted if passed a dictionary without
	the 'localSeconds' key. To the best of my knowledge, the bug was not
	observable in the [clock] command itself.

2008-06-16  Andreas Kupries  <[email protected]>

	* generic/tclCmdIL.c (TclInfoFrame): Moved the code looking up the
	* tests/info.test: information for key 'proc' out of the
	TCL_LOCATION_BC branch to after the switch, this is common to all
	frame types. Updated the testsuite to match. This was exposed by the
	2008-06-08 commit (Miguel), switching uplevel from direct eval to
	compilation. [Bug 1987851]

2008-06-16  Andreas Kupries  <[email protected]>

	* tests/ioTrans.test (iortrans-11.*): Fixed same issue as for
	iortrans.tf-11.*, cleanup of temp file, making this a followup to the
	entry on 2008-06-10 by myself.

2008-06-13  David Gravereaux  <[email protected]>

	* win/rules.vc: SYMBOLS macro is now being set to zero when $(OPTS) is
	not available.
	* win/makefile.vc: The Stubs source files (tclStubLib.c and
	tclOOStubLib.c) should not be compiled with the -GL flag.

2008-06-13  Joe Mistachkin  <[email protected]>

	TIP #285 IMPLEMENTATION

	* doc/Eval.3: Added documentation for the Tcl_CancelEval and
	Tcl_Canceled functions and the TCL_CANCEL_UNWIND flag bit.
	* doc/after.n: Corrected the spelling of 'canceled' in the
	documentation.
	* doc/interp.n: Added documentation for [interp cancel].
	* generic/tcl.decls: Added the Tcl_CancelEval and Tcl_Canceled
	functions to the stubs table.
	* generic/tcl.h: Added the TCL_CANCEL_UNWIND flag bit.
	* generic/tclBasic.c: The bulk of the script cancellation
	functionality is defined here. Added code to initialize and manage the
	script cancellation hash table in a thread-safe manner. Reset script
	cancellation flags prior to increasing the nesting level (if the
	nesting level is currently zero) and always cooperatively check for
	script cancellation near the start of TclEvalObjvInternal and after
	invoking async handlers.
	* generic/tclDecls.h: Regenerated.
	* generic/tclEvent.c: Call TclFinalizeEvaluation during finalization
	to cleanup the script cancellation hash table. During [vwait], always
	cooperatively check for script cancellation. Corrected the spelling of
	'canceled' in comments to be consistent with the documentation.
	* generic/tclExecute.c: Reset script cancellation flags prior to
	increasing the nesting level (if the nesting level is currently zero)
	and always cooperatively check for script cancellation after invoking
	async handlers. Prevent [catch] from catching script cancellation when
	the TCL_CANCEL_UNWIND flag is set (similar to the manner used by TIP
	143 when a limit has been exceeded).
	* generic/tclInt.decls: Added TclResetCancellation to the internal
	stubs table.
	* generic/tclInt.h: Added asyncCancel and asyncCancelMsg fields to the
	private Interp structure. Added private interp flag value CANCELED to
	help control script cancellation.
	* generic/tclIntDecls.h: Regenerated.
	* generic/tclInterp.c (Tcl_InterpObjCmd): Added [interp cancel]
	subcommand.
	* generic/tclNotify.c (Tcl_DeleteEventSource): Corrected the spelling
	of 'canceled' in comments to be consistent with the documentation.
	* generic/tclParse.c: Reset script cancellation flags prior to
	* generic/tclProc.c: increasing the nesting level (if the nesting
	level is currently zero) and cooperatively check for script
	cancellation prior to evaluating commands.
	* generic/tclStubInit.c: Regenerated.
	* generic/tclThreadTest.c (Tcl_ThreadObjCmd): Added script
	cancellation support ([testthread cancel]).
	Modified [testthread id] to allow querying of the 'main' thread ID.
	Corrected comments to reflect the actual command syntax. Made
	[testthread wait] cooperatively check for script cancellation. Added
	[testthread event] to allow for processing one pending event without
	blocking.
	* generic/tclTimer.c: Delay for a maximum of 500 milliseconds prior to
	checking for async handlers and script cancellation.
	* tests/cmdAH.test: Changed [interp c] to [interp create].
	* tests/interp.test: Added and fixed tests for [interp cancel].
	* tests/thread.test: Added tests for script cancellation via
	[testthread cancel].
	* tools/man2help2.tcl: Fixed problems with WinHelp target (see
	* tools/man2tcl.c: [Bug 1934200], [Bug 1934265], and [Bug 1934272]).
	* win/makefile.vc: Added 'pdbs' option for Windows build rules to
	* win/rules.vc:	   allow for non-debug builds with full symbols.
	* win/tcl.hpj.in: Corrected version for WinHelp target.
	* win/tclWinNotify.c: Used SleepEx and WaitForSingleObjectEx on
	* win/tclWinThrd.c: Windows because they are alertable.

2008-06-12  Daniel Steffen  <[email protected]>

	* unix/Makefile.in:		Add complete deps on tclDTrace.h.

	* generic/tclOO.c:		Use TclOOStubs hooks field to retrieve
	* generic/tclOODecls.h:		TclOOIntStubs pointer. [Bug 1980953]
	* generic/tclOOIntDecls.h:
	* generic/tclOOStubInit.c:
	* generic/tclOOStubLib.c:

	* generic/tclIORTrans.c:	Fix signed <-> unsigned cast warnings.

	* unix/Makefile.in:		Clean generated tclDTrace.h file.
	* unix/configure.in (SunOS):	Fix static DTrace-enabled build.

	* unix/tcl.m4 (SunOS-5.11): Fix 64bit amd64 support with gcc & Sun cc.
	* unix/configure: autoconf-2.59

	* macosx/Tcl.xcodeproj/project.pbxproj:	Add tclIORTrans.c; updates and
						cleanup for Xcode 3.1/Leopard.
	* macosx/Tcl.xcode/project.pbxproj:	Sync Tcl.xcodeproj changes.
	* macosx/README:			Document new build configs.

2008-06-10  Joe English  <[email protected]>

	* generic/tclEncoding.c(UtfToUtfProc): Avoid unwanted sign extension
	when converting incomplete UTF-8 sequences. See [Bug 1908443] for
	details.

2008-06-10  Andreas Kupries  <[email protected]>

	* tests/ioTrans.test (iortrans.tf-6.1): Fixed the [Bug 1988552],
	reported by Kevin. Have to close the channel before removal of the
	file. Fixed same bug in test 'iortrans.tf-11.0', after fixing missing
	cleanup of the file in 'iortrans.tf-11.*'. Lastly fixed the names of
	the threaded tests 'iortrans-8.*' to the correct 'iortrans.tf-8.*'.

2008-06-09  Andreas Kupries  <[email protected]>

	* generic/tclIORTrans.c (ReflectInput): Fixed a bug triggered by Pat
	Thoyts <[email protected]>. Reset the EOF flag after
	draining the Tcl level into the result buffer, to make sure that the
	result buffer will be drained as well by repeated calls to
	ReflectInput should it contain more than one buffer-full of data.
	Without that reset the higher I/O system will not call on ReflectInput
	anymore due to the assumed EOF, thus losing the data which did not fit
	in the buffer of the call which caused the eof and drain.

2008-06-09  Donal K. Fellows  <[email protected]>

	* generic/tclOOCall.c (TclOOGetSortedMethodList): Plug memory leak
	that occurred when all methods were hidden. [Bug 1987817]

2008-06-08  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c:	   Compilation of uplevel scripts, allow
	* generic/tclCompCmds.c:   non-body compiled scripts to access the
	* generic/tclCompile.c:	   LVT (but not to extend it) and enable the
	* generic/tclCompile.h:	   canonical list opt to sidestep the
	* generic/tclExecute.c:	   compiler. [Patch 1973096]
	* generic/tclProc.c:
	* tests/uplevel.test:

2008-06-06  Andreas Kupries  <[email protected]>

	TIP #230 IMPLEMENTATION

	* generic/tclIOCmd.c: Integration of transform commands into 'chan'
			      ensemble.
	* generic/tclInt.h: Definitions of the transform commands.
	* generic/tclIORTrans.c: Implementation of the reflection transforms.
	* tests/chan.test:  Tests updated for new sub-commands of 'chan'.
	* tests/ioCmd.test: Tests updated for new sub-commands of 'chan'.
	* tests/ioTrans.test: Whole new set of tests for the reflection
			      transform.
	* unix/Makefile.in: Integration of new files into build rules.
	* win/Makefile.in:  Integration of new files into build rules.
	* win/makefile.vc:  Integration of new files into build rules.

	NOTE: The file 'tclIORTrans.c' has a lot of code in common with the
	      file 'tclIORChan.c', as that made it much easier to develop the
	      reference implementation as a separate module. Now that the
	      transforms have been committed the one thing left to do is to go
	      over both modules and see which of the common parts we can
	      factor out and share.

2008-06-04  Pat Thoyts  <[email protected]>

	* generic/tclBinary.c: TIP #317 implementation
	* tests/binary.test:

2008-06-02  Kevin B. Kenny  <[email protected]>

	* generic/tclOO.c (ReleaseClassContents): Fix the one remaining
	valgrind complaint about oo.test, caused by failing to protect the
	Object as well as the Class corresponding to a subclass being deleted
	and hence getting a freed-memory read when attempting to delete the
	class command. [Bug 1981001]

2008-06-01  Donal K. Fellows  <[email protected]>

	* generic/tclOOMethod.c (Tcl_NewMethod): Complete the fix of [Bug
	1981001], previous fix was incomplete though helpful in telling me
	where to look.

2008-06-01  Joe Mistachkin  <[email protected]>

	* win/Makefile.in: Add tclOO genstubs to Windows makefiles and remove
	* win/makefile.vc: -DBUILD_tcloo because it is no longer required.

2008-06-01  Kevin B. Kenny  <[email protected]>

	* generic/tclOODecls.h:	   Added the swizzling of DLLEXPORT and
	* generic/tclOOIntDecls.h: DLLIMPORT needed to make EXTERN work.

	* generic/tclDictObj.c:	 Added missing initializers to the ensemble
				 map to silence a compiler warning. Thanks to
				 George Peter Staplin for the report.

	* generic/tclOOMethod.c: Fix a bug where the refcount of a method was
				 reset if the method was redefined while there
				 was an active invocation. [Bug 1981001]

2008-06-01  Donal K. Fellows  <[email protected]>

	* generic/tclOO.decls, unix/Makefile.in (genstubs): Make generation of
	stub tables correct.
	* generic/tclOO{Decls.h,IntDecls.h,StubInit.c,StubLib.c}: Fixes to
	make the generation work correctly, removing subtle differences
	between output of different versions of stub generator.

2008-06-01  Daniel Steffen  <[email protected]>

	* generic/tclOOStubLib.c:	Ensure use of tcl stubs; include in
	* unix/Makefile.in:		stub lib; disable broken tclOO
					genstubs

	* generic/tclOO.c:		Make tclOO stubs tables 'static const'
	* generic/tclOODecls.h:		and stub table pointers MODULE_SCOPE
	* generic/tclOOIntDecls.h:	(change generated files manually
	* generic/tclOOStubInit.c:	pending genstubs support for tclOO).
	* generic/tclOOStubLib.c:

	* generic/tclOO.c:		Fix warnings for 'int<->ptr
	* generic/tclOOCall.c:		conversion' and 'signed vs unsigned
	* generic/tclOOMethod.c:	comparison'.

	* tests/msgcat.test:	Fix for ::tcl::mac::locale with @modifier.

	* tools/tsdPerf.tcl:	Use [info sharedlibextension]

	* unix/tclConfig.h.in:	autoheader-2.59

	* macosx/Tcl.xcodeproj/project.pbxproj:	Add new tclOO files; add debug
	* macosx/README:			configs with corefoundation
						disabled and with gcov; update
						to Xcode 3.1.

2008-05-31  Donal K. Fellows  <[email protected]>

	* generic/tclOO.c (InitFoundation): Correct reference counting for
	strings used when creating the constructor for classes.
	* generic/tclOOMethod.c (TclOODelMethodRef): Correct fencepost error
	in reference counting of method implementation structures.
	* tests/oo.test (oo-0.5): Added a test to detect a memory leak problem
	relating to disposal of the core object system.

	TIP#257 IMPLEMENTATION

	* generic/tclBasic.c, generic/tclOOInt.h: Correct declarations.
	* win/Makefile.in, win/makefile.bc, win/makefile.vc: Build support for
	Win32, from Joe Mistachkin. [Patch 1980861]

	* generic/tclOO*, doc/*, tests/oo.test: Port of implementation of
	TclOO to sit directly inside Tcl. Note that this is incomplete (e.g.
	no build support yet for Windows).

2008-05-26  Jeff Hobbs  <[email protected]>

	* tests/io.test (io-53.9): Need to close chan before removing file.

2008-05-26  Donal K. Fellows  <[email protected]>

	* win/makefile.bc:		    Remove deprecated winhelp target.
	* win/Makefile.in, win/makefile.vc: It didn't work correctly anyway.

2008-05-23  Andreas Kupries  <[email protected]>

	* win/tclWinChan.c (FileWideSeekProc): Accepted a patch by Alexandre
	Ferrieux <[email protected]> to fix the [Bug 1965787].
	'tell' now works for locations > 2 GB as well instead of going
	negative.

	* generic/tclIO.c (Tcl_SetChannelBufferSize): Accepted a patch by
	* tests/io.test: Alexandre Ferrieux <[email protected]>
	* tests/chanio.test: to fix the [Bug 1969953]. Buffersize outside of
	the supported range are now clipped to nearest boundary instead of
	ignored.

2008-05-22  Don Porter  <[email protected]>

	* generic/tclNamesp.c (Tcl_LogCommandInfo):	Restored ability to
	handle the argument value length = -1. Thanks to Chris Darroch for
	discovering the bug and providing the fix. [Bug 1968245]

2008-05-21  Don Porter  <[email protected]>

	* generic/tclParse.c (ParseComment):	The new TclParseAllWhiteSpace
	* tests/parse.test (parse-15.60):	routine has no mechanism to
	return the "incomplete" status of "\\\n" so calling this routine
	anywhere that can be reached within a Tcl_ParseCommand() call is a
	mistake. In particular, ParseComment() must not use it. [Bug 1968882]

2008-05-20  Donal K. Fellows  <[email protected]>

	* generic/tclNamesp.c (Tcl_SetNamespaceUnknownHandler): Corrected odd
	logic for handling installation of namespace unknown handlers which
	could lead too very strange things happening in the error case.

2008-05-16  Miguel Sofer  <[email protected]>

	* generic/tclCompile.c: Fix crash with tcl_traceExec. Found and fixed
	by Alexander Pasadyn. [Bug 1964803]

2008-05-15  Pat Thoyts  <[email protected]>

	* win/makefile.vc: We should use the thread allocator for threaded
	* win/rules.vc:	   builds. Added 'tclalloc' option to disable.

2008-05-09  George Peter Staplin  <[email protected]>

	* tools/tsdPerf.c:	A loadable Tcl extension for testing TSD
	performance.
	* tools/tsdPerf.tcl:	A simplistic tool that uses the thread
	extension and tsdPerf.so to get some performance metrics by,
	simulating, simple TSD contention.

2008-05-09  George Peter Staplin  <[email protected]>

	* generic/tcl.h:	Make Tcl_ThreadDataKey a void *.
	* generic/tclInt.h:	Change around some function names and add some
	new per-platform declarations for thread-specific data functions.
	* generic/tclThread.c:	Make use of of the new function names that no
	longer have a Tclp prefix.
	* generic/tclThreadStorage.c: Replace the core thread-specific data
	(TSD) mechanism with an array offset solution that eliminates the hash
	tables, and only uses one slot of native TSD. Many thanks to Kevin B.
	Kenny for his help with this.

	* unix/tclUnixThrd.c:	Add platform-specific TSD functions for use by
	* win/tclWinThrd.c:	tclThreadStorage.c.

2008-05-09  Kevin B. Kenny  <[email protected]>

	* tests/dict.test (dict-19.2): Corrected a bug where the test was
	changed to use [apply] instead of a temporary proc, but the cleanup
	script still attempted to delete the temporary proc.

2008-05-07  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmds.c (TclCompileDictAppendCmd): Fix silly off-by
	one error that caused a crash every time a compiled 'dict append' with
	more than one argument was used. Found by Colin McCormack.

2008-05-02  Pat Thoyts  <[email protected]>

	* generic/tclBasic.c:	 Converted the [binary] command into an
	* generic/tclBinary.c:	 ensemble.
	* generic/tclInt.h:
	* test/binary.test:	 Updated the error tests for ensemble errors.

	* generic/tclFileName.c: Reverted accidental commit of TIP 316 APIs.

2008-04-27  Donal K. Fellows  <[email protected]>

	* */*.c: A large tranche of getting rid of pre-C89-isms; if your
	compiler doesn't support things like proper function declarations,
	'void' and 'const', borrow a proper one when building Tcl. (The header
	files allow building things that link against Tcl with really ancient
	compilers still; the requirement is just when building Tcl itself.)

2008-04-26  Zoran Vasiljevic  <[email protected]>

	* generic/tclAsync.c: Tcl_AsyncDelete(): panic if attempt to locate
	handler token fails. Happens when some other thread attempts to delete
	somebody else's token.

	Also, panic early if we find out the wrong thread attempting to delete
	the async handler (common trap). As, only the one that created the
	handler is allowed to delete it.

2008-04-24  Andreas Kupries  <[email protected]>

	* tests/ioCmd.test: Extended testsuite for reflected channel
	implementation. Added test cases about how it handles if the rug is
	pulled out from under a channel (= killing threads, interpreters
	containing the tcl command for a channel, and channel sitting in a
	different interpreter/thread.)

	* generic/tclIORChan.c: Fixed the bugs exposed by the new testcases,
	redone most of the cleanup and exit handling.

2008-04-21  Don Porter  <[email protected]>

	* generic/tclIOUtil.c:		Removed all code delimited by
	* generic/tclTest.c:		USE_OBSOLETE_FS_HOOKS, completing
	* tests/ioCmd.test:		the deprecation path for these
	* tests/ioUtil.test (removed):	obsolete interfaces. (Code was active
	in Tcl 8.4, present but enabled only by customized compile switch in
	Tcl 8.5, and now completely gone for Tcl 8.6). Also removed all tests
	relevant only to the removed interfaces.

2008-04-19  George Peter Staplin  <[email protected]>

	* doc/Ensemble.3: Fix a typo: s/defiend/defined/
	Thanks to hat0 for spotting this.

2008-04-16  Daniel Steffen  <[email protected]>

	* generic/tclInt.h:		Make stubs tables 'static const' and
	* generic/tclStubInit.c:	export only module-scope pointers to
	* generic/tclStubLib.c:		the main stubs tables (for package
	* tools/genStubs.tcl:		initialization). [Patch 1938497]
	* generic/tclBasic.c (Tcl_CreateInterp):
	* generic/tclTomMathInterface.c (TclTommath_Init):

	* generic/tclInt.h:		Revise Tcl_SetNotifier() to use a
	* generic/tclNotify.c:		module-scope hooks table instead of
	* generic/tclStubInit.c:	runtime stubs-table modification;
	* macosx/tclMacOSXNotify.c:	ensure all hookable notifier functions
	* win/tclWinNotify.c:		check for hooks; remove hook checks in
	* unix/tclUnixNotfy.c:		notifier API callers. [Patch 1938497]

2008-04-15  Andreas Kupries  <[email protected]>

	* generic/tclIO.c (CopyData):	Applied another patch by Alexandre
	* io.test (io-53.8a):		Ferrieux <[email protected]>,
	* chanio.test (chan-io-53.8a):	to shift EOF handling to the async
	part of the command if a callback is specified, should the channel be
	at EOF already when fcopy is called. Testcase by myself.

2008-04-15  Daniel Steffen  <[email protected]>

	* unix/Makefile.in:	Adjust tclDTrace.h dependencies for removal
				of tclStubLib.o from TCL_OBJS. [Bug 1942795]

2008-04-14  Kevin B. Kenny  <[email protected]>

	* unix/tclUnixTime.c (NativeGetTime): Removed obsolete use of
	'struct timezone' in the call to 'gettimeofday'. [Bug 1942197]

	* tests/clock.test (clock-33.5, clock-33.5a, clock-33.8, clock-33.8a):
	Added comments to the test that it can fail on a heavily loaded
	system.

2008-04-10  Andreas Kupries  <[email protected]>

	* generic/tclIOCmd.c (Tcl_FcopyObjCmd): Keeping check for negative
	values, changed to not be an error, but behave like the special value
	-1 (copy all, default).

	* tests/iocmd.test (iocmd-15.{12,13}): Removed.

	* tests/io.test (io-52.5{,a,b}): Reverted last change, added
	* tests/chanio.test (chan-io-52.5{,a,b}): comment regarding the
	meaning of -1, added two more testcases for other negative values,
	and input wrapped to negative.

2008-04-09  Donal K. Fellows  <[email protected]>

	* tests/{fCmd,unixFCmd,winFCmd,winFile}.test: Tidying up of the test
	suite to make better use of tcltest2 and be clearer about what is
	being tested.

	* win/Makefile.in (html): Added target for doing convenient
	documentation builds, mirroring the one from unix/Makefile.

2008-04-09  Andreas Kupries  <[email protected]>

	* tests/chanio.test (chan-io-52.5): Removed '-size -1' from test,
	* tests/io.test (io-52.5): does not seem to have any bearing, and was
	an illegal value. Test case is not affected by the value of -size,
	test flag restoration and that evrything was properly copied.

	* generic/tclIOCmd.c (Tcl_FcopyObjCmd): Added checking of -size value
	* tests/ioCmd.test (iocmd-15.{13,14}): to reject negative values, and
	values overflowing 32-bit signed. Basic patch by Alexandre Ferrieux
	<[email protected]>, with modifications from me to
	separate overflow from true negative value. Extended testsuite. [Bug
	1557855]

2008-04-09  Daniel Steffen  <[email protected]>

	* tests/chanio.test (chan-io-53.8,53.9,53.10): Fix typo & quoting for
	* tests/io.test (io-53.8,53.9,53.10):	       spaces in builddir path

2008-04-08  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c: Added comments to the alignment macros used in
	GrowEvaluationStack() and friends.

2008-04-08  Daniel Steffen  <[email protected]>

	* tools/genStubs.tcl:	Revert erroneous 2008-04-02 change marking
				*StubsPtr as EXTERN instead of extern.

	* generic/tclDecls.h:	make genstubs
	* generic/tclIntDecls.h:
	* generic/tclIntPlatDecls.h:
	* generic/tclPlatDecls.h:
	* generic/tclTomMathDecls.h:

2008-04-07  Andreas Kupries  <[email protected]>

	* tests/io.test (io-53.10): Testcase for bi-directional fcopy.
	* tests/chanio.test:
	* generic/tclIO.c: Additional changes to data structures for fcopy and
	* generic/tclIO.h: channels to perform proper cleanup in case of a
	channel having two background copy operations running as is now
	possible.

	* generic/tclIO.c (BUSY_STATE, CheckChannelErrors, TclCopyChannel):
	New macro, and the places using it. This change allows for
	bi-directional fcopy on channels. Thanks to Alexandre Ferrieux
	<[email protected]> for the patch. [Bug 1350564]

2008-04-07  Reinhard Max  <[email protected]>

	* generic/tclStringObj.c (Tcl_AppendFormatToObj): Fix [format {% d}]
	so that it behaves the same way as in 8.4 and as C's printf().
	* tests/format.test: Add a test for '% d' and '%+d'.

2008-04-05  Kevin B. Kenny  <[email protected]>

	* win/tclWinFile.c: (WinSymLinkDirectory): Fixed a problem that Tcl
	was creating an NTFS junction point (IO_REPARSE_TAG_MOUNT_POINT) but
	filling in the union member for a Vista symbolic link. We had gotten
	away with this error because the union member
	(SymbolicLinkReparseBuffer) was misdefined in this file and in the
	'winnt.h' in early versions of MinGW. MinGW 3.4.2 has the correct
	definition of SymbolicLinkReparseBuffer, exposing the mismatch, and
	making tests cmdAH-19.4.1, fCmd-28.*, and filename-11.* fail.
	* tests/chanio.test (chan-io-53.9):
	* tests/io.test (io-53.9): Made test cleanup robust against the
	possibility of slow process shutdown on Windows.

	* win/tcl.m4: Added -D_CRT_SECURE_NO_DEPRECATE and
	-DCRT_NONSTDC_NO_DEPRECATE to the MSVC compilation flags so that the
	compilation doesn't barf on perfectly reasonable Posix system calls.
	* win/configure: Manually patched (don't have the right autoconf to
	hand).

2008-04-04  Andreas Kupries  <[email protected]>

	* tests/io.test (io-53.9): Added testcase for [Bug 780533], based
	* tests/chanio.test: on Alexandre's test script. Also fixed problem
	with timer in preceding test, was not canceled properly in the ok case

2008-04-04  Andreas Kupries  <[email protected]>

	* generic/tclIORChan.c (ReflectOutput): Allow zero return from write
	when input was zero-length anyway. Otherwise keept it an error, and
	separate the message from 'written too much'.

	* tests/ioCmd.test (iocmd-24.6): Testcase updated for changed message.

	* generic/tclIORChan.c (ReflectClose): Added missing removal of the
	now closed channel from the reflection map. Before we could crash the
	system by invoking 'chan postevent' on a closed reflected channel,
	dereferencing the dangling pointer in the map.

	* tests/ioCmd.test (iocmd-31.8): Testcase for the above.

2008-04-03  Andreas Kupries  <[email protected]>

	* generic/tclIO.c (CopyData): Applied patch [Bug 1932639] to
	* tests/io.test: prevent fcopy from calling -command synchronously
	* tests/chanio.test: the first time. Thanks to Alexandre Ferrieux
	<[email protected]> for report and patch.

2008-04-02  Daniel Steffen  <[email protected]>

	* generic/tcl.decls:	Remove 'export' declarations of symbols now
				only in libtclstub and no longer in libtcl.

	* generic/tclStubLib.c:	Make symbols in libtclstub.a MODULE_SCOPE to
	* tools/genStubs.tcl:	avoid exporting them from libraries that link
				with -ltclstub; constify tcl*StubsPtr and stub
				table hook pointers. [Bug 1819422]

	* generic/tclDecls.h:	make genstubs
	* generic/tclIntDecls.h:
	* generic/tclIntPlatDecls.h:
	* generic/tclPlatDecls.h:
	* generic/tclStubInit.c:
	* generic/tclTomMathDecls.h:

2008-04-02  Andreas Kupries  <[email protected]>

	* generic/tclIO.c (CopyData): Applied patch for fcopy problem [Bug
	780533], with many thanks to Alexandre Ferrieux
	<[email protected]> for tracking it down and providing a
	solution. Still have to convert his test script into a proper test
	case.

2008-04-01  Andreas Kupries  <[email protected]>

	* generic/tclStrToD.c: Applied patch for [Bug 1839067] (fp rounding
	* unix/tcl.m4:	       setup on solaris x86, native cc), provided by
			       Michael Schlenker.

2008-04-01  Don Porter  <[email protected]>

	* generic/tclStubLib.c:	Removed needless #ifdef complexity.

	* generic/tclStubLib.c (Tcl_InitStubs):	Added missing error message.
	* generic/tclPkg.c (Tcl_PkgInitStubsCheck):

	* README:		Bump version number to 8.6a0
	* generic/tcl.h:
	* library/init.tcl:
	* macosx/Tcl-Common.xcconfig:
	* macosx/Tcl.pbproj/default.pbxuser:
	* macosx/Tcl.pbproj/project.pbxproj:
	* tools/tcl.wse.in:
	* unix/configure.in:
	* unix/tcl.spec:
	* win/README:
	* win/configure.in:
	* win/makefile.bc:
	* win/tcl.m4:

	* unix/configure:	autoconf-2.59
	* win/configure:

	* generic/tclBasic.c:	Revised stubs-generation tool and interp
	* tools/genStubs.tcl:	creation so that "tclStubsPtr" is not present
	* unix/Makefile.in:	in libtcl.so, but is present only in
	* win/Makefile.in:	libtclstub.a. This tightens up the rules for
	* win/makefile.bc:	users of the stubs interfaces. [Bug 1819422]
	* win/makefile.vc:

	* generic/tclDecls.h:	make genstubs
	* generic/tclIntDecls.h:
	* generic/tclIntPlatDecls.h:
	* generic/tclPlatDecls.h:
	* generic/tclTomMathDecls.h:

2008-03-30  Kevin Kenny  <[email protected]>

	* generic/tclInt.h (TclIsNaN):
	* unix/configure.in: Added code to the configurator to check for a
			     standard isnan() macro and use it if one is
			     found. This change avoids bugs where the test of
			     ((d) != (d)) is optimized away by an
			     overaggressive compiler. [Bug 1783544]
	* generic/tclObj.c: Added missing #include <math.h> needed to locate
			    isnan() after the above change.

	* unix/configure: autoconf-2.61

	* tests/mathop.test (mathop-25.9, mathop-25.14): Modified tests to
	deal with (slightly buggy) math libraries in which pow() returns an
	incorrectly rounded result. [Bug 1808174]

2008-03-26  Don Porter  <[email protected]>

	*** 8.5.2 TAGGED FOR RELEASE ***

	* generic/tcl.h:	Bump to 8.5.2 for release.
	* library/init.tcl:
	* tools/tcl.wse.in:
	* unix/configure.in:
	* unix/tcl.spec:
	* win/configure.in:

	* unix/configure:	autoconf-2.59
	* win/configure:

	* changes:		Updated for 8.5.2 release.

2008-03-28  Donal K. Fellows  <[email protected]>

	* tests/fCmd.test: Substantial rewrite to use many more tcltest
	features. Great reduction in quantity of [catch] gymnastics. Several
	buggy tests fixed, including one where the result of the previous test
	was being checked!

2008-03-27  Kevin B. Kenny  <[email protected]>

	* library/tzdata/America/Marigot:
	* library/tztata/America/St_Barthelemy:
	* library/tzdata/America/Argentina/San_Luis:
	* library/tzdata/Asia/Ho_Chi_Minh:
	* library/tzdata/Asia/Kolkata:	(new files)
	* library/tzdata/America/Caracas:
	* library/tzdata/America/Havana:
	* library/tzdata/America/Santiago:
	* library/tzdata/America/Argentina/Buenos_Aires:
	* library/tzdata/America/Argentina/Catamarca:
	* library/tzdata/America/Argentina/Cordoba:
	* library/tzdata/America/Argentina/Jujuy:
	* library/tzdata/America/Argentina/La_Rioja:
	* library/tzdata/America/Argentina/Mendoza:
	* library/tzdata/America/Argentina/Rio_Gallegos:
	* library/tzdata/America/Argentina/San_Juan:
	* library/tzdata/America/Argentina/Tucuman:
	* library/tzdata/America/Argentina/Ushuaia:
	* library/tzdata/Asia/Baghdad:
	* library/tzdata/Asia/Calcutta:
	* library/tzdata/Asia/Damascus:
	* library/tzdata/Asia/Saigon:
	* library/tzdata/Pacific/Easter:
		Changes up to and including Olson's tzdata2008b.

2008-03-27  Daniel Steffen  <[email protected]>

	* unix/tcl.m4 (SunOS-5.1x): Fix 64bit support for Sun cc. [Bug
	1921166]

	* unix/configure: autoconf-2.59

2008-03-26  Don Porter  <[email protected]>

	* changes:		Updated for 8.5.2 release.

2008-03-24  Pat Thoyts  <[email protected]>

	* generic/tclBinary.c: [Bug 1923966] - crash in binary format
	* tests/binary.test:   Added tests for the above crash condition.

2008-03-21  Donal K. Fellows  <[email protected]>

	* doc/switch.n: Clarified documentation in respect of two-argument
	invokation. [Bug 1899962]

	* tests/switch.test: Added more tests of regexp-mode compilation of
	the [switch] command. [Bug 1854435]

2008-03-20  Donal K. Fellows  <[email protected]>

	* generic/tcl.h, generic/tclThreadAlloc.c: Tidied up the declarations
	of Tcl_GetMemoryInfo so that it is always defined. Will panic when
	called against a Tcl that was previously built without it at all,
	which is OK because that also indicates a serious mismatch between
	memory configuration options.

2008-03-19  Donal K. Fellows  <[email protected]>

	* generic/tcl.h, generic/tclThreadAlloc.c (Tcl_GetMemoryInfo): Make
	sure this function is available when direct linking. [Bug 1868171]

	* tests/reg.test (reg-33.14): Marked nonPortable because some
	environments have small default stack sizes. [Bug 1905562]

2008-03-18  Andreas Kupries  <[email protected]>

	* library/tm.tcl (::tcl::tm::UnknownHandler): Changed 'source' to
	'source -encoding utf-8'. This fixes a portability problem of Tcl
	Modules pointed out by Don Porter. By using plain 'source' we were at
	the mercy of 'encoding system', making modules less portable than they
	could be. The exact scenario: A writes a TM in some weird encoding
	which is A's system encoding, distributes it, and somewhere else it
	cannot be read/used because the system encoding is different. Forcing
	the use of utf-8 makes the module portable.

	***INCOMPATIBILITY*** for all Tcl Modules already written in non-utf-8
	compatible encodings.

2008-03-18  Don Porter  <[email protected]>

	* generic/tclExecute.c:	Patch from Miguel Sofer to correct the
	alignment of memory allocated by GrowEvaluationStack(). [Bug 1914503]

2008-03-18  Andreas Kupries  <[email protected]>

	* library/tm.tcl (::tcl::tm::Defaults): Modified handling of
	environment variables. Solution slightly different than proposed in
	the report. Using the underscored form TCLX_y_TM_PATH even if
	TCLX.y_TM_PATH exists. Also using a loop to cut prevent code
	replication. [Bug 1914604]

2008-03-16  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmds.c (TclCompileDictForCmd): Correct the handling
	of stack space calculation (the jump pattern used was confusing the
	simple-minded code doing the calculations). [Bug 1903325]

	* doc/lreplace.n: Clarified documentation of what happens with
	negative indices. [Bug 1905809] Added example, tidied up formatting.

2008-03-14  Don Porter  <[email protected]>

	* generic/tclBasic.c (OldMathFuncProc):	Same workaround protection
	from bad TclStackAlloc() alignment. Thanks George Peter Staplin.

	* generic/tclCmdIL.c (Tcl_LsortObjCmd):	Use ckalloc() to allocate
	SortElement arrays instead of TclStackAlloc() which isn't getting
	alignment right. Workaround for [Bug 1914503].

2008-03-14  Reinhard Max  <[email protected]>

	* generic/tclTest.c:  Ignore the return value of write() when we are
	* unix/tclUnixPipe.c: about to exit anyways.

2008-03-13  Daniel Steffen  <[email protected]>

	* unix/configure.in: Use backslash-quoting instead of double-quoting
	* unix/tcl.m4:	     for lib paths in tclConfig.sh. [Bug 1913622]
	* unix/configure:    autoconf-2.59

2008-03-13  Don Porter  <[email protected]>

	* changes:		Updated for 8.5.2 release.

	* generic/tclStrToD.c:	Resolve identifier conflict over "pow10" with
	libm in Cygwin and DJGPP. Thanks to Gordon Schumacher and Philip
	Moore. [Patch 1800636]

2008-03-12  Daniel Steffen  <[email protected]>

	* macosx/Tcl.xcodeproj/project.pbxproj:	Add support for Xcode 3.1
	* macosx/Tcl.xcodeproj/default.pbxuser:	CODE_SIGN_IDENTITY and
	* macosx/Tcl-Common.xcconfig:		'xcodebuild install'.

2008-03-12  Andreas Kupries  <[email protected]>

	* doc/info.n: Replaced {expand} with {*}.

2008-03-12  Jeff Hobbs  <[email protected]>

	* unix/Makefile.in (install-libraries):	Bump http to 2.7
	* win/Makefile.in (install-libraries):	Added -myaddr option to allow
	* library/http/http.tcl (http::geturl):	control of selected socket
	* library/http/pkgIndex.tcl:		interface. [Bug 559898]
	* doc/http.n, tests/http.test:		Added -keepalive and
	-protocol 1.1 with chunked transfer encoding support. [Bug 1063703,
	1470377, 219225] (default keepalive is 0)
	Added ability to override Host in -headers. [Bug 928154]
	Added -strict option to control URL validation on per-call basis.
	[Bug 1560506]

2008-03-11  Jeff Hobbs  <[email protected]>

	* library/http/http.tcl (http::geturl): Add -method option to support
	* tests/http.test (http-3.1):		http PUT and DELETE requests.
	* doc/http.n:				[Bug 1599901, 862554]

	* library/http/http.tcl: Whitespace changes, code cleanup. Allow http
	to be re-sourced without overwriting http state.

2008-03-11  Daniel Steffen  <[email protected]>

	* generic/tclEncoding.c (LoadEscapeEncoding): Avoid leaking escape
	sub-encodings, fixes encoding-11.1 failing after iso2022-jp loaded.
	[Bug 1893053]

	* macosx/tclMacOSXNotify.c: Avoid using CoreFoundation after fork() on
	Darwin 9 even when TclpCreateProcess() uses vfork().

	* macosx/Tcl.xcodeproj/project.pbxproj:	Add support for Xcode 3.1 and
	* macosx/Tcl.xcodeproj/default.pbxuser:	configs for building with
	* macosx/Tcl-Common.xcconfig:		gcc-4.2 and llvm-gcc-4.2.

	* unix/tclUnixPort.h:			Workaround vfork() problems in
						llvm-gcc-4.2.1 -O4 build.

	* unix/tclUnixPort.h:			Move MODULE_SCOPE compat
						define to top. [Bug 1911102]

	* macosx/GNUmakefile:			Fix quoting to allow paths
	* macosx/Tcl-Common.xcconfig:		to ${builddir} and
	* unix/Makefile.in:			${INSTALL_ROOT} to contain
	* unix/configure.in:			spaces.
	* unix/install-sh:
	* unix/tcl.m4:
	* tests/ioCmd.test:

	* unix/configure:			autoconf-2.59

	* unix/Makefile.in (install-strip):	Strip non-global symbols from
						dynamic library.

	* unix/tclUnixNotfy.c:			Fix warning.

	* tests/exec.test (exec-9.7):		Reduce timing sensitivity
	* tests/socket.test (socket-2.11):	(esp. on multi-proc machines).

	* tests/fCmd.test (fCmd-9.4):		Skip on Darwin 9 (xfail).

2008-03-11  Miguel Sofer  <[email protected]>

	* generic/tclVar.c (TclDeleteNamespaceVars):
	* tests/var.test (var-8.2): Unset traces on vars should be called with
	a FQ named during namespace deletion. This was causing infinite loops
	when unset traces recreated the var, as reported by Julian Noble. [Bug
	1911919]

2008-03-10  Don Porter  <[email protected]>

	* changes:		Updated for 8.5.2 release.

	* doc/http.n:	Revised to indicate that [package require http 2.5.5]
	is needed to get all the documented commands ([http::meta]).

	* generic/tclEvent.c (TclDefaultBgErrorHandlerObjCmd):	Added error
	* tests/event.test (event-5.*):	checking to protect against callers
	passing invalid return options dictionaries. [Bug 1901113]

	* generic/tclBasic.c (ExprAbsFunc):	Revised so that the abs()
	* tests/expr.test:	function and the [::tcl::mathfunc::abs]
	command do not return the value of -0, or equivalent values with more
	alarming string reps like -1e-350. [Bug 1893815]

2008-03-07  Andreas Kupries  <[email protected]>

	* generic/tclResult.c (ReleaseKeys): Workaround for [Bug 1904907].
	Reset the return option keys to NULL to allow full re-initialization
	by GetKeys(). This introduces a memory leak for the key objects, but
	gets us around a crash in the finalization of reflected channels when
	handling returns, either at compile- or runtime. In both cases we
	access the keys after they have been released by their thread exit
	handler. A proper fix is entangled with the untangling of the
	finalization ordering and attendant issues. For now we choose the
	lesser evil.

2008-03-07  Don Porter  <[email protected]>

	* generic/tclExecute.c (Tcl_ExprObj):	Revised expression bytecode
	compiling so that bytecodes invalid due to changing context or due to
	the difference between expressions and scripts are not reused. [Bug
	1899164]

	* generic/tclCmdAH.c:	Revised direct evaluation implementation of
	[expr] so that [expr $e] caches compiled bytecodes for the expression
	as the intrep of $e.

	* tests/execute.test (execute-6.*):	More tests checking that
	script bytecode is invalidated in the right situations.

2008-03-07  Donal K. Fellows  <[email protected]>

	* win/configure.in: Add AC_HEADER_STDC to support msys/win64.

2008-03-06  Donal K. Fellows  <[email protected]>

	* doc/namespace.n: Minor tidying up. [Bug 1909019]

2008-03-04  Don Porter  <[email protected]>

	* tests/execute.test (6.3,4):	Added tests for [Bug 1899164].

2008-03-03  Reinhard Max  <[email protected]>

	* unix/tclUnixChan.c: Fix mark and space parity on Linux, which uses
	CMSPAR instead of PAREXT.

2008-03-02  Miguel Sofer  <[email protected]>

	* generic/tclNamesp.c (GetNamespaceFromObj):
	* tests/interp.test (interp-28.2): Spoil the intrep of an nsNameType
	obj when the reference crosses interpreter boundaries.

2008-02-29  Don Porter  <[email protected]>

	* generic/tclResult.c (Tcl_SetReturnOptions):	Revised the refcount
	management of Tcl_SetReturnOptions to become that of a conventional
	Consumer routine. Thanks to Peter Spjuth for pointing out the
	difficulties calling Tcl_SetReturnOptions with non-0-count value for
	options.
	* generic/tclExecute.c (INST_RETURN_STK): Revised the one caller
	within Tcl itself which passes a non-0-count value to
	Tcl_SetReturnOptions().

	* generic/tclBasic.c (Tcl_AppendObjToErrorInfo):	Revised the
	refcount management of Tcl_AppendObjToErrorInfo to become that of a
	conventional Consumer routine. This preserves the ease of use for the
	overwhelming common callers who pass in a 0-count value, but makes the
	proper call with a non-0-count value less surprising.
	* generic/tclEvent.c (TclDefaultBgErrorHandlerObjCmd):	Revised the
	one caller within Tcl itself which passes a non-0-count value to
	Tcl_AppendObjToErrorInfo().

2008-02-28  Joe English  <[email protected]>

	* unix/tclPort.h, unix/tclCompat.h, unix/tclUnixChan.h: Reduce scope
	of <sys/filio.h> and <sys/ioctl.h> #includes. [Patch 1903339]

2008-02-28  Joe English  <[email protected]>

	* unix/tclUnixChan.c, unix/tclUnixNotfy.c, unix/tclUnixPipe.c:
	Consolidate all code conditionalized on -DUSE_FIONBIO into one place.
	* unix/tclUnixPort.h, unix/tclUnixCompat.c: New routine
	TclUnixSetBlockingMode(). [Patch 1903339]

2008-02-28  Don Porter  <[email protected]>

	* generic/tclBasic.c (TclEvalObjvInternal):	Plug memory leak when
	an enter trace deletes or changes the command, prompting a reparsing.
	Don't let the second pass lose commandPtr value allocated during the
	first pass.

	* generic/tclCompExpr.c (ParseExpr):	Plug memory leak in error
	message generation.

	* generic/tclStringObj.c (Tcl_AppendFormatToObj): [format %llx $big]
	leaked an mp_int.

	* generic/tclCompCmds.c (TclCompileReturnCmd):	The 2007-10-18 commit
	to optimize compiled [return -level 0 $x] [RFE 1794073] introduced a
	memory leak of the return options dictionary. Fixing that.

2008-02-27  Pat Thoyts  <[email protected]>

	* library/http/http.tcl: [Bug 705956] - fix inverted logic when
	cleaning up socket error in geturl.

2008-02-27  Kevin B. Kenny  <[email protected]>

	* doc/clock.n: Corrected minor indentation gaffe in the penultimate
	paragraph. [Bug 1898025]
	* generic/tclClock.c (ParseClockFormatArgs): Changed to check that the
	clock value is in the range of a 64-bit integer. [Bug 1862555]
	* library/clock.tcl (::tcl::clock::format, ::tcl::clock::scan,
	(::tcl::clock::add, ::tcl::clock::LocalizeFormat): Fixed bugs in
	caching of localized strings that caused weird results when localized
	date/time formats were used. [Bug 1902423]
	* tests/clock.test (clock-61.*, clock-62.1): Regression tests for [Bug
	1862555] and [Bug 1902423].

2008-02-26  Joe English  <[email protected]>

	* generic/tclIOUtil.c, unix/tclUnixPort.h, unix/tclUnixChan.c:
	Remove dead/unused portability-related #defines and unused conditional
	code. See [Patch 1901828] for discussion.

2008-02-26  Joe English  <[email protected]>

	* generic/tclIORChan.c (enum MethodName),
	* generic/tclCompExpr.c (enum Marks): More stray trailing ","s

2008-02-26  Joe English  <[email protected]>

	* unix/configure.in(socklen_t test): Define socklen_t as "int" if
	missing, not "unsigned". Use AC_TRY_COMPILE instead of
	AC_EGREP_HEADER.
	* unix/configure: regenerated.

2008-02-26  Joe English  <[email protected]>

	* generic/tclCompile.h: Remove stray trailing "," from enum
	InstOperandType definition (C99ism).

2008-02-26  Jeff Hobbs  <[email protected]>

	* generic/tclUtil.c (TclReToGlob): Fix the handling of the last star
	* tests/regexpComp.test:	   possibly being escaped in
	determining right anchor. [Bug 1902436]

2008-02-26  Pat Thoyts  <[email protected]>

	* library/http/pkgIndex.tcl: Set version 2.5.5
	* library/http/http.tcl:     It is better to do the [eof] check after
	trying to read from the socket. No clashes found in testing. Added
	http::meta command to access the http headers. [Bug 1868845]

2008-02-22  Pat Thoyts  <[email protected]>

	* library/http/pkgIndex.tcl: Set version 2.5.4
	* library/http/http.tcl:     Always check that the state array exists
	in the http::status command. [Bug 1818565]

2008-02-13  Don Porter  <[email protected]>

	* generic/tcl.h:	Bump version number to 8.5.2b1 to distinguish
	* library/init.tcl:	CVS development snapshots from the 8.5.1 and
	* unix/configure.in:	8.5.2 releases.
	* unix/tcl.spec:
	* win/configure.in:
	* README

	* unix/configure:	autoconf (2.59)
	* win/configure:

2008-02-12  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmds.c (TclCompileSwitchCmd): Corrected logic for
	* tests/switch.test (switch-10.15): handling -nocase compilation; the
	-exact -nocase option cannot be compiled currently. [Bug 1891827]

	* unix/README: Documented missing configure flags. [Bug 1799011]

2008-02-06  Kevin B. Kenny  <[email protected]>

	* doc/clock.n (%N): Corrected an error in the explanation of the %N
	format group.
	* generic/tclClock.c (ClockParseformatargsObjCmd):
	* library/clock.tcl (::tcl::clock::format):
	* tests/clock.test (clock-1.0, clock-1.4):
	Performance enhancements in [clock format] (moving the analysis of
	$args into C code, holding on to Tcl_Objs with resolved command names,
	[lassign] in place of [foreach], avoiding [namespace which] for
	command resolution).

2008-02-04  Don Porter  <[email protected]>

	*** 8.5.1 TAGGED FOR RELEASE ***

	* changes:		Updated for 8.5.1 release.

	* generic/tcl.h:	Bump to 8.5.1 for release.
	* library/init.tcl:
	* tools/tcl.wse.in:
	* unix/configure.in:
	* unix/tcl.spec:
	* win/configure.in:

	* unix/configure:	autoconf-2.59
	* win/configure:

2008-02-04  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c (INST_CONCAT1): Fix optimisation for in-place
	concatenation (was going over String type)

2008-02-02  Daniel Steffen  <[email protected]>

	* unix/configure.in (Darwin):	Correct Info.plist year substitution
					in non-framework builds.

	* unix/configure:		autoconf-2.59

2008-01-30  Miguel Sofer  <[email protected]>

	* generic/tclInterp.c (Tcl_GetAlias): Fix for [Bug 1882373], thanks go
	to an00na.

2008-01-30  Donal K. Fellows  <[email protected]>

	* tools/tcltk-man2html.tcl: Reworked manual page scraper to do a
	proper job of handling references to Ttk options. [Tk Bug 1876493]

2008-01-29  Donal K. Fellows  <[email protected]>

	* doc/man.macros (SO, SE): Adjusted macros so that it is possible for
	Ttk to have its "standard options" on a manual page that is not called
	"options". [Tk Bug 1876493]

2008-01-25  Don Porter  <[email protected]>

	* changes:		Updated for 8.5.1 release.

2008-01-23  Don Porter  <[email protected]>

	* generic/tclInt.h:		New macro TclGrowParseTokenArray() to
	* generic/tclCompCmds.c:	simplify code that might need to grow
	* generic/tclCompExpr.c:	an array of Tcl_Tokens in the parsePtr
	* generic/tclParse.c:		field of a Tcl_Parse. Replaces the
	TclExpandTokenArray() routine via replacing:
		int needed = parsePtr->numTokens + growth;
		while (needed > parsePtr->tokensAvailable) {
		    TclExpandTokenArray(parsePtr);
		}
	with:
		TclGrowParseTokenArray(parsePtr, growth);
	This revision merged over from dgp-refactor branch.

	* generic/tclCompile.h:	Demote TclCompEvalObj() from internal stubs to
	* generic/tclInt.decls:	a MODULE_SCOPE routine declared in
	tclCompile.h.

	* generic/tclIntDecls.h:	make genstubs
	* generic/tclStubInit.c:

2008-01-22  Don Porter  <[email protected]>

	* generic/tclTimer.c (AfterProc):	Replace Tcl_EvalEx() with
	Tcl_EvalObjEx() to evaluate [after] callbacks. Part of trend to favor
	compiled execution over direct evaluation.

2008-01-22  Miguel Sofer  <[email protected]>

	* generic/tclCmdIl.c (Tcl_LreverseObjCmd):
	* tests/cmdIL.test (cmdIL-7.7): Fix crash on reversing an empty list.
	[Bug 1876793]

2008-01-20  Jeff Hobbs  <[email protected]>

	* unix/README: Minor typo fixes [Bug 1853072]

	* generic/tclIO.c (TclGetsObjBinary): Operate on topmost channel.
	[Bug 1869405] (Ficicchia)

2008-01-17  Don Porter  <[email protected]>

	* generic/tclCompExpr.c:	Revision to preserve parsed intreps of
	numeric and boolean literals when compiling expressions with (optimize
	== 1).

2008-01-15  Miguel Sofer  <[email protected]>

	* generic/tclCompExpr.c: Add an 'optimize' argument to
	* generic/tclCompile.c:	 TclCompileExpr() to profit from better
	* generic/tclCompile.h:	 literal management according to usage.
	* generic/tclExecute.c:

	* generic/tclCompExpr.c: Fix literal leak in exprs [Bug 1869989] (dgp)
	* generic/tclExecute.c:
	* tests/compExpr.test:

	* doc/proc.n: Changed wording for access to non-local variables; added
	mention to [namespace upvar]. Lame attempt at dealing with
	documentation. [Bug 1872708]

2008-01-15  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c:	 Replacing 'operator' by 'op' in the def of
	* generic/tclCompExpr.c: struct TclOpCmdClientData to accommodate C++
	* generic/tclCompile.h:	 compilers. [Bug 1855644]

2008-01-13  Jeff Hobbs  <[email protected]>

	* win/tclWinSerial.c (SerialCloseProc, TclWinOpenSerialChannel): Use
	critical section for read & write side. [Bug 1353846] (newman)

2008-01-11  Miguel Sofer  <[email protected]>

	* unix/tclUnixThrd.c (TclpThreadGetStackSize): Restore stack checking
	functionality in freebsd. [Bug 1850424]

	* unix/tclUnixThrd.c (TclpThreadGetStackSize): Fix for crash in
	freebsd. [Bug 1860425]

2008-01-10  Don Porter  <[email protected]>

	* generic/tclStringObj.c (Tcl_AppendFormatToObj):  Correct failure to
	* tests/format.test:	account for big.used == 0 corner case in the
	%ll(idox) format directives. [Bug 1867855]

2008-01-09  George Peter Staplin  <[email protected]>

	* doc/vwait.n: Add a missing be to fix a typo.

2008-01-04  Jeff Hobbs  <[email protected]>

	* tools/tcltk-man2html.tcl (make-man-pages): Make man page title use
	more specific info on lhs to improve tabbed browser view titles.

2008-01-02  Donal K. Fellows  <[email protected]>

	* doc/binary.n: Fixed documentation bug reported on tcl-core, and
	reordered documentation to discourage people from using the hex
	formatter that is hardly ever useful.

2008-01-02  Don Porter  <[email protected]>

	* generic/tcl.h:	Bump version number to 8.5.1b1 to distinguish
	* library/init.tcl:	CVS development snapshots from the 8.5.0 and
	* unix/configure.in:	8.5.1 releases.
	* unix/tcl.spec:
	* win/configure.in:
	* README

	* unix/configure:	autoconf (2.59)
	* win/configure:

	******************************************************************
	*** CHANGELOG ENTRIES FOR 2006-2007 IN "ChangeLog.2007"	       ***
	*** CHANGELOG ENTRIES FOR 2005 IN "ChangeLog.2005"	       ***
	*** CHANGELOG ENTRIES FOR 2004 IN "ChangeLog.2004"	       ***
	*** CHANGELOG ENTRIES FOR 2003 IN "ChangeLog.2003"	       ***
	*** CHANGELOG ENTRIES FOR 2002 IN "ChangeLog.2002"	       ***
	*** CHANGELOG ENTRIES FOR 2001 IN "ChangeLog.2001"	       ***
	*** CHANGELOG ENTRIES FOR 2000 IN "ChangeLog.2000"	       ***
	*** CHANGELOG ENTRIES FOR 1999 AND EARLIER IN "ChangeLog.1999" ***
	******************************************************************
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<








































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































Changes to changes.

2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
to implement the safe base, instead of deleting the commands from a safe
interpreter. (JL)

11/15/96 (new feature) Implemented the safe base, a mechanism for
installing and requesting security policies, purely in Tcl code. Overloads
the package command to also allow an interpreter to "require" a policy. The
following new library commands are provided:
	tcl_safeCreateInterp	-- creates a slave an initializes the
				   policy mechanism.
	tcl_safeInitInterp	-- initializes an existing slave with the
				   policy mechanism.
	tcl_safeDeleteInterp	-- deletes a slave and deinitializes the
				   policy mechanism.
Added a new file to the library, safeinit.tcl, to hold implementation. (JL)
On 7/9/97, removed the policy loading mechanism from the Safe Base. Left







|







2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
to implement the safe base, instead of deleting the commands from a safe
interpreter. (JL)

11/15/96 (new feature) Implemented the safe base, a mechanism for
installing and requesting security policies, purely in Tcl code. Overloads
the package command to also allow an interpreter to "require" a policy. The
following new library commands are provided:
	tcl_safeCreateInterp	-- creates a slave and initializes the
				   policy mechanism.
	tcl_safeInitInterp	-- initializes an existing slave with the
				   policy mechanism.
	tcl_safeDeleteInterp	-- deletes a slave and deinitializes the
				   policy mechanism.
Added a new file to the library, safeinit.tcl, to hold implementation. (JL)
On 7/9/97, removed the policy loading mechanism from the Safe Base. Left
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038

6/19/97 (bug fix) Fixed a panic due to the following four line script:
	interp create x
	x alias foo bar
	x eval rename foo blotz
	x alias foo {}
The problem was that the interp code was not using the actual current name
of the command to be deleted as a result of un-aliasing foo. (JL)

6/19/97 (feature change) Pass interp down to the ChannelOption and
driver specific calls so system errors can be differentiated from syntax
ones. Changed Tcl_DriverGetOptionProc type. Affects Tcl_GetChannelOption,
TcpGetOptionProc,  TtyGetOptionProc, etc. (DL)
*** POTENTIAL INCOMPATIBILITY ***








|







3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038

6/19/97 (bug fix) Fixed a panic due to the following four line script:
	interp create x
	x alias foo bar
	x eval rename foo blotz
	x alias foo {}
The problem was that the interp code was not using the actual current name
of the command to be deleted as a result of unaliasing foo. (JL)

6/19/97 (feature change) Pass interp down to the ChannelOption and
driver specific calls so system errors can be differentiated from syntax
ones. Changed Tcl_DriverGetOptionProc type. Affects Tcl_GetChannelOption,
TcpGetOptionProc,  TtyGetOptionProc, etc. (DL)
*** POTENTIAL INCOMPATIBILITY ***

4163
4164
4165
4166
4167
4168
4169
4170
4171
4172
4173
4174
4175
4176
4177
    - Modifying the TclpInitLibraryPath routines.
(surles)

3/14/99 (feature change) Added hooks for TclPro Wrapper to initialize
the location of the encoding files and libraries.  This fix included:
    - Adding the TclSetPerInitScript routine.
    - Modifying the Tcl_Init routines to evaluate the non-NULL
      pre-init script.
    - Adding the Tcl_SetdefaultEncodingDir and Tcl_GetDefaultEncodingDir
      routines.
    - Modifying the TclpInitLibrary routines to append the default
      encoding dir.
(surles)

3/14/99 (feature change) Test suite now uses "test" namespace to







|







4163
4164
4165
4166
4167
4168
4169
4170
4171
4172
4173
4174
4175
4176
4177
    - Modifying the TclpInitLibraryPath routines.
(surles)

3/14/99 (feature change) Added hooks for TclPro Wrapper to initialize
the location of the encoding files and libraries.  This fix included:
    - Adding the TclSetPerInitScript routine.
    - Modifying the Tcl_Init routines to evaluate the non-NULL
      preinit script.
    - Adding the Tcl_SetdefaultEncodingDir and Tcl_GetDefaultEncodingDir
      routines.
    - Modifying the TclpInitLibrary routines to append the default
      encoding dir.
(surles)

3/14/99 (feature change) Test suite now uses "test" namespace to
4646
4647
4648
4649
4650
4651
4652
4653
4654
4655
4656
4657
4658
4659
4660
9/21/99 (bug fix) fixed static buffer overflow problem. [Bug: 2483] (hobbs)

9/21/99 (bug fix) fixed end-int linsert interpretation. [Bug: 2693] (hobbs)

9/21/99 (bug fix) fixed bug when setting array in non-existent
namespace. [Bug: 2613] (hobbs)

--- Released 8.2.1, October 04, 1999 --- See ChangeLog for details ---

10/30/99 (feature enhancement) new regexp engine from Henry Spencer
was patched in - should greatly reduce stack space usage. (spencer)

10/30/99 (bug fix) fixed Purify reported memory leaks in findexecutable
test command, TclpCreateProcess on Unix, in handling of C environ array,
and in testthread code.  No more known (reported) mem leaks for Tcl







|







4646
4647
4648
4649
4650
4651
4652
4653
4654
4655
4656
4657
4658
4659
4660
9/21/99 (bug fix) fixed static buffer overflow problem. [Bug: 2483] (hobbs)

9/21/99 (bug fix) fixed end-int linsert interpretation. [Bug: 2693] (hobbs)

9/21/99 (bug fix) fixed bug when setting array in non-existent
namespace. [Bug: 2613] (hobbs)

--- Released 8.2.1, October 04, 1999

10/30/99 (feature enhancement) new regexp engine from Henry Spencer
was patched in - should greatly reduce stack space usage. (spencer)

10/30/99 (bug fix) fixed Purify reported memory leaks in findexecutable
test command, TclpCreateProcess on Unix, in handling of C environ array,
and in testthread code.  No more known (reported) mem leaks for Tcl
4676
4677
4678
4679
4680
4681
4682
4683
4684
4685
4686
4687
4688
4689
4690
[Bug: 2459, 2515] (David Whitehouse)

10/30/99 (bug fix) fixed [string index] to return ByteArrayObj
when indexing into one (test case string-5.16) [Bug: 2871] (hobbs)

10/30/99 (bug fix) fixes for mac UTF filename handling (ingham)

--- Released 8.2.2, November 04, 1999 --- See ChangeLog for details ---

11/19/99 (feature enhancement) bug fixes for http package as well as
patch required by TLS (SSL) extension that adds http::(un)register
and -type to http::geturl.  Up'd http pkg version to 2.2.

11/19/99 (bug fix) removed extra decr of numLevels in Tcl_EvalObjEx
that could cause seg fault ([email protected])







|







4676
4677
4678
4679
4680
4681
4682
4683
4684
4685
4686
4687
4688
4689
4690
[Bug: 2459, 2515] (David Whitehouse)

10/30/99 (bug fix) fixed [string index] to return ByteArrayObj
when indexing into one (test case string-5.16) [Bug: 2871] (hobbs)

10/30/99 (bug fix) fixes for mac UTF filename handling (ingham)

--- Released 8.2.2, November 04, 1999

11/19/99 (feature enhancement) bug fixes for http package as well as
patch required by TLS (SSL) extension that adds http::(un)register
and -type to http::geturl.  Up'd http pkg version to 2.2.

11/19/99 (bug fix) removed extra decr of numLevels in Tcl_EvalObjEx
that could cause seg fault ([email protected])
4701
4702
4703
4704
4705
4706
4707
4708
4709
4710
4711
4712
4713
4714
4715
TclFinalizeLoad.  This stops the seg fault on exit that some users would
see (ie with oratcl) when using DLLs that do nasty things like register
atexit handlers.

12/07/99 (bug fix) fixes for 'expr + {[incr]}' and 'expr + {[error]}'
cases (different causes).

--- Released 8.2.3, December 16, 1999 --- See ChangeLog for details ---

1999-09-14 (feature enhancement) added -start switch to regexp and regsub.

1999-09-15 (feature enhancement) add 'array unset' command.

1999-09-15 (feature enhancement) rewrote runtime libraries to use new
string functions







|







4701
4702
4703
4704
4705
4706
4707
4708
4709
4710
4711
4712
4713
4714
4715
TclFinalizeLoad.  This stops the seg fault on exit that some users would
see (ie with oratcl) when using DLLs that do nasty things like register
atexit handlers.

12/07/99 (bug fix) fixes for 'expr + {[incr]}' and 'expr + {[error]}'
cases (different causes).

--- Released 8.2.3, December 16, 1999

1999-09-14 (feature enhancement) added -start switch to regexp and regsub.

1999-09-15 (feature enhancement) add 'array unset' command.

1999-09-15 (feature enhancement) rewrote runtime libraries to use new
string functions
4758
4759
4760
4761
4762
4763
4764
4765
4766
4767
4768
4769
4770
4771
4772

1999-12-21 (bug fix) fixed applescript for I18N

1999-12-21 (feature enhancement) added -unique option to lsort (hobbs)

1999-12-21 (bug fix) changed thread ids to longs (for 64bit systems)

--- Released 8.3b1, December 22, 1999 --- See ChangeLog for details ---

2000-01-10 (feature enhancement) clock scan now supports the common
ISO 8601 date/time formats.  See docs for details. (melski)

2000-01-10 (bug fix) prevented \ooo substitution from accepting
non-octal digits [Bug: 3975] (hobbs)








|







4758
4759
4760
4761
4762
4763
4764
4765
4766
4767
4768
4769
4770
4771
4772

1999-12-21 (bug fix) fixed applescript for I18N

1999-12-21 (feature enhancement) added -unique option to lsort (hobbs)

1999-12-21 (bug fix) changed thread ids to longs (for 64bit systems)

--- Released 8.3b1, December 22, 1999

2000-01-10 (feature enhancement) clock scan now supports the common
ISO 8601 date/time formats.  See docs for details. (melski)

2000-01-10 (bug fix) prevented \ooo substitution from accepting
non-octal digits [Bug: 3975] (hobbs)

4784
4785
4786
4787
4788
4789
4790
4791
4792
4793
4794
4795
4796
4797
4798

2000-01-12 (feature enhancement) added support for setting permissions
symbolicly (like chmod) in [file attributes $file -permissions ...] (schoebel)

2000-01-13 (bug fix) fixed lsort -dictionary problem when sorting
characters between 'Z' and 'a' (flawed upper/lower comparison logic) (melski)

--- Released 8.3b2, January 13, 2000 --- See ChangeLog for details ---

2000-01-14 (feature enhancement) clock format %Q added, clock scan updated

2000-01-20 (bug fix) corrected complex array elem compiling (Spjuth)

2000-01-20 (bug fix) made [info body] always return a string type arg,
to prevent possible misuse of bytecodes in the wrong context (hobbs)







|







4784
4785
4786
4787
4788
4789
4790
4791
4792
4793
4794
4795
4796
4797
4798

2000-01-12 (feature enhancement) added support for setting permissions
symbolicly (like chmod) in [file attributes $file -permissions ...] (schoebel)

2000-01-13 (bug fix) fixed lsort -dictionary problem when sorting
characters between 'Z' and 'a' (flawed upper/lower comparison logic) (melski)

--- Released 8.3b2, January 13, 2000

2000-01-14 (feature enhancement) clock format %Q added, clock scan updated

2000-01-20 (bug fix) corrected complex array elem compiling (Spjuth)

2000-01-20 (bug fix) made [info body] always return a string type arg,
to prevent possible misuse of bytecodes in the wrong context (hobbs)
4823
4824
4825
4826
4827
4828
4829
4830
4831
4832
4833
4834
4835
4836
4837

2000-02-09 (bug fix) restored Mac source to build readiness and prevented
mac panic from an error when closing an async socket (steffen, ingham)

2000-02-10 (feature enhancement) improved error reporting for failed
loads on Windows (dejong, hobbs)

--- Released 8.3.0, February 10, 2000 --- See ChangeLog for details ---

2000-03 (bug fixes, feature enhancement) overhaul of http package for
proper handling of async callbacks (new options), version is now at 2.3
(tamhankar, welch)

2000-03 (performance enhancement) speedup in Windows filename handling (newman)
and ==/!= empty string in exprs. (hobbs)







|







4823
4824
4825
4826
4827
4828
4829
4830
4831
4832
4833
4834
4835
4836
4837

2000-02-09 (bug fix) restored Mac source to build readiness and prevented
mac panic from an error when closing an async socket (steffen, ingham)

2000-02-10 (feature enhancement) improved error reporting for failed
loads on Windows (dejong, hobbs)

--- Released 8.3.0, February 10, 2000

2000-03 (bug fixes, feature enhancement) overhaul of http package for
proper handling of async callbacks (new options), version is now at 2.3
(tamhankar, welch)

2000-03 (performance enhancement) speedup in Windows filename handling (newman)
and ==/!= empty string in exprs. (hobbs)
4866
4867
4868
4869
4870
4871
4872
4873
4874
4875
4876
4877
4878
4879
4880
tclLoadDyld.c dl type. (sanchez)

2000-04-23 (bug fix) several Mac socket fixes (ingham)

2000-04-24 (bug fix) fixed hang in threaded Unix case when backgrounded
exec process was running (dejong)

--- Released 8.3.1, April 26, 2000 --- See ChangeLog for details ---

2000-04-26 (doc fix) updated/added documentation for many API's and
commands (melski)

2000-05-02 (feature enhancement) added support for joinable threads;
extended API's for channels to allow channels to move between threads
(kupries)







|







4866
4867
4868
4869
4870
4871
4872
4873
4874
4875
4876
4877
4878
4879
4880
tclLoadDyld.c dl type. (sanchez)

2000-04-23 (bug fix) several Mac socket fixes (ingham)

2000-04-24 (bug fix) fixed hang in threaded Unix case when backgrounded
exec process was running (dejong)

--- Released 8.3.1, April 26, 2000

2000-04-26 (doc fix) updated/added documentation for many API's and
commands (melski)

2000-05-02 (feature enhancement) added support for joinable threads;
extended API's for channels to allow channels to move between threads
(kupries)
4916
4917
4918
4919
4920
4921
4922
4923
4924
4925
4926
4927
4928
4929
4930

2000-05-31 (feature enhancement) added support for regexp and exact
pattern matching for [array names] (gazetta)

2000-05-31 (feature enhancement) added -nocomplain and -- flags to
[unset] to allow for silent unset operation (hobbs)

--- Released 8.4a1, June 6, 2000 --- See ChangeLog for details ---

2000-05-29 (bug fix) corrected resource cleanup in http error cases.
Improved handling of error cases in http. (tamhankar)

2000-07 (feature rewrite) complete rewrite of the Tcl IO channel subsystem
to correct problems (hangs, core dumps) with the initial stacked channel
implementation.  The new system has many more tests for robustness and







|







4916
4917
4918
4919
4920
4921
4922
4923
4924
4925
4926
4927
4928
4929
4930

2000-05-31 (feature enhancement) added support for regexp and exact
pattern matching for [array names] (gazetta)

2000-05-31 (feature enhancement) added -nocomplain and -- flags to
[unset] to allow for silent unset operation (hobbs)

--- Released 8.4a1, June 6, 2000

2000-05-29 (bug fix) corrected resource cleanup in http error cases.
Improved handling of error cases in http. (tamhankar)

2000-07 (feature rewrite) complete rewrite of the Tcl IO channel subsystem
to correct problems (hangs, core dumps) with the initial stacked channel
implementation.  The new system has many more tests for robustness and
4955
4956
4957
4958
4959
4960
4961
4962
4963
4964
4965
4966
4967
4968
4969

2000-08-07 (doc fixes) numerous doc fixes to correct SEE ALSO and NAME
sections. (english)

2000-08-07 (bug fix) new man pages memory.n, TCL_MEM_DEBUG.3, Init.3 and
DumpActiveMemory.3. (melski)

--- Released 8.3.2, August 9, 2000 --- See ChangeLog for details ---

2000-06 thru 2000-11 (build improvements) Added support for mingw (gcc on
Windows), AIX-5 and Win64 builds (dejong, hobbs)

2000-06-23 (feature enhancement) ability to use Tcl_Obj *s as hash keys (duffin)

2000-06-29 (new features) added [mcmax] and [mcmset] and extended [unknown] in







|







4955
4956
4957
4958
4959
4960
4961
4962
4963
4964
4965
4966
4967
4968
4969

2000-08-07 (doc fixes) numerous doc fixes to correct SEE ALSO and NAME
sections. (english)

2000-08-07 (bug fix) new man pages memory.n, TCL_MEM_DEBUG.3, Init.3 and
DumpActiveMemory.3. (melski)

--- Released 8.3.2, August 9, 2000

2000-06 thru 2000-11 (build improvements) Added support for mingw (gcc on
Windows), AIX-5 and Win64 builds (dejong, hobbs)

2000-06-23 (feature enhancement) ability to use Tcl_Obj *s as hash keys (duffin)

2000-06-29 (new features) added [mcmax] and [mcmset] and extended [unknown] in
5014
5015
5016
5017
5018
5019
5020
5021
5022
5023
5024
5025
5026
5027
5028

2000-11-02 (bug fix) Corrected sharing of tclLibraryPath in threaded
environment (gravereaux)

2000-11-03 (new feature) Tcl_SetMainLoop enables defining an event loop for
tclsh.  This enables Tk as a truly loadable package. (hobbs)

--- Released 8.4a2, November 3, 2000 --- See ChangeLog for details ---

2000-09-27 (bug fix) fixed a bug introduced by a partial fix in 8.3.2 that
didn't set nonBlocking correctly when resetting the flags for the write
side (mem leak) Correct mem leak in channels when statePtr was released
(hobbs)

2000-09-29 (bug fix) corrected reporting of space parity on Windows (Eason)







|







5014
5015
5016
5017
5018
5019
5020
5021
5022
5023
5024
5025
5026
5027
5028

2000-11-02 (bug fix) Corrected sharing of tclLibraryPath in threaded
environment (gravereaux)

2000-11-03 (new feature) Tcl_SetMainLoop enables defining an event loop for
tclsh.  This enables Tk as a truly loadable package. (hobbs)

--- Released 8.4a2, November 3, 2000

2000-09-27 (bug fix) fixed a bug introduced by a partial fix in 8.3.2 that
didn't set nonBlocking correctly when resetting the flags for the write
side (mem leak) Correct mem leak in channels when statePtr was released
(hobbs)

2000-09-29 (bug fix) corrected reporting of space parity on Windows (Eason)
5072
5073
5074
5075
5076
5077
5078
5079
5080
5081
5082
5083
5084
5085
5086
2001-04-03 (doc fixes) numerous doc corrections and clarifications.
Update of READMEs.

2001-04-04 (build improvements) redid Mac build structure (steffen)
Corrected IRIX-5* configure (english).  Added support for AIX-5 (hobbs).
Added support for Win64 (hobbs).

--- Released 8.3.3, April 6, 2001 --- See ChangeLog for details ---

2000-11-23 (new feature)[TIP 7] higher resolution timer on Windows (kenny)

2001-01-18 (new feature) Tcl_InitHashTableEx renamed to Tcl_InitCustomHashTable
(kupries)

2001-03-30 (new feature)[TIP 10] support for thread-aware/hot channels (kupries)







|







5072
5073
5074
5075
5076
5077
5078
5079
5080
5081
5082
5083
5084
5085
5086
2001-04-03 (doc fixes) numerous doc corrections and clarifications.
Update of READMEs.

2001-04-04 (build improvements) redid Mac build structure (steffen)
Corrected IRIX-5* configure (english).  Added support for AIX-5 (hobbs).
Added support for Win64 (hobbs).

--- Released 8.3.3, April 6, 2001

2000-11-23 (new feature)[TIP 7] higher resolution timer on Windows (kenny)

2001-01-18 (new feature) Tcl_InitHashTableEx renamed to Tcl_InitCustomHashTable
(kupries)

2001-03-30 (new feature)[TIP 10] support for thread-aware/hot channels (kupries)
5146
5147
5148
5149
5150
5151
5152
5153
5154
5155
5156
5157
5158
5159
5160
 * improved build support for IRIX, GNU HURD, Mac OS 9 and OS X

 * configure scripts revamped for better support of cygwin and gcc on
   Windows (mdejong)

 * corrected several minor errors noted by Purify (hobbs)

--- Released 8.4a3, August 6, 2001 --- See ChangeLog for details ---

2001-06-27 (bug fix)[217987] corrected backslash substitution of non-ASCII
characters.  (hobbs, riefenstahl)

2001-06-28 (bug fix)[231259] failure to re-compile after cmd shadowing (sofer)

2001-07-02 (bug fix)[227512] corrected [concat] treatment of UTF-8 strings







|







5146
5147
5148
5149
5150
5151
5152
5153
5154
5155
5156
5157
5158
5159
5160
 * improved build support for IRIX, GNU HURD, Mac OS 9 and OS X

 * configure scripts revamped for better support of cygwin and gcc on
   Windows (mdejong)

 * corrected several minor errors noted by Purify (hobbs)

--- Released 8.4a3, August 6, 2001

2001-06-27 (bug fix)[217987] corrected backslash substitution of non-ASCII
characters.  (hobbs, riefenstahl)

2001-06-28 (bug fix)[231259] failure to re-compile after cmd shadowing (sofer)

2001-07-02 (bug fix)[227512] corrected [concat] treatment of UTF-8 strings
5252
5253
5254
5255
5256
5257
5258
5259
5260
5261
5262
5263
5264
5265
5266
2001-10-16 (new feature, Mac) change in binary extension format from MachO
bundles to standard .dylib dynamic libraries like on other unices.
        *** POTENTIAL INCOMPATIBILITY ***

2001-10-18 (bug fix) corrected off-by-one-day error in clock scan with
relative months and years during swing hours. (lavana)

--- Released 8.3.4, October 19, 2001 --- See ChangeLog for details ---

2001-08-21 (bug fix)[219184] overagressive compilation of [catch] (sofer)

2001-08-22 (new feature)[227482] [dde request -binary] (hobbs)
=> dde 1.2

2001-08-30 (performance enhancement)[456668] fully qualified command names use







|







5252
5253
5254
5255
5256
5257
5258
5259
5260
5261
5262
5263
5264
5265
5266
2001-10-16 (new feature, Mac) change in binary extension format from MachO
bundles to standard .dylib dynamic libraries like on other unices.
        *** POTENTIAL INCOMPATIBILITY ***

2001-10-18 (bug fix) corrected off-by-one-day error in clock scan with
relative months and years during swing hours. (lavana)

--- Released 8.3.4, October 19, 2001

2001-08-21 (bug fix)[219184] overagressive compilation of [catch] (sofer)

2001-08-22 (new feature)[227482] [dde request -binary] (hobbs)
=> dde 1.2

2001-08-30 (performance enhancement)[456668] fully qualified command names use
5278
5279
5280
5281
5282
5283
5284
5285
5286
5287
5288
5289
5290
5291
5292
5293
2001-09-07 (new feature) restored VC++ 5.0 compatibility (gravereaux)

2001-09-10 (performance enhancement)[TIP 53,451441] [proc foo args {}] now
compiles to 0 bytecodes (sofer)

2001-09-13 (new feature)[TIP 56] Tcl_EvalTokensStandard API (sofer)

2001-09-13 (new feature) Old ChangeLog entries => ChangeLog.1999 (hobbs)

2001-09-17 (new feature) compiling with TCL_COMPILE_DEBUG now required to
enable all compile and execution tracing (sofer)
        *** POTENTIAL INCOMPATIBILITY ***

2001-09-19 (bug fix)[411825] made TclNeedSpace UTF-8 aware (fellows)

2001-09-19 (bug fix)[219166] overagressive compilation of "quoted" bodies of







<
<







5278
5279
5280
5281
5282
5283
5284


5285
5286
5287
5288
5289
5290
5291
2001-09-07 (new feature) restored VC++ 5.0 compatibility (gravereaux)

2001-09-10 (performance enhancement)[TIP 53,451441] [proc foo args {}] now
compiles to 0 bytecodes (sofer)

2001-09-13 (new feature)[TIP 56] Tcl_EvalTokensStandard API (sofer)



2001-09-17 (new feature) compiling with TCL_COMPILE_DEBUG now required to
enable all compile and execution tracing (sofer)
        *** POTENTIAL INCOMPATIBILITY ***

2001-09-19 (bug fix)[411825] made TclNeedSpace UTF-8 aware (fellows)

2001-09-19 (bug fix)[219166] overagressive compilation of "quoted" bodies of
5364
5365
5366
5367
5368
5369
5370
5371
5372
5373
5374
5375
5376
5377
5378
5379
2002-01-24 (HTTP server bug workaround)[504508] leave the default port out
of the Host: header value
=> http 2.4.1 (hobbs)

2002-01-25 (new feature)[496733] socket options -eofchar and -translation
return read-only values (dejong)

2002-01-28 (new feature) Old ChangeLog entries => ChangeLog.20900 (hobbs)

2002-01-28 (performance enhancement) bytecompiled [regexp] for trivial cases
that amount to string matching.  Also -nocase and --. (hobbs)

2002-02-05 (bug fix) [http::error] called when [::error] intended
=> http 2.4.2 (porter)

2002-02-05 (bug fix)[465765] avoid zero-byte writes to STREAMs







<
<







5362
5363
5364
5365
5366
5367
5368


5369
5370
5371
5372
5373
5374
5375
2002-01-24 (HTTP server bug workaround)[504508] leave the default port out
of the Host: header value
=> http 2.4.1 (hobbs)

2002-01-25 (new feature)[496733] socket options -eofchar and -translation
return read-only values (dejong)



2002-01-28 (performance enhancement) bytecompiled [regexp] for trivial cases
that amount to string matching.  Also -nocase and --. (hobbs)

2002-02-05 (bug fix) [http::error] called when [::error] intended
=> http 2.4.2 (porter)

2002-02-05 (bug fix)[465765] avoid zero-byte writes to STREAMs
5390
5391
5392
5393
5394
5395
5396
5397
5398
5399
5400
5401
5402
5403
5404
2002-02-12 (new feature) partial support for DJGPP Tcl on DOS (gravereaux)

2002-02-14 (mem leak) Fixed leaking an empty Tcl_Obj when [gets $chan]
errored out. (kupries, sofer)

2002-02-15 (new feature)[TIP 72] support for 64-bit integer values on
32-bit platforms and ability to work with >2GiB files.  Extends many
commands.  See ChangeLog and TIP for details.
	*** POTENTIAL INCOMPATIBILITY ***

2002-02-22 (bug fix)[476537] Fix panic when loading shared library without
proper use of stubs on platform without backlinking (porter)

2002-02-22 (new feature)  64-bit support for xlc compiler on AIX-4 (hobbs)








|







5386
5387
5388
5389
5390
5391
5392
5393
5394
5395
5396
5397
5398
5399
5400
2002-02-12 (new feature) partial support for DJGPP Tcl on DOS (gravereaux)

2002-02-14 (mem leak) Fixed leaking an empty Tcl_Obj when [gets $chan]
errored out. (kupries, sofer)

2002-02-15 (new feature)[TIP 72] support for 64-bit integer values on
32-bit platforms and ability to work with >2GiB files.  Extends many
commands.  See TIP for details.
	*** POTENTIAL INCOMPATIBILITY ***

2002-02-22 (bug fix)[476537] Fix panic when loading shared library without
proper use of stubs on platform without backlinking (porter)

2002-02-22 (new feature)  64-bit support for xlc compiler on AIX-4 (hobbs)

5431
5432
5433
5434
5435
5436
5437
5438
5439
5440
5441
5442
5443
5444
5445
of prior Tcl releases.  Others will need to be reconciled.
        *** POTENTIAL INCOMPATIBILITY ***

2002-03-04 (bug fix)[474358, 218099, 219314, 524674] fixed several problems
related to the handling of iso2022 text and finalization of escape-based
encodings. (taguchi, takahashi, hobbs)

--- Released 8.4a4, March 5, 2002 --- See ChangeLog for details ---

2002-03-06 (new feature)[TIP 80] expanded [lsearch] options (wilkason, fellows)

2002-03-07 (new feature)[TIP 87] [interp recursionlimit] (trier)

2002-03-08 (platform feature) mingw 1.1 build favored (dejong)








|







5427
5428
5429
5430
5431
5432
5433
5434
5435
5436
5437
5438
5439
5440
5441
of prior Tcl releases.  Others will need to be reconciled.
        *** POTENTIAL INCOMPATIBILITY ***

2002-03-04 (bug fix)[474358, 218099, 219314, 524674] fixed several problems
related to the handling of iso2022 text and finalization of escape-based
encodings. (taguchi, takahashi, hobbs)

--- Released 8.4a4, March 5, 2002

2002-03-06 (new feature)[TIP 80] expanded [lsearch] options (wilkason, fellows)

2002-03-07 (new feature)[TIP 87] [interp recursionlimit] (trier)

2002-03-08 (platform feature) mingw 1.1 build favored (dejong)

5541
5542
5543
5544
5545
5546
5547
5548
5549
5550
5551
5552
5553
5554
5555
options to configure (max)

2002-06-26 (bug fix)[565880] [clock format] now respects locale (max)
        *** POTENTIAL INCOMPATIBILITY ***

2002-07-03 (bug fix)[577015] [catch] catches even compile errors (sofer)

--- Released 8.4b1, July 5, 2002 --- See ChangeLog for details ---

2002-07-08 (bug fix) restored compatibility of [viewFile] in tcltest (porter)

2002-07-11 (bug fix) [file normalize] returns long form on Win 95/98/ME (darley)

2002-07-15 (performance enhancment) variable operations rewritten to store
	and use cached Var pointers (sofer)







|







5537
5538
5539
5540
5541
5542
5543
5544
5545
5546
5547
5548
5549
5550
5551
options to configure (max)

2002-06-26 (bug fix)[565880] [clock format] now respects locale (max)
        *** POTENTIAL INCOMPATIBILITY ***

2002-07-03 (bug fix)[577015] [catch] catches even compile errors (sofer)

--- Released 8.4b1, July 5, 2002

2002-07-08 (bug fix) restored compatibility of [viewFile] in tcltest (porter)

2002-07-11 (bug fix) [file normalize] returns long form on Win 95/98/ME (darley)

2002-07-15 (performance enhancment) variable operations rewritten to store
	and use cached Var pointers (sofer)
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

2002-08-07 (feature enhancement)[584794,584650,472576] boolean values
	are no longer always re-parsed from string. (sofer)

Many internal bugs fixed.
Considerable cleanup of the test suite.

--- Released 8.4b2, August 9, 2002 --- See ChangeLog for details ---

2002-08-20 (new feature) --enable-memdebug configure option (kupries)

2002-08-23 (bug fix)[597936] mem leak with USE_THREAD_ALLOC (sofer,zoran)

2002-08-26 (bug fix)[599788] segfault in compiler (sofer,wilkason)

2002-08-28 (bug fix)[414910] avoid mem leaks accessing environment variables
	on Windows (welton,gravereaux)

2002-08-31 (platform support)[TIP 108] Mac OS X port (steffen,ingham)

2002-09-02 (platfrom support) 64-bit compile on HP-11 (martin)

--- Released 8.4.0, September 10, 2002 --- See ChangeLog for details ---

2002-09-18 (platform support) Updated support for compiling with Cygwin and
either mingw or gcc. (khan, howell, dejong)

2002-09-22 (bug fix)[612786, 611922] Corrected [puts -nonewline] within
test bodies. Also corrected reporting of body return code.  Updated tcltest
to v2.2.1.







|














|







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

2002-08-07 (feature enhancement)[584794,584650,472576] boolean values
	are no longer always re-parsed from string. (sofer)

Many internal bugs fixed.
Considerable cleanup of the test suite.

--- Released 8.4b2, August 9, 2002

2002-08-20 (new feature) --enable-memdebug configure option (kupries)

2002-08-23 (bug fix)[597936] mem leak with USE_THREAD_ALLOC (sofer,zoran)

2002-08-26 (bug fix)[599788] segfault in compiler (sofer,wilkason)

2002-08-28 (bug fix)[414910] avoid mem leaks accessing environment variables
	on Windows (welton,gravereaux)

2002-08-31 (platform support)[TIP 108] Mac OS X port (steffen,ingham)

2002-09-02 (platfrom support) 64-bit compile on HP-11 (martin)

--- Released 8.4.0, September 10, 2002

2002-09-18 (platform support) Updated support for compiling with Cygwin and
either mingw or gcc. (khan, howell, dejong)

2002-09-22 (bug fix)[612786, 611922] Corrected [puts -nonewline] within
test bodies. Also corrected reporting of body return code.  Updated tcltest
to v2.2.1.
5657
5658
5659
5660
5661
5662
5663
5664
5665
5666
5667
5668
5669
5670
5671
to v1.1. (hobbs)

2002-10-22 (platform support)[624509] On macosx, add embedded framework
dirs to tcl_pkgPath: @executable_path/../Frameworks and
@executable_path/../PrivateFrameworks (if they exist), as well as the dirs
in DYLD_FRAMEWORK_PATH (if set). (steffen)

--- Released 8.4.1, October 22, 2002 --- See ChangeLog for details ---

2002-10-28 (bug fix)[627660] [package unknown] chaining for platform specifics

2002-10-29 (bug fix)[627546] verbose [load] (dyld) error mesages on MacOSX

2002-11-01 (bug fix) [package provide registry] consistent versions.








|







5653
5654
5655
5656
5657
5658
5659
5660
5661
5662
5663
5664
5665
5666
5667
to v1.1. (hobbs)

2002-10-22 (platform support)[624509] On macosx, add embedded framework
dirs to tcl_pkgPath: @executable_path/../Frameworks and
@executable_path/../PrivateFrameworks (if they exist), as well as the dirs
in DYLD_FRAMEWORK_PATH (if set). (steffen)

--- Released 8.4.1, October 22, 2002

2002-10-28 (bug fix)[627660] [package unknown] chaining for platform specifics

2002-10-29 (bug fix)[627546] verbose [load] (dyld) error mesages on MacOSX

2002-11-01 (bug fix) [package provide registry] consistent versions.

5750
5751
5752
5753
5754
5755
5756
5757
5758
5759
5760
5761
5762
5763
5764
2003-02-22 (bug fix)[571002] plugged data leak during thread exit

2003-02-25 (feature change) [pkg_mkIndex -load]: case-insensitive match
        *** POTENTIAL INCOMPATIBILITY ***

2003-02-27 (bug fix)[694232] stop [lsearch -start 0 {} x] segfault

--- Released 8.4.2, March 3, 2003 --- See ChangeLog for details ---

2003-03-06 (bug fix)[699042] Correct case-insensitive unicode string
comparison in Tcl_UniCharNcasecmp

2003-03-11 (bug fix) Corrected loading of tclpip8x.dll on Win9x

2003-03-12 (bug fix)[702383] Corrected parsing of interp create --







|







5746
5747
5748
5749
5750
5751
5752
5753
5754
5755
5756
5757
5758
5759
5760
2003-02-22 (bug fix)[571002] plugged data leak during thread exit

2003-02-25 (feature change) [pkg_mkIndex -load]: case-insensitive match
        *** POTENTIAL INCOMPATIBILITY ***

2003-02-27 (bug fix)[694232] stop [lsearch -start 0 {} x] segfault

--- Released 8.4.2, March 3, 2003

2003-03-06 (bug fix)[699042] Correct case-insensitive unicode string
comparison in Tcl_UniCharNcasecmp

2003-03-11 (bug fix) Corrected loading of tclpip8x.dll on Win9x

2003-03-12 (bug fix)[702383] Corrected parsing of interp create --
5832
5833
5834
5835
5836
5837
5838
5839
5840
5841
5842
5843
5844
5845
5846
2003-05-14 (bug fix)[557030] Correct handling of the gb2312 encoding by
making it an alias of the euc-cn encoding and creating a gb2312-raw
encoding for the original.  Most uses of gb2312 really mean euc-cn.

2003-05-14 (bug fix)[736421] Corrected another putenv() copy behavior
problem when compiling on Windows and using Microsoft's runtime.

--- Released 8.4.3, May 20, 2003 --- See ChangeLog for details ---

2003-05-23 (bug fix)[726018] reverted internals change to the
'cmdName' Tcl_ObjType that broke several extensions (TclBlend, e4graph...)
in the 8.4.3 release.

2003-06-10 (bug fix)[495830] stop eval of bytecode in deleted interp.








|







5828
5829
5830
5831
5832
5833
5834
5835
5836
5837
5838
5839
5840
5841
5842
2003-05-14 (bug fix)[557030] Correct handling of the gb2312 encoding by
making it an alias of the euc-cn encoding and creating a gb2312-raw
encoding for the original.  Most uses of gb2312 really mean euc-cn.

2003-05-14 (bug fix)[736421] Corrected another putenv() copy behavior
problem when compiling on Windows and using Microsoft's runtime.

--- Released 8.4.3, May 20, 2003

2003-05-23 (bug fix)[726018] reverted internals change to the
'cmdName' Tcl_ObjType that broke several extensions (TclBlend, e4graph...)
in the 8.4.3 release.

2003-06-10 (bug fix)[495830] stop eval of bytecode in deleted interp.

5873
5874
5875
5876
5877
5878
5879
5880
5881
5882
5883
5884
5885
5886
5887
2003-07-18 (bug fix)[759888] support for user:pass in URL by [http::geturl]
=> http 2.4.4

Improved documentation, new tests, and some code cleanup.
[655300, 720634, 735364, 748700, 756112, 756744, 756951, 758488, 760768,
763312, 769895, 771539, 771840, 771947, 771949, 772333]

--- Released 8.4.4, July 22, 2003 --- See ChangeLog for details ---

2003-07-23 (bug fix)[775976] fix registry compilation for VC7.

2003-08-05 (enhancement)[781585] Use Tcl_ResetResult in bytecodes to
prevent potential costly Tcl_Obj duplication.

2003-08-06 (bug fix)[781609] prevent non-Windows platforms from trying to







|







5869
5870
5871
5872
5873
5874
5875
5876
5877
5878
5879
5880
5881
5882
5883
2003-07-18 (bug fix)[759888] support for user:pass in URL by [http::geturl]
=> http 2.4.4

Improved documentation, new tests, and some code cleanup.
[655300, 720634, 735364, 748700, 756112, 756744, 756951, 758488, 760768,
763312, 769895, 771539, 771840, 771947, 771949, 772333]

--- Released 8.4.4, July 22, 2003

2003-07-23 (bug fix)[775976] fix registry compilation for VC7.

2003-08-05 (enhancement)[781585] Use Tcl_ResetResult in bytecodes to
prevent potential costly Tcl_Obj duplication.

2003-08-06 (bug fix)[781609] prevent non-Windows platforms from trying to
5919
5920
5921
5922
5923
5924
5925
5926
5927
5928
5929
5930
5931
5932
5933
2003-11-05 (bug fix)[832657] Allow .. in libpath initialization.

2003-11-11 (bug fix) Improve AIX-64 build configuration.

2003-11-17 (bug fix)[230589, 504785, 505048, 703709, 840258] fixes to
various odd regexp "can't happen" bugs.

--- Released 8.4.5, November 20, 2003 --- See ChangeLog for details ---

2003-12-02 (bug fix)[851747] object sharing fix in [binary scan]

2003-12-09 (platform support)[852369] update errno usage for recent glibc

2003-12-12 (bug fix)[858937] fix for [file normalize ~nobody]








|







5915
5916
5917
5918
5919
5920
5921
5922
5923
5924
5925
5926
5927
5928
5929
2003-11-05 (bug fix)[832657] Allow .. in libpath initialization.

2003-11-11 (bug fix) Improve AIX-64 build configuration.

2003-11-17 (bug fix)[230589, 504785, 505048, 703709, 840258] fixes to
various odd regexp "can't happen" bugs.

--- Released 8.4.5, November 20, 2003

2003-12-02 (bug fix)[851747] object sharing fix in [binary scan]

2003-12-09 (platform support)[852369] update errno usage for recent glibc

2003-12-12 (bug fix)[858937] fix for [file normalize ~nobody]

5956
5957
5958
5959
5960
5961
5962
5963
5964
5965
5966
5967
5968
5969
5970

2004-02-25 (bug fix)[888777] plugged memory leak with long host names (cassoff)

2004-03-01 (bug fix)[462580] corrected level interpretation of Tcl_CreateTrace

2004-03-01 (platform support)[218561] Allow 64-bit configure on IRIX64-6.5*

--- Released 8.4.6, March 1, 2004 --- See ChangeLog for details ---

Changes to 8.5a1 include all changes to the 8.4 line through 8.4.6,
plus the following, which focuses on the high-level feature changes
in this changeset (new minor version) rather than bug fixes:

 * refactored IO code to split FS path code into generic/tclPathObj.c
  and generic/tclFileSystem.h







|







5952
5953
5954
5955
5956
5957
5958
5959
5960
5961
5962
5963
5964
5965
5966

2004-02-25 (bug fix)[888777] plugged memory leak with long host names (cassoff)

2004-03-01 (bug fix)[462580] corrected level interpretation of Tcl_CreateTrace

2004-03-01 (platform support)[218561] Allow 64-bit configure on IRIX64-6.5*

--- Released 8.4.6, March 1, 2004

Changes to 8.5a1 include all changes to the 8.4 line through 8.4.6,
plus the following, which focuses on the high-level feature changes
in this changeset (new minor version) rather than bug fixes:

 * refactored IO code to split FS path code into generic/tclPathObj.c
  and generic/tclFileSystem.h
6042
6043
6044
6045
6046
6047
6048
6049
6050
6051
6052
6053
6054
6055
6056

 * [TIP #156] add "root locale" to msgcat
=> msgcat 1.4

 * [TIP #157] leading {expand} syntax on words to cause argument expansion.
   This is a safer/cleaner alternative to the use of 'eval'.

--- Released 8.5a1, March 3, 2004 --- See ChangeLog for details ---

2004-03-04 (new feature) registry package is [unload]able (thoyts)
=> registry 1.1.4

2004-03-08 (bug fix)[910525] [glob -path] in root directory (darley)

2004-03-12 (new feature)[TIP 163] [dict merge] (english, fellows)







|







6038
6039
6040
6041
6042
6043
6044
6045
6046
6047
6048
6049
6050
6051
6052

 * [TIP #156] add "root locale" to msgcat
=> msgcat 1.4

 * [TIP #157] leading {expand} syntax on words to cause argument expansion.
   This is a safer/cleaner alternative to the use of 'eval'.

--- Released 8.5a1, March 3, 2004

2004-03-04 (new feature) registry package is [unload]able (thoyts)
=> registry 1.1.4

2004-03-08 (bug fix)[910525] [glob -path] in root directory (darley)

2004-03-12 (new feature)[TIP 163] [dict merge] (english, fellows)
6066
6067
6068
6069
6070
6071
6072
6073
6074
6075
6076
6077
6078
6079
6080
2004-03-31 (bug fix)[811461] ignore locales with no "language" part (porter)
=> msgcat 1.4.1

2004-04-01 (bug fix) make [glob -type d -dir . *] work across VFS boundary

2004-04-06 (clean up) refactored Tcl header file #include order.  Might
create need for changes in extensions that #include private headers.
Changed source code files should work with older Tcl as well.  See ChangeLog.
     *** POTENTIAL INCOMPATIBILITY ***

2004-04-07 (bug fix)[920667] install into any Unicode path on Win (hobbs)

2004-04-07 (platform support) properly substitute more values in Windows
tclConfig.sh (hobbs)








|







6062
6063
6064
6065
6066
6067
6068
6069
6070
6071
6072
6073
6074
6075
6076
2004-03-31 (bug fix)[811461] ignore locales with no "language" part (porter)
=> msgcat 1.4.1

2004-04-01 (bug fix) make [glob -type d -dir . *] work across VFS boundary

2004-04-06 (clean up) refactored Tcl header file #include order.  Might
create need for changes in extensions that #include private headers.
Changed source code files should work with older Tcl as well.
     *** POTENTIAL INCOMPATIBILITY ***

2004-04-07 (bug fix)[920667] install into any Unicode path on Win (hobbs)

2004-04-07 (platform support) properly substitute more values in Windows
tclConfig.sh (hobbs)

6342
6343
6344
6345
6346
6347
6348
6349
6350
6351
6352
6353
6354
6355
6356
2004-12-02 (bug fix)[1074671] Ensure tilde paths are not returned specially
by 'glob' (darley)

Doc improvements [759545,926590,935853,1017072,1018486,1022527,1027849,
	1032243,1047928,1048005,1058446,1062647,1065732,1073334,etc.]
Test suite expansion [1036649,1001997,etc.]

--- Released 8.5a2, December 7, 2004 --- See ChangeLog for details ---

2004-12-13 (bug fix)[1083082] encoding memory leaks (ade,porter)

2004-12-13 (bug fix)[1082349] restored C++ extension support (porter)

2004-12-14 (bug fix)[1081541] workaround automake-ism "$U" (porter)








|







6338
6339
6340
6341
6342
6343
6344
6345
6346
6347
6348
6349
6350
6351
6352
2004-12-02 (bug fix)[1074671] Ensure tilde paths are not returned specially
by 'glob' (darley)

Doc improvements [759545,926590,935853,1017072,1018486,1022527,1027849,
	1032243,1047928,1048005,1058446,1062647,1065732,1073334,etc.]
Test suite expansion [1036649,1001997,etc.]

--- Released 8.5a2, December 7, 2004

2004-12-13 (bug fix)[1083082] encoding memory leaks (ade,porter)

2004-12-13 (bug fix)[1082349] restored C++ extension support (porter)

2004-12-14 (bug fix)[1081541] workaround automake-ism "$U" (porter)

6486
6487
6488
6489
6490
6491
6492
6493
6494
6495
6496
6497
6498
6499
6500

2005-06-01 (new feature)[TIP 241] -nocase: lsort, lsearch, switch (mistachkin)

2005-06-01 (bug fix)[1209759] "return TCL_RETURN;" could cause panic (porter)

Documentation improvements [1075433,1085127,1117017,1124160,1149605,etc.]

--- Released 8.5a3, June 4, 2005 --- See ChangeLog for details ---

2005-06-06 (bug fix)[1213678] Windows/gcc: crash in stack.test (kenny)

2005-06-07 (new feature)[TIP 208] [chan] and [chan truncate] (fellows)

2005-06-07 (revert) Restored registration of "procbody" Tcl_ObjType (porter)
Reduces the ***POTENTIAL INCOMPATIBILITY*** from 2005-05-17.







|







6482
6483
6484
6485
6486
6487
6488
6489
6490
6491
6492
6493
6494
6495
6496

2005-06-01 (new feature)[TIP 241] -nocase: lsort, lsearch, switch (mistachkin)

2005-06-01 (bug fix)[1209759] "return TCL_RETURN;" could cause panic (porter)

Documentation improvements [1075433,1085127,1117017,1124160,1149605,etc.]

--- Released 8.5a3, June 4, 2005

2005-06-06 (bug fix)[1213678] Windows/gcc: crash in stack.test (kenny)

2005-06-07 (new feature)[TIP 208] [chan] and [chan truncate] (fellows)

2005-06-07 (revert) Restored registration of "procbody" Tcl_ObjType (porter)
Reduces the ***POTENTIAL INCOMPATIBILITY*** from 2005-05-17.
6737
6738
6739
6740
6741
6742
6743
6744
6745
6746
6747
6748
6749
6750
6751
2006-04-12 (feature change)[1376892] revised definition of [:print:] (fellows)

(platform support) Use of _ANSI_ARGS_ purged.  ANSI compiler required (fellows)

Documentation improvements [1211078,1190891,1292427,1277503,1104682,1359183,
1415725,666770]

--- Released 8.5a4, April 27, 2006 --- See ChangeLog for details ---

2006-05-04 (bug fix)[1480509] srand() accept wide input (porter,afredd)

2006-05-05 (bug fix)[1481986] interactive Tcl_Main blocks main loop (porter,lin)

2006-05-13 (bug fix)[1482718] proc re-compile: preserve the previous
bytecode while references still on the stack (porter,ryazanov)







|







6733
6734
6735
6736
6737
6738
6739
6740
6741
6742
6743
6744
6745
6746
6747
2006-04-12 (feature change)[1376892] revised definition of [:print:] (fellows)

(platform support) Use of _ANSI_ARGS_ purged.  ANSI compiler required (fellows)

Documentation improvements [1211078,1190891,1292427,1277503,1104682,1359183,
1415725,666770]

--- Released 8.5a4, April 27, 2006

2006-05-04 (bug fix)[1480509] srand() accept wide input (porter,afredd)

2006-05-05 (bug fix)[1481986] interactive Tcl_Main blocks main loop (porter,lin)

2006-05-13 (bug fix)[1482718] proc re-compile: preserve the previous
bytecode while references still on the stack (porter,ryazanov)
6833
6834
6835
6836
6837
6838
6839
6840
6841
6842
6843
6844
6845
6846
6847

2006-10-10 (bug fix)[1566526] crash cleaning up [namespace path] data (porter)

2006-10-12 (bug fix)[1576006] better error messages from [interp alias] (sofer)

2006-10-13 (platform support) get stack size on Darwin (steffen)

--- Released 8.5a5, October 20, 2006 --- See ChangeLog for details ---

2006-10-20 (configure change) Added autodetection for OS-supplied timezone
files (max)

2006-10-23 (enhancement)[1577278] Ensure the Tcl call stack always has a
CallFrame, even at level 0 (sofer)
	*** POTENTIAL INCOMPATIBILITY for users of tclInt.h ***







|







6829
6830
6831
6832
6833
6834
6835
6836
6837
6838
6839
6840
6841
6842
6843

2006-10-10 (bug fix)[1566526] crash cleaning up [namespace path] data (porter)

2006-10-12 (bug fix)[1576006] better error messages from [interp alias] (sofer)

2006-10-13 (platform support) get stack size on Darwin (steffen)

--- Released 8.5a5, October 20, 2006

2006-10-20 (configure change) Added autodetection for OS-supplied timezone
files (max)

2006-10-23 (enhancement)[1577278] Ensure the Tcl call stack always has a
CallFrame, even at level 0 (sofer)
	*** POTENTIAL INCOMPATIBILITY for users of tclInt.h ***
6915
6916
6917
6918
6919
6920
6921
6922
6923
6924
6925
6926
6927
6928
6929

2007-04-20 (bug fix) Improve clock localization for Japanese locale (kenny)

2007-04-20 (enhancement) Document Tcl_SetNotifier & Tcl_ServiceModeHook (kenny)

2007-04-23 (bug fix) fts_open() crash on 64bit Darwin 8 or earlier (steffen)

--- Released 8.5a6, April 25, 2007 --- See ChangeLog for details ---

2007-04-30 (bug fix)[1705778] many valgrind-detected leaks corrected

2007-05-01 (bug fix)[1710709] leak in [string map] (porter)

2007-05-02 (bug fix)[1710707] leaks in filesystem paths (mistachkin,kenny)








|







6911
6912
6913
6914
6915
6916
6917
6918
6919
6920
6921
6922
6923
6924
6925

2007-04-20 (bug fix) Improve clock localization for Japanese locale (kenny)

2007-04-20 (enhancement) Document Tcl_SetNotifier & Tcl_ServiceModeHook (kenny)

2007-04-23 (bug fix) fts_open() crash on 64bit Darwin 8 or earlier (steffen)

--- Released 8.5a6, April 25, 2007

2007-04-30 (bug fix)[1705778] many valgrind-detected leaks corrected

2007-05-01 (bug fix)[1710709] leak in [string map] (porter)

2007-05-02 (bug fix)[1710707] leaks in filesystem paths (mistachkin,kenny)

6973
6974
6975
6976
6977
6978
6979
6980
6981
6982
6983
6984
6985
6986
6987

2007-08-14 (platform support) Darwin [load] from VFS on intel & 64bit (steffen)

2007-08-15 (bug fix)[1773127] corrected open mode "a+" (rottman,fellows)

2007-08-16 (bug fix)[1773040] ::errorInfo trace crash (janssen,porter)

2007-08-16 (performance)[1564517] pre-compile constant expressions (porter)

2007-08-21 (bug fix)[1775878] 'puts \' in interactive tclsh failed to move to
prompt for continuation line (porter)

2007-08-25 (bug fix)[1781282] [clock scan] case senstivity (kenny)

2007-08-25 (performance)[1767293] ** on native integer types (kenny)







|







6969
6970
6971
6972
6973
6974
6975
6976
6977
6978
6979
6980
6981
6982
6983

2007-08-14 (platform support) Darwin [load] from VFS on intel & 64bit (steffen)

2007-08-15 (bug fix)[1773127] corrected open mode "a+" (rottman,fellows)

2007-08-16 (bug fix)[1773040] ::errorInfo trace crash (janssen,porter)

2007-08-16 (performance)[1564517] precompile constant expressions (porter)

2007-08-21 (bug fix)[1775878] 'puts \' in interactive tclsh failed to move to
prompt for continuation line (porter)

2007-08-25 (bug fix)[1781282] [clock scan] case senstivity (kenny)

2007-08-25 (performance)[1767293] ** on native integer types (kenny)
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
2007-09-15 (platform support) SunOS-5.1x link with cc, not ld (steffen)

2007-09-17 (platform support)[1748251] Fix NetBSD link failures (english)

(bug fix)[1066755] Several stack efficiency efforts increases recursion limit
on Windows to be larger than the default [interp recursionlimit] value

--- Released 8.5b1, September 26, 2007 --- See ChangeLog for details ---

2007-10-02 (bug fix)[1806422] proper [tcl::tm::path] autoload (porter)

2007-10-02 (bug fix) Improve Tcl_DecrRefCount() robustness (staplin)

2007-10-11 (bug fix)[1805887] [string is int -failindex] for 0o, 0b (porter)

2007-10-15 (bug fix)[1813528] Tcl_ParseBraces read past buffer (mistachkin)

2007-10-25 (bug fix)[1726873] intermittent crash in threads (vasiljevic)

--- Released 8.5b2, October 26, 2007 --- See ChangeLog for details ---

2007-10-27 (bug fix)[1821159] fixed broken compile on x86_64 (sofer)

2007-10-27 (bug fix)[1810264] stop panic in RE lexer (fellows)

2007-10-28 (enhancement)[1826906] Embed iso8859-1 encoding in libtcl (fellows)








|











|







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
2007-09-15 (platform support) SunOS-5.1x link with cc, not ld (steffen)

2007-09-17 (platform support)[1748251] Fix NetBSD link failures (english)

(bug fix)[1066755] Several stack efficiency efforts increases recursion limit
on Windows to be larger than the default [interp recursionlimit] value

--- Released 8.5b1, September 26, 2007

2007-10-02 (bug fix)[1806422] proper [tcl::tm::path] autoload (porter)

2007-10-02 (bug fix) Improve Tcl_DecrRefCount() robustness (staplin)

2007-10-11 (bug fix)[1805887] [string is int -failindex] for 0o, 0b (porter)

2007-10-15 (bug fix)[1813528] Tcl_ParseBraces read past buffer (mistachkin)

2007-10-25 (bug fix)[1726873] intermittent crash in threads (vasiljevic)

--- Released 8.5b2, October 26, 2007

2007-10-27 (bug fix)[1821159] fixed broken compile on x86_64 (sofer)

2007-10-27 (bug fix)[1810264] stop panic in RE lexer (fellows)

2007-10-28 (enhancement)[1826906] Embed iso8859-1 encoding in libtcl (fellows)

7066
7067
7068
7069
7070
7071
7072
7073
7074
7075
7076
7077
7078
7079
7080

2007-11-15 (new feature)[1231022] configure option: --disable-rpath (fellows)

2007-11-15 (bug fix)[1810038] infinite loop in RE compiler (lane,porter)

Many significant documentation improvements (fellows, sofer)

--- Released 8.5b3, November 19, 2007 --- See ChangeLog for details ---

2007-11-20 (enhancement) string rep of dict has stable order (fellows)

2007-11-21 (enhancement) compiled ensemble support (fellows)

2007-11-22 (enhancement) [dict] is now an ensemble (fellows)








|







7062
7063
7064
7065
7066
7067
7068
7069
7070
7071
7072
7073
7074
7075
7076

2007-11-15 (new feature)[1231022] configure option: --disable-rpath (fellows)

2007-11-15 (bug fix)[1810038] infinite loop in RE compiler (lane,porter)

Many significant documentation improvements (fellows, sofer)

--- Released 8.5b3, November 19, 2007

2007-11-20 (enhancement) string rep of dict has stable order (fellows)

2007-11-21 (enhancement) compiled ensemble support (fellows)

2007-11-22 (enhancement) [dict] is now an ensemble (fellows)

7100
7101
7102
7103
7104
7105
7106
7107
7108
7109
7110
7111
7112
7113
7114
2007-12-17 (bug fix)[1851832,1851524] memory alignment correction (sofer)

2007-12-18 (bug fix)[1810264] revised regexp engine to prevent debilitating
over-consumption of resources (drewry,lane,ormandy,fellows)

Several documentation and release notes improvements

--- Released 8.5.0, December 20, 2007 --- See ChangeLog for details ---

2007-12-23 (bug fix)[1857126] restore backref support to regexps (hobbs)

2007-12-26 (enhancement)[1856994] [lsort] performance (sofer)

2008-01-10 (bug fix)[1867855] fix [format %lli 0] crash (porter)








|







7096
7097
7098
7099
7100
7101
7102
7103
7104
7105
7106
7107
7108
7109
7110
2007-12-17 (bug fix)[1851832,1851524] memory alignment correction (sofer)

2007-12-18 (bug fix)[1810264] revised regexp engine to prevent debilitating
over-consumption of resources (drewry,lane,ormandy,fellows)

Several documentation and release notes improvements

--- Released 8.5.0, December 20, 2007

2007-12-23 (bug fix)[1857126] restore backref support to regexps (hobbs)

2007-12-26 (enhancement)[1856994] [lsort] performance (sofer)

2008-01-10 (bug fix)[1867855] fix [format %lli 0] crash (porter)

7122
7123
7124
7125
7126
7127
7128
7129
7130
7131
7132
7133
7134
7135
7136

2008-01-22 (bug fix)[1867855] fix [lreverse {}] crash (sofer,madden)

2008-01-30 (bug fix)[1882373] fix Tcl_GetAlias pointer code (an00na)

Several documentation and release notes improvements

--- Released 8.5.1, February 5, 2008 --- See ChangeLog for details ---

2008-02-06 (enhancement) [clock format] performance (kenny)

2008-02-12 (bug fix)[1891827] compiled [switch -nocase] error (fellows)

2008-02-22 (bug fix)[1818565] missing state array in http::status (thoyts)
=> http 2.5.4







|







7118
7119
7120
7121
7122
7123
7124
7125
7126
7127
7128
7129
7130
7131
7132

2008-01-22 (bug fix)[1867855] fix [lreverse {}] crash (sofer,madden)

2008-01-30 (bug fix)[1882373] fix Tcl_GetAlias pointer code (an00na)

Several documentation and release notes improvements

--- Released 8.5.1, February 5, 2008

2008-02-06 (enhancement) [clock format] performance (kenny)

2008-02-12 (bug fix)[1891827] compiled [switch -nocase] error (fellows)

2008-02-22 (bug fix)[1818565] missing state array in http::status (thoyts)
=> http 2.5.4
7183
7184
7185
7186
7187
7188
7189
7190
7191
7192
7193
7194
7195
7196
7197

2008-03-24 (bug fix)[1923966] crash in [binary format x0s] (thoyts)

2008-03-27 (platform support)[1921166] Solaris 64bit build fixes (steffen)

2008-03-27 clock tzdata updated to Olson's tzdata2008b (kenny)

--- Released 8.5.2, March 28, 2008 --- See ChangeLog for details ---

2008-03-30 (bug fix)[1783544] more robust TclIsNaN() (kenny,teterin)

2008-04-01 (interface)[1819422] tclStubsPtr no longer in libtcl (porter)
	*** POTENTIAL INCOMPATIBILITY ***

2008-04-01 (bug fix)[1839067] FP round fix for Solaris/x86 (kupries,schlenker)







|







7179
7180
7181
7182
7183
7184
7185
7186
7187
7188
7189
7190
7191
7192
7193

2008-03-24 (bug fix)[1923966] crash in [binary format x0s] (thoyts)

2008-03-27 (platform support)[1921166] Solaris 64bit build fixes (steffen)

2008-03-27 clock tzdata updated to Olson's tzdata2008b (kenny)

--- Released 8.5.2, March 28, 2008

2008-03-30 (bug fix)[1783544] more robust TclIsNaN() (kenny,teterin)

2008-04-01 (interface)[1819422] tclStubsPtr no longer in libtcl (porter)
	*** POTENTIAL INCOMPATIBILITY ***

2008-04-01 (bug fix)[1839067] FP round fix for Solaris/x86 (kupries,schlenker)
7238
7239
7240
7241
7242
7243
7244
7245
7246
7247
7248
7249
7250
7251
7252

2008-06-23 (bug fix)[1972879] bad path intrep caching (porter)

2008-06-24 (bug fix)[1999176] crash in [glob -dir {} a] (porter)

2008-06-25 (bug fix)[1999119] Support TM packages in Safe Base (kupries)

--- Released 8.6a1, June 25, 2008 --- See ChangeLog for details ---

2008-06-29 (bug fix)[2004480] plug memory leaks (ade,porter,steffen)

2008-07-01 (enhancement)[1905562] embed recursion limit in RE engine (fellows)

2008-07-03 (bug fix)[1969717] fix package finding on Samba shares (jos)








|







7234
7235
7236
7237
7238
7239
7240
7241
7242
7243
7244
7245
7246
7247
7248

2008-06-23 (bug fix)[1972879] bad path intrep caching (porter)

2008-06-24 (bug fix)[1999176] crash in [glob -dir {} a] (porter)

2008-06-25 (bug fix)[1999119] Support TM packages in Safe Base (kupries)

--- Released 8.6a1, June 25, 2008

2008-06-29 (bug fix)[2004480] plug memory leaks (ade,porter,steffen)

2008-07-01 (enhancement)[1905562] embed recursion limit in RE engine (fellows)

2008-07-03 (bug fix)[1969717] fix package finding on Samba shares (jos)

7291
7292
7293
7294
7295
7296
7297
7298
7299
7300
7301
7302
7303
7304
7305

2008-08-21 (new feature) CONST-ified Tcl routines passing (Tcl_ObjType *),
(Tcl_Filesystem *), or (Tcl_Timer *) arguments (nijtmans,porter)
	*** POTENTIAL INCOMPATIBILITY ***

2008-08-21 (bug fix)[2065115] Restored ***= regexp functioning (hobbs,porter)

--- Released 8.6a2, August 25, 2008 --- See ChangeLog for details ---

2008-08-29 (bug fix)[2082299] Install TclOO header files (fellows)

2008-09-01 oo methods called during interp deletion no longer skipped if
they do not need the dying interp (fellows)

2008-09-02 (support) Dropped support for pre-ANSI compilers.  (porter)







|







7287
7288
7289
7290
7291
7292
7293
7294
7295
7296
7297
7298
7299
7300
7301

2008-08-21 (new feature) CONST-ified Tcl routines passing (Tcl_ObjType *),
(Tcl_Filesystem *), or (Tcl_Timer *) arguments (nijtmans,porter)
	*** POTENTIAL INCOMPATIBILITY ***

2008-08-21 (bug fix)[2065115] Restored ***= regexp functioning (hobbs,porter)

--- Released 8.6a2, August 25, 2008

2008-08-29 (bug fix)[2082299] Install TclOO header files (fellows)

2008-09-01 oo methods called during interp deletion no longer skipped if
they do not need the dying interp (fellows)

2008-09-02 (support) Dropped support for pre-ANSI compilers.  (porter)
7372
7373
7374
7375
7376
7377
7378
7379
7380
7381
7382
7383
7384
7385
7386

2008-10-07 (new feature)[TIP 328] [coroutine],[yield],[info coroutine] (sofer)

2008-10-08 (bug fix)[2151707] fix stack trace from variable trace (porter)

2008-10-10 (bug fix)[2155658] crash in oo method export (fellows)

--- Released 8.6a3, October 10, 2008 --- See ChangeLog for details ---

2008-10-13 (bug fix) Fix ability to join threads on 64-bit Windows (thoyts)

2008-10-23 (bug fix)[2186888] Direct-eval [for] handling of [continue] was
broken by NRE reform (sofer,porter)

2008-10-24 (bug fix) fix failure to read SHOUTcast streams (thoyts)







|







7368
7369
7370
7371
7372
7373
7374
7375
7376
7377
7378
7379
7380
7381
7382

2008-10-07 (new feature)[TIP 328] [coroutine],[yield],[info coroutine] (sofer)

2008-10-08 (bug fix)[2151707] fix stack trace from variable trace (porter)

2008-10-10 (bug fix)[2155658] crash in oo method export (fellows)

--- Released 8.6a3, October 10, 2008

2008-10-13 (bug fix) Fix ability to join threads on 64-bit Windows (thoyts)

2008-10-23 (bug fix)[2186888] Direct-eval [for] handling of [continue] was
broken by NRE reform (sofer,porter)

2008-10-24 (bug fix) fix failure to read SHOUTcast streams (thoyts)
7442
7443
7444
7445
7446
7447
7448
7449
7450
7451
7452
7453
7454
7455
7456

2008-12-17 (new feature)[TIP 308] package tdbc 1.0b1 (kenny)

2008-12-18 (new feature)[TIP 332] [close $chan read|write] (ferrieux)

2008-12-18 (bug fix)[2444274] panic in long commands from {*} (goth,porter)

--- Released 8.6b1, December 19, 2008 --- See ChangeLog for details ---

2008-12-27 [TIP 234] Tcl_Zlib* interface revisions (fellows)
	*** INCOMPATIBILITY with interface of 8.6b1 ***

2009-01-02 (platform support)[878333] IRIX compat for mkstemp() (fellows)

2009-01-03 (bug fix)[2481670] [clock add] error message (talvo)







|







7438
7439
7440
7441
7442
7443
7444
7445
7446
7447
7448
7449
7450
7451
7452

2008-12-17 (new feature)[TIP 308] package tdbc 1.0b1 (kenny)

2008-12-18 (new feature)[TIP 332] [close $chan read|write] (ferrieux)

2008-12-18 (bug fix)[2444274] panic in long commands from {*} (goth,porter)

--- Released 8.6b1, December 19, 2008

2008-12-27 [TIP 234] Tcl_Zlib* interface revisions (fellows)
	*** INCOMPATIBILITY with interface of 8.6b1 ***

2009-01-02 (platform support)[878333] IRIX compat for mkstemp() (fellows)

2009-01-03 (bug fix)[2481670] [clock add] error message (talvo)
7950
7951
7952
7953
7954
7955
7956
7957
7958
7959
7960
7961
7962
7963
7964

2011-07-28 tzdata updated to Olson's tzdata2011h (porter)

2011-08-01 (bug fix)[3383616] memleak exposed by XOTcl (neumann,sofer)

Many more Tcl built-in command errors now set an -errorcode.

--- Released 8.6b2, August 8, 2011 --- See ChangeLog for details ---

2011-07-02 (bug fix)[3349507] correct double(1[string repeat 0 23]) (kenny)

2011-07-19 (bug fix)[3371644] Tcl_ConvertElement() segfault (sader, ferrieux)

2011-07-21 (bug fix)[3372130] hypot(.) segfault (nijtmans)








|







7946
7947
7948
7949
7950
7951
7952
7953
7954
7955
7956
7957
7958
7959
7960

2011-07-28 tzdata updated to Olson's tzdata2011h (porter)

2011-08-01 (bug fix)[3383616] memleak exposed by XOTcl (neumann,sofer)

Many more Tcl built-in command errors now set an -errorcode.

--- Released 8.6b2, August 8, 2011

2011-07-02 (bug fix)[3349507] correct double(1[string repeat 0 23]) (kenny)

2011-07-19 (bug fix)[3371644] Tcl_ConvertElement() segfault (sader, ferrieux)

2011-07-21 (bug fix)[3372130] hypot(.) segfault (nijtmans)

8111
8112
8113
8114
8115
8116
8117
8118
8119
8120
8121
8122
8123
8124
8125
2012-09-07 (TIP 404) New msgcat commands [mcflset], [mcflmset] (oehlmann)
=> msgcat 1.5.0

Many revisions to better support a Cygwin environment (nijtmans)

Dropped support for OS X versions less than 10.4 (Tiger) (fellows)

--- Released 8.6b3, September 18, 2012 --- See ChangeLog for details ---

2012-09-20 (enhancement) full Unicode support (nijtmans)
=> dde 1.4.0

2012-09-20 (enhancement) update bundled zlib to 1.2.7 (nijtmans)

2012-10-03 (bug fix) exit panic on stacked std channel (griffin,porter)







|







8107
8108
8109
8110
8111
8112
8113
8114
8115
8116
8117
8118
8119
8120
8121
2012-09-07 (TIP 404) New msgcat commands [mcflset], [mcflmset] (oehlmann)
=> msgcat 1.5.0

Many revisions to better support a Cygwin environment (nijtmans)

Dropped support for OS X versions less than 10.4 (Tiger) (fellows)

--- Released 8.6b3, September 18, 2012

2012-09-20 (enhancement) full Unicode support (nijtmans)
=> dde 1.4.0

2012-09-20 (enhancement) update bundled zlib to 1.2.7 (nijtmans)

2012-10-03 (bug fix) exit panic on stacked std channel (griffin,porter)
8158
8159
8160
8161
8162
8163
8164
8165
8166
8167
8168
8169
8170
8171
8172
2012-12-03 (bug fix) [configure] query broke init from argv (porter)
=> tcltest 2.3.5

2012-12-13 (bug fix)[3595576] crash: [catch {} -> noSuchNs::var] (sofer,porter)

2012-12-13 (bug fix) crash: [zlib gunzip $data -header noSuchNs::var] (porter)

--- Released 8.6.0, December 20, 2012 --- See ChangeLog for details ---

2012-12-22 (bug fix)[3598150] DString to Tcl_Obj memleak (afredd)

2012-12-27 (bug fix)[3598580] Tcl_ListObjReplace() refcount fix (nijtmans)

2013-01-04 (bug fix) memleak in [format] compiler (fellows)








|







8154
8155
8156
8157
8158
8159
8160
8161
8162
8163
8164
8165
8166
8167
8168
2012-12-03 (bug fix) [configure] query broke init from argv (porter)
=> tcltest 2.3.5

2012-12-13 (bug fix)[3595576] crash: [catch {} -> noSuchNs::var] (sofer,porter)

2012-12-13 (bug fix) crash: [zlib gunzip $data -header noSuchNs::var] (porter)

--- Released 8.6.0, December 20, 2012

2012-12-22 (bug fix)[3598150] DString to Tcl_Obj memleak (afredd)

2012-12-27 (bug fix)[3598580] Tcl_ListObjReplace() refcount fix (nijtmans)

2013-01-04 (bug fix) memleak in [format] compiler (fellows)

8247
8248
8249
8250
8251
8252
8253
8254
8255
8256
8257
8258
8259
8260
8261

2013-05-29 (bug fix)[3614102] [apply {{} {list [if 1]}}] stack woes (porter)

2013-06-03 Restored lost performance appending to long strings (elby,porter)

2013-06-05 (bug fix)[2835313] [while 1 {foo [continue]}] crash (fellows)

2013-06-17 (bug fix)[a876646] [:cntrl:] includes \x00 to \x1f (nijtmans)

2013-06-27 (bug fix)[983509] missing encodings for config values (nijtmans)

2013-06-27 (bug fix)[34538b] apply DST in 2099 (lang)

2013-07-02 (bug fix)[32afa6] corrected dirent64 check (griffin)








|







8243
8244
8245
8246
8247
8248
8249
8250
8251
8252
8253
8254
8255
8256
8257

2013-05-29 (bug fix)[3614102] [apply {{} {list [if 1]}}] stack woes (porter)

2013-06-03 Restored lost performance appending to long strings (elby,porter)

2013-06-05 (bug fix)[2835313] [while 1 {foo [continue]}] crash (fellows)

2013-06-17 (bug fix)[a876646] [:cntrl:] includes \x00 to \x1F (nijtmans)

2013-06-27 (bug fix)[983509] missing encodings for config values (nijtmans)

2013-06-27 (bug fix)[34538b] apply DST in 2099 (lang)

2013-07-02 (bug fix)[32afa6] corrected dirent64 check (griffin)

8681
8682
8683
8684
8685
8686
8687
8688
8689
8690
8691
8692
8693
8694
8695
2016-07-02 (enhancement)[09fabc] Sort order of -relateddir (lanam)

2016-07-07 (bug)[5d7ca0] Win: [file executable] for .cmd and .ps1 (nadkarni)
        *** POTENTIAL INCOMPATIBILITY ***

2016-07-08 (bug)[a47641] [file normalize] & Windows junctions (nadkarni)

2016-07-09 [ae61a6] [file] handling of Win hardcoded names (CON) (nadkarni)
        *** POTENTIAL INCOMPATIBILITY ***

2016-07-09 [3613671] [file owned] (more) useful on Win (nadkarni)

2016-07-09 (bug)[1493a4] [namespace upvar] use of resolvers (beric,fellows)
        *** POTENTIAL INCOMPATIBILITY ***








|







8677
8678
8679
8680
8681
8682
8683
8684
8685
8686
8687
8688
8689
8690
8691
2016-07-02 (enhancement)[09fabc] Sort order of -relateddir (lanam)

2016-07-07 (bug)[5d7ca0] Win: [file executable] for .cmd and .ps1 (nadkarni)
        *** POTENTIAL INCOMPATIBILITY ***

2016-07-08 (bug)[a47641] [file normalize] & Windows junctions (nadkarni)

2016-07-09 [ae61a6] [file] handling of Win hard-coded names (CON) (nadkarni)
        *** POTENTIAL INCOMPATIBILITY ***

2016-07-09 [3613671] [file owned] (more) useful on Win (nadkarni)

2016-07-09 (bug)[1493a4] [namespace upvar] use of resolvers (beric,fellows)
        *** POTENTIAL INCOMPATIBILITY ***

9409
9410
9411
9412
9413
9414
9415




















































2021-10-27 (new) support for MacOS Monterey (nijtmans)
=> platform 1.0.18

2021-10-27 tzdata updated to Olson's tzdata2021e (nijtmans)

- Released 8.6.12, Nov 5, 2021 - details at https://core.tcl-lang.org/tcl/ -


























































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

2021-10-27 (new) support for MacOS Monterey (nijtmans)
=> platform 1.0.18

2021-10-27 tzdata updated to Olson's tzdata2021e (nijtmans)

- Released 8.6.12, Nov 5, 2021 - details at https://core.tcl-lang.org/tcl/ -

2021-12-08 (update) tcltest package to version 2.5.4

2022-01-13 (bug)[26f132] Crash when sizeof(int) < sizeof(void *) (Plan 9 port)

2022-01-19 (TIP 623)[e9a271] Tcl_GetRange index args < 0 (petasis,nijtmans)

2022-03-08 (bug) test string-5.22 (porter)

2022-03-11 (bug)[8a7ec8] fat binary compile on Mac M1 (davis, nijtmans)

2022-04-04 (bug)[e5ed1b] numeric IPv6 in URLs (nijtmans)
=> http 2.9.6

2022-04-26 (bug)[27520c] test error-9.6 (goth,sebres)

2022-05-04 (bug)[8eb64b] http package tolerant again invalid reply header

2022-05-11 (bug)[6898f9] http package failed detection of shiftjis charset

2022-05-25 (bug)[76ad7a] tests string-6.13[23] (mistachkin, nijtmans)

2022-06-20 (bug)[55bf73] Avoid connection reuse after response code 101.
=> http 2.9.8

2022-07-22 (bug)[713653] FP rounding exposed by x86 musl (rubicon,sebres)

2022-07-22 More portable notation of microseconds in verbose output (sebres)
=> tcltest 2.5.5

2022-07-27 (bug)[b3977d] Process CR-LF split across packets (nadkarni,sebres)

2022-07-29 (bug)[4eb3a1] crash due to undetected bytecode invalidity (nadkarni)

2022-08-23 (new)[371080] Portability to CHERI-enabled Morello processor (jrtc27)

2022-09-06 (bug)[55a02f] Fallback init env(HOME) from USERPROFILE (nadkarni)

2022-09-13 (bug)[1073da] crash writing invalid utf-8 (nijtmans)

2022-09-14 (new) Update to Unicode-15 (nijtmans)

2022-10-14 tzdata updated to Olson's tzdata2022e (nijtmans)

Update bundled zlib to 1.2.13

Update bundled libtommath

Many code fixes to avoid overflow or undefined behavior.  Thanks chrstphrchvz.

- Released 8.6.13, Nov 22, 2022 - details at https://core.tcl-lang.org/tcl/ -

Deleted compat/dirent.h.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/*
 * dirent.h --
 *
 *	This file is a replacement for <dirent.h> in systems that
 *	support the old BSD-style <sys/dir.h> with a "struct direct".
 *
 * Copyright (c) 1991 The Regents of the University of California.
 * Copyright (c) 1994 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifndef _DIRENT
#define _DIRENT

#include <sys/dir.h>

#define dirent direct

#endif /* _DIRENT */
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<










































Deleted compat/dirent2.h.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
/*
 * dirent.h --
 *
 *	Declarations of a library of directory-reading procedures
 *	in the POSIX style ("struct dirent").
 *
 * Copyright (c) 1991 The Regents of the University of California.
 * Copyright (c) 1994 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifndef _DIRENT
#define _DIRENT

/*
 * Dirent structure, which holds information about a single
 * directory entry.
 */

#define MAXNAMLEN 255
#define DIRBLKSIZ 512

struct dirent {
    long d_ino;			/* Inode number of entry */
    short d_reclen;		/* Length of this record */
    short d_namlen;		/* Length of string in d_name */
    char d_name[MAXNAMLEN + 1];	/* Name must be no longer than this */
};

/*
 * State that keeps track of the reading of a directory (clients
 * should never look inside this structure;  the fields should
 * only be accessed by the library procedures).
 */

typedef struct _dirdesc {
    int dd_fd;
    long dd_loc;
    long dd_size;
    char dd_buf[DIRBLKSIZ];
} DIR;

/*
 * Procedures defined for reading directories:
 */

extern void		closedir (DIR *dirp);
extern DIR *		opendir (char *name);
extern struct dirent *	readdir (DIR *dirp);

#endif /* _DIRENT */
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<










































































































Deleted compat/memcmp.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
/*
 * memcmp.c --
 *
 *	Source code for the "memcmp" library routine.
 *
 * Copyright (c) 1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclPort.h"

/*
 * Here is the prototype just in case it is not included in tclPort.h.
 */

int		memcmp(const void *s1, const void *s2, size_t n);

/*
 *----------------------------------------------------------------------
 *
 * memcmp --
 *
 *	Compares two bytes sequences.
 *
 * Results:
 *	Compares its arguments, looking at the first n bytes (each interpreted
 *	as an unsigned char), and returns an integer less than, equal to, or
 *	greater than 0, according as s1 is less than, equal to, or greater
 *	than s2 when taken to be unsigned 8 bit numbers.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
memcmp(
    const void *s1,		/* First string. */
    const void *s2,		/* Second string. */
    size_t n)			/* Length to compare. */
{
    const unsigned char *ptr1 = (const unsigned char *) s1;
    const unsigned char *ptr2 = (const unsigned char *) s2;

    for ( ; n-- ; ptr1++, ptr2++) {
	unsigned char u1 = *ptr1, u2 = *ptr2;

	if (u1 != u2) {
	    return (u1-u2);
	}
    }
    return 0;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
































































































































Deleted compat/opendir.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
/*
 * opendir.c --
 *
 *	This file provides dirent-style directory-reading procedures for V7
 *	Unix systems that don't have such procedures. The origin of this code
 *	is unclear, but it seems to have come originally from Larry Wall.
 */

#include "tclInt.h"

#undef DIRSIZ
#define DIRSIZ(dp) \
    ((sizeof(struct dirent) - (MAXNAMLEN+1)) + (((dp)->d_namlen+1 + 3) &~ 3))

/*
 * open a directory.
 */

DIR *
opendir(
    char *name)
{
    DIR *dirp;
    int fd;
    const char *myname;

    myname = ((*name == '\0') ? "." : name);
    if ((fd = open(myname, 0, 0)) == -1) {
	return NULL;
    }
    dirp = (DIR *) Tcl_Alloc(sizeof(DIR));
    if (dirp == NULL) {
	/* unreachable? */
	close(fd);
	return NULL;
    }
    dirp->dd_fd = fd;
    dirp->dd_loc = 0;
    return dirp;
}

/*
 * read an old style directory entry and present it as a new one
 */
#ifndef pyr
#define	ODIRSIZ	14

struct olddirect {
    ino_t od_ino;
    char od_name[ODIRSIZ];
};
#else	/* a Pyramid in the ATT universe */
#define	ODIRSIZ	248

struct olddirect {
    long od_ino;
    short od_fill1, od_fill2;
    char od_name[ODIRSIZ];
};
#endif

/*
 * get next entry in a directory.
 */

struct dirent *
readdir(
    DIR *dirp)
{
    struct olddirect *dp;
    static struct dirent dir;

    for (;;) {
	if (dirp->dd_loc == 0) {
	    dirp->dd_size = read(dirp->dd_fd, dirp->dd_buf, DIRBLKSIZ);
	    if (dirp->dd_size <= 0) {
		return NULL;
	    }
	}
	if (dirp->dd_loc >= dirp->dd_size) {
	    dirp->dd_loc = 0;
	    continue;
	}
	dp = (struct olddirect *)(dirp->dd_buf + dirp->dd_loc);
	dirp->dd_loc += sizeof(struct olddirect);
	if (dp->od_ino == 0) {
	    continue;
	}
	dir.d_ino = dp->od_ino;
	strncpy(dir.d_name, dp->od_name, ODIRSIZ);
	dir.d_name[ODIRSIZ] = '\0'; /* insure null termination */
	dir.d_namlen = strlen(dir.d_name);
	dir.d_reclen = DIRSIZ(&dir);
	return &dir;
    }
}

/*
 * close a directory.
 */

void
closedir(
    DIR *dirp)
{
    close(dirp->dd_fd);
    dirp->dd_fd = -1;
    dirp->dd_loc = 0;
    Tcl_Free(dirp);
}
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<




























































































































































































































Deleted compat/stdint.h.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
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
/*  A portable stdint.h
 ****************************************************************************
 *  BSD License:
 ****************************************************************************
 *
 *  Copyright (c) 2005-2016 Paul Hsieh
 *  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
 *     notice, this list of conditions and the following disclaimer in the
 *     documentation and/or other materials provided with the distribution.
 *  3. The name of the author may not be used to endorse or promote products
 *     derived from this software without specific prior written permission.
 *
 *  THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
 *  IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
 *  OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
 *  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
 *  INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
 *  NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 *  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 *  THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 *  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
 *  THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *
 ****************************************************************************
 *
 *  Version 0.1.16.0
 *
 *  The ANSI C standard committee, for the C99 standard, specified the
 *  inclusion of a new standard include file called stdint.h.  This is
 *  a very useful and long desired include file which contains several
 *  very precise definitions for integer scalar types that is critically
 *  important for making several classes of applications portable
 *  including cryptography, hashing, variable length integer libraries
 *  and so on.  But for most developers its likely useful just for
 *  programming sanity.
 *
 *  The problem is that some compiler vendors chose to ignore the C99
 *  standard and some older compilers have no opportunity to be updated.
 *  Because of this situation, simply including stdint.h in your code
 *  makes it unportable.
 *
 *  So that's what this file is all about.  It's an attempt to build a
 *  single universal include file that works on as many platforms as
 *  possible to deliver what stdint.h is supposed to.  Even compilers
 *  that already come with stdint.h can use this file instead without
 *  any loss of functionality.  A few things that should be noted about
 *  this file:
 *
 *    1) It is not guaranteed to be portable and/or present an identical
 *       interface on all platforms.  The extreme variability of the
 *       ANSI C standard makes this an impossibility right from the
 *       very get go. Its really only meant to be useful for the vast
 *       majority of platforms that possess the capability of
 *       implementing usefully and precisely defined, standard sized
 *       integer scalars.  Systems which are not intrinsically 2s
 *       complement may produce invalid constants.
 *
 *    2) There is an unavoidable use of non-reserved symbols.
 *
 *    3) Other standard include files are invoked.
 *
 *    4) This file may come in conflict with future platforms that do
 *       include stdint.h.  The hope is that one or the other can be
 *       used with no real difference.
 *
 *    5) In the current version, if your platform can't represent
 *       int32_t, int16_t and int8_t, it just dumps out with a compiler
 *       error.
 *
 *    6) 64 bit integers may or may not be defined.  Test for their
 *       presence with the test: #ifdef INT64_MAX or #ifdef UINT64_MAX.
 *       Note that this is different from the C99 specification which
 *       requires the existence of 64 bit support in the compiler.  If
 *       this is not defined for your platform, yet it is capable of
 *       dealing with 64 bits then it is because this file has not yet
 *       been extended to cover all of your system's capabilities.
 *
 *    7) (u)intptr_t may or may not be defined.  Test for its presence
 *       with the test: #ifdef PTRDIFF_MAX.  If this is not defined
 *       for your platform, then it is because this file has not yet
 *       been extended to cover all of your system's capabilities, not
 *       because its optional.
 *
 *    8) The following might not been defined even if your platform is
 *       capable of defining it:
 *
 *       WCHAR_MIN
 *       WCHAR_MAX
 *       (u)int64_t
 *       PTRDIFF_MIN
 *       PTRDIFF_MAX
 *       (u)intptr_t
 *
 *    9) The following have not been defined:
 *
 *       WINT_MIN
 *       WINT_MAX
 *
 *   10) The criteria for defining (u)int_least(*)_t isn't clear,
 *       except for systems which don't have a type that precisely
 *       defined 8, 16, or 32 bit types (which this include file does
 *       not support anyways). Default definitions have been given.
 *
 *   11) The criteria for defining (u)int_fast(*)_t isn't something I
 *       would trust to any particular compiler vendor or the ANSI C
 *       committee.  It is well known that "compatible systems" are
 *       commonly created that have very different performance
 *       characteristics from the systems they are compatible with,
 *       especially those whose vendors make both the compiler and the
 *       system.  Default definitions have been given, but its strongly
 *       recommended that users never use these definitions for any
 *       reason (they do *NOT* deliver any serious guarantee of
 *       improved performance -- not in this file, nor any vendor's
 *       stdint.h).
 *
 *   12) The following macros:
 *
 *       PRINTF_INTMAX_MODIFIER
 *       PRINTF_INT64_MODIFIER
 *       PRINTF_INT32_MODIFIER
 *       PRINTF_INT16_MODIFIER
 *       PRINTF_LEAST64_MODIFIER
 *       PRINTF_LEAST32_MODIFIER
 *       PRINTF_LEAST16_MODIFIER
 *       PRINTF_INTPTR_MODIFIER
 *
 *       are strings which have been defined as the modifiers required
 *       for the "d", "u" and "x" printf formats to correctly output
 *       (u)intmax_t, (u)int64_t, (u)int32_t, (u)int16_t, (u)least64_t,
 *       (u)least32_t, (u)least16_t and (u)intptr_t types respectively.
 *       PRINTF_INTPTR_MODIFIER is not defined for some systems which
 *       provide their own stdint.h.  PRINTF_INT64_MODIFIER is not
 *       defined if INT64_MAX is not defined.  These are an extension
 *       beyond what C99 specifies must be in stdint.h.
 *
 *       In addition, the following macros are defined:
 *
 *       PRINTF_INTMAX_HEX_WIDTH
 *       PRINTF_INT64_HEX_WIDTH
 *       PRINTF_INT32_HEX_WIDTH
 *       PRINTF_INT16_HEX_WIDTH
 *       PRINTF_INT8_HEX_WIDTH
 *       PRINTF_INTMAX_DEC_WIDTH
 *       PRINTF_INT64_DEC_WIDTH
 *       PRINTF_INT32_DEC_WIDTH
 *       PRINTF_INT16_DEC_WIDTH
 *       PRINTF_UINT8_DEC_WIDTH
 *       PRINTF_UINTMAX_DEC_WIDTH
 *       PRINTF_UINT64_DEC_WIDTH
 *       PRINTF_UINT32_DEC_WIDTH
 *       PRINTF_UINT16_DEC_WIDTH
 *       PRINTF_UINT8_DEC_WIDTH
 *
 *       Which specifies the maximum number of characters required to
 *       print the number of that type in either hexadecimal or decimal.
 *       These are an extension beyond what C99 specifies must be in
 *       stdint.h.
 *
 *  Compilers tested (all with 0 warnings at their highest respective
 *  settings): Borland Turbo C 2.0, WATCOM C/C++ 11.0 (16 bits and 32
 *  bits), Microsoft Visual C++ 6.0 (32 bit), Microsoft Visual Studio
 *  .net (VC7), Intel C++ 4.0, GNU gcc v3.3.3
 *
 *  This file should be considered a work in progress.  Suggestions for
 *  improvements, especially those which increase coverage are strongly
 *  encouraged.
 *
 *  Acknowledgements
 *
 *  The following people have made significant contributions to the
 *  development and testing of this file:
 *
 *  Chris Howie
 *  John Steele Scott
 *  Dave Thorup
 *  John Dill
 *  Florian Wobbe
 *  Christopher Sean Morrison
 *  Mikkel Fahnoe Jorgensen
 *
 */

#include <stddef.h>
#include <limits.h>
#include <signal.h>

/*
 *  For gcc with _STDINT_H, fill in the PRINTF_INT*_MODIFIER macros, and
 *  do nothing else.  On the Mac OS X version of gcc this is _STDINT_H_.
 */

#if ((defined(__SUNPRO_C) && __SUNPRO_C >= 0x570) || (defined(_MSC_VER) && _MSC_VER >= 1600) || (defined(__STDC__) && __STDC__ && defined(__STDC_VERSION__) && __STDC_VERSION__ >= 199901L) || (defined (__WATCOMC__) && (defined (_STDINT_H_INCLUDED) || __WATCOMC__ >= 1250)) || (defined(__GNUC__) && (__GNUC__ > 3 || defined(_STDINT_H) || defined(_STDINT_H_) || defined (__UINT_FAST64_TYPE__)) )) && !defined (_PSTDINT_H_INCLUDED)
#include <stdint.h>
#define _PSTDINT_H_INCLUDED
# if defined(__GNUC__) && (defined(__x86_64__) || defined(__ppc64__)) && !(defined(__APPLE__) && defined(__MACH__))
#  ifndef PRINTF_INT64_MODIFIER
#   define PRINTF_INT64_MODIFIER "l"
#  endif
#  ifndef PRINTF_INT32_MODIFIER
#   define PRINTF_INT32_MODIFIER ""
#  endif
# else
#  ifndef PRINTF_INT64_MODIFIER
#   define PRINTF_INT64_MODIFIER "ll"
#  endif
#  ifndef PRINTF_INT32_MODIFIER
#   if (UINT_MAX == UINT32_MAX)
#    define PRINTF_INT32_MODIFIER ""
#   else
#    define PRINTF_INT32_MODIFIER "l"
#   endif
#  endif
# endif
# ifndef PRINTF_INT16_MODIFIER
#  define PRINTF_INT16_MODIFIER "h"
# endif
# ifndef PRINTF_INTMAX_MODIFIER
#  define PRINTF_INTMAX_MODIFIER PRINTF_INT64_MODIFIER
# endif
# ifndef PRINTF_INT64_HEX_WIDTH
#  define PRINTF_INT64_HEX_WIDTH "16"
# endif
# ifndef PRINTF_UINT64_HEX_WIDTH
#  define PRINTF_UINT64_HEX_WIDTH "16"
# endif
# ifndef PRINTF_INT32_HEX_WIDTH
#  define PRINTF_INT32_HEX_WIDTH "8"
# endif
# ifndef PRINTF_UINT32_HEX_WIDTH
#  define PRINTF_UINT32_HEX_WIDTH "8"
# endif
# ifndef PRINTF_INT16_HEX_WIDTH
#  define PRINTF_INT16_HEX_WIDTH "4"
# endif
# ifndef PRINTF_UINT16_HEX_WIDTH
#  define PRINTF_UINT16_HEX_WIDTH "4"
# endif
# ifndef PRINTF_INT8_HEX_WIDTH
#  define PRINTF_INT8_HEX_WIDTH "2"
# endif
# ifndef PRINTF_UINT8_HEX_WIDTH
#  define PRINTF_UINT8_HEX_WIDTH "2"
# endif
# ifndef PRINTF_INT64_DEC_WIDTH
#  define PRINTF_INT64_DEC_WIDTH "19"
# endif
# ifndef PRINTF_UINT64_DEC_WIDTH
#  define PRINTF_UINT64_DEC_WIDTH "20"
# endif
# ifndef PRINTF_INT32_DEC_WIDTH
#  define PRINTF_INT32_DEC_WIDTH "10"
# endif
# ifndef PRINTF_UINT32_DEC_WIDTH
#  define PRINTF_UINT32_DEC_WIDTH "10"
# endif
# ifndef PRINTF_INT16_DEC_WIDTH
#  define PRINTF_INT16_DEC_WIDTH "5"
# endif
# ifndef PRINTF_UINT16_DEC_WIDTH
#  define PRINTF_UINT16_DEC_WIDTH "5"
# endif
# ifndef PRINTF_INT8_DEC_WIDTH
#  define PRINTF_INT8_DEC_WIDTH "3"
# endif
# ifndef PRINTF_UINT8_DEC_WIDTH
#  define PRINTF_UINT8_DEC_WIDTH "3"
# endif
# ifndef PRINTF_INTMAX_HEX_WIDTH
#  define PRINTF_INTMAX_HEX_WIDTH PRINTF_UINT64_HEX_WIDTH
# endif
# ifndef PRINTF_UINTMAX_HEX_WIDTH
#  define PRINTF_UINTMAX_HEX_WIDTH PRINTF_UINT64_HEX_WIDTH
# endif
# ifndef PRINTF_INTMAX_DEC_WIDTH
#  define PRINTF_INTMAX_DEC_WIDTH PRINTF_UINT64_DEC_WIDTH
# endif
# ifndef PRINTF_UINTMAX_DEC_WIDTH
#  define PRINTF_UINTMAX_DEC_WIDTH PRINTF_UINT64_DEC_WIDTH
# endif

/*
 *  Something really weird is going on with Open Watcom.  Just pull some of
 *  these duplicated definitions from Open Watcom's stdint.h file for now.
 */

# if defined (__WATCOMC__) && __WATCOMC__ >= 1250
#  if !defined (INT64_C)
#   define INT64_C(x)   (x + (INT64_MAX - INT64_MAX))
#  endif
#  if !defined (UINT64_C)
#   define UINT64_C(x)  (x + (UINT64_MAX - UINT64_MAX))
#  endif
#  if !defined (INT32_C)
#   define INT32_C(x)   (x + (INT32_MAX - INT32_MAX))
#  endif
#  if !defined (UINT32_C)
#   define UINT32_C(x)  (x + (UINT32_MAX - UINT32_MAX))
#  endif
#  if !defined (INT16_C)
#   define INT16_C(x)   (x)
#  endif
#  if !defined (UINT16_C)
#   define UINT16_C(x)  (x)
#  endif
#  if !defined (INT8_C)
#   define INT8_C(x)   (x)
#  endif
#  if !defined (UINT8_C)
#   define UINT8_C(x)  (x)
#  endif
#  if !defined (UINT64_MAX)
#   define UINT64_MAX  18446744073709551615ULL
#  endif
#  if !defined (INT64_MAX)
#   define INT64_MAX  9223372036854775807LL
#  endif
#  if !defined (UINT32_MAX)
#   define UINT32_MAX  4294967295UL
#  endif
#  if !defined (INT32_MAX)
#   define INT32_MAX  2147483647L
#  endif
#  if !defined (INTMAX_MAX)
#   define INTMAX_MAX INT64_MAX
#  endif
#  if !defined (INTMAX_MIN)
#   define INTMAX_MIN INT64_MIN
#  endif
# endif
#endif

/*
 *  I have no idea what is the truly correct thing to do on older Solaris.
 *  From some online discussions, this seems to be what is being
 *  recommended.  For people who actually are developing on older Solaris,
 *  what I would like to know is, does this define all of the relevant
 *  macros of a complete stdint.h?  Remember, in pstdint.h 64 bit is
 *  considered optional.
 */

#if (defined(__SUNPRO_C) && __SUNPRO_C >= 0x420) && !defined(_PSTDINT_H_INCLUDED)
#include <sys/inttypes.h>
#define _PSTDINT_H_INCLUDED
#endif

#ifndef _PSTDINT_H_INCLUDED
#define _PSTDINT_H_INCLUDED

#ifndef SIZE_MAX
# define SIZE_MAX ((size_t)-1)
#endif

/*
 *  Deduce the type assignments from limits.h under the assumption that
 *  integer sizes in bits are powers of 2, and follow the ANSI
 *  definitions.
 */

#ifndef UINT8_MAX
# define UINT8_MAX 0xff
#endif
#if !defined(uint8_t) && !defined(_UINT8_T) && !defined(vxWorks)
# if (UCHAR_MAX == UINT8_MAX) || defined (S_SPLINT_S)
    typedef unsigned char uint8_t;
#   define UINT8_C(v) ((uint8_t) v)
# else
#   error "Platform not supported"
# endif
#endif

#ifndef INT8_MAX
# define INT8_MAX 0x7f
#endif
#ifndef INT8_MIN
# define INT8_MIN INT8_C(0x80)
#endif
#if !defined(int8_t) && !defined(_INT8_T) && !defined(vxWorks)
# if (SCHAR_MAX == INT8_MAX) || defined (S_SPLINT_S)
    typedef signed char int8_t;
#   define INT8_C(v) ((int8_t) v)
# else
#   error "Platform not supported"
# endif
#endif

#ifndef UINT16_MAX
# define UINT16_MAX 0xffff
#endif
#if !defined(uint16_t) && !defined(_UINT16_T) && !defined(vxWorks)
#if (UINT_MAX == UINT16_MAX) || defined (S_SPLINT_S)
  typedef unsigned int uint16_t;
# ifndef PRINTF_INT16_MODIFIER
#  define PRINTF_INT16_MODIFIER ""
# endif
# define UINT16_C(v) ((uint16_t) (v))
#elif (USHRT_MAX == UINT16_MAX)
  typedef unsigned short uint16_t;
# define UINT16_C(v) ((uint16_t) (v))
# ifndef PRINTF_INT16_MODIFIER
#  define PRINTF_INT16_MODIFIER "h"
# endif
#else
#error "Platform not supported"
#endif
#endif

#ifndef INT16_MAX
# define INT16_MAX 0x7fff
#endif
#ifndef INT16_MIN
# define INT16_MIN INT16_C(0x8000)
#endif
#if !defined(int16_t) && !defined(_INT16_T) && !defined(vxWorks)
#if (INT_MAX == INT16_MAX) || defined (S_SPLINT_S)
  typedef signed int int16_t;
# define INT16_C(v) ((int16_t) (v))
# ifndef PRINTF_INT16_MODIFIER
#  define PRINTF_INT16_MODIFIER ""
# endif
#elif (SHRT_MAX == INT16_MAX)
  typedef signed short int16_t;
# define INT16_C(v) ((int16_t) (v))
# ifndef PRINTF_INT16_MODIFIER
#  define PRINTF_INT16_MODIFIER "h"
# endif
#else
#error "Platform not supported"
#endif
#endif

#ifndef UINT32_MAX
# define UINT32_MAX (0xffffffffUL)
#endif
#if !defined(uint32_t) && !defined(_UINT32_T) && !defined(vxWorks)
#if (ULONG_MAX == UINT32_MAX) || defined (S_SPLINT_S)
  typedef unsigned long uint32_t;
# define UINT32_C(v) v ## UL
# ifndef PRINTF_INT32_MODIFIER
#  define PRINTF_INT32_MODIFIER "l"
# endif
#elif (UINT_MAX == UINT32_MAX)
  typedef unsigned int uint32_t;
# ifndef PRINTF_INT32_MODIFIER
#  define PRINTF_INT32_MODIFIER ""
# endif
# define UINT32_C(v) v ## U
#elif (USHRT_MAX == UINT32_MAX)
  typedef unsigned short uint32_t;
# define UINT32_C(v) ((unsigned short) (v))
# ifndef PRINTF_INT32_MODIFIER
#  define PRINTF_INT32_MODIFIER ""
# endif
#else
#error "Platform not supported"
#endif
#endif

#ifndef INT32_MAX
# define INT32_MAX (0x7fffffffL)
#endif
#ifndef INT32_MIN
# define INT32_MIN INT32_C(0x80000000)
#endif
#if !defined(int32_t) && !defined(_INT32_T) && !defined(vxWorks)
#if (LONG_MAX == INT32_MAX) || defined (S_SPLINT_S)
  typedef signed long int32_t;
# define INT32_C(v) v ## L
# ifndef PRINTF_INT32_MODIFIER
#  define PRINTF_INT32_MODIFIER "l"
# endif
#elif (INT_MAX == INT32_MAX)
  typedef signed int int32_t;
# define INT32_C(v) v
# ifndef PRINTF_INT32_MODIFIER
#  define PRINTF_INT32_MODIFIER ""
# endif
#elif (SHRT_MAX == INT32_MAX)
  typedef signed short int32_t;
# define INT32_C(v) ((short) (v))
# ifndef PRINTF_INT32_MODIFIER
#  define PRINTF_INT32_MODIFIER ""
# endif
#else
#error "Platform not supported"
#endif
#endif

/*
 *  The macro stdint_int64_defined is temporarily used to record
 *  whether or not 64 integer support is available.  It must be
 *  defined for any 64 integer extensions for new platforms that are
 *  added.
 */

#undef stdint_int64_defined
#if (defined(__STDC__) && defined(__STDC_VERSION__)) || defined (S_SPLINT_S)
# if (__STDC__ && __STDC_VERSION__ >= 199901L) || defined (S_SPLINT_S)
#  define stdint_int64_defined
   typedef long long int64_t;
   typedef unsigned long long uint64_t;
#  define UINT64_C(v) v ## ULL
#  define  INT64_C(v) v ## LL
#  ifndef PRINTF_INT64_MODIFIER
#   define PRINTF_INT64_MODIFIER "ll"
#  endif
# endif
#endif

#if !defined (stdint_int64_defined)
# if defined(__GNUC__) && !defined(vxWorks)
#  define stdint_int64_defined
   __extension__ typedef long long int64_t;
   __extension__ typedef unsigned long long uint64_t;
#  define UINT64_C(v) v ## ULL
#  define  INT64_C(v) v ## LL
#  ifndef PRINTF_INT64_MODIFIER
#   define PRINTF_INT64_MODIFIER "ll"
#  endif
# elif defined(__MWERKS__) || defined (__SUNPRO_C) || defined (__SUNPRO_CC) || defined (__APPLE_CC__) || defined (_LONG_LONG) || defined (_CRAYC) || defined (S_SPLINT_S)
#  define stdint_int64_defined
   typedef long long int64_t;
   typedef unsigned long long uint64_t;
#  define UINT64_C(v) v ## ULL
#  define  INT64_C(v) v ## LL
#  ifndef PRINTF_INT64_MODIFIER
#   define PRINTF_INT64_MODIFIER "ll"
#  endif
# elif (defined(__WATCOMC__) && defined(__WATCOM_INT64__)) || (defined(_MSC_VER) && _INTEGRAL_MAX_BITS >= 64) || (defined (__BORLANDC__) && __BORLANDC__ > 0x460) || defined (__alpha) || defined (__DECC)
#  define stdint_int64_defined
   typedef __int64 int64_t;
   typedef unsigned __int64 uint64_t;
#  define UINT64_C(v) v ## UI64
#  define  INT64_C(v) v ## I64
#  ifndef PRINTF_INT64_MODIFIER
#   define PRINTF_INT64_MODIFIER "I64"
#  endif
# endif
#endif

#if !defined (LONG_LONG_MAX) && defined (INT64_C)
# define LONG_LONG_MAX INT64_C (9223372036854775807)
#endif
#ifndef ULONG_LONG_MAX
# define ULONG_LONG_MAX UINT64_C (18446744073709551615)
#endif

#if !defined (INT64_MAX) && defined (INT64_C)
# define INT64_MAX INT64_C (9223372036854775807)
#endif
#if !defined (INT64_MIN) && defined (INT64_C)
# define INT64_MIN INT64_C (-9223372036854775808)
#endif
#if !defined (UINT64_MAX) && defined (INT64_C)
# define UINT64_MAX UINT64_C (18446744073709551615)
#endif

/*
 *  Width of hexadecimal for number field.
 */

#ifndef PRINTF_INT64_HEX_WIDTH
# define PRINTF_INT64_HEX_WIDTH "16"
#endif
#ifndef PRINTF_INT32_HEX_WIDTH
# define PRINTF_INT32_HEX_WIDTH "8"
#endif
#ifndef PRINTF_INT16_HEX_WIDTH
# define PRINTF_INT16_HEX_WIDTH "4"
#endif
#ifndef PRINTF_INT8_HEX_WIDTH
# define PRINTF_INT8_HEX_WIDTH "2"
#endif
#ifndef PRINTF_INT64_DEC_WIDTH
# define PRINTF_INT64_DEC_WIDTH "19"
#endif
#ifndef PRINTF_INT32_DEC_WIDTH
# define PRINTF_INT32_DEC_WIDTH "10"
#endif
#ifndef PRINTF_INT16_DEC_WIDTH
# define PRINTF_INT16_DEC_WIDTH "5"
#endif
#ifndef PRINTF_INT8_DEC_WIDTH
# define PRINTF_INT8_DEC_WIDTH "3"
#endif
#ifndef PRINTF_UINT64_DEC_WIDTH
# define PRINTF_UINT64_DEC_WIDTH "20"
#endif
#ifndef PRINTF_UINT32_DEC_WIDTH
# define PRINTF_UINT32_DEC_WIDTH "10"
#endif
#ifndef PRINTF_UINT16_DEC_WIDTH
# define PRINTF_UINT16_DEC_WIDTH "5"
#endif
#ifndef PRINTF_UINT8_DEC_WIDTH
# define PRINTF_UINT8_DEC_WIDTH "3"
#endif

/*
 *  Ok, lets not worry about 128 bit integers for now.  Moore's law says
 *  we don't need to worry about that until about 2040 at which point
 *  we'll have bigger things to worry about.
 */

#ifdef stdint_int64_defined
  typedef int64_t intmax_t;
  typedef uint64_t uintmax_t;
# define  INTMAX_MAX   INT64_MAX
# define  INTMAX_MIN   INT64_MIN
# define UINTMAX_MAX  UINT64_MAX
# define UINTMAX_C(v) UINT64_C(v)
# define  INTMAX_C(v)  INT64_C(v)
# ifndef PRINTF_INTMAX_MODIFIER
#   define PRINTF_INTMAX_MODIFIER PRINTF_INT64_MODIFIER
# endif
# ifndef PRINTF_INTMAX_HEX_WIDTH
#  define PRINTF_INTMAX_HEX_WIDTH PRINTF_INT64_HEX_WIDTH
# endif
# ifndef PRINTF_INTMAX_DEC_WIDTH
#  define PRINTF_INTMAX_DEC_WIDTH PRINTF_INT64_DEC_WIDTH
# endif
#else
  typedef int32_t intmax_t;
  typedef uint32_t uintmax_t;
# define  INTMAX_MAX   INT32_MAX
# define UINTMAX_MAX  UINT32_MAX
# define UINTMAX_C(v) UINT32_C(v)
# define  INTMAX_C(v)  INT32_C(v)
# ifndef PRINTF_INTMAX_MODIFIER
#   define PRINTF_INTMAX_MODIFIER PRINTF_INT32_MODIFIER
# endif
# ifndef PRINTF_INTMAX_HEX_WIDTH
#  define PRINTF_INTMAX_HEX_WIDTH PRINTF_INT32_HEX_WIDTH
# endif
# ifndef PRINTF_INTMAX_DEC_WIDTH
#  define PRINTF_INTMAX_DEC_WIDTH PRINTF_INT32_DEC_WIDTH
# endif
#endif

/*
 *  Because this file currently only supports platforms which have
 *  precise powers of 2 as bit sizes for the default integers, the
 *  least definitions are all trivial.  Its possible that a future
 *  version of this file could have different definitions.
 */

#ifndef stdint_least_defined
  typedef   int8_t   int_least8_t;
  typedef  uint8_t  uint_least8_t;
  typedef  int16_t  int_least16_t;
  typedef uint16_t uint_least16_t;
  typedef  int32_t  int_least32_t;
  typedef uint32_t uint_least32_t;
# define PRINTF_LEAST32_MODIFIER PRINTF_INT32_MODIFIER
# define PRINTF_LEAST16_MODIFIER PRINTF_INT16_MODIFIER
# define  UINT_LEAST8_MAX  UINT8_MAX
# define   INT_LEAST8_MAX   INT8_MAX
# define UINT_LEAST16_MAX UINT16_MAX
# define  INT_LEAST16_MAX  INT16_MAX
# define UINT_LEAST32_MAX UINT32_MAX
# define  INT_LEAST32_MAX  INT32_MAX
# define   INT_LEAST8_MIN   INT8_MIN
# define  INT_LEAST16_MIN  INT16_MIN
# define  INT_LEAST32_MIN  INT32_MIN
# ifdef stdint_int64_defined
    typedef  int64_t  int_least64_t;
    typedef uint64_t uint_least64_t;
#   define PRINTF_LEAST64_MODIFIER PRINTF_INT64_MODIFIER
#   define UINT_LEAST64_MAX UINT64_MAX
#   define  INT_LEAST64_MAX  INT64_MAX
#   define  INT_LEAST64_MIN  INT64_MIN
# endif
#endif
#undef stdint_least_defined

/*
 *  The ANSI C committee has defined *int*_fast*_t types as well.  This,
 *  of course, defies rationality -- you can't know what will be fast
 *  just from the type itself.  Even for a given architecture, compatible
 *  implementations might have different performance characteristics.
 *  Developers are warned to stay away from these types when using this
 *  or any other stdint.h.
 */

typedef   int_least8_t   int_fast8_t;
typedef  uint_least8_t  uint_fast8_t;
typedef  int_least16_t  int_fast16_t;
typedef uint_least16_t uint_fast16_t;
typedef  int_least32_t  int_fast32_t;
typedef uint_least32_t uint_fast32_t;
#define  UINT_FAST8_MAX  UINT_LEAST8_MAX
#define   INT_FAST8_MAX   INT_LEAST8_MAX
#define UINT_FAST16_MAX UINT_LEAST16_MAX
#define  INT_FAST16_MAX  INT_LEAST16_MAX
#define UINT_FAST32_MAX UINT_LEAST32_MAX
#define  INT_FAST32_MAX  INT_LEAST32_MAX
#define   INT_FAST8_MIN   INT_LEAST8_MIN
#define  INT_FAST16_MIN  INT_LEAST16_MIN
#define  INT_FAST32_MIN  INT_LEAST32_MIN
#ifdef stdint_int64_defined
  typedef  int_least64_t  int_fast64_t;
  typedef uint_least64_t uint_fast64_t;
# define UINT_FAST64_MAX UINT_LEAST64_MAX
# define  INT_FAST64_MAX  INT_LEAST64_MAX
# define  INT_FAST64_MIN  INT_LEAST64_MIN
#endif

#undef stdint_int64_defined

/*
 *  Whatever piecemeal, per compiler thing we can do about the wchar_t
 *  type limits.
 */

#if defined(__WATCOMC__) || defined(_MSC_VER) || defined (__GNUC__) && !defined(vxWorks)
# include <wchar.h>
# ifndef WCHAR_MIN
#  define WCHAR_MIN 0
# endif
# ifndef WCHAR_MAX
#  define WCHAR_MAX ((wchar_t)-1)
# endif
#endif

/*
 *  Whatever piecemeal, per compiler/platform thing we can do about the
 *  (u)intptr_t types and limits.
 */

#if (defined (_MSC_VER) && defined (_UINTPTR_T_DEFINED)) || defined (_UINTPTR_T)
# define STDINT_H_UINTPTR_T_DEFINED
#endif

#ifndef STDINT_H_UINTPTR_T_DEFINED
# if defined (__alpha__) || defined (__ia64__) || defined (__x86_64__) || defined (_WIN64) || defined (__ppc64__)
#  define stdint_intptr_bits 64
# elif defined (__WATCOMC__) || defined (__TURBOC__)
#  if defined(__TINY__) || defined(__SMALL__) || defined(__MEDIUM__)
#    define stdint_intptr_bits 16
#  else
#    define stdint_intptr_bits 32
#  endif
# elif defined (__i386__) || defined (_WIN32) || defined (WIN32) || defined (__ppc64__)
#  define stdint_intptr_bits 32
# elif defined (__INTEL_COMPILER)
/* TODO -- what did Intel do about x86-64? */
# else
/* #error "This platform might not be supported yet" */
# endif

# ifdef stdint_intptr_bits
#  define stdint_intptr_glue3_i(a,b,c)  a##b##c
#  define stdint_intptr_glue3(a,b,c)    stdint_intptr_glue3_i(a,b,c)
#  ifndef PRINTF_INTPTR_MODIFIER
#    define PRINTF_INTPTR_MODIFIER      stdint_intptr_glue3(PRINTF_INT,stdint_intptr_bits,_MODIFIER)
#  endif
#  ifndef PTRDIFF_MAX
#    define PTRDIFF_MAX                 stdint_intptr_glue3(INT,stdint_intptr_bits,_MAX)
#  endif
#  ifndef PTRDIFF_MIN
#    define PTRDIFF_MIN                 stdint_intptr_glue3(INT,stdint_intptr_bits,_MIN)
#  endif
#  ifndef UINTPTR_MAX
#    define UINTPTR_MAX                 stdint_intptr_glue3(UINT,stdint_intptr_bits,_MAX)
#  endif
#  ifndef INTPTR_MAX
#    define INTPTR_MAX                  stdint_intptr_glue3(INT,stdint_intptr_bits,_MAX)
#  endif
#  ifndef INTPTR_MIN
#    define INTPTR_MIN                  stdint_intptr_glue3(INT,stdint_intptr_bits,_MIN)
#  endif
#  ifndef INTPTR_C
#    define INTPTR_C(x)                 stdint_intptr_glue3(INT,stdint_intptr_bits,_C)(x)
#  endif
#  ifndef UINTPTR_C
#    define UINTPTR_C(x)                stdint_intptr_glue3(UINT,stdint_intptr_bits,_C)(x)
#  endif
  typedef stdint_intptr_glue3(uint,stdint_intptr_bits,_t) uintptr_t;
  typedef stdint_intptr_glue3( int,stdint_intptr_bits,_t)  intptr_t;
# else
/* TODO -- This following is likely wrong for some platforms, and does
   nothing for the definition of uintptr_t. */
  typedef ptrdiff_t intptr_t;
# endif
# define STDINT_H_UINTPTR_T_DEFINED
#endif

/*
 *  Assumes sig_atomic_t is signed and we have a 2s complement machine.
 */

#ifndef SIG_ATOMIC_MAX
# define SIG_ATOMIC_MAX ((((sig_atomic_t) 1) << (sizeof (sig_atomic_t)*CHAR_BIT-1)) - 1)
#endif

#endif

#if defined (__TEST_PSTDINT_FOR_CORRECTNESS)

/*
 *  Please compile with the maximum warning settings to make sure macros are
 *  not defined more than once.
 */

#include <stdlib.h>
#include <stdio.h>
#include <string.h>

#define glue3_aux(x,y,z) x ## y ## z
#define glue3(x,y,z) glue3_aux(x,y,z)

#define DECLU(bits) glue3(uint,bits,_t) glue3(u,bits,) = glue3(UINT,bits,_C) (0);
#define DECLI(bits) glue3(int,bits,_t) glue3(i,bits,) = glue3(INT,bits,_C) (0);

#define DECL(us,bits) glue3(DECL,us,) (bits)

#define TESTUMAX(bits) glue3(u,bits,) = ~glue3(u,bits,); if (glue3(UINT,bits,_MAX) != glue3(u,bits,)) printf ("Something wrong with UINT%d_MAX\n", bits)

#define REPORTERROR(msg) { err_n++; if (err_first <= 0) err_first = __LINE__; printf msg; }

#define X_SIZE_MAX ((size_t)-1)

int main () {
	int err_n = 0;
	int err_first = 0;
	DECL(I,8)
	DECL(U,8)
	DECL(I,16)
	DECL(U,16)
	DECL(I,32)
	DECL(U,32)
#ifdef INT64_MAX
	DECL(I,64)
	DECL(U,64)
#endif
	intmax_t imax = INTMAX_C(0);
	uintmax_t umax = UINTMAX_C(0);
	char str0[256], str1[256];

	sprintf (str0, "%" PRINTF_INT32_MODIFIER "d", INT32_C(2147483647));
	if (0 != strcmp (str0, "2147483647")) REPORTERROR (("Something wrong with PRINTF_INT32_MODIFIER : %s\n", str0));
	if (atoi(PRINTF_INT32_DEC_WIDTH) != (int) strlen(str0)) REPORTERROR (("Something wrong with PRINTF_INT32_DEC_WIDTH : %s\n", PRINTF_INT32_DEC_WIDTH));
	sprintf (str0, "%" PRINTF_INT32_MODIFIER "u", UINT32_C(4294967295));
	if (0 != strcmp (str0, "4294967295")) REPORTERROR (("Something wrong with PRINTF_INT32_MODIFIER : %s\n", str0));
	if (atoi(PRINTF_UINT32_DEC_WIDTH) != (int) strlen(str0)) REPORTERROR (("Something wrong with PRINTF_UINT32_DEC_WIDTH : %s\n", PRINTF_UINT32_DEC_WIDTH));
#ifdef INT64_MAX
	sprintf (str1, "%" PRINTF_INT64_MODIFIER "d", INT64_C(9223372036854775807));
	if (0 != strcmp (str1, "9223372036854775807")) REPORTERROR (("Something wrong with PRINTF_INT32_MODIFIER : %s\n", str1));
	if (atoi(PRINTF_INT64_DEC_WIDTH) != (int) strlen(str1)) REPORTERROR (("Something wrong with PRINTF_INT64_DEC_WIDTH : %s, %d\n", PRINTF_INT64_DEC_WIDTH, (int) strlen(str1)));
	sprintf (str1, "%" PRINTF_INT64_MODIFIER "u", UINT64_C(18446744073709550591));
	if (0 != strcmp (str1, "18446744073709550591")) REPORTERROR (("Something wrong with PRINTF_INT32_MODIFIER : %s\n", str1));
	if (atoi(PRINTF_UINT64_DEC_WIDTH) != (int) strlen(str1)) REPORTERROR (("Something wrong with PRINTF_UINT64_DEC_WIDTH : %s, %d\n", PRINTF_UINT64_DEC_WIDTH, (int) strlen(str1)));
#endif

	sprintf (str0, "%d %x\n", 0, ~0);

	sprintf (str1, "%d %x\n",  i8, ~0);
	if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with i8 : %s\n", str1));
	sprintf (str1, "%u %x\n",  u8, ~0);
	if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with u8 : %s\n", str1));
	sprintf (str1, "%d %x\n",  i16, ~0);
	if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with i16 : %s\n", str1));
	sprintf (str1, "%u %x\n",  u16, ~0);
	if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with u16 : %s\n", str1));
	sprintf (str1, "%" PRINTF_INT32_MODIFIER "d %x\n",  i32, ~0);
	if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with i32 : %s\n", str1));
	sprintf (str1, "%" PRINTF_INT32_MODIFIER "u %x\n",  u32, ~0);
	if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with u32 : %s\n", str1));
#ifdef INT64_MAX
	sprintf (str1, "%" PRINTF_INT64_MODIFIER "d %x\n",  i64, ~0);
	if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with i64 : %s\n", str1));
#endif
	sprintf (str1, "%" PRINTF_INTMAX_MODIFIER "d %x\n",  imax, ~0);
	if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with imax : %s\n", str1));
	sprintf (str1, "%" PRINTF_INTMAX_MODIFIER "u %x\n",  umax, ~0);
	if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with umax : %s\n", str1));

	TESTUMAX(8);
	TESTUMAX(16);
	TESTUMAX(32);
#ifdef INT64_MAX
	TESTUMAX(64);
#endif

#define STR(v) #v
#define Q(v) printf ("sizeof " STR(v) " = %u\n", (unsigned) sizeof (v));
	if (err_n) {
		printf ("pstdint.h is not correct.  Please use sizes below to correct it:\n");
	}

	Q(int)
	Q(unsigned)
	Q(long int)
	Q(short int)
	Q(int8_t)
	Q(int16_t)
	Q(int32_t)
#ifdef INT64_MAX
	Q(int64_t)
#endif

#if UINT_MAX < X_SIZE_MAX
	printf ("UINT_MAX < X_SIZE_MAX\n");
#else
	printf ("UINT_MAX >= X_SIZE_MAX\n");
#endif
	printf ("%" PRINTF_INT64_MODIFIER "u vs %" PRINTF_INT64_MODIFIER "u\n", UINT_MAX, X_SIZE_MAX);

	return EXIT_SUCCESS;
}

#endif
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<














































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































Deleted compat/stdlib.h.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
/*
 * stdlib.h --
 *
 *	Declares facilities exported by the "stdlib" portion of the C library.
 *	This file isn't complete in the ANSI-C sense; it only declares things
 *	that are needed by Tcl. This file is needed even on many systems with
 *	their own stdlib.h (e.g. SunOS) because not all stdlib.h files declare
 *	all the procedures needed here (such as strtol/strtoul).
 *
 * Copyright (c) 1991 The Regents of the University of California.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifndef _STDLIB
#define _STDLIB

extern void		abort(void);
extern double		atof(const char *string);
extern int		atoi(const char *string);
extern long		atol(const char *string);
extern void *		calloc(unsigned long numElements, unsigned long size);
extern void		exit(int status);
extern void		free(void *blockPtr);
extern char *		getenv(const char *name);
extern void *		malloc(unsigned long numBytes);
extern void		qsort(void *base, unsigned long n, unsigned long size, int (*compar)(
			    const void *element1, const void *element2));
extern void *		realloc(void *ptr, unsigned long numBytes);
extern char *		realpath(const char *path, char *resolved_path);
extern int		mkstemps(char *templ, int suffixlen);
extern int		mkstemp(char *templ);
extern char *		mkdtemp(char *templ);
extern long		strtol(const char *string, char **endPtr, int base);
extern unsigned long	strtoul(const char *string, char **endPtr, int base);

#endif /* _STDLIB */
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<














































































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

#include "tcl.h"
#ifndef NULL
#define NULL 0
#endif

/*
 *----------------------------------------------------------------------
 *
 * strstr --
 *
 *	Locate the first instance of a substring in a string.
 *
 * Results:
 *	If string contains substring, the return value is the location of the
 *	first matching instance of substring in string. If string doesn't
 *	contain substring, the return value is 0. Matching is done on an exact
 *	character-for-character basis with no wildcards or special characters.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

char *
strstr(
    const char *string,		/* String to search. */
    const char *substring)		/* Substring to try to find in string. */
{
    const char *a, *b;

    /*
     * First scan quickly through the two strings looking for a
     * single-character match. When it's found, then compare the rest of the
     * substring.
     */

    b = substring;
    if (*b == 0) {
	return (char *)string;
    }
    for ( ; *string != 0; string += 1) {
	if (*string != *b) {
	    continue;
	}
	a = string;
	while (1) {
	    if (*b == 0) {
		return (char *)string;
	    }
	    if (*a++ != *b++) {
		break;
	    }
	}
	b = substring;
    }
    return NULL;
}
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<












































































































































Deleted compat/strtol.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
/*
 * strtol.c --
 *
 *	Source code for the "strtol" library procedure.
 *
 * Copyright (c) 1988 The Regents of the University of California.
 * Copyright (c) 1994 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

/*
 *----------------------------------------------------------------------
 *
 * strtol --
 *
 *	Convert an ASCII string into an integer.
 *
 * Results:
 *	The return value is the integer equivalent of string. If endPtr is
 *	non-NULL, then *endPtr is filled in with the character after the last
 *	one that was part of the integer. If string doesn't contain a valid
 *	integer value, then zero is returned and *endPtr is set to string.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

long int
strtol(
    const char *string,		/* String of ASCII digits, possibly preceded
				 * by white space. For bases greater than 10,
				 * either lower- or upper-case digits may be
				 * used. */
    char **endPtr,		/* Where to store address of terminating
				 * character, or NULL. */
    int base)			/* Base for conversion. Must be less than 37.
				 * If 0, then the base is chosen from the
				 * leading characters of string: "0x" means
				 * hex, "0" means octal, anything else means
				 * decimal. */
{
    const char *p;
    long result;

    /*
     * Skip any leading blanks.
     */

    p = string;
    while (isspace(UCHAR(*p))) {
	p += 1;
    }

    /*
     * Check for a sign.
     */

    if (*p == '-') {
	p += 1;
	result = -(strtoul(p, endPtr, base));
    } else {
	if (*p == '+') {
	    p += 1;
	}
	result = strtoul(p, endPtr, base);
    }
    if ((result == 0) && (endPtr != 0) && (*endPtr == p)) {
	*endPtr = (char *) string;
    }
    return result;
}
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<


























































































































































Deleted compat/strtoul.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
/*
 * strtoul.c --
 *
 *	Source code for the "strtoul" library procedure.
 *
 * Copyright (c) 1988 The Regents of the University of California.
 * Copyright (c) 1994 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

/*
 * The table below is used to convert from ASCII digits to a numerical
 * equivalent. It maps from '0' through 'z' to integers (100 for non-digit
 * characters).
 */

static const char cvtIn[] = {
    0, 1, 2, 3, 4, 5, 6, 7, 8, 9,		/* '0' - '9' */
    100, 100, 100, 100, 100, 100, 100,		/* punctuation */
    10, 11, 12, 13, 14, 15, 16, 17, 18, 19,	/* 'A' - 'Z' */
    20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
    30, 31, 32, 33, 34, 35,
    100, 100, 100, 100, 100, 100,		/* punctuation */
    10, 11, 12, 13, 14, 15, 16, 17, 18, 19,	/* 'a' - 'z' */
    20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
    30, 31, 32, 33, 34, 35};

/*
 *----------------------------------------------------------------------
 *
 * strtoul --
 *
 *	Convert an ASCII string into an integer.
 *
 * Results:
 *	The return value is the integer equivalent of string. If endPtr is
 *	non-NULL, then *endPtr is filled in with the character after the last
 *	one that was part of the integer. If string doesn't contain a valid
 *	integer value, then zero is returned and *endPtr is set to string.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

unsigned long int
strtoul(
    const char *string,		/* String of ASCII digits, possibly preceded
				 * by white space. For bases greater than 10,
				 * either lower- or upper-case digits may be
				 * used. */
    char **endPtr,		/* Where to store address of terminating
				 * character, or NULL. */
    int base)			/* Base for conversion.  Must be less than 37.
				 * If 0, then the base is chosen from the
				 * leading characters of string: "0x" means
				 * hex, "0" means octal, anything else means
				 * decimal. */
{
    const char *p;
    unsigned long int result = 0;
    unsigned digit;
    int anyDigits = 0;
    int negative=0;
    int overflow=0;

    /*
     * Skip any leading blanks.
     */

    p = string;
    while (isspace(UCHAR(*p))) {
	p += 1;
    }
    if (*p == '-') {
        negative = 1;
        p += 1;
    } else {
        if (*p == '+') {
            p += 1;
        }
    }

    /*
     * If no base was provided, pick one from the leading characters of the
     * string.
     */

    if (base == 0) {
	if (*p == '0') {
	    p += 1;
	    if ((*p == 'x') || (*p == 'X')) {
		p += 1;
		base = 16;
	    } else {
		/*
		 * Must set anyDigits here, otherwise "0" produces a "no
		 * digits" error.
		 */

		anyDigits = 1;
		base = 8;
	    }
	} else {
	    base = 10;
	}
    } else if (base == 16) {
	/*
	 * Skip a leading "0x" from hex numbers.
	 */

	if ((p[0] == '0') && ((p[1] == 'x') || (p[1] == 'X'))) {
	    p += 2;
	}
    }

    /*
     * Sorry this code is so messy, but speed seems important. Do different
     * things for base 8, 10, 16, and other.
     */

    if (base == 8) {
	unsigned long maxres = ULONG_MAX >> 3;

	for ( ; ; p += 1) {
	    digit = *p - '0';
	    if (digit > 7) {
		break;
	    }
	    if (result > maxres) { overflow = 1; }
	    result = (result << 3);
	    if (digit > (ULONG_MAX - result)) { overflow = 1; }
	    result += digit;
	    anyDigits = 1;
	}
    } else if (base == 10) {
	unsigned long maxres = ULONG_MAX / 10;

	for ( ; ; p += 1) {
	    digit = *p - '0';
	    if (digit > 9) {
		break;
	    }
	    if (result > maxres) { overflow = 1; }
	    result *= 10;
	    if (digit > (ULONG_MAX - result)) { overflow = 1; }
	    result += digit;
	    anyDigits = 1;
	}
    } else if (base == 16) {
	unsigned long maxres = ULONG_MAX >> 4;

	for ( ; ; p += 1) {
	    digit = *p - '0';
	    if (digit > ('z' - '0')) {
		break;
	    }
	    digit = cvtIn[digit];
	    if (digit > 15) {
		break;
	    }
	    if (result > maxres) { overflow = 1; }
	    result = (result << 4);
	    if (digit > (ULONG_MAX - result)) { overflow = 1; }
	    result += digit;
	    anyDigits = 1;
	}
    } else if (base >= 2 && base <= 36) {
	unsigned long maxres = ULONG_MAX / base;

	for ( ; ; p += 1) {
	    digit = *p - '0';
	    if (digit > ('z' - '0')) {
		break;
	    }
	    digit = cvtIn[digit];
	    if (digit >= ( (unsigned) base )) {
		break;
	    }
	    if (result > maxres) { overflow = 1; }
	    result *= base;
	    if (digit > (ULONG_MAX - result)) { overflow = 1; }
	    result += digit;
	    anyDigits = 1;
	}
    }

    /*
     * See if there were any digits at all.
     */

    if (!anyDigits) {
	p = string;
    }

    if (endPtr != 0) {
	/* unsafe, but required by the strtoul prototype */
	*endPtr = (char *) p;
    }

    if (overflow) {
	errno = ERANGE;
	return ULONG_MAX;
    }
    if (negative) {
	return -result;
    }
    return result;
}
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<












































































































































































































































































































































































































































Changes to compat/waitpid.c.

152
153
154
155
156
157
158
159




160
161
162
163
164
165
166
    saveInfo:
	for (waitPtr = deadList; waitPtr != NULL; waitPtr = waitPtr->nextPtr) {
	    if (waitPtr->pid == result) {
		waitPtr->status = status;
		goto waitAgain;
	    }
	}
	waitPtr = (WaitInfo *) Tcl_Alloc(sizeof(WaitInfo));




	waitPtr->pid = result;
	waitPtr->status = status;
	waitPtr->nextPtr = deadList;
	deadList = waitPtr;

    waitAgain:
	continue;







|
>
>
>
>







152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
    saveInfo:
	for (waitPtr = deadList; waitPtr != NULL; waitPtr = waitPtr->nextPtr) {
	    if (waitPtr->pid == result) {
		waitPtr->status = status;
		goto waitAgain;
	    }
	}
	waitPtr = (WaitInfo *) Tcl_AttemptAlloc(sizeof(WaitInfo));
	if (!waitPtr) {
	    errno = ENOMEM;
	    return -1;
	}
	waitPtr->pid = result;
	waitPtr->status = status;
	waitPtr->nextPtr = deadList;
	deadList = waitPtr;

    waitAgain:
	continue;

Changes to compat/zlib/contrib/minizip/minizip.c.

62
63
64
65
66
67
68



69
70
71
72
73
74
75
#endif

#include "zip.h"

#ifdef _WIN32
        #define USEWIN32IOAPI
        #include "iowin32.h"



#endif



#define WRITEBUFFERSIZE (16384)
#define MAXFILENAME (256)








>
>
>







62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
#endif

#include "zip.h"

#ifdef _WIN32
        #define USEWIN32IOAPI
        #include "iowin32.h"
#       if defined(_MSC_VER)
#           define snprintf _snprintf
#       endif
#endif



#define WRITEBUFFERSIZE (16384)
#define MAXFILENAME (256)

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


void addPathToZip(zipFile zf, const char *filenameinzip, const char *password, int opt_exclude_path,int opt_compress_level) {
    tinydir_dir dir;
    int i;
    char newname[512];

    tinydir_open_sorted(&dir, filenameinzip);

    for (i = 0; i < dir.n_files; i++)
    {
        tinydir_file file;
        tinydir_readfile_n(&dir, &file, i);
        if(strcmp(file.name,".")==0) continue;
        if(strcmp(file.name,"..")==0) continue;
        sprintf(newname,"%s/%s",dir.path,file.name);
        if (file.is_dir)
        {
            addPathToZip(zf,newname,password,opt_exclude_path,opt_compress_level);
        } else {
            addFileToZip(zf,newname,password,opt_exclude_path,opt_compress_level);
        }
    }







|









|







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


void addPathToZip(zipFile zf, const char *filenameinzip, const char *password, int opt_exclude_path,int opt_compress_level) {
    tinydir_dir dir;
    int i;
    char newname[MAXFILENAME+1+MAXFILENAME+1];

    tinydir_open_sorted(&dir, filenameinzip);

    for (i = 0; i < dir.n_files; i++)
    {
        tinydir_file file;
        tinydir_readfile_n(&dir, &file, i);
        if(strcmp(file.name,".")==0) continue;
        if(strcmp(file.name,"..")==0) continue;
        snprintf(newname, sizeof(newname), "%.*s/%.*s", MAXFILENAME, dir.path, MAXFILENAME, file.name);
        if (file.is_dir)
        {
            addPathToZip(zf,newname,password,opt_exclude_path,opt_compress_level);
        } else {
            addFileToZip(zf,newname,password,opt_exclude_path,opt_compress_level);
        }
    }

Deleted doc/AbstractListObj.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
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
'\"
'\" Copyright (c) 2022 Brian Griffin.  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_AbstractListType 3 8.7 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_AbstractListObjNew,
Tcl_AbsstractListObjCopy,
Tcl_AbstractListGetConcreteRep,
Tcl_AbstractListGetElements,
Tcl_AbstractListGetType,
Tcl_AbstractListObjIndex,
Tcl_AbstractListObjLength,
Tcl_AbstractListObjRange,
Tcl_AbstractListObjReverse,
Tcl_AbstractListSetConcreteRep,
\- manipulate Tcl values as abstract lists.
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_Obj *
\fBTcl_AbstractListObjNew\fR(\fIinterp, abstractListType\fR)
Tcl_AbstractListType *
\fBTcl_AbstractListGetType\fR(\fIlistPtr\fR)
void
\fBTcl_AbstractListSetConcreteRep\fR(\fIlistPtr, repPtr\fR)
void *
\fBTcl_AbstractListGetConcreteRep\fR(\fIlistPtr\fR)
Tcl_WideInt
\fBTcl_AbstractListObjLength\fR(\fIlistPtr\fR)
int
\fBTcl_AbstractListObjIndex\fR(\fIinterp\fR, \fIlistPtr, index\fR, \fIelemObjPtr*\fR)
int
\fBTcl_AbstractListObjRange\fR(\fIinterp\fR, \fIlistPtr, fromIdx, toIdx\fR, \fInewObjPtr\fR)
int
\fBTcl_AbstractListObjReverse(\fIinterp\fR, \fIlistPtr\fR, \fInewObjPtr\fR)
int
\fBTcl_AbstraceListObjGetElements\fR(\fIinterp\fR, \fIlistPtr\fR, \fIobjcPtr\fR, \fIobjvPtr\fR)
Tcl_Obj *
\fBTcl_AbstractListObjCopy\fR(\fIinterp\fR, \fIlistPtr\fR);
typedef Tcl_Obj* (Tcl_ALNewObjProc) (int objc, Tcl_Obj * const objv[]);
typedef void (Tcl_ALDupRepProc) (Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
typedef Tcl_WideInt (Tcl_ALLengthProc) (Tcl_Obj *listPtr);
typedef int (Tcl_ALIndexProc) (Tcl_Interp *interp, Tcl_Obj *listPtr,
                               Tcl_WideInt index, Tcl_Obj** elemObj);
typedef int (Tcl_ALSliceProc) (Tcl_Interp *interp, Tcl_Obj *listPtr,
                               Tcl_WideInt fromIdx, Tcl_WideInt toIdx,
                               Tcl_Obj **newObjPtr);
typedef int (Tcl_ALReverseProc) (Tcl_Interp *interp, Tcl_Obj *listPtr,
                                 Tcl_Obj **newObjPtr);
typedef int (Tcl_ALGetElements) (Tcl_Interp *interp, Tcl_Obj *listPtr,
                                 int *objcptr, Tcl_Obj ***objvptr);
typedef void (Tcl_ALFreeConcreteRep) (Tcl_Obj *listPtr);
typedef void (Tcl_ALToStringRep) (Tcl_Obj *listPtr);
.SH ARGUMENTS
.AS
.AP Tcl_Interp *interp in
If an error occurs while converting a value to be a list value,
an error message is left in the interpreter's result value
unless \fIinterp\fR is NULL.
.AP Tcl_AbstractListType *abstractListType in
This structure defines the behavior for the \fBAbstractList\fR for a
given concrete \fBAbstractList\fR type. The struct provides the name
plus a collection of functions that implement the various List
operations on the AbstractType value.  \fBTcl_AbstractListObjNew\fR
call creates a new Tcl_Obj based on a preinitilized AbstractList
struct.
.AP Tcl_Obj *listPtr in/out
A Tcl_Obj of type AbstractList. Use to read or modify the type or
value content an AbstractList type.
.AP void *repPtr in
A reference to the concrete type representation storage. Specific
concrete types allocate and use this space to store whatever details
of value are needed.
.AP Tcl_WideInt index in
Index of the list element that \fBTcl_AbstractListObjIndex\fR
is to return.
The first element has index 0.
.AP Tcl_Obj **elemObjPtr
A location where the returned reference to an element Obj is to be
stored.
.AP Tcl_WideInt fromIdx in
The starting index of the list element for the slice that
\fBTcl_AbstractListObjRange\fR is to return.
.AP Tcl_WideInt toIdx in
The ending index of the list element for the slice that
\fBTcl_AbstractListObjRange\fR is to return.
.AP Tcl_Obj **newObjPtr in
A location where the new slice or reversed Obj reference is to be
stored.
.AP (Tcl_ALNewObjProc) in
Function pointer for a function used to create new instances of the
custom AbstractList listPtr.
.AP (Tcl_ALDupRepProc) in
Function pointer for a function used to duplicate (make a copy) of the
custom AbstractList listPtr.
.AP (Tcl_ALLengthProc) in
Function pointer for a function used to return the length of the
custom AbstractList.
.AP (Tcl_ALIndexProc) in
Function pointer for a function used to return an element listPtr for
the given index value.
.AP (Tcl_ALSliceProc) in
Function pointer for a function used to create a new slice from an
existing AbstractList.
.AP (Tcl_ALReverseProc) in
Function pointer for a function used to create a new AbstractList with
the element order reversed.
.BE

.SH DESCRIPTION
.PP
The AbstractList type provides an interface for creating new List type
representations. An AbstractList behaves like a List when using script
level list commands.  How the values are stored or produced is up to
the implementation.  A simple example of an AbstractList is the [lseq]
command which produces a list of numeric values in sequence.  The
underlying implementation does not store a list of numeric values.
Instead, it produces values on demand based on the index using an
arithmetic expression: "value = start + (step * index)".
.PP
An AbstractList is created by defining an internal storage
representation for the list along with a set of functions that manage
and manipulate the list value(s).  These functions provide
"List" like results from the List family of commands.

.SH ABSTRACTLIST C API
.PP
\fBTcl_AbstractListObjNew\fR returns a new Tcl_Obj based on the
concrete type definition given. The caller must then complete the
initialization of the Obj by setting the concrete represtation. (see
\fBTcl_AbstractListSetConcreteRep\fR())

\fBTcl_AbstractListGetType\fR returns the Tcl_AbstractList struct for
the given Obj.  This function is used internally to access the
implementation functions.  It can also be used in a specific
implementation to confirm that the Obj is of the expected AbstractList
type.

\fBTcl_AbstractListSetConcreteRep\fR is called when creating an
instance of an AbstractList. It stores the repPtr, to the allocated
value Representation, in the Tcl_Obj.

\fBTcl_AbstractListGetConcreteRep\fR returns the previously stored
repPtr for a given Obj value.

\fBTcl_AbstractListObjLength\fR returns the list length, i.e., number
of elements in the given AbstractList. This function is typically used
internally by when evaluating various List operations.  It would not
typically be used by an AbstractList concrete implementaion since the
internal representation is readily available within the
implementation, presumably.

\fBTcl_AbstractListObjIndex\fR returns the element Tcl_Obj for a given
index location.

\fBTcl_AbstractListObjRange\fR returns a new Obj value constructed
from a slice of the original AbstractList value, ranging from
\fIfromIdx\fR to the \fItoIdx\fR. If this function is not provided,
the default behavior will be to construct a traditional List using the
Index function.

\fBTcl_AbstractListObjReverse\fR returns a new Obj value constructed by
reversing the index order. If this function is not provided, the
default behavior will be to construct a traditional List using the
Index function.

\fBTcl_AbstraceListObjGetElements\fR returns an objv array containing
all elements of the AbstractList. (*** need words about memory
ownership ***)

\fBTcl_AbstractListObjCopy\fR returns a duplicate Obj from the original.

.SH ABSTRACTLIST IMPLEMENTATION FUNCTIONS
The following functions are to be defined by a specific implementation
to provide full or parcial List compatible behavior. The Length and
Index functions are required, and the rest are optional.
Unimplemented functions will either use a default implementation that
relies on Length and Index functions, or, the AbstractList will
"shimmer" into a formal List value.
.PP
.CS
typedef Tcl_Obj* (Tcl_ALNewObjProc) (int objc, Tcl_Obj * const objv[]);
typedef void (Tcl_ALDupRepProc) (Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
typedef Tcl_WideInt  (Tcl_ALLengthProc) (Tcl_Obj *listPtr);
typedef int (Tcl_ALIndexProc)  (Tcl_Interp *interp, Tcl_Obj *listPtr,
                                 Tcl_WideInt index, Tcl_Obj** elemObj);
typedef int (Tcl_ALSliceProc)  (Tcl_Interp *interp, Tcl_Obj *listPtr,
                                Tcl_WideInt fromIdx, Tcl_WideInt toIdx,
                                Tcl_Obj **newObjPtr);
typedef int (Tcl_ALReverseProc) (Tcl_Interp *interp, Tcl_Obj *listPtr,
                                 Tcl_Obj **newObjPtr);
typedef int (Tcl_ALGetElements) (Tcl_Interp *interp, Tcl_Obj *listPtr,
                                 int *objcptr, Tcl_Obj ***objvptr);
typedef void (Tcl_ALFreeConcreteRep) (Tcl_Obj *listPtr);
typedef void (Tcl_ALToStringRep) (Tcl_Obj *listPtr);
.CE
.PP
.SH AbstractList Example
.PP
\fBTcl_AbstractListObjNew\fR is used to create an object with a custom
List representation.
.PP
.CS
/*
** Define the AbstractList type callbacks
*/
static \fBTcl_AbstractListType\fR arithSeriesType = {
    TCL_ABSTRACTLIST_VERSION_1,
    "arithseries",
    Tcl_NewArithSeriesObj,
    DupArithSeriesRep,
    TclArithSeriesObjLength,
    TclArithSeriesObjIndex,
    TclArithSeriesObjRange,
    TclArithSeriesObjReverse,
    TclArithSeriesGetElements,
    FreeArithSeriesRep,
    UpdateStringOfArithSeries
};
.CE
.PP
The Index and Length procs must be defined. The others are optional.
If an optional proc is not defined, it may use a default routine that
makes use of Length and Index, or the value will be converted to a
List, and then the operation will proceed normally, and note: this
will permanently change the value representation to a \fBList\fR
representation.
.PP
.CS
/*
** Define the concrete representation for the ArithSeries type
*/
typedef struct ArithSeries {
    int start,
    int end,
    int step,
    int length
} ArithSeries;

/*
** Allocate and initialize the concrete repdresentation.
*/
arithSeriesRepPtr = (ArithSeries*)\fBTcl_Alloc\fR(sizeof (ArithSeries));
arithSeriesRepPtr->isDouble = 0;
arithSeriesRepPtr->start = 0;
arithSeriesRepPtr->end = 15;
arithSeriesRepPtr->step = 1;
arithSeriesRepPtr->len = 15;
arithSeriesRepPtr->elements = NULL;

/*
** Create an instance Tcl_Obj
*/
\fBTcl_Obj\fR *arithObj = \fBTcl_AbstractListObjNew\fR(interp, &arithSeriesType);

/*
** Set the concrete value for the Obj.
*/
\fBTcl_AbstractListSetConcreteRep\fR(arithObj, arithSeriesRepPtr);

return arithObj;
.CE
.PP
If any List operation is used to modify the AbstractList, for example
[lset $abstraceList 3 17], it will first be converted to a List before
completing the change.
.PP
.CS
/* Example functions */
Tcl_Obj*
ArithSeriesObjIndex(Tcl_Obj *arithSeriesObjPtr, Tcl_WideInt index)
{
    ArithSeries *arithSeriesRepPtr;
    Tcl_WideInt element;
    if (arithSeriesObjPtr->typePtr != &tclAbstractListType) {
        Tcl_Panic("ArithSeriesObjIndex called with a not ArithSeries Obj.");
    }
    arithSeriesRepPtr = ArithSeriesRepPtr(arithSeriesObjPtr);

    if (index < 0 || index >= arithSeriesRepPtr->length) {
        return NULL;
    }

    /* List[i] = Start + (Step * i) */
    element = (arithSeriesRepPtr->start + (index) * arithSeriesRepPtr->step);

    return Tcl_NewWideIntObj(element);
}

Tcl_WideInt ArithSeriesObjLength(Tcl_Obj *arithSeriesObjPtr)
{
    ArithSeries *arithSeriesRepPtr = ArithSeriesRepPtr(arithSeriesObjPtr);
    return arithSeriesRepPtr->length;
}

.CE
.PP
The functions \fBTcl_AbstractListObjLength\fR,
\fBTcl_AbstractListObjIndex\fR, \fBTcl_AbstractListObjRange\fR, and
\fBTcl_AbstractListObjReverse\fR can be used to interact with a known
AbstatractList Tcl_Obj value, as well as \fBTcl_ListObjLength\fR,
\fBTcl_ListObjIndex\fR, without causing the obj value to converted to
a \fBList\fR.  Tcl_ListObjGetElements can also be used on an
AbstractList, just note that this call may result in new element
objects being created for every element in the abstract list.  Since
an abstract list can be arbitrarily large and not consume space, this
call may have undesired consequences.
.PP
.SH "SEE ALSO"
Tcl_NewListObj(3), Tcl_NewObj(3), Tcl_DecrRefCount(3), Tcl_IncrRefCount(3), Tcl_GetObjResult(3)
.SH KEYWORDS
index, internal representation, length, list, list value,
list type, value, value type, replace, string representation
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<






























































































































































































































































































































































































































































































































































































































































Changes to doc/AddErrInfo.3.

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
.AP "const char" *message in
For \fBTcl_AddErrorInfo\fR,
this is a conventional C string to append to the \fB\-errorinfo\fR return option.
For \fBTcl_AddObjErrorInfo\fR,
this points to the first byte of an array of \fIlength\fR bytes
containing a string to append to the \fB\-errorinfo\fR return option.
This byte array may contain embedded null bytes
unless \fIlength\fR is TCL_INDEX_NONE.
.AP Tcl_Obj *objPtr in
A message to be appended to the \fB\-errorinfo\fR return option
in the form of a Tcl_Obj value.
.AP size_t length in
The number of bytes to copy from \fImessage\fR when
appending to the \fB\-errorinfo\fR return option.
If TCL_INDEX_NONE, all bytes up to the first null byte are used.
.AP Tcl_Obj *errorObjPtr in
The \fB\-errorcode\fR return option will be set to this value.
.AP "const char" *element in
String to record as one element of the \fB\-errorcode\fR return option.
Last \fIelement\fR argument must be NULL.
.AP va_list argList in
An argument list which must have been initialized using
\fBva_start\fR, and cleared using \fBva_end\fR.
.AP int lineNum
The line number of a script where an error occurred.
.AP "const char" *script in
Pointer to first character in script containing command (must be <= command)
.AP "const char" *command in
Pointer to first character in command that generated the error
.AP size_t commandLength in
Number of bytes in command; TCL_INDEX_NONE means use all bytes up to first null byte
.BE
.SH DESCRIPTION
.PP
The \fBTcl_SetReturnOptions\fR and \fBTcl_GetReturnOptions\fR
routines expose the same capabilities as the \fBreturn\fR and
\fBcatch\fR commands, respectively, in the form of a C interface.
.PP







|



|


|





<
<
<






|
|







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
.AP "const char" *message in
For \fBTcl_AddErrorInfo\fR,
this is a conventional C string to append to the \fB\-errorinfo\fR return option.
For \fBTcl_AddObjErrorInfo\fR,
this points to the first byte of an array of \fIlength\fR bytes
containing a string to append to the \fB\-errorinfo\fR return option.
This byte array may contain embedded null bytes
unless \fIlength\fR is negative.
.AP Tcl_Obj *objPtr in
A message to be appended to the \fB\-errorinfo\fR return option
in the form of a Tcl_Obj value.
.AP Tcl_Size length in
The number of bytes to copy from \fImessage\fR when
appending to the \fB\-errorinfo\fR return option.
If negative, all bytes up to the first null byte are used.
.AP Tcl_Obj *errorObjPtr in
The \fB\-errorcode\fR return option will be set to this value.
.AP "const char" *element in
String to record as one element of the \fB\-errorcode\fR return option.
Last \fIelement\fR argument must be NULL.



.AP int lineNum
The line number of a script where an error occurred.
.AP "const char" *script in
Pointer to first character in script containing command (must be <= command)
.AP "const char" *command in
Pointer to first character in command that generated the error
.AP Tcl_Size commandLength in
Number of bytes in command; a negative value means use all bytes up to first null byte
.BE
.SH DESCRIPTION
.PP
The \fBTcl_SetReturnOptions\fR and \fBTcl_GetReturnOptions\fR
routines expose the same capabilities as the \fBreturn\fR and
\fBcatch\fR commands, respectively, in the form of a C interface.
.PP
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
\fBTcl_AddObjErrorInfo\fR is nearly identical
to \fBTcl_AddErrorInfo\fR, except that it has an additional \fIlength\fR
argument.  This allows the \fImessage\fR string to contain
embedded null bytes.  This is essentially never a good idea.
If the \fImessage\fR needs to contain the null character \fBU+0000\fR,
Tcl's usual internal encoding rules should be used to avoid
the need for a null byte.  If the \fBTcl_AddObjErrorInfo\fR
interface is used at all, it should be with a TCL_INDEX_NONE \fIlength\fR value.
.PP
The procedure \fBTcl_SetObjErrorCode\fR is used to set the
\fB\-errorcode\fR return option to the list value \fIerrorObjPtr\fR
built up by the caller.
\fBTcl_SetObjErrorCode\fR is typically invoked just
before returning an error. If an error is
returned without calling \fBTcl_SetObjErrorCode\fR or







|







220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
\fBTcl_AddObjErrorInfo\fR is nearly identical
to \fBTcl_AddErrorInfo\fR, except that it has an additional \fIlength\fR
argument.  This allows the \fImessage\fR string to contain
embedded null bytes.  This is essentially never a good idea.
If the \fImessage\fR needs to contain the null character \fBU+0000\fR,
Tcl's usual internal encoding rules should be used to avoid
the need for a null byte.  If the \fBTcl_AddObjErrorInfo\fR
interface is used at all, it should be with a negative \fIlength\fR value.
.PP
The procedure \fBTcl_SetObjErrorCode\fR is used to set the
\fB\-errorcode\fR return option to the list value \fIerrorObjPtr\fR
built up by the caller.
\fBTcl_SetObjErrorCode\fR is typically invoked just
before returning an error. If an error is
returned without calling \fBTcl_SetObjErrorCode\fR or

Changes to doc/ByteArrObj.3.

30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
unsigned char *
\fBTcl_SetByteArrayLength\fR(\fIobjPtr, numBytes\fR)
.SH ARGUMENTS
.AS "const unsigned char" *numBytesPtr in/out
.AP "const unsigned char" *bytes in
The array of bytes used to initialize or set a byte-array value. May be NULL
even if \fInumBytes\fR is non-zero.
.AP size_t numBytes in
The number of bytes in the array.
.AP Tcl_Obj *objPtr in/out
For \fBTcl_SetByteArrayObj\fR, this points to an unshared value to be
overwritten by a byte-array value.  For \fBTcl_GetBytesFromObj\fR,
\fBTcl_GetByteArrayFromObj\fR and \fBTcl_SetByteArrayLength\fR, this points
to the value from which to extract an array of bytes.
.AP Tcl_Interp *interp in
Interpreter to use for error reporting.
.AP "size_t \&| int" *numBytesPtr out
Points to space where the number of bytes in the array may be written.
Caller may pass NULL when it does not need this information.
.BE

.SH DESCRIPTION
.PP
These routines are used to create, modify, store, transfer, and retrieve







|








|







30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
unsigned char *
\fBTcl_SetByteArrayLength\fR(\fIobjPtr, numBytes\fR)
.SH ARGUMENTS
.AS "const unsigned char" *numBytesPtr in/out
.AP "const unsigned char" *bytes in
The array of bytes used to initialize or set a byte-array value. May be NULL
even if \fInumBytes\fR is non-zero.
.AP Tcl_Size numBytes in
The number of bytes in the array.
.AP Tcl_Obj *objPtr in/out
For \fBTcl_SetByteArrayObj\fR, this points to an unshared value to be
overwritten by a byte-array value.  For \fBTcl_GetBytesFromObj\fR,
\fBTcl_GetByteArrayFromObj\fR and \fBTcl_SetByteArrayLength\fR, this points
to the value from which to extract an array of bytes.
.AP Tcl_Interp *interp in
Interpreter to use for error reporting.
.AP "Tcl_Size \&| int" *numBytesPtr out
Points to space where the number of bytes in the array may be written.
Caller may pass NULL when it does not need this information.
.BE

.SH DESCRIPTION
.PP
These routines are used to create, modify, store, transfer, and retrieve
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
has not been disturbed.  The pointer may be used to overwrite the byte
contents of the internal representation, so long as the value is unshared
and any string representation is invalidated.
.PP
On success, both \fBTcl_GetBytesFromObj\fR and \fBTcl_GetByteArrayFromObj\fR
write the number of bytes in the byte-array value of \fIobjPtr\fR
to the space pointed to by \fInumBytesPtr\fR.  This space may be of type
\fBsize_t\fR or of type \fBint\fR.  It is recommended that callers provide
a \fBsize_t\fR space for this purpose.  If the caller provides only
an \fBint\fR space and the number of bytes in the byte-array value of
\fIobjPtr\fR is greater than \fBINT_MAX\fR, the routine will fail due
to being unable to correctly report the byte-array size to the caller.
The ability to provide an \fBint\fR space is best considered a migration
aid for codebases constrained to continue operating with Tcl releases
older than 8.7.
.PP







|
|







130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
has not been disturbed.  The pointer may be used to overwrite the byte
contents of the internal representation, so long as the value is unshared
and any string representation is invalidated.
.PP
On success, both \fBTcl_GetBytesFromObj\fR and \fBTcl_GetByteArrayFromObj\fR
write the number of bytes in the byte-array value of \fIobjPtr\fR
to the space pointed to by \fInumBytesPtr\fR.  This space may be of type
\fBTcl_Size\fR or of type \fBint\fR.  It is recommended that callers provide
a \fBTcl_Size\fR space for this purpose.  If the caller provides only
an \fBint\fR space and the number of bytes in the byte-array value of
\fIobjPtr\fR is greater than \fBINT_MAX\fR, the routine will fail due
to being unable to correctly report the byte-array size to the caller.
The ability to provide an \fBint\fR space is best considered a migration
aid for codebases constrained to continue operating with Tcl releases
older than 8.7.
.PP

Changes to doc/Cancel.3.

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
.AP Tcl_Interp *interp in
Interpreter in which to cancel the script.
.AP Tcl_Obj *resultObjPtr in
Error message to use in the cancellation, or NULL to use a default message. If
not NULL, this object will have its reference count decremented before
\fBTcl_CancelEval\fR returns.
.AP int flags in
ORed combination of flag bits that specify additional options.
For \fBTcl_CancelEval\fR, only \fBTCL_CANCEL_UNWIND\fR is currently
supported.  For \fBTcl_Canceled\fR, only \fBTCL_LEAVE_ERR_MSG\fR and
\fBTCL_CANCEL_UNWIND\fR are currently supported.
.AP void *clientData in
Currently reserved for future use.
It should be set to NULL.
.BE
.SH DESCRIPTION
.PP
\fBTcl_CancelEval\fR cancels or unwinds the script in progress soon after
the next invocation of asynchronous handlers, causing \fBTCL_ERROR\fR to be
the return code for that script.  This function is thread-safe and may be
called from any thread in the process.
.PP
\fBTcl_Canceled\fR checks if the script in progress has been canceled and
returns \fBTCL_ERROR\fR if it has.  Otherwise, \fBTCL_OK\fR is returned.
Extensions can use this function to check to see if they should abort a long
running command.  This function is thread sensitive and may only be called
from the thread the interpreter was created in.
.SS "FLAG BITS"
Any ORed combination of the following values may be used for the
\fIflags\fR argument to procedures such as \fBTcl_CancelEval\fR:
.TP 20
\fBTCL_CANCEL_UNWIND\fR
.
This flag is used by \fBTcl_CancelEval\fR and \fBTcl_Canceled\fR.
For \fBTcl_CancelEval\fR, if this flag is set, the script in progress
is canceled and the evaluation stack for the interpreter is unwound.







|




















|







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
.AP Tcl_Interp *interp in
Interpreter in which to cancel the script.
.AP Tcl_Obj *resultObjPtr in
Error message to use in the cancellation, or NULL to use a default message. If
not NULL, this object will have its reference count decremented before
\fBTcl_CancelEval\fR returns.
.AP int flags in
OR'ed combination of flag bits that specify additional options.
For \fBTcl_CancelEval\fR, only \fBTCL_CANCEL_UNWIND\fR is currently
supported.  For \fBTcl_Canceled\fR, only \fBTCL_LEAVE_ERR_MSG\fR and
\fBTCL_CANCEL_UNWIND\fR are currently supported.
.AP void *clientData in
Currently reserved for future use.
It should be set to NULL.
.BE
.SH DESCRIPTION
.PP
\fBTcl_CancelEval\fR cancels or unwinds the script in progress soon after
the next invocation of asynchronous handlers, causing \fBTCL_ERROR\fR to be
the return code for that script.  This function is thread-safe and may be
called from any thread in the process.
.PP
\fBTcl_Canceled\fR checks if the script in progress has been canceled and
returns \fBTCL_ERROR\fR if it has.  Otherwise, \fBTCL_OK\fR is returned.
Extensions can use this function to check to see if they should abort a long
running command.  This function is thread sensitive and may only be called
from the thread the interpreter was created in.
.SS "FLAG BITS"
Any OR'ed combination of the following values may be used for the
\fIflags\fR argument to procedures such as \fBTcl_CancelEval\fR:
.TP 20
\fBTCL_CANCEL_UNWIND\fR
.
This flag is used by \fBTcl_CancelEval\fR and \fBTcl_Canceled\fR.
For \fBTcl_CancelEval\fR, if this flag is set, the script in progress
is canceled and the evaluation stack for the interpreter is unwound.

Changes to doc/Class.3.

77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
.AP "const char" *name in
The name of the object to create, or NULL if a new unused name is to be
automatically selected.
.AP "const char" *nsName in
The name of the namespace to create for the object's private use, or NULL if a
new unused name is to be automatically selected. The namespace must not
already exist.
.AP size_t objc in
The number of elements in the \fIobjv\fR array.
.AP "Tcl_Obj *const" *objv in
The arguments to the command to create the instance of the class.
.AP size_t skip in
The number of arguments at the start of the argument array, \fIobjv\fR, that
are not arguments to any constructors. This allows the generation of correct
error messages even when complicated calling patterns are used (e.g., via the
\fBnext\fR command).
.AP Tcl_ObjectMetadataType *metaTypePtr in
The type of \fImetadata\fR being set with \fBTcl_ClassSetMetadata\fR or
retrieved with \fBTcl_ClassGetMetadata\fR.







|



|







77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
.AP "const char" *name in
The name of the object to create, or NULL if a new unused name is to be
automatically selected.
.AP "const char" *nsName in
The name of the namespace to create for the object's private use, or NULL if a
new unused name is to be automatically selected. The namespace must not
already exist.
.AP Tcl_Size objc in
The number of elements in the \fIobjv\fR array.
.AP "Tcl_Obj *const" *objv in
The arguments to the command to create the instance of the class.
.AP Tcl_Size skip in
The number of arguments at the start of the argument array, \fIobjv\fR, that
are not arguments to any constructors. This allows the generation of correct
error messages even when complicated calling patterns are used (e.g., via the
\fBnext\fR command).
.AP Tcl_ObjectMetadataType *metaTypePtr in
The type of \fImetadata\fR being set with \fBTcl_ClassSetMetadata\fR or
retrieved with \fBTcl_ClassGetMetadata\fR.

Changes to doc/Concat.3.

14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
.nf
\fB#include <tcl.h>\fR
.sp
const char *
\fBTcl_Concat\fR(\fIargc, argv\fR)
.SH ARGUMENTS
.AS "const char *const" argv[]
.AP size_t argc in
Number of strings.
.AP "const char *const" argv[] in
Array of strings to concatenate.  Must have \fIargc\fR entries.
.BE

.SH DESCRIPTION
.PP







|







14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
.nf
\fB#include <tcl.h>\fR
.sp
const char *
\fBTcl_Concat\fR(\fIargc, argv\fR)
.SH ARGUMENTS
.AS "const char *const" argv[]
.AP Tcl_Size argc in
Number of strings.
.AP "const char *const" argv[] in
Array of strings to concatenate.  Must have \fIargc\fR entries.
.BE

.SH DESCRIPTION
.PP

Changes to doc/CrtAlias.3.

65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
below).
.AP "const char" *childCmd in
Name of source command for alias.
.AP Tcl_Interp *targetInterp in
Interpreter that contains the target command for an alias.
.AP "const char" *targetCmd in
Name of target command for alias in \fItargetInterp\fR.
.AP size_t argc in
Count of additional arguments to pass to the alias command.
.AP "const char *const" *argv in
Vector of strings, the additional arguments to pass to the alias command.
This storage is owned by the caller.
.AP size_t objc in
Count of additional value arguments to pass to the aliased command.
.AP Tcl_Obj **objv in
Vector of Tcl_Obj structures, the additional value arguments to pass to
the aliased command.
This storage is owned by the caller.
.AP Tcl_Interp **targetInterpPtr in
Pointer to location to store the address of the interpreter where a target







|




|







65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
below).
.AP "const char" *childCmd in
Name of source command for alias.
.AP Tcl_Interp *targetInterp in
Interpreter that contains the target command for an alias.
.AP "const char" *targetCmd in
Name of target command for alias in \fItargetInterp\fR.
.AP Tcl_Size argc in
Count of additional arguments to pass to the alias command.
.AP "const char *const" *argv in
Vector of strings, the additional arguments to pass to the alias command.
This storage is owned by the caller.
.AP Tcl_Size objc in
Count of additional value arguments to pass to the aliased command.
.AP Tcl_Obj **objv in
Vector of Tcl_Obj structures, the additional value arguments to pass to
the aliased command.
This storage is owned by the caller.
.AP Tcl_Interp **targetInterpPtr in
Pointer to location to store the address of the interpreter where a target

Changes to doc/CrtChannel.3.

137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
The channel to operate on.
.AP int direction in
\fBTCL_READABLE\fR means the input handle is wanted; \fBTCL_WRITABLE\fR
means the output handle is wanted.
.AP void **handlePtr out
Points to the location where the desired OS-specific handle should be
stored.
.AP size_t size in
The size, in bytes, of buffers to allocate in this channel.
.AP int mask in
An OR-ed combination of \fBTCL_READABLE\fR, \fBTCL_WRITABLE\fR
and \fBTCL_EXCEPTION\fR that indicates events that have occurred on
this channel.
.AP Tcl_Interp *interp in
Current interpreter. (can be NULL)







|







137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
The channel to operate on.
.AP int direction in
\fBTCL_READABLE\fR means the input handle is wanted; \fBTCL_WRITABLE\fR
means the output handle is wanted.
.AP void **handlePtr out
Points to the location where the desired OS-specific handle should be
stored.
.AP Tcl_Size size in
The size, in bytes, of buffers to allocate in this channel.
.AP int mask in
An OR-ed combination of \fBTCL_READABLE\fR, \fBTCL_WRITABLE\fR
and \fBTCL_EXCEPTION\fR that indicates events that have occurred on
this channel.
.AP Tcl_Interp *interp in
Current interpreter. (can be NULL)

Changes to doc/CrtObjCmd.3.

183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
\fBTcl_CreateObjCommand2\fR does the same as \fBTcl_CreateObjCommand\fR,
except its \fIproc2\fR argument is of type \fBTcl_ObjCmdProc2\fR.
.PP
.CS
typedef int \fBTcl_ObjCmdProc2\fR(
        void *\fIclientData\fR,
        Tcl_Interp *\fIinterp\fR,
        size_t \fIobjc\fR,
        Tcl_Obj *const \fIobjv\fR[]);
.CE
.PP
\fBTcl_DeleteCommand\fR deletes a command from a command interpreter.
Once the call completes, attempts to invoke \fIcmdName\fR in
\fIinterp\fR will result in errors.
If \fIcmdName\fR is not bound as a command in \fIinterp\fR then







|







183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
\fBTcl_CreateObjCommand2\fR does the same as \fBTcl_CreateObjCommand\fR,
except its \fIproc2\fR argument is of type \fBTcl_ObjCmdProc2\fR.
.PP
.CS
typedef int \fBTcl_ObjCmdProc2\fR(
        void *\fIclientData\fR,
        Tcl_Interp *\fIinterp\fR,
        Tcl_Size \fIobjc\fR,
        Tcl_Obj *const \fIobjv\fR[]);
.CE
.PP
\fBTcl_DeleteCommand\fR deletes a command from a command interpreter.
Once the call completes, attempts to invoke \fIcmdName\fR in
\fIinterp\fR will result in errors.
If \fIcmdName\fR is not bound as a command in \fIinterp\fR then
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
If the command is not found, then it returns 0.
Otherwise it places information about the command
in the \fBTcl_CmdInfo\fR structure
pointed to by \fIinfoPtr\fR and returns 1.
A \fBTcl_CmdInfo\fR structure has the following fields:
.PP
.CS
typedef struct Tcl_CmdInfo {
    int \fIisNativeObjectProc\fR;
    Tcl_ObjCmdProc *\fIobjProc\fR;
    void *\fIobjClientData\fR;
    Tcl_CmdProc *\fIproc\fR;
    void *\fIclientData\fR;
    Tcl_CmdDeleteProc *\fIdeleteProc\fR;
    void *\fIdeleteData\fR;







|







220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
If the command is not found, then it returns 0.
Otherwise it places information about the command
in the \fBTcl_CmdInfo\fR structure
pointed to by \fIinfoPtr\fR and returns 1.
A \fBTcl_CmdInfo\fR structure has the following fields:
.PP
.CS
typedef struct {
    int \fIisNativeObjectProc\fR;
    Tcl_ObjCmdProc *\fIobjProc\fR;
    void *\fIobjClientData\fR;
    Tcl_CmdProc *\fIproc\fR;
    void *\fIclientData\fR;
    Tcl_CmdDeleteProc *\fIdeleteProc\fR;
    void *\fIdeleteData\fR;

Changes to doc/CrtTrace.3.

25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
\fBTcl_CreateObjTrace2\fR(\fIinterp, level, flags, objProc2, clientData, deleteProc\fR)
.sp
\fBTcl_DeleteTrace\fR(\fIinterp, trace\fR)
.SH ARGUMENTS
.AS Tcl_CmdObjTraceDeleteProc *deleteProc
.AP Tcl_Interp *interp in
Interpreter containing command to be traced or untraced.
.AP int level in
Only commands at or below this nesting level will be traced unless
0 is specified.  1 means
top-level commands only, 2 means top-level commands or those that are
invoked as immediate consequences of executing top-level commands
(procedure bodies, bracketed commands, etc.) and so on.
A value of 0 means that commands at any level are traced.
.AP int flags in







|







25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
\fBTcl_CreateObjTrace2\fR(\fIinterp, level, flags, objProc2, clientData, deleteProc\fR)
.sp
\fBTcl_DeleteTrace\fR(\fIinterp, trace\fR)
.SH ARGUMENTS
.AS Tcl_CmdObjTraceDeleteProc *deleteProc
.AP Tcl_Interp *interp in
Interpreter containing command to be traced or untraced.
.AP Tcl_Size level in
Only commands at or below this nesting level will be traced unless
0 is specified.  1 means
top-level commands only, 2 means top-level commands or those that are
invoked as immediate consequences of executing top-level commands
(procedure bodies, bracketed commands, etc.) and so on.
A value of 0 means that commands at any level are traced.
.AP int flags in
76
77
78
79
80
81
82














83
84
85
86
87
88
89
        \fBTcl_Interp\fR* \fIinterp\fR,
        int \fIlevel\fR,
        const char *\fIcommand\fR,
        \fBTcl_Command\fR \fIcommandToken\fR,
        int \fIobjc\fR,
        \fBTcl_Obj\fR *const \fIobjv\fR[]);
.CE














.PP
The \fIclientData\fR and \fIinterp\fR parameters are copies of the
corresponding arguments given to \fBTcl_CreateTrace\fR.
\fIclientData\fR typically points to an application-specific data
structure that describes what to do when \fIobjProc\fR is invoked.  The
\fIlevel\fR parameter gives the nesting level of the command (1 for
top-level commands passed to \fBTcl_Eval\fR by the application, 2 for







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







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
        \fBTcl_Interp\fR* \fIinterp\fR,
        int \fIlevel\fR,
        const char *\fIcommand\fR,
        \fBTcl_Command\fR \fIcommandToken\fR,
        int \fIobjc\fR,
        \fBTcl_Obj\fR *const \fIobjv\fR[]);
.CE
.PP
\fIobjProc2\fR should have arguments and result that match the type,
\fBTcl_CmdObjTraceProc2\fR:
.PP
.CS
typedef int \fBTcl_CmdObjTraceProc2\fR(
        \fBvoid *\fR \fIclientData\fR,
        \fBTcl_Interp\fR* \fIinterp\fR,
        Tcl_Size \fIlevel\fR,
        const char *\fIcommand\fR,
        \fBTcl_Command\fR \fIcommandToken\fR,
        Tcl_Size \fIobjc\fR,
        \fBTcl_Obj\fR *const \fIobjv\fR[]);
.CE
.PP
The \fIclientData\fR and \fIinterp\fR parameters are copies of the
corresponding arguments given to \fBTcl_CreateTrace\fR.
\fIclientData\fR typically points to an application-specific data
structure that describes what to do when \fIobjProc\fR is invoked.  The
\fIlevel\fR parameter gives the nesting level of the command (1 for
top-level commands passed to \fBTcl_Eval\fR by the application, 2 for

Changes to doc/DString.3.

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
char *
\fBTcl_DStringAppendElement\fR(\fIdsPtr, element\fR)
.sp
\fBTcl_DStringStartSublist\fR(\fIdsPtr\fR)
.sp
\fBTcl_DStringEndSublist\fR(\fIdsPtr\fR)
.sp
size_t
\fBTcl_DStringLength\fR(\fIdsPtr\fR)
.sp
char *
\fBTcl_DStringValue\fR(\fIdsPtr\fR)
.sp
\fBTcl_DStringSetLength\fR(\fIdsPtr, newLength\fR)
.sp
\fBTcl_DStringFree\fR(\fIdsPtr\fR)
.sp
\fBTcl_DStringResult\fR(\fIinterp, dsPtr\fR)
.sp
\fBTcl_DStringGetResult\fR(\fIinterp, dsPtr\fR)




.SH ARGUMENTS
.AS Tcl_DString newLength in/out
.AP Tcl_DString *dsPtr in/out
Pointer to structure that is used to manage a dynamic string.
.AP "const char" *bytes in
Pointer to characters to append to dynamic string.
.AP "const char" *element in
Pointer to characters to append as list element to dynamic string.
.AP size_t length in
Number of bytes from \fIbytes\fR to add to dynamic string.  If TCL_INDEX_NONE,
add all characters up to null terminating character.
.AP size_t newLength in
New length for dynamic string, not including null terminating
character.
.AP Tcl_Interp *interp in/out
Interpreter whose result is to be set from or moved to the
dynamic string.
.BE








|












>
>
>
>








|
|

|







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
char *
\fBTcl_DStringAppendElement\fR(\fIdsPtr, element\fR)
.sp
\fBTcl_DStringStartSublist\fR(\fIdsPtr\fR)
.sp
\fBTcl_DStringEndSublist\fR(\fIdsPtr\fR)
.sp
Tcl_Size
\fBTcl_DStringLength\fR(\fIdsPtr\fR)
.sp
char *
\fBTcl_DStringValue\fR(\fIdsPtr\fR)
.sp
\fBTcl_DStringSetLength\fR(\fIdsPtr, newLength\fR)
.sp
\fBTcl_DStringFree\fR(\fIdsPtr\fR)
.sp
\fBTcl_DStringResult\fR(\fIinterp, dsPtr\fR)
.sp
\fBTcl_DStringGetResult\fR(\fIinterp, dsPtr\fR)
.sp
Tcl_Obj *
\fBTcl_DStringToObj\fR(\fIdsPtr\fR)
.sp
.SH ARGUMENTS
.AS Tcl_DString newLength in/out
.AP Tcl_DString *dsPtr in/out
Pointer to structure that is used to manage a dynamic string.
.AP "const char" *bytes in
Pointer to characters to append to dynamic string.
.AP "const char" *element in
Pointer to characters to append as list element to dynamic string.
.AP Tcl_Size length in
Number of bytes from \fIbytes\fR to add to dynamic string.  If negative,
add all characters up to null terminating character.
.AP Tcl_Size newLength in
New length for dynamic string, not including null terminating
character.
.AP Tcl_Interp *interp in/out
Interpreter whose result is to be set from or moved to the
dynamic string.
.BE

132
133
134
135
136
137
138




139
140
141
142
143
144










145
146
147
.PP
\fBTcl_DStringResult\fR sets the result of \fIinterp\fR to the value of
the dynamic string given by \fIdsPtr\fR.  It does this by moving
a pointer from \fIdsPtr\fR to the interpreter's result.
This saves the cost of allocating new memory and copying the string.
\fBTcl_DStringResult\fR also reinitializes the dynamic string to
an empty string.




.PP
\fBTcl_DStringGetResult\fR does the opposite of \fBTcl_DStringResult\fR.
It sets the value of \fIdsPtr\fR to the result of \fIinterp\fR and
it clears \fIinterp\fR's result.
If possible it does this by moving a pointer rather than by copying
the string.











.SH KEYWORDS
append, dynamic string, free, result







>
>
>
>






>
>
>
>
>
>
>
>
>
>



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
.PP
\fBTcl_DStringResult\fR sets the result of \fIinterp\fR to the value of
the dynamic string given by \fIdsPtr\fR.  It does this by moving
a pointer from \fIdsPtr\fR to the interpreter's result.
This saves the cost of allocating new memory and copying the string.
\fBTcl_DStringResult\fR also reinitializes the dynamic string to
an empty string.
Since the dynamic string is reinitialized, there is no need to
further call \fBTcl_DStringFree\fR on it and it can be reused without
calling \fBTcl_DStringInit\fR. The caller must ensure that the dynamic
string stored in \fIdsPtr\fR is encoded in Tcl's internal UTF-8 format.
.PP
\fBTcl_DStringGetResult\fR does the opposite of \fBTcl_DStringResult\fR.
It sets the value of \fIdsPtr\fR to the result of \fIinterp\fR and
it clears \fIinterp\fR's result.
If possible it does this by moving a pointer rather than by copying
the string.
.PP
\fBTcl_DStringToObj\fR returns a \fBTcl_Obj\fR containing the value of the
dynamic string given by \fIdsPtr\fR. It does this by moving a pointer from
\fIdsPtr\fR to a newly allocated \fBTcl_Obj\fR and reinitializing to dynamic
string to an empty string. This saves the cost of allocating new memory and
copying the string. Since the dynamic string is reinitialized, there is no need
to further call \fBTcl_DStringFree\fR on it and it can be reused without calling
\fBTcl_DStringInit\fR. The returned \fBTcl_Obj\fR has a reference count of 0.
The caller must ensure that the dynamic string stored in \fIdsPtr\fR is encoded
in Tcl's internal UTF-8 format.

.SH KEYWORDS
append, dynamic string, free, result

Changes to doc/DetachPids.3.

18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
.sp
\fBTcl_ReapDetachedProcs\fR()
.sp
Tcl_Pid
\fBTcl_WaitPid\fR(\fIpid, statusPtr, options\fR)
.SH ARGUMENTS
.AS Tcl_Pid *statusPtr out
.AP size_t numPids in
Number of process ids contained in the array pointed to by \fIpidPtr\fR.
.AP int *pidPtr in
Address of array containing \fInumPids\fR process ids.
.AP Tcl_Pid pid in
The id of the process (pipe) to wait for.
.AP int *statusPtr out
The result of waiting on a process (pipe). Either 0 or ECHILD.







|







18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
.sp
\fBTcl_ReapDetachedProcs\fR()
.sp
Tcl_Pid
\fBTcl_WaitPid\fR(\fIpid, statusPtr, options\fR)
.SH ARGUMENTS
.AS Tcl_Pid *statusPtr out
.AP Tcl_Size numPids in
Number of process ids contained in the array pointed to by \fIpidPtr\fR.
.AP int *pidPtr in
Address of array containing \fInumPids\fR process ids.
.AP Tcl_Pid pid in
The id of the process (pipe) to wait for.
.AP int *statusPtr out
The result of waiting on a process (pipe). Either 0 or ECHILD.

Changes to doc/DictObj.3.

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
dictionary value (or sub-value, in the case of
\fBTcl_DictObjPutKeyList\fR.)
.AP Tcl_Obj **valuePtrPtr out
Points to a variable that will have the value from a key/value pair
placed within it.  For \fBTcl_DictObjFirst\fR and
\fBTcl_DictObjNext\fR, this may be NULL to indicate that the caller is
not interested in the value.
.AP "size_t \&| int" *sizePtr out
Points to a variable that will have the number of key/value pairs
contained within the dictionary placed within it.
.AP Tcl_DictSearch *searchPtr in/out
Pointer to record to use to keep track of progress in enumerating all
key/value pairs in a dictionary.  The contents of the record will be
initialized by the call to \fBTcl_DictObjFirst\fR.  If the enumerating
is to be terminated before all values in the dictionary have been
returned, the search record \fImust\fR be passed to
\fBTcl_DictObjDone\fR to enable the internal locks to be released.
.AP int *donePtr out
Points to a variable that will have a non-zero value written into it
when the enumeration of the key/value pairs in a dictionary has
completed, and a zero otherwise.
.AP size_t keyc in
Indicates the number of keys that will be supplied in the \fIkeyv\fR
array.
.AP "Tcl_Obj *const" *keyv in
Array of \fIkeyc\fR pointers to values that
\fBTcl_DictObjPutKeyList\fR and \fBTcl_DictObjRemoveKeyList\fR will
use to locate the key/value pair to manipulate within the
sub-dictionaries of the main dictionary value passed to them.







|













|







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
dictionary value (or sub-value, in the case of
\fBTcl_DictObjPutKeyList\fR.)
.AP Tcl_Obj **valuePtrPtr out
Points to a variable that will have the value from a key/value pair
placed within it.  For \fBTcl_DictObjFirst\fR and
\fBTcl_DictObjNext\fR, this may be NULL to indicate that the caller is
not interested in the value.
.AP "Tcl_Size \&| int" *sizePtr out
Points to a variable that will have the number of key/value pairs
contained within the dictionary placed within it.
.AP Tcl_DictSearch *searchPtr in/out
Pointer to record to use to keep track of progress in enumerating all
key/value pairs in a dictionary.  The contents of the record will be
initialized by the call to \fBTcl_DictObjFirst\fR.  If the enumerating
is to be terminated before all values in the dictionary have been
returned, the search record \fImust\fR be passed to
\fBTcl_DictObjDone\fR to enable the internal locks to be released.
.AP int *donePtr out
Points to a variable that will have a non-zero value written into it
when the enumeration of the key/value pairs in a dictionary has
completed, and a zero otherwise.
.AP Tcl_Size keyc in
Indicates the number of keys that will be supplied in the \fIkeyv\fR
array.
.AP "Tcl_Obj *const" *keyv in
Array of \fIkeyc\fR pointers to values that
\fBTcl_DictObjPutKeyList\fR and \fBTcl_DictObjRemoveKeyList\fR will
use to locate the key/value pair to manipulate within the
sub-dictionaries of the main dictionary value passed to them.

Changes to doc/Encoding.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
'\"
'\" Copyright (c) 1997-1998 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_GetEncoding 3 "8.1" Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_GetEncoding, Tcl_FreeEncoding, Tcl_GetEncodingFromObj, Tcl_ExternalToUtfDString, Tcl_ExternalToUtf, Tcl_UtfToExternalDString, Tcl_UtfToExternal, Tcl_GetEncodingName, Tcl_SetSystemEncoding, Tcl_GetEncodingNameFromEnvironment, Tcl_GetEncodingNames, Tcl_CreateEncoding, Tcl_GetEncodingSearchPath, Tcl_SetEncodingSearchPath \- procedures for creating and using encodings
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_Encoding
\fBTcl_GetEncoding\fR(\fIinterp, name\fR)
.sp
void
\fBTcl_FreeEncoding\fR(\fIencoding\fR)
.sp
int
\fBTcl_GetEncodingFromObj\fR(\fIinterp, objPtr, encodingPtr\fR)
.sp
char *
\fBTcl_ExternalToUtfDString\fR(\fIencoding, src, srcLen, dstPtr\fR)
.sp
size_t
\fBTcl_ExternalToUtfDStringEx\fR(\fIencoding, src, srcLen, flags, dstPtr\fR)
.sp
char *
\fBTcl_UtfToExternalDString\fR(\fIencoding, src, srcLen, dstPtr\fR)
.sp
size_t
\fBTcl_UtfToExternalDStringEx\fR(\fIencoding, src, srcLen, flags, dstPtr\fR)
.sp
int
\fBTcl_ExternalToUtf\fR(\fIinterp, encoding, src, srcLen, flags, statePtr,
                  dst, dstLen, srcReadPtr, dstWrotePtr, dstCharsPtr\fR)
.sp
int
\fBTcl_UtfToExternal\fR(\fIinterp, encoding, src, srcLen, flags, statePtr,
                  dst, dstLen, srcReadPtr, dstWrotePtr, dstCharsPtr\fR)
.sp
const char *
\fBTcl_GetEncodingName\fR(\fIencoding\fR)
.sp
int
\fBTcl_GetEncodingNulLength\fR(\fIencoding\fR)
.sp
int
\fBTcl_SetSystemEncoding\fR(\fIinterp, name\fR)
.sp
const char *
\fBTcl_GetEncodingNameFromEnvironment\fR(\fIbufPtr\fR)










|
















|
|




|
|












|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
'\"
'\" Copyright (c) 1997-1998 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_GetEncoding 3 "8.1" Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_GetEncoding, Tcl_FreeEncoding, Tcl_GetEncodingFromObj, Tcl_ExternalToUtfDString, Tcl_ExternalToUtfDStringEx, Tcl_ExternalToUtf, Tcl_UtfToExternalDString, Tcl_UtfToExternalDStringEx, Tcl_UtfToExternal, Tcl_GetEncodingName, Tcl_SetSystemEncoding, Tcl_GetEncodingNameFromEnvironment, Tcl_GetEncodingNames, Tcl_CreateEncoding, Tcl_GetEncodingSearchPath, Tcl_SetEncodingSearchPath \- procedures for creating and using encodings
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_Encoding
\fBTcl_GetEncoding\fR(\fIinterp, name\fR)
.sp
void
\fBTcl_FreeEncoding\fR(\fIencoding\fR)
.sp
int
\fBTcl_GetEncodingFromObj\fR(\fIinterp, objPtr, encodingPtr\fR)
.sp
char *
\fBTcl_ExternalToUtfDString\fR(\fIencoding, src, srcLen, dstPtr\fR)
.sp
int
\fBTcl_ExternalToUtfDStringEx\fR(\fIinterp, encoding, src, srcLen, flags, dstPtr, errorIdxPtr\fR)
.sp
char *
\fBTcl_UtfToExternalDString\fR(\fIencoding, src, srcLen, dstPtr\fR)
.sp
int
\fBTcl_UtfToExternalDStringEx\fR(\fIinterp, encoding, src, srcLen, flags, dstPtr, errorIdxPtr\fR)
.sp
int
\fBTcl_ExternalToUtf\fR(\fIinterp, encoding, src, srcLen, flags, statePtr,
                  dst, dstLen, srcReadPtr, dstWrotePtr, dstCharsPtr\fR)
.sp
int
\fBTcl_UtfToExternal\fR(\fIinterp, encoding, src, srcLen, flags, statePtr,
                  dst, dstLen, srcReadPtr, dstWrotePtr, dstCharsPtr\fR)
.sp
const char *
\fBTcl_GetEncodingName\fR(\fIencoding\fR)
.sp
Tcl_Size
\fBTcl_GetEncodingNulLength\fR(\fIencoding\fR)
.sp
int
\fBTcl_SetSystemEncoding\fR(\fIinterp, name\fR)
.sp
const char *
\fBTcl_GetEncodingNameFromEnvironment\fR(\fIbufPtr\fR)
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
.AP "const char" *src in
For the \fBTcl_ExternalToUtf\fR functions, an array of bytes in the
specified encoding that are to be converted to UTF-8.  For the
\fBTcl_UtfToExternal\fR function, an array of
UTF-8 characters to be converted to the specified encoding.
.AP "const TCHAR" *tsrc in
An array of Windows TCHAR characters to convert to UTF-8.
.AP size_t srcLen in
Length of \fIsrc\fR or \fItsrc\fR in bytes.  If the length is negative, the
encoding-specific length of the string is used.
.AP Tcl_DString *dstPtr out
Pointer to an uninitialized or free \fBTcl_DString\fR in which the converted
result will be stored.
.AP int flags in
Various flag bits OR-ed together.
\fBTCL_ENCODING_START\fR signifies that the
source buffer is the first block in a (potentially multi-block) input
stream, telling the conversion routine to reset to an initial state and
perform any initialization that needs to occur before the first byte is
converted. \fBTCL_ENCODING_END\fR signifies that the source buffer is the last
block in a (potentially multi-block) input stream, telling the conversion
routine to perform any finalization that needs to occur after the last
byte is converted and then to reset to an initial state.
\fBTCL_ENCODING_NOCOMPLAIN\fR signifies that the conversion routine should
not return immediately upon reading a source character that does not exist in
the target encoding, but it will substitute a default fallback character for
all of such characters. The flag \fBTCL_ENCODING_STOPONERROR\fR has no effect,
it only has meaning in Tcl 8.x. The flag \fBTCL_ENCODING_STRICT\fR makes the
encoder/decoder more strict in what it considers to be an invalid byte
sequence. The flag \fBTCL_ENCODING_MODIFIED\fR makes
\fBTcl_UtfToExternalDStringEx\fR and \fBTcl_UtfToExternal\fR produce the byte
sequence \exC0\ex80 in stead of \ex00, for the utf-8/cesu-8 encoders.
.AP Tcl_EncodingState *statePtr in/out
Used when converting a (generally long or indefinite length) byte stream
in a piece-by-piece fashion.  The conversion routine stores its current
state in \fI*statePtr\fR after \fIsrc\fR (the buffer containing the
current piece) has been converted; that state information must be passed
back when converting the next piece of the stream so the conversion
routine knows what state it was in when it left off at the end of the







|






|







|
|
|
|
|
|
|
|
|
<







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
.AP "const char" *src in
For the \fBTcl_ExternalToUtf\fR functions, an array of bytes in the
specified encoding that are to be converted to UTF-8.  For the
\fBTcl_UtfToExternal\fR function, an array of
UTF-8 characters to be converted to the specified encoding.
.AP "const TCHAR" *tsrc in
An array of Windows TCHAR characters to convert to UTF-8.
.AP Tcl_Size srcLen in
Length of \fIsrc\fR or \fItsrc\fR in bytes.  If the length is negative, the
encoding-specific length of the string is used.
.AP Tcl_DString *dstPtr out
Pointer to an uninitialized or free \fBTcl_DString\fR in which the converted
result will be stored.
.AP int flags in
This is a bit mask passed in to control the operation of the encoding functions.
\fBTCL_ENCODING_START\fR signifies that the
source buffer is the first block in a (potentially multi-block) input
stream, telling the conversion routine to reset to an initial state and
perform any initialization that needs to occur before the first byte is
converted. \fBTCL_ENCODING_END\fR signifies that the source buffer is the last
block in a (potentially multi-block) input stream, telling the conversion
routine to perform any finalization that needs to occur after the last
byte is converted and then to reset to an initial state. The
\fBTCL_PROFILE_*\fR bits defined in the \fBPROFILES\fR section below
control the encoding profile to be used for dealing with invalid data or
other errors in the encoding transform.
\fBTCL_ENCODING_STOPONERROR\fR is present for backward compatibility with
Tcl 8.6 and forces the encoding profile to \fBstrict\fR.

Some flags bits may not be usable with some functions as noted in the
function descriptions below.

.AP Tcl_EncodingState *statePtr in/out
Used when converting a (generally long or indefinite length) byte stream
in a piece-by-piece fashion.  The conversion routine stores its current
state in \fI*statePtr\fR after \fIsrc\fR (the buffer containing the
current piece) has been converted; that state information must be passed
back when converting the next piece of the stream so the conversion
routine knows what state it was in when it left off at the end of the
132
133
134
135
136
137
138



139
140
141
142
143
144
145
a problem converting some source characters.  May be NULL.
.AP int *dstWrotePtr out
Filled with the number of bytes that were actually stored in the output
buffer as a result of the conversion.  May be NULL.
.AP int *dstCharsPtr out
Filled with the number of characters that correspond to the number of bytes
stored in the output buffer.  May be NULL.



.AP Tcl_DString *bufPtr out
Storage for the prescribed system encoding name.
.AP "const Tcl_EncodingType" *typePtr in
Structure that defines a new type of encoding.
.AP Tcl_Obj *searchPath in
List of filesystem directories in which to search for encoding data files.
.AP "const char" *path in







>
>
>







131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
a problem converting some source characters.  May be NULL.
.AP int *dstWrotePtr out
Filled with the number of bytes that were actually stored in the output
buffer as a result of the conversion.  May be NULL.
.AP int *dstCharsPtr out
Filled with the number of characters that correspond to the number of bytes
stored in the output buffer.  May be NULL.
.AP Tcl_Size *errorIdxPtr out
Filled with the index of the byte or character that caused the encoding transform
to fail. May be NULL.
.AP Tcl_DString *bufPtr out
Storage for the prescribed system encoding name.
.AP "const Tcl_EncodingType" *typePtr in
Structure that defines a new type of encoding.
.AP Tcl_Obj *searchPath in
List of filesystem directories in which to search for encoding data files.
.AP "const char" *path in
206
207
208
209
210
211
212
213
214









215
216









217
218
219
220
221
222
223
specified \fIencoding\fR into UTF-8.  The converted bytes are stored in
\fIdstPtr\fR, which is then null-terminated.  The caller should eventually
call \fBTcl_DStringFree\fR to free any information stored in \fIdstPtr\fR.
When converting, if any of the characters in the source buffer cannot be
represented in the target encoding, a default fallback character will be
used.  The return value is a pointer to the value stored in the DString.
.PP
\fBTcl_ExternalToUtfDStringEx\fR is the same as \fBTcl_ExternalToUtfDString\fR,
but it has an additional flags parameter.  The return value is the index of









the first byte in the input string causing a conversion error.
Or TCL_INDEX_NONE if all is OK.









.PP
\fBTcl_ExternalToUtf\fR converts a source buffer \fIsrc\fR from the specified
\fIencoding\fR into UTF-8.  Up to \fIsrcLen\fR bytes are converted from the
source buffer and up to \fIdstLen\fR converted bytes are stored in \fIdst\fR.
In all cases, \fI*srcReadPtr\fR is filled with the number of bytes that were
successfully converted from \fIsrc\fR and \fI*dstWrotePtr\fR is filled with
the corresponding number of bytes that were stored in \fIdst\fR.  The return







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







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
specified \fIencoding\fR into UTF-8.  The converted bytes are stored in
\fIdstPtr\fR, which is then null-terminated.  The caller should eventually
call \fBTcl_DStringFree\fR to free any information stored in \fIdstPtr\fR.
When converting, if any of the characters in the source buffer cannot be
represented in the target encoding, a default fallback character will be
used.  The return value is a pointer to the value stored in the DString.
.PP
\fBTcl_ExternalToUtfDStringEx\fR is a more flexible version of older
\fBTcl_ExternalToUtfDString\fR function. It takes three additional parameters,
\fBinterp\fR, \fBflags\fR and \fBerrorIdxPtr\fR. The \fBflags\fR parameter may
be used to specify the profile to be used for the transform. The
\fBTCL_ENCODING_START\fR and \fBTCL_ENCODING_END\fR bits in \fBflags\fR are
ignored as the function assumes the entire source string to be decoded is passed
into the function. On success, the function returns \fBTCL_ERROR\fR with the
converted string stored in \fB*dstPtr\fR. For errors other than conversion
errors, such as invalid flags, the function returns \fBTCL_OK\fR with an error
message in \fBinterp\fR if it is not NULL.
.PP
For conversion errors, \fBTcl_ExternalToUtfDStringEx\fR returns one

of the \fBTCL_CONVERT_*\fR errors listed below for \fBTcl_ExternalToUtf\fR.
When one of these conversion errors is returned, an error message is
stored in \fBinterp\fR only if \fBerrorIdxPtr\fR is NULL. Otherwise, no error message
is stored as the function expects the caller is interested whatever is
decoded to that point and not treating this as an immediate error condition.
The index of the error location is stored in \fB*errorIdxPtr\fR.
.PP
The caller must call \fBTcl_DStringFree\fR to free up the \fB*dstPtr\fR resources
irrespective of the return value from the function.
.PP
\fBTcl_ExternalToUtf\fR converts a source buffer \fIsrc\fR from the specified
\fIencoding\fR into UTF-8.  Up to \fIsrcLen\fR bytes are converted from the
source buffer and up to \fIdstLen\fR converted bytes are stored in \fIdst\fR.
In all cases, \fI*srcReadPtr\fR is filled with the number of bytes that were
successfully converted from \fIsrc\fR and \fI*dstWrotePtr\fR is filled with
the corresponding number of bytes that were stored in \fIdst\fR.  The return
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
The last few bytes in the source buffer were the beginning of a multibyte
sequence, but more bytes were needed to complete this sequence.  A
subsequent call to the conversion routine should pass a buffer containing
the unconverted bytes that remained in \fIsrc\fR plus some further bytes
from the source stream to properly convert the formerly split-up multibyte
sequence.
.IP \fBTCL_CONVERT_SYNTAX\fR 29
The source buffer contained an invalid character sequence.  This may occur
if the input stream has been damaged or if the input encoding method was
misidentified.
.IP \fBTCL_CONVERT_UNKNOWN\fR 29
The source buffer contained a character that could not be represented in
the target encoding and \fBTCL_ENCODING_NOCOMPLAIN\fR was not specified.
.RE
.LP
\fBTcl_UtfToExternalDString\fR converts a source buffer \fIsrc\fR from UTF-8
into the specified \fIencoding\fR.  The converted bytes are stored in
\fIdstPtr\fR, which is then terminated with the appropriate encoding-specific
null.  The caller should eventually call \fBTcl_DStringFree\fR to free any
information stored in \fIdstPtr\fR.  When converting, if any of the
characters in the source buffer cannot be represented in the target
encoding, a default fallback character will be used.  The return value is
a pointer to the value stored in the DString.
.PP
\fBTcl_UtfToExternalDStringEx\fR is the same as \fBTcl_UtfToExternalDString\fR,


but it has an additional flags parameter.  The return value is the index of

the first byte of an utf-8 byte-sequence in the input string causing a
conversion error. Or TCL_INDEX_NONE if all is OK.


.PP
\fBTcl_UtfToExternal\fR converts a source buffer \fIsrc\fR from UTF-8 into
the specified \fIencoding\fR.  Up to \fIsrcLen\fR bytes are converted from
the source buffer and up to \fIdstLen\fR converted bytes are stored in
\fIdst\fR.  In all cases, \fI*srcReadPtr\fR is filled with the number of
bytes that were successfully converted from \fIsrc\fR and \fI*dstWrotePtr\fR
is filled with the corresponding number of bytes that were stored in







|




|











|
>
>
|
>
|
<
>
>







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
The last few bytes in the source buffer were the beginning of a multibyte
sequence, but more bytes were needed to complete this sequence.  A
subsequent call to the conversion routine should pass a buffer containing
the unconverted bytes that remained in \fIsrc\fR plus some further bytes
from the source stream to properly convert the formerly split-up multibyte
sequence.
.IP \fBTCL_CONVERT_SYNTAX\fR 29
The source buffer contained an invalid byte or character sequence.  This may occur
if the input stream has been damaged or if the input encoding method was
misidentified.
.IP \fBTCL_CONVERT_UNKNOWN\fR 29
The source buffer contained a character that could not be represented in
the target encoding.
.RE
.LP
\fBTcl_UtfToExternalDString\fR converts a source buffer \fIsrc\fR from UTF-8
into the specified \fIencoding\fR.  The converted bytes are stored in
\fIdstPtr\fR, which is then terminated with the appropriate encoding-specific
null.  The caller should eventually call \fBTcl_DStringFree\fR to free any
information stored in \fIdstPtr\fR.  When converting, if any of the
characters in the source buffer cannot be represented in the target
encoding, a default fallback character will be used.  The return value is
a pointer to the value stored in the DString.
.PP
\fBTcl_UtfToExternalDStringEx\fR is an enhanced version of
\fBTcl_UtfToExternalDString\fR that transforms UTF-8 encoded source data to a specified
\fIencoding\fR. Except for the direction of the transform, the parameters and
return values are identical to those of \fBTcl_ExternalToUtfDStringEx\fR. See
that function above for details about the same.


Irrespective of the return code from the function, the caller must free
resources associated with \fB*dstPtr\fR when the function returns.
.PP
\fBTcl_UtfToExternal\fR converts a source buffer \fIsrc\fR from UTF-8 into
the specified \fIencoding\fR.  Up to \fIsrcLen\fR bytes are converted from
the source buffer and up to \fIdstLen\fR converted bytes are stored in
\fIdst\fR.  In all cases, \fI*srcReadPtr\fR is filled with the number of
bytes that were successfully converted from \fIsrc\fR and \fI*dstWrotePtr\fR
is filled with the corresponding number of bytes that were stored in
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
.CS
typedef struct Tcl_EncodingType {
    const char *\fIencodingName\fR;
    Tcl_EncodingConvertProc *\fItoUtfProc\fR;
    Tcl_EncodingConvertProc *\fIfromUtfProc\fR;
    Tcl_EncodingFreeProc *\fIfreeProc\fR;
    void *\fIclientData\fR;
    int \fInullSize\fR;
} \fBTcl_EncodingType\fR;
.CE
.PP
The \fIencodingName\fR provides a string name for the encoding, by
which it can be referred in other procedures such as
\fBTcl_GetEncoding\fR.  The \fItoUtfProc\fR refers to a callback
procedure to invoke to convert text from this encoding into UTF-8.







|







343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
.CS
typedef struct Tcl_EncodingType {
    const char *\fIencodingName\fR;
    Tcl_EncodingConvertProc *\fItoUtfProc\fR;
    Tcl_EncodingConvertProc *\fIfromUtfProc\fR;
    Tcl_EncodingFreeProc *\fIfreeProc\fR;
    void *\fIclientData\fR;
    Tcl_Size \fInullSize\fR;
} \fBTcl_EncodingType\fR;
.CE
.PP
The \fIencodingName\fR provides a string name for the encoding, by
which it can be referred in other procedures such as
\fBTcl_GetEncoding\fR.  The \fItoUtfProc\fR refers to a callback
procedure to invoke to convert text from this encoding into UTF-8.
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
.PP
.CS
.ta 1.5i
# Encoding file: iso2022-jp, escape-driven
E
init		{}
final		{}
iso8859-1	\ex1b(B
jis0201		\ex1b(J
jis0208		\ex1b$@
jis0208		\ex1b$B
jis0212		\ex1b$(D
gb2312		\ex1b$A
ksc5601		\ex1b$(C
.CE
.PP
In the file, the first column represents an option and the second column
is the associated value.  \fBinit\fR is a string to emit or expect before
the first character is converted, while \fBfinal\fR is a string to emit
or expect after the last character.  All other options are names of
table-based encodings; the associated value is the escape-sequence that
marks that encoding.  Tcl syntax is used for the values; in the above
example, for instance,
.QW \fB{}\fR
represents the empty string and
.QW \fB\ex1b\fR
represents character 27.
.PP
When \fBTcl_GetEncoding\fR encounters an encoding \fIname\fR that has not
been loaded, it attempts to load an encoding file called \fIname\fB.enc\fR
from the \fBencoding\fR subdirectory of each directory that Tcl searches
for its script library.  If the encoding file exists, but is
malformed, an error message will be left in \fIinterp\fR.
.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







|
|
|
|
|
|
|











|
















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




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
.PP
.CS
.ta 1.5i
# Encoding file: iso2022-jp, escape-driven
E
init		{}
final		{}
iso8859-1	\ex1B(B
jis0201		\ex1B(J
jis0208		\ex1B$@
jis0208		\ex1B$B
jis0212		\ex1B$(D
gb2312		\ex1B$A
ksc5601		\ex1B$(C
.CE
.PP
In the file, the first column represents an option and the second column
is the associated value.  \fBinit\fR is a string to emit or expect before
the first character is converted, while \fBfinal\fR is a string to emit
or expect after the last character.  All other options are names of
table-based encodings; the associated value is the escape-sequence that
marks that encoding.  Tcl syntax is used for the values; in the above
example, for instance,
.QW \fB{}\fR
represents the empty string and
.QW \fB\ex1B\fR
represents character 27.
.PP
When \fBTcl_GetEncoding\fR encounters an encoding \fIname\fR that has not
been loaded, it attempts to load an encoding file called \fIname\fB.enc\fR
from the \fBencoding\fR subdirectory of each directory that Tcl searches
for its script library.  If the encoding file exists, but is
malformed, an error message will be left in \fIinterp\fR.
.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 "PROFILES"
Encoding profiles define the manner in which errors in the encoding transforms
are handled by the encoding functions. An application can specify the profile
to be used by OR-ing the \fBflags\fR parameter passed to the function
with at most one of \fBTCL_ENCODING_PROFILE_TCL8\fR,
\fBTCL_ENCODING_PROFILE_STRICT\fR or \fBTCL_ENCODING_PROFILE_REPLACE\fR.
These correspond to the \fBtcl8\fR, \fBstrict\fR and \fBreplace\fR profiles
respectively. If none are specified, a version-dependent default profile is used.
For Tcl 9.0, the default profile is \fBtcl8\fR.
.PP
For details about profiles, see the \fBPROFILES\fR section in
the documentation of the \fBencoding\fR command.
.SH "SEE ALSO"
encoding(n)
.SH KEYWORDS
utf, encoding, convert

Changes to doc/Ensemble.3.

65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
but all other functions must not.
.AP "const char" *name in
The name of the ensemble command to be created.
.AP Tcl_Namespace *namespacePtr in
The namespace to which the ensemble command is to be bound, or NULL
for the current namespace.
.AP int ensFlags in
An ORed set of flag bits describing the basic configuration of the
ensemble. Currently only one bit has meaning, \fBTCL_ENSEMBLE_PREFIX\fR,
which is present when the ensemble command should also match
unambiguous prefixes of subcommands.
.AP Tcl_Obj *cmdNameObj in
A value holding the name of the ensemble command to look up.
.AP int flags in
An ORed set of flag bits controlling the behavior of
\fBTcl_FindEnsemble\fR. Currently only \fBTCL_LEAVE_ERR_MSG\fR is supported.
.AP Tcl_Command token in
A normal command token that refers to an ensemble command, or which
you wish to use for testing as an ensemble command in \fBTcl_IsEnsemble\fR.
.AP int *ensFlagsPtr out
Pointer to a variable into which to write the current ensemble flag
bits; currently only the bit \fBTCL_ENSEMBLE_PREFIX\fR is defined.







|






|







65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
but all other functions must not.
.AP "const char" *name in
The name of the ensemble command to be created.
.AP Tcl_Namespace *namespacePtr in
The namespace to which the ensemble command is to be bound, or NULL
for the current namespace.
.AP int ensFlags in
An OR'ed set of flag bits describing the basic configuration of the
ensemble. Currently only one bit has meaning, \fBTCL_ENSEMBLE_PREFIX\fR,
which is present when the ensemble command should also match
unambiguous prefixes of subcommands.
.AP Tcl_Obj *cmdNameObj in
A value holding the name of the ensemble command to look up.
.AP int flags in
An OR'ed set of flag bits controlling the behavior of
\fBTcl_FindEnsemble\fR. Currently only \fBTCL_LEAVE_ERR_MSG\fR is supported.
.AP Tcl_Command token in
A normal command token that refers to an ensemble command, or which
you wish to use for testing as an ensemble command in \fBTcl_IsEnsemble\fR.
.AP int *ensFlagsPtr out
Pointer to a variable into which to write the current ensemble flag
bits; currently only the bit \fBTCL_ENSEMBLE_PREFIX\fR is defined.

Changes to doc/Eval.3.

42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
.AS Tcl_Interp **termPtr
.AP Tcl_Interp *interp in
Interpreter in which to execute the script.  The interpreter's result is
modified to hold the result or error message from the script.
.AP Tcl_Obj *objPtr in
A Tcl value containing the script to execute.
.AP int flags in
ORed combination of flag bits that specify additional options.
\fBTCL_EVAL_GLOBAL\fR and \fBTCL_EVAL_DIRECT\fR are currently supported.
.AP "const char" *fileName in
Name of a file containing a Tcl script.
.AP size_t objc in
The number of values in the array pointed to by \fIobjv\fR;
this is also the number of words in the command.
.AP Tcl_Obj **objv in
Points to an array of pointers to values; each value holds the
value of a single word in the command to execute.
.AP int numBytes in
The number of bytes in \fIscript\fR, not including any







|



|







42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
.AS Tcl_Interp **termPtr
.AP Tcl_Interp *interp in
Interpreter in which to execute the script.  The interpreter's result is
modified to hold the result or error message from the script.
.AP Tcl_Obj *objPtr in
A Tcl value containing the script to execute.
.AP int flags in
OR'ed combination of flag bits that specify additional options.
\fBTCL_EVAL_GLOBAL\fR and \fBTCL_EVAL_DIRECT\fR are currently supported.
.AP "const char" *fileName in
Name of a file containing a Tcl script.
.AP Tcl_Size objc in
The number of values in the array pointed to by \fIobjv\fR;
this is also the number of words in the command.
.AP Tcl_Obj **objv in
Points to an array of pointers to values; each value holds the
value of a single word in the command to execute.
.AP int numBytes in
The number of bytes in \fIscript\fR, not including any
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
(^Z) for all platforms. If you require a
.QW ^Z
in code for string comparison, you can use
.QW \ex1A ,
which will be safely substituted by the Tcl interpreter into
.QW ^Z .
.PP
\fBTcl_EvalObjv\fR executes a single pre-parsed command instead of a
script.  The \fIobjc\fR and \fIobjv\fR arguments contain the values
of the words for the Tcl command, one word in each value in
\fIobjv\fR.  \fBTcl_EvalObjv\fR evaluates the command and returns
a completion code and result just like \fBTcl_EvalObjEx\fR.
The caller of \fBTcl_EvalObjv\fR has to manage the reference count of the
elements of \fIobjv\fR, insuring that the values are valid until
\fBTcl_EvalObjv\fR returns.







|







97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
(^Z) for all platforms. If you require a
.QW ^Z
in code for string comparison, you can use
.QW \ex1A ,
which will be safely substituted by the Tcl interpreter into
.QW ^Z .
.PP
\fBTcl_EvalObjv\fR executes a single preparsed command instead of a
script.  The \fIobjc\fR and \fIobjv\fR arguments contain the values
of the words for the Tcl command, one word in each value in
\fIobjv\fR.  \fBTcl_EvalObjv\fR evaluates the command and returns
a completion code and result just like \fBTcl_EvalObjEx\fR.
The caller of \fBTcl_EvalObjv\fR has to manage the reference count of the
elements of \fIobjv\fR, insuring that the values are valid until
\fBTcl_EvalObjv\fR returns.
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
It returns the result of the command and also modifies
the interpreter result in the same way as \fBTcl_Eval\fR.
The last argument to \fBTcl_VarEval\fR must be NULL to indicate the end
of arguments.  \fBTcl_VarEval\fR is now deprecated.

.SH "FLAG BITS"
.PP
Any ORed combination of the following values may be used for the
\fIflags\fR argument to procedures such as \fBTcl_EvalObjEx\fR:
.TP 23
\fBTCL_EVAL_DIRECT\fR
.
This flag is only used by \fBTcl_EvalObjEx\fR; it is ignored by
other procedures.  If this flag bit is set, the script is not
compiled to bytecodes; instead it is executed directly







|







138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
It returns the result of the command and also modifies
the interpreter result in the same way as \fBTcl_Eval\fR.
The last argument to \fBTcl_VarEval\fR must be NULL to indicate the end
of arguments.  \fBTcl_VarEval\fR is now deprecated.

.SH "FLAG BITS"
.PP
Any OR'ed combination of the following values may be used for the
\fIflags\fR argument to procedures such as \fBTcl_EvalObjEx\fR:
.TP 23
\fBTCL_EVAL_DIRECT\fR
.
This flag is only used by \fBTcl_EvalObjEx\fR; it is ignored by
other procedures.  If this flag bit is set, the script is not
compiled to bytecodes; instead it is executed directly

Changes to doc/FileSystem.3.

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
The first of two path values to compare. The value may be converted
to \fBpath\fR type.
.AP Tcl_Obj *secondPtr in
The second of two path values to compare. The value may be converted
to \fBpath\fR type.
.AP Tcl_Obj *listObj in
The list of path elements to operate on with a \fBjoin\fR operation.
.AP size_t elements in
The number of elements in the \fIlistObj\fR which should
be joined together. If TCL_INDEX_NONE, 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.







|

|










|







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
The first of two path values to compare. The value may be converted
to \fBpath\fR type.
.AP Tcl_Obj *secondPtr in
The second of two path values to compare. The value may be converted
to \fBpath\fR type.
.AP Tcl_Obj *listObj in
The list of path elements to operate on with a \fBjoin\fR operation.
.AP Tcl_Size elements in
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
Preallocated 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.
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
used to set those values for a given file.
.AP "const char" *modeString in
Specifies how the file is to be accessed. May have any of the values
allowed for the \fImode\fR argument to the Tcl \fBopen\fR command.
.AP int permissions in
POSIX-style permission flags such as 0644. If a new file is created, these
permissions will be set on the created file.
.AP "size_t \&| int" *lenPtr out
If non-NULL, filled with the number of elements in the split path.
.AP Tcl_Obj *basePtr in
The base path on to which to join the given elements. May be NULL.
.AP size_t objc in
The number of elements in \fIobjv\fR.
.AP "Tcl_Obj *const" objv[] in
The elements to join to the given base path.
.AP Tcl_Obj *linkNamePtr in
The name of the link to be created or read.
.AP Tcl_Obj *toPtr in
What the link called \fIlinkNamePtr\fR should be linked to, or NULL if







|



|







265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
used to set those values for a given file.
.AP "const char" *modeString in
Specifies how the file is to be accessed. May have any of the values
allowed for the \fImode\fR argument to the Tcl \fBopen\fR command.
.AP int permissions in
POSIX-style permission flags such as 0644. If a new file is created, these
permissions will be set on the created file.
.AP "Tcl_Size \&| int" *lenPtr out
If non-NULL, filled with the number of elements in the split path.
.AP Tcl_Obj *basePtr in
The base path on to which to join the given elements. May be NULL.
.AP Tcl_Size objc in
The number of elements in \fIobjv\fR.
.AP "Tcl_Obj *const" objv[] in
The elements to join to the given base path.
.AP Tcl_Obj *linkNamePtr in
The name of the link to be created or read.
.AP Tcl_Obj *toPtr in
What the link called \fIlinkNamePtr\fR should be linked to, or NULL if
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
.QW "read link"
action is performed. The result
is a Tcl_Obj specifying the contents of the symbolic link given by
\fIlinkNamePtr\fR, or NULL if the link could not be read. The result is owned
by the caller, which should call \fBTcl_DecrRefCount\fR when the result is no
longer needed. If the \fItoPtr\fR is not NULL, Tcl should create a link
of one of the types passed in in the \fIlinkAction\fR flag. This flag is
an ORed combination of \fBTCL_CREATE_SYMBOLIC_LINK\fR and \fBTCL_CREATE_HARD_LINK\fR.
Where a choice exists (i.e.\ more than one flag is passed in), the Tcl
convention is to prefer symbolic links. When a link is successfully
created, the return value should be \fItoPtr\fR (which is therefore
already owned by the caller). If unsuccessful, NULL is returned.
.PP
\fBTcl_FSLstat\fR fills the \fITcl_StatBuf\fR structure \fIstatPtr\fR with
information about the specified file. You do not need any access rights to the







|







479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
.QW "read link"
action is performed. The result
is a Tcl_Obj specifying the contents of the symbolic link given by
\fIlinkNamePtr\fR, or NULL if the link could not be read. The result is owned
by the caller, which should call \fBTcl_DecrRefCount\fR when the result is no
longer needed. If the \fItoPtr\fR is not NULL, Tcl should create a link
of one of the types passed in in the \fIlinkAction\fR flag. This flag is
an OR'ed combination of \fBTCL_CREATE_SYMBOLIC_LINK\fR and \fBTCL_CREATE_HARD_LINK\fR.
Where a choice exists (i.e.\ more than one flag is passed in), the Tcl
convention is to prefer symbolic links. When a link is successfully
created, the return value should be \fItoPtr\fR (which is therefore
already owned by the caller). If unsuccessful, NULL is returned.
.PP
\fBTcl_FSLstat\fR fills the \fITcl_StatBuf\fR structure \fIstatPtr\fR with
information about the specified file. You do not need any access rights to the
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
passed into this function (\fIpathPtr\fR or \fIpath\fR elements) have
a reference count
of zero, they will be freed when this function returns.
.PP
\fBTcl_FSConvertToPathType\fR tries to convert the given Tcl_Obj to a valid
Tcl path type, taking account of the fact that the cwd may have changed
even if this value is already supposedly of the correct type.
The filename may begin with
.QW ~
(to indicate current user's home directory) or
.QW ~<user>
(to indicate any user's home directory).
.PP
If the conversion succeeds (i.e.\ the value is a valid path in one of
the current filesystems), then \fBTCL_OK\fR is returned. Otherwise
\fBTCL_ERROR\fR is returned, and an error message may
be left in the interpreter.
.PP
\fBTcl_FSGetInternalRep\fR extracts the internal representation of a given







<
<
<
<
<







674
675
676
677
678
679
680





681
682
683
684
685
686
687
passed into this function (\fIpathPtr\fR or \fIpath\fR elements) have
a reference count
of zero, they will be freed when this function returns.
.PP
\fBTcl_FSConvertToPathType\fR tries to convert the given Tcl_Obj to a valid
Tcl path type, taking account of the fact that the cwd may have changed
even if this value is already supposedly of the correct type.





.PP
If the conversion succeeds (i.e.\ the value is a valid path in one of
the current filesystems), then \fBTCL_OK\fR is returned. Otherwise
\fBTCL_ERROR\fR is returned, and an error message may
be left in the interpreter.
.PP
\fBTcl_FSGetInternalRep\fR extracts the internal representation of a given
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
not require additional conversions.
.PP
\fBTcl_FSGetTranslatedPath\fR attempts to extract the translated path
from the given Tcl_Obj.
.PP
If the translation succeeds (i.e.\ the value is a valid path), then it is
returned. Otherwise NULL will be returned, and an error message may be
left in the interpreter. A
.QW translated
path is one which contains no
.QW ~
or
.QW ~user
sequences (these have been expanded to their current
representation in the filesystem). The value returned is owned by the
caller, which must store it or call \fBTcl_DecrRefCount\fR to ensure memory is
freed. This function is of little practical use, and
\fBTcl_FSGetNormalizedPath\fR or \fBTcl_FSGetNativePath\fR are usually
better functions to use for most purposes.
.PP
\fBTcl_FSGetTranslatedStringPath\fR does the same as
\fBTcl_FSGetTranslatedPath\fR, but returns a character string or NULL.







|
<
<
<
<
<
<
<







695
696
697
698
699
700
701
702







703
704
705
706
707
708
709
not require additional conversions.
.PP
\fBTcl_FSGetTranslatedPath\fR attempts to extract the translated path
from the given Tcl_Obj.
.PP
If the translation succeeds (i.e.\ the value is a valid path), then it is
returned. Otherwise NULL will be returned, and an error message may be
left in the interpreter. The value returned is owned by the







caller, which must store it or call \fBTcl_DecrRefCount\fR to ensure memory is
freed. This function is of little practical use, and
\fBTcl_FSGetNormalizedPath\fR or \fBTcl_FSGetNativePath\fR are usually
better functions to use for most purposes.
.PP
\fBTcl_FSGetTranslatedStringPath\fR does the same as
\fBTcl_FSGetTranslatedPath\fR, but returns a character string or NULL.
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
.SS "THE TCL_FILESYSTEM STRUCTURE"
.PP
The \fBTcl_Filesystem\fR structure contains the following fields:
.PP
.CS
typedef struct Tcl_Filesystem {
    const char *\fItypeName\fR;
    int \fIstructureLength\fR;
    Tcl_FSVersion \fIversion\fR;
    Tcl_FSPathInFilesystemProc *\fIpathInFilesystemProc\fR;
    Tcl_FSDupInternalRepProc *\fIdupInternalRepProc\fR;
    Tcl_FSFreeInternalRepProc *\fIfreeInternalRepProc\fR;
    Tcl_FSInternalToNormalizedProc *\fIinternalToNormalizedProc\fR;
    Tcl_FSCreateInternalRepProc *\fIcreateInternalRepProc\fR;
    Tcl_FSNormalizePathProc *\fInormalizePathProc\fR;







|







834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
.SS "THE TCL_FILESYSTEM STRUCTURE"
.PP
The \fBTcl_Filesystem\fR structure contains the following fields:
.PP
.CS
typedef struct Tcl_Filesystem {
    const char *\fItypeName\fR;
    Tcl_Size \fIstructureLength\fR;
    Tcl_FSVersion \fIversion\fR;
    Tcl_FSPathInFilesystemProc *\fIpathInFilesystemProc\fR;
    Tcl_FSDupInternalRepProc *\fIdupInternalRepProc\fR;
    Tcl_FSFreeInternalRepProc *\fIfreeInternalRepProc\fR;
    Tcl_FSInternalToNormalizedProc *\fIinternalToNormalizedProc\fR;
    Tcl_FSCreateInternalRepProc *\fIcreateInternalRepProc\fR;
    Tcl_FSNormalizePathProc *\fInormalizePathProc\fR;
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
path value. In Tcl, every
.QW path
must have a single unique
.QW normalized
string representation. Depending on the filesystem,
there may be more than one unnormalized string representation which
refers to that path (e.g.\ a relative path, a path with different
character case if the filesystem is case insensitive, a path contain a
reference to a home directory such as
.QW ~ ,
a path containing symbolic
links, etc). If the very last component in the path is a symbolic
link, it should not be converted into the value it points to (but
its case or other aspects should be made unique). All other path
components should be converted from symbolic links. This one
exception is required to agree with Tcl's semantics with \fBfile
delete\fR, \fBfile rename\fR, \fBfile copy\fR operating on symbolic links.







|
<
<







1052
1053
1054
1055
1056
1057
1058
1059


1060
1061
1062
1063
1064
1065
1066
path value. In Tcl, every
.QW path
must have a single unique
.QW normalized
string representation. Depending on the filesystem,
there may be more than one unnormalized string representation which
refers to that path (e.g.\ a relative path, a path with different
character case if the filesystem is case insensitive,


a path containing symbolic
links, etc). If the very last component in the path is a symbolic
link, it should not be converted into the value it points to (but
its case or other aspects should be made unique). All other path
components should be converted from symbolic links. This one
exception is required to agree with Tcl's semantics with \fBfile
delete\fR, \fBfile rename\fR, \fBfile copy\fR operating on symbolic links.

Changes to doc/IntObj.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
'\"
'\" Copyright (c) 1996-1997 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_IntObj 3 8.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_NewIntObj, Tcl_NewLongObj, Tcl_NewWideIntObj, Tcl_SetIntObj, Tcl_SetLongObj, Tcl_SetWideIntObj, Tcl_GetIntFromObj, Tcl_GetIntForIndex, Tcl_GetLongFromObj, Tcl_GetWideIntFromObj, Tcl_NewBignumObj, Tcl_SetBignumObj, Tcl_GetBignumFromObj, Tcl_TakeBignumFromObj \- manipulate Tcl values as integers
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_Obj *
\fBTcl_NewIntObj\fR(\fIintValue\fR)
.sp










|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
'\"
'\" Copyright (c) 1996-1997 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_IntObj 3 8.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_NewIntObj, Tcl_NewLongObj, Tcl_NewWideIntObj, Tcl_SetIntObj, Tcl_SetLongObj, Tcl_SetWideIntObj, Tcl_GetIntFromObj, Tcl_GetIntForIndex, Tcl_GetLongFromObj, Tcl_GetWideIntFromObj, Tcl_GetWideUIntFromObj, Tcl_NewBignumObj, Tcl_SetBignumObj, Tcl_GetBignumFromObj, Tcl_TakeBignumFromObj \- manipulate Tcl values as integers
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_Obj *
\fBTcl_NewIntObj\fR(\fIintValue\fR)
.sp
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
.sp
int
\fBTcl_GetLongFromObj\fR(\fIinterp, objPtr, longPtr\fR)
.sp
int
\fBTcl_GetWideIntFromObj\fR(\fIinterp, objPtr, widePtr\fR)
.sp






.sp
\fB#include <tclTomMath.h>\fR
.sp
Tcl_Obj *
\fBTcl_NewBignumObj\fR(\fIbigValue\fR)
.sp
\fBTcl_SetBignumObj\fR(\fIobjPtr, bigValue\fR)
.sp
int
\fBTcl_GetBignumFromObj\fR(\fIinterp, objPtr, bigValue\fR)
.sp
int
\fBTcl_TakeBignumFromObj\fR(\fIinterp, objPtr, bigValue\fR)
.sp
int
\fBTcl_InitBignumFromDouble\fR(\fIinterp, doubleValue, bigValue\fR)
.SH ARGUMENTS
.AS Tcl_WideInt doubleValue in/out
.AP size_t endValue in
\fBTcl_GetIntForIndex\fR will return this when the input value is "end".
.AP int intValue in
Integer value used to initialize or set a Tcl value.
.AP long longValue in
Long integer value used to initialize or set a Tcl value.
.AP Tcl_WideInt wideValue in
Wide integer value used to initialize or set a Tcl value.







>
>
>
>
>
>


















|







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
.sp
int
\fBTcl_GetLongFromObj\fR(\fIinterp, objPtr, longPtr\fR)
.sp
int
\fBTcl_GetWideIntFromObj\fR(\fIinterp, objPtr, widePtr\fR)
.sp
int
\fBTcl_GetWideUIntFromObj\fR(\fIinterp, objPtr, uwidePtr\fR)
.sp
int
\fBTcl_GetSizeIntFromObj\fR(\fIinterp, objPtr, sizePtr\fR)
.sp
.sp
\fB#include <tclTomMath.h>\fR
.sp
Tcl_Obj *
\fBTcl_NewBignumObj\fR(\fIbigValue\fR)
.sp
\fBTcl_SetBignumObj\fR(\fIobjPtr, bigValue\fR)
.sp
int
\fBTcl_GetBignumFromObj\fR(\fIinterp, objPtr, bigValue\fR)
.sp
int
\fBTcl_TakeBignumFromObj\fR(\fIinterp, objPtr, bigValue\fR)
.sp
int
\fBTcl_InitBignumFromDouble\fR(\fIinterp, doubleValue, bigValue\fR)
.SH ARGUMENTS
.AS Tcl_WideInt doubleValue in/out
.AP Tcl_Size endValue in
\fBTcl_GetIntForIndex\fR will return this when the input value is "end".
.AP int intValue in
Integer value used to initialize or set a Tcl value.
.AP long longValue in
Long integer value used to initialize or set a Tcl value.
.AP Tcl_WideInt wideValue in
Wide integer value used to initialize or set a Tcl value.
76
77
78
79
80
81
82
83
84
85
86




87
88
89
90
91
92
93
.AP Tcl_Interp *interp in/out
When non-NULL, an error message is left here when integral value
retrieval fails.
.AP int *intPtr out
Points to place to store the integer value retrieved from \fIobjPtr\fR.
.AP long *longPtr out
Points to place to store the long integer value retrieved from \fIobjPtr\fR.
.AP size_t *indexPtr out
Points to place to store the size_t value retrieved from \fIobjPtr\fR.
.AP Tcl_WideInt *widePtr out
Points to place to store the wide integer value retrieved from \fIobjPtr\fR.




.AP mp_int *bigValue in/out
Points to a multi-precision integer structure declared by the LibTomMath
library.
.AP double doubleValue in
Double value from which the integer part is determined and
used to initialize a multi-precision integer value.
.BE







|
|


>
>
>
>







82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
.AP Tcl_Interp *interp in/out
When non-NULL, an error message is left here when integral value
retrieval fails.
.AP int *intPtr out
Points to place to store the integer value retrieved from \fIobjPtr\fR.
.AP long *longPtr out
Points to place to store the long integer value retrieved from \fIobjPtr\fR.
.AP Tcl_Size *indexPtr out
Points to place to store the Tcl_Size value retrieved from \fIobjPtr\fR.
.AP Tcl_WideInt *widePtr out
Points to place to store the wide integer value retrieved from \fIobjPtr\fR.
.AP Tcl_WideUInt *uwidePtr out
Points to place to store the unsigned wide integer value retrieved from \fIobjPtr\fR.
.AP Tcl_Size *sizePtr out
Points to place to store the \fBTcl_Size\fR integer value retrieved from \fIobjPtr\fR.
.AP mp_int *bigValue in/out
Points to a multi-precision integer structure declared by the LibTomMath
library.
.AP double doubleValue in
Double value from which the integer part is determined and
used to initialize a multi-precision integer value.
.BE
129
130
131
132
133
134
135
136

137
138
139
140
141
142
143
\fIobjPtr\fR does not hold an index value.  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 the
same routine more efficient.
.PP
The \fBTcl_GetIntFromObj\fR, \fBTcl_GetLongFromObj\fR,
\fBTcl_GetWideIntFromObj\fR, \fBTcl_GetBignumFromObj\fR, and

\fBTcl_TakeBignumFromObj\fR routines attempt to retrieve an integral
value of the appropriate type from the Tcl value \fIobjPtr\fR.  If the
attempt succeeds, then \fBTCL_OK\fR is returned, and the value is
written to the storage provided by the caller.  The attempt might
fail if \fIobjPtr\fR does not hold an integral value, or if the
value exceeds the range of the target type.  If the attempt fails,
then \fBTCL_ERROR\fR is returned, and if \fIinterp\fR is non-NULL,







|
>







139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
\fIobjPtr\fR does not hold an index value.  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 the
same routine more efficient.
.PP
The \fBTcl_GetIntFromObj\fR, \fBTcl_GetLongFromObj\fR,
\fBTcl_GetWideIntFromObj\fR, \fBTcl_GetSizeIntFromObj\fR,
\fBTcl_GetBignumFromObj\fR, and
\fBTcl_TakeBignumFromObj\fR routines attempt to retrieve an integral
value of the appropriate type from the Tcl value \fIobjPtr\fR.  If the
attempt succeeds, then \fBTCL_OK\fR is returned, and the value is
written to the storage provided by the caller.  The attempt might
fail if \fIobjPtr\fR does not hold an integral value, or if the
value exceeds the range of the target type.  If the attempt fails,
then \fBTCL_ERROR\fR is returned, and if \fIinterp\fR is non-NULL,

Changes to doc/Limit.3.

61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
.AS Tcl_LimitHandlerDeleteProc commandLimit in/out
.AP Tcl_Interp *interp in
Interpreter that the limit being managed applies to or that will have
its limits checked.
.AP int type in
The type of limit that the operation refers to.  This must be either
\fBTCL_LIMIT_COMMANDS\fR or \fBTCL_LIMIT_TIME\fR.
.AP size_t commandLimit in
The maximum number of commands (as reported by \fBinfo cmdcount\fR)
that may be executed in the interpreter.
.AP Tcl_Time *timeLimitPtr in/out
A pointer to a structure that will either have the new time limit read
from (\fBTcl_LimitSetTime\fR) or the current time limit written to
(\fBTcl_LimitGetTime\fR).
.AP int granularity in







|







61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
.AS Tcl_LimitHandlerDeleteProc commandLimit in/out
.AP Tcl_Interp *interp in
Interpreter that the limit being managed applies to or that will have
its limits checked.
.AP int type in
The type of limit that the operation refers to.  This must be either
\fBTCL_LIMIT_COMMANDS\fR or \fBTCL_LIMIT_TIME\fR.
.AP Tcl_Size commandLimit in
The maximum number of commands (as reported by \fBinfo cmdcount\fR)
that may be executed in the interpreter.
.AP Tcl_Time *timeLimitPtr in/out
A pointer to a structure that will either have the new time limit read
from (\fBTcl_LimitSetTime\fR) or the current time limit written to
(\fBTcl_LimitGetTime\fR).
.AP int granularity in

Changes to doc/LinkVar.3.

55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
In \fBTcl_LinkArray\fR, the additional linked types \fBTCL_LINK_CHARS\fR and
\fBTCL_LINK_BINARY\fR may be used.
.VE "TIP 312"
.sp
All the above for both functions may be
optionally OR'ed with \fBTCL_LINK_READ_ONLY\fR to make the Tcl
variable read-only.
.AP size_t size in
.VS "TIP 312"
The number of elements in the C array. Must be greater than zero.
.VE "TIP 312"
.BE
.SH DESCRIPTION
.PP
\fBTcl_LinkVar\fR uses variable traces to keep the Tcl variable







|







55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
In \fBTcl_LinkArray\fR, the additional linked types \fBTCL_LINK_CHARS\fR and
\fBTCL_LINK_BINARY\fR may be used.
.VE "TIP 312"
.sp
All the above for both functions may be
optionally OR'ed with \fBTCL_LINK_READ_ONLY\fR to make the Tcl
variable read-only.
.AP Tcl_Size size in
.VS "TIP 312"
The number of elements in the C array. Must be greater than zero.
.VE "TIP 312"
.BE
.SH DESCRIPTION
.PP
\fBTcl_LinkVar\fR uses variable traces to keep the Tcl variable
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
.TP
\fBTCL_LINK_WIDE_UINT\fR
.
The C variable, or each element of the C array, is of type \fBTcl_WideUInt\fR
(which is an unsigned integer type at least 64-bits wide on all platforms that
can support it.)
Any value written into the Tcl variable must have a proper unsigned
integer form acceptable to \fBTcl_GetWideIntFromObj\fR (it will be
cast to unsigned);
.\" FIXME! Use bignums instead.
attempts to write non-integer values into \fIvarName\fR will be
rejected with Tcl errors. Incomplete integer representations (like
the empty string, '+', '-' or the hex/octal/decimal/binary prefix) are accepted
as if they are valid too.
.TP
\fBTCL_LINK_BOOLEAN\fR
.







|
<
<







235
236
237
238
239
240
241
242


243
244
245
246
247
248
249
.TP
\fBTCL_LINK_WIDE_UINT\fR
.
The C variable, or each element of the C array, is of type \fBTcl_WideUInt\fR
(which is an unsigned integer type at least 64-bits wide on all platforms that
can support it.)
Any value written into the Tcl variable must have a proper unsigned
wideinteger form acceptable to \fBTcl_GetWideUIntFromObj\fR;


attempts to write non-integer values into \fIvarName\fR will be
rejected with Tcl errors. Incomplete integer representations (like
the empty string, '+', '-' or the hex/octal/decimal/binary prefix) are accepted
as if they are valid too.
.TP
\fBTCL_LINK_BOOLEAN\fR
.

Changes to doc/ListObj.3.

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
an attempt will be made to convert it to one.
.AP Tcl_Obj *objPtr in
For \fBTcl_ListObjAppendElement\fR,
points to the Tcl value that will be appended to \fIlistPtr\fR.
For \fBTcl_SetListObj\fR,
this points to the Tcl value that will be converted to a list value
containing the \fIobjc\fR elements of the array referenced by \fIobjv\fR.
.AP "size_t \&| int" *objcPtr in
Points to location where \fBTcl_ListObjGetElements\fR
stores the number of element values in \fIlistPtr\fR.
.AP Tcl_Obj ***objvPtr out
A location where \fBTcl_ListObjGetElements\fR stores a pointer to an array
of pointers to the element values of \fIlistPtr\fR.
.AP size_t objc in
The number of Tcl values that \fBTcl_NewListObj\fR
will insert into a new list value,
and \fBTcl_ListObjReplace\fR will insert into \fIlistPtr\fR.
For \fBTcl_SetListObj\fR,
the number of Tcl values to insert into \fIobjPtr\fR.
.AP "Tcl_Obj *const" objv[] in
An array of pointers to values.
\fBTcl_NewListObj\fR will insert these values into a new list value
and \fBTcl_ListObjReplace\fR will insert them into an existing \fIlistPtr\fR.
Each value will become a separate list element.
.AP "size_t \&| int" *lengthPtr out
Points to location where \fBTcl_ListObjLength\fR
stores the length of the list.
.AP size_t index in
Index of the list element that \fBTcl_ListObjIndex\fR
is to return.
The first element has index 0.
.AP Tcl_Obj **objPtrPtr out
Points to place where \fBTcl_ListObjIndex\fR is to store
a pointer to the resulting list element value.
.AP size_t first in
Index of the starting list element that \fBTcl_ListObjReplace\fR
is to replace.
The list's first element has index 0.
.AP size_t count in
The number of elements that \fBTcl_ListObjReplace\fR
is to replace.
.BE

.SH DESCRIPTION
.PP
Tcl list values have an internal representation that supports







|





|










|


|






|



|







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
an attempt will be made to convert it to one.
.AP Tcl_Obj *objPtr in
For \fBTcl_ListObjAppendElement\fR,
points to the Tcl value that will be appended to \fIlistPtr\fR.
For \fBTcl_SetListObj\fR,
this points to the Tcl value that will be converted to a list value
containing the \fIobjc\fR elements of the array referenced by \fIobjv\fR.
.AP "Tcl_Size \&| int" *objcPtr in
Points to location where \fBTcl_ListObjGetElements\fR
stores the number of element values in \fIlistPtr\fR.
.AP Tcl_Obj ***objvPtr out
A location where \fBTcl_ListObjGetElements\fR stores a pointer to an array
of pointers to the element values of \fIlistPtr\fR.
.AP Tcl_Size objc in
The number of Tcl values that \fBTcl_NewListObj\fR
will insert into a new list value,
and \fBTcl_ListObjReplace\fR will insert into \fIlistPtr\fR.
For \fBTcl_SetListObj\fR,
the number of Tcl values to insert into \fIobjPtr\fR.
.AP "Tcl_Obj *const" objv[] in
An array of pointers to values.
\fBTcl_NewListObj\fR will insert these values into a new list value
and \fBTcl_ListObjReplace\fR will insert them into an existing \fIlistPtr\fR.
Each value will become a separate list element.
.AP "Tcl_Size \&| int" *lengthPtr out
Points to location where \fBTcl_ListObjLength\fR
stores the length of the list.
.AP Tcl_Size index in
Index of the list element that \fBTcl_ListObjIndex\fR
is to return.
The first element has index 0.
.AP Tcl_Obj **objPtrPtr out
Points to place where \fBTcl_ListObjIndex\fR is to store
a pointer to the resulting list element value.
.AP Tcl_Size first in
Index of the starting list element that \fBTcl_ListObjReplace\fR
is to replace.
The list's first element has index 0.
.AP Tcl_Size count in
The number of elements that \fBTcl_ListObjReplace\fR
is to replace.
.BE

.SH DESCRIPTION
.PP
Tcl list values have an internal representation that supports
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
in the address \fIobjPtrPtr\fR.
If \fIlistPtr\fR does not already refer to a list value,
\fBTcl_ListObjIndex\fR will attempt to convert it to one;
if the conversion fails, it returns \fBTCL_ERROR\fR
and leaves an error message in the interpreter's result value
if \fIinterp\fR is not NULL.
If the index is out of range,
that is, \fIindex\fR is TCL_INDEX_NONE or
greater than or equal to the number of elements in the list,
\fBTcl_ListObjIndex\fR stores a NULL in \fIobjPtrPtr\fR
and returns \fBTCL_OK\fR.
Otherwise it returns \fBTCL_OK\fR after storing the element's
value pointer.
The reference count for the list element is not incremented;
the caller must do that if it needs to retain a pointer to the element.
.PP
\fBTcl_ListObjReplace\fR replaces zero or more elements
of the list referenced by \fIlistPtr\fR
with the \fIobjc\fR values in the array referenced by \fIobjv\fR.
If \fIlistPtr\fR does not point to a list value,
\fBTcl_ListObjReplace\fR will attempt to convert it to one;
if the conversion fails, it returns \fBTCL_ERROR\fR
and leaves an error message in the interpreter's result value
if \fIinterp\fR is not NULL.
Otherwise, it returns \fBTCL_OK\fR after replacing the values.
If \fIobjv\fR is NULL, no new elements are added.
If the argument \fIfirst\fR is zero or TCL_INDEX_NONE,
it refers to the first element.
If \fIfirst\fR is greater than or equal to the
number of elements in the list, then no elements are deleted;
the new elements are appended to the list.
\fIcount\fR gives the number of elements to replace.
If \fIcount\fR is zero or TCL_INDEX_NONE then no elements are deleted;
the new elements are simply inserted before the one
designated by \fIfirst\fR.
\fBTcl_ListObjReplace\fR invalidates \fIlistPtr\fR's
old string representation.
The reference counts of any elements inserted from \fIobjv\fR
are incremented since the resulting list now refers to them.
Similarly, the reference counts for any replaced values are decremented.







|


















|





|







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
in the address \fIobjPtrPtr\fR.
If \fIlistPtr\fR does not already refer to a list value,
\fBTcl_ListObjIndex\fR will attempt to convert it to one;
if the conversion fails, it returns \fBTCL_ERROR\fR
and leaves an error message in the interpreter's result value
if \fIinterp\fR is not NULL.
If the index is out of range,
that is, \fIindex\fR is negative or
greater than or equal to the number of elements in the list,
\fBTcl_ListObjIndex\fR stores a NULL in \fIobjPtrPtr\fR
and returns \fBTCL_OK\fR.
Otherwise it returns \fBTCL_OK\fR after storing the element's
value pointer.
The reference count for the list element is not incremented;
the caller must do that if it needs to retain a pointer to the element.
.PP
\fBTcl_ListObjReplace\fR replaces zero or more elements
of the list referenced by \fIlistPtr\fR
with the \fIobjc\fR values in the array referenced by \fIobjv\fR.
If \fIlistPtr\fR does not point to a list value,
\fBTcl_ListObjReplace\fR will attempt to convert it to one;
if the conversion fails, it returns \fBTCL_ERROR\fR
and leaves an error message in the interpreter's result value
if \fIinterp\fR is not NULL.
Otherwise, it returns \fBTCL_OK\fR after replacing the values.
If \fIobjv\fR is NULL, no new elements are added.
If the argument \fIfirst\fR is zero or negative,
it refers to the first element.
If \fIfirst\fR is greater than or equal to the
number of elements in the list, then no elements are deleted;
the new elements are appended to the list.
\fIcount\fR gives the number of elements to replace.
If \fIcount\fR is zero or negative then no elements are deleted;
the new elements are simply inserted before the one
designated by \fIfirst\fR.
\fBTcl_ListObjReplace\fR invalidates \fIlistPtr\fR's
old string representation.
The reference counts of any elements inserted from \fIobjv\fR
are incremented since the resulting list now refers to them.
Similarly, the reference counts for any replaced values are decremented.

Changes to doc/Method.3.

54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
.sp
Tcl_Method
\fBTcl_ObjectContextMethod\fR(\fIcontext\fR)
.sp
Tcl_Object
\fBTcl_ObjectContextObject\fR(\fIcontext\fR)
.sp
size_t
\fBTcl_ObjectContextSkippedArgs\fR(\fIcontext\fR)
.SH ARGUMENTS
.AS void *clientData in
.AP Tcl_Interp *interp in/out
The interpreter holding the object or class to create or update a method in.
.AP Tcl_Object object in
The object to create the method in.







|







54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
.sp
Tcl_Method
\fBTcl_ObjectContextMethod\fR(\fIcontext\fR)
.sp
Tcl_Object
\fBTcl_ObjectContextObject\fR(\fIcontext\fR)
.sp
Tcl_Size
\fBTcl_ObjectContextSkippedArgs\fR(\fIcontext\fR)
.SH ARGUMENTS
.AS void *clientData in
.AP Tcl_Interp *interp in/out
The interpreter holding the object or class to create or update a method in.
.AP Tcl_Object object in
The object to create the method in.
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
when the method was created. If NULL, the \fIclientData\fR value will not be
retrieved.
.AP Tcl_Method method in
A reference to a method to query.
.AP Tcl_ObjectContext context in
A reference to a method-call context. Note that client code \fImust not\fR
retain a reference to a context.
.AP size_t objc in
The number of arguments to pass to the method implementation.
.AP "Tcl_Obj *const" *objv in
An array of arguments to pass to the method implementation.
.AP size_t skip in
The number of arguments passed to the method implementation that do not
represent "real" arguments.
.BE
.SH DESCRIPTION
.PP
A method is an operation carried out on an object that is associated with the
object. Every method must be attached to either an object or a class; methods







|



|







91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
when the method was created. If NULL, the \fIclientData\fR value will not be
retrieved.
.AP Tcl_Method method in
A reference to a method to query.
.AP Tcl_ObjectContext context in
A reference to a method-call context. Note that client code \fImust not\fR
retain a reference to a context.
.AP Tcl_Size objc in
The number of arguments to pass to the method implementation.
.AP "Tcl_Obj *const" *objv in
An array of arguments to pass to the method implementation.
.AP Tcl_Size skip in
The number of arguments passed to the method implementation that do not
represent "real" arguments.
.BE
.SH DESCRIPTION
.PP
A method is an operation carried out on an object that is associated with the
object. Every method must be attached to either an object or a class; methods

Changes to doc/NRE.3.

65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
Called instead of \fIproc2\fR when a trampoline is already in use.
.AP void *clientData in
Arbitrary one-word value passed to \fIproc\fR, \fInreProc\fR, \fIdeleteProc\fR
and \fIobjProc\fR.
.AP Tcl_CmdDeleteProc *deleteProc in/out
Called before \fIcmdName\fR is deleted from the interpreter, allowing for
command-specific cleanup. May be NULL.
.AP size_t objc in
Number of items in \fIobjv\fR.
.AP Tcl_Obj **objv in
Words in the command.
.AP Tcl_Obj *objPtr in
A script or expression to evaluate.
.AP int flags in
As described for \fITcl_EvalObjv\fR.







|







65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
Called instead of \fIproc2\fR when a trampoline is already in use.
.AP void *clientData in
Arbitrary one-word value passed to \fIproc\fR, \fInreProc\fR, \fIdeleteProc\fR
and \fIobjProc\fR.
.AP Tcl_CmdDeleteProc *deleteProc in/out
Called before \fIcmdName\fR is deleted from the interpreter, allowing for
command-specific cleanup. May be NULL.
.AP Tcl_Size objc in
Number of items in \fIobjv\fR.
.AP Tcl_Obj **objv in
Words in the command.
.AP Tcl_Obj *objPtr in
A script or expression to evaluate.
.AP int flags in
As described for \fITcl_EvalObjv\fR.

Changes to doc/Namespace.3.

129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
.PP
\fBTcl_Export\fR sets and appends to the export patterns for a
namespace.  Patterns are appended unless the \fIresetListFirst\fR flag
is true.
.PP
\fBTcl_Import\fR imports commands matching a pattern into a
namespace.  Note that the pattern must include the name of the
namespace to import from.  This function returns an error if
an attempt to import a command over an existing command is made,
unless the \fIallowOverwrite\fR flag has been set.
.PP
\fBTcl_ForgetImport\fR removes imports matching a pattern.
.PP
\fBTcl_GetCurrentNamespace\fR returns the current namespace for an
interpreter.







|







129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
.PP
\fBTcl_Export\fR sets and appends to the export patterns for a
namespace.  Patterns are appended unless the \fIresetListFirst\fR flag
is true.
.PP
\fBTcl_Import\fR imports commands matching a pattern into a
namespace.  Note that the pattern must include the name of the
namespace to import from.  This function returns TCL_ERROR if
an attempt to import a command over an existing command is made,
unless the \fIallowOverwrite\fR flag has been set.
.PP
\fBTcl_ForgetImport\fR removes imports matching a pattern.
.PP
\fBTcl_GetCurrentNamespace\fR returns the current namespace for an
interpreter.

Changes to doc/Number.3.

23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
.SH ARGUMENTS
.AS Tcl_Interp clientDataPtr out
.AP Tcl_Interp *interp out
When non-NULL, error information is recorded here when the value is not
in any of the numeric formats recognized by Tcl.
.AP "const char" *bytes in
Points to first byte of the string value to be examined.
.AP size_t numBytes in
The number of bytes, starting at \fIbytes\fR, that should be examined.
If the value \fBTCL_INDEX_NONE\fR is provided, then all bytes should
be examined until the first \fBNUL\fR byte terminates examination.
.AP "void *" *clientDataPtr out
Points to space where a pointer value may be written through which a numeric
value is available to read.
.AP int *typePtr out
Points to space where a value may be written reporting what type of
numeric storage is available to read.







|

|







23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
.SH ARGUMENTS
.AS Tcl_Interp clientDataPtr out
.AP Tcl_Interp *interp out
When non-NULL, error information is recorded here when the value is not
in any of the numeric formats recognized by Tcl.
.AP "const char" *bytes in
Points to first byte of the string value to be examined.
.AP Tcl_Size numBytes in
The number of bytes, starting at \fIbytes\fR, that should be examined.
If \fBnumBytes\fR is negative, then all bytes should
be examined until the first \fBNUL\fR byte terminates examination.
.AP "void *" *clientDataPtr out
Points to space where a pointer value may be written through which a numeric
value is available to read.
.AP int *typePtr out
Points to space where a value may be written reporting what type of
numeric storage is available to read.
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
multiple-precision integer library, included with Tcl.
.PP
The routines \fBTcl_GetNumber\fR and \fBTcl_GetNumberFromObj\fR perform
the same function.  They differ only in how the arguments present the Tcl
value to be examined.  \fBTcl_GetNumber\fR accepts a counted string
value in the arguments \fIbytes\fR and \fInumBytes\fR (or a
\fBNUL\fR-terminated string value when \fInumBytes\fR is
\fBTCL_INDEX_NONE\fR).  \fBTcl_GetNumberFromObj\fR accepts the Tcl value
in \fIobjPtr\fR.
.PP
Both routines examine the Tcl value and determine whether Tcl recognizes
it as a number.  If not, both routines return \fBTCL_ERROR\fR and (when
\fIinterp\fR is not NULL) record an error message and error code
in \fIinterp\fR.
.PP







|







59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
multiple-precision integer library, included with Tcl.
.PP
The routines \fBTcl_GetNumber\fR and \fBTcl_GetNumberFromObj\fR perform
the same function.  They differ only in how the arguments present the Tcl
value to be examined.  \fBTcl_GetNumber\fR accepts a counted string
value in the arguments \fIbytes\fR and \fInumBytes\fR (or a
\fBNUL\fR-terminated string value when \fInumBytes\fR is
negative).  \fBTcl_GetNumberFromObj\fR accepts the Tcl value
in \fIobjPtr\fR.
.PP
Both routines examine the Tcl value and determine whether Tcl recognizes
it as a number.  If not, both routines return \fBTCL_ERROR\fR and (when
\fIinterp\fR is not NULL) record an error message and error code
in \fIinterp\fR.
.PP

Changes to doc/Object.3.

19
20
21
22
23
24
25


26
27
28
29
30
31
32
Tcl_Obj *
\fBTcl_DuplicateObj\fR(\fIobjPtr\fR)
.sp
\fBTcl_IncrRefCount\fR(\fIobjPtr\fR)
.sp
\fBTcl_DecrRefCount\fR(\fIobjPtr\fR)
.sp


int
\fBTcl_IsShared\fR(\fIobjPtr\fR)
.sp
\fBTcl_InvalidateStringRep\fR(\fIobjPtr\fR)
.SH ARGUMENTS
.AS Tcl_Obj *objPtr
.AP Tcl_Obj *objPtr in







>
>







19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Tcl_Obj *
\fBTcl_DuplicateObj\fR(\fIobjPtr\fR)
.sp
\fBTcl_IncrRefCount\fR(\fIobjPtr\fR)
.sp
\fBTcl_DecrRefCount\fR(\fIobjPtr\fR)
.sp
\fBTcl_BumpObj\fR(\fIobjPtr\fR)
.sp
int
\fBTcl_IsShared\fR(\fIobjPtr\fR)
.sp
\fBTcl_InvalidateStringRep\fR(\fIobjPtr\fR)
.SH ARGUMENTS
.AS Tcl_Obj *objPtr
.AP Tcl_Obj *objPtr in
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
.SH "THE TCL_OBJ STRUCTURE"
.PP
Each Tcl value is represented by a \fBTcl_Obj\fR structure
which is defined as follows.
.PP
.CS
typedef struct Tcl_Obj {
    size_t \fIrefCount\fR;
    char *\fIbytes\fR;
    size_t \fIlength\fR;
    const Tcl_ObjType *\fItypePtr\fR;
    union {
        long \fIlongValue\fR;
        double \fIdoubleValue\fR;
        void *\fIotherValuePtr\fR;
        Tcl_WideInt \fIwideValue\fR;
        struct {







|

|







109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
.SH "THE TCL_OBJ STRUCTURE"
.PP
Each Tcl value is represented by a \fBTcl_Obj\fR structure
which is defined as follows.
.PP
.CS
typedef struct Tcl_Obj {
    Tcl_Size \fIrefCount\fR;
    char *\fIbytes\fR;
    Tcl_Size \fIlength\fR;
    const Tcl_ObjType *\fItypePtr\fR;
    union {
        long \fIlongValue\fR;
        double \fIdoubleValue\fR;
        void *\fIotherValuePtr\fR;
        Tcl_WideInt \fIwideValue\fR;
        struct {
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
.PP
The string representation of \fIx\fR's value is needed
and is recomputed.
The string representation is now \fB124\fR
and both representations are again valid.
.SH "STORAGE MANAGEMENT OF VALUES"
.PP
Tcl values are allocated on the heap and are shared as much as possible
to reduce storage requirements.
Reference counting is used to determine when a value is
no longer needed and can safely be freed.
A value just created by \fBTcl_NewObj\fR or \fBTcl_NewStringObj\fR

has \fIrefCount\fR 0, meaning that the object can often be given to a function
like \fBTcl_SetObjResult\fR, \fBTcl_ListObjAppendElement\fR, or
\fBTcl_DictObjPut\fR (as a value) without explicit reference management, all
of which are common use cases. (The latter two require that the the target
list or dictionary be well-formed, but that is often easy to arrange when the
value is being initially constructed.)
The macro \fBTcl_IncrRefCount\fR increments the reference count
when a new reference to the value is created.
The macro \fBTcl_DecrRefCount\fR decrements the count
when a reference is no longer needed and,
if the value's reference count drops to zero, frees its storage.


A value shared by different code or data structures has
\fIrefCount\fR greater than 1.
Incrementing a value's reference count ensures that
it will not be freed too early or have its value change accidentally.

.PP
As an example, the bytecode interpreter shares argument values
between calling and called Tcl procedures to avoid having to copy values.
It assigns the call's argument values to the procedure's
formal parameter variables.
In doing so, it calls \fBTcl_IncrRefCount\fR to increment
the reference count of each argument since there is now a new
reference to it from the formal parameter.
When the called procedure returns,
the interpreter calls \fBTcl_DecrRefCount\fR to decrement
each argument's reference count.
When a value's reference count drops less than or equal to zero,
\fBTcl_DecrRefCount\fR reclaims its storage.


Most command procedures do not have to be concerned about
reference counting since they use a value's value immediately
and do not retain a pointer to the value after they return.







However, if they do retain a pointer to a value in a data structure,
they must be careful to increment its reference count
since the retained pointer is a new reference.




.PP
Command procedures that directly modify values
such as those for \fBlappend\fR and \fBlinsert\fR must be careful to
copy a shared value before changing it.
They must first check whether the value is shared
by calling \fBTcl_IsShared\fR.
If the value is shared they must copy the value







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

|
<
|
>













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







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
.PP
The string representation of \fIx\fR's value is needed
and is recomputed.
The string representation is now \fB124\fR
and both representations are again valid.
.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, \fBTcl_NewStringObj\fR, or
any Abstract List command or function, 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 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.

If the value's reference count drops to zero, frees
its storage.
The macro \fBTcl_BumpObj\fR will check if the value has no references (i.e. in a "new" state) and free the value.
A value shared by different code or data structures has
\fIrefCount\fR greater than 1.  Incrementing a value's reference count

ensures that it will not be freed too early or have its value change
accidentally.
.PP
As an example, the bytecode interpreter shares argument values
between calling and called Tcl procedures to avoid having to copy values.
It assigns the call's argument values to the procedure's
formal parameter variables.
In doing so, it calls \fBTcl_IncrRefCount\fR to increment
the reference count of each argument since there is now a new
reference to it from the formal parameter.
When the called procedure returns,
the interpreter calls \fBTcl_DecrRefCount\fR to decrement
each argument's reference count.
When a value's reference count drops less than or equal to zero,
\fBTcl_DecrRefCount\fR reclaims its storage.

.PP
Most command procedures have not been concerned about reference
counting since they use a value's value immediately and do not retain
a pointer to the value after they return.  However, there are some
procedures that may return a new value, with a refCount of 0. In this
situation, it is the caller's responsibility to free the value before
the procedure returns.  One way to cover this is to always call
\fBTcl_IncrRefCount\fR before using the value, then call
\fBTcl_DecrRefCount\fR before returning. The other way is to use
\fBTcl_BumpObj\fR after the value is no longer needed or
referenced. This macro will free the value if there are no other
references to the value. When retaining a pointer to a value in a data
structure the procedure must be careful to increment its reference
count since the retained pointer is a new reference. Examples of
procedures that return new values are \fBTcl_NewIntObj\fR, and
commands like \fBlseq\fR, which creates an Abstract List, and an
lindex on this list may return a new Obj with a refCount of 0.

.PP
Command procedures that directly modify values
such as those for \fBlappend\fR and \fBlinsert\fR must be careful to
copy a shared value before changing it.
They must first check whether the value is shared
by calling \fBTcl_IsShared\fR.
If the value is shared they must copy the value
346
347
348
349
350
351
352





353
354
355
356
357
.CE
.PP
As another example, \fBincr\fR's command procedure
must check whether the variable's value is shared before
incrementing the integer in its internal representation.
If it is shared, it needs to duplicate the value
in order to avoid accidentally changing values in other data structures.





.SH "SEE ALSO"
Tcl_ConvertToType(3), Tcl_GetIntFromObj(3), Tcl_ListObjAppendElement(3), Tcl_ListObjIndex(3), Tcl_ListObjReplace(3), Tcl_RegisterObjType(3)
.SH KEYWORDS
internal representation, value, value creation, value type,
reference counting, string representation, type conversion







>
>
>
>
>





362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
.CE
.PP
As another example, \fBincr\fR's command procedure
must check whether the variable's value is shared before
incrementing the integer in its internal representation.
If it is shared, it needs to duplicate the value
in order to avoid accidentally changing values in other data structures.
.PP
In cases where a value is obtained, used, and not retained, the value
can be freed using \fBTcl_BumpObj\fR. This
is functionally equivalent to calling \fBTcl_IncrRefCount\fR followed
\fBTcl_DecrRefCount\fR.
.SH "SEE ALSO"
Tcl_ConvertToType(3), Tcl_GetIntFromObj(3), Tcl_ListObjAppendElement(3), Tcl_ListObjIndex(3), Tcl_ListObjReplace(3), Tcl_RegisterObjType(3)
.SH KEYWORDS
internal representation, value, value creation, value type,
reference counting, string representation, type conversion

Changes to doc/ObjectType.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
'\"
'\" Copyright (c) 1996-1997 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_ObjType 3 8.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_RegisterObjType, Tcl_GetObjType, Tcl_AppendAllObjTypes, Tcl_ConvertToType  \- manipulate Tcl value types
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
'\"
'\" Copyright (c) 1996-1997 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_ObjType 3 9.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_RegisterObjType, Tcl_GetObjType, Tcl_AppendAllObjTypes, Tcl_ConvertToType  \- manipulate Tcl value types
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
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
In many cases, the \fItypePtr->setFromAnyProc\fR routine will
set \fIobjPtr->typePtr\fR to the argument value \fItypePtr\fR,
but that is no longer guaranteed.  The \fIsetFromAnyProc\fR is
free to set the internal representation for \fIobjPtr\fR to make
use of another related Tcl_ObjType, if it sees fit.
.SH "THE TCL_OBJTYPE STRUCTURE"
.PP
Extension writers can define new value types by defining four
procedures and
initializing a Tcl_ObjType structure to describe the type.
Extension writers may also pass a pointer to their Tcl_ObjType
structure to \fBTcl_RegisterObjType\fR if they wish to permit
other extensions to look up their Tcl_ObjType by name with
the \fBTcl_GetObjType\fR routine.
The \fBTcl_ObjType\fR structure is defined as follows:
.PP
.CS
typedef struct Tcl_ObjType {
    const char *\fIname\fR;
    Tcl_FreeInternalRepProc *\fIfreeIntRepProc\fR;
    Tcl_DupInternalRepProc *\fIdupIntRepProc\fR;
    Tcl_UpdateStringProc *\fIupdateStringProc\fR;
    Tcl_SetFromAnyProc *\fIsetFromAnyProc\fR;










} \fBTcl_ObjType\fR;
.CE
.SS "THE NAME FIELD"
.PP
The \fIname\fR member describes the name of the type, e.g. \fBint\fR.
When a type is registered, this is the name used by callers
of \fBTcl_GetObjType\fR to lookup the type.  For unregistered







|
<
|
|
|
|
|
|








>
>
>
>
>
>
>
>
>
>







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
In many cases, the \fItypePtr->setFromAnyProc\fR routine will
set \fIobjPtr->typePtr\fR to the argument value \fItypePtr\fR,
but that is no longer guaranteed.  The \fIsetFromAnyProc\fR is
free to set the internal representation for \fIobjPtr\fR to make
use of another related Tcl_ObjType, if it sees fit.
.SH "THE TCL_OBJTYPE STRUCTURE"
.PP
Extension writers can define new value types by defining four to eight

procedures and initializing a Tcl_ObjType structure to describe the
type.  Extension writers may also pass a pointer to their Tcl_ObjType
structure to \fBTcl_RegisterObjType\fR if they wish to permit other
extensions to look up their Tcl_ObjType by name with the
\fBTcl_GetObjType\fR routine.  The \fBTcl_ObjType\fR structure is
defined as follows:
.PP
.CS
typedef struct Tcl_ObjType {
    const char *\fIname\fR;
    Tcl_FreeInternalRepProc *\fIfreeIntRepProc\fR;
    Tcl_DupInternalRepProc *\fIdupIntRepProc\fR;
    Tcl_UpdateStringProc *\fIupdateStringProc\fR;
    Tcl_SetFromAnyProc *\fIsetFromAnyProc\fR;
    size_t \fIversion\fR;
    /* List emulation functions - ObjType Version 1 & 2 */
    Tcl_ObjTypeLengthProc *lengthProc;
    /* List emulation functions - ObjType Version 2 */
    Tcl_ObjTypeIndexProc *\fIindexProc\fR;
    Tcl_ObjTypeSliceProc *\fIsliceProc\fR;
    Tcl_ObjTypeReverseProc *\fIreverseProc\fR;
    Tcl_ObjTypeGetElements *\fIgetElementsProc\fR;
    Tcl_ObjTypeSetElement *\fIsetElementProc\fR;
    Tcl_ObjTypeReplaceProc *\fIreplaceProc\fR;
} \fBTcl_ObjType\fR;
.CE
.SS "THE NAME FIELD"
.PP
The \fIname\fR member describes the name of the type, e.g. \fBint\fR.
When a type is registered, this is the name used by callers
of \fBTcl_GetObjType\fR to lookup the type.  For unregistered
249
250
251
252
253
254
255


























































































































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







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







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
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.
.SS "THE VERSION FIELD"
.PP
The \fIversion\fR member provides for future extensibility of the
structure and should be set to \fBTCL_OBJTYPE_V0\fR for compatability
of ObjType definitions prior to version 9.0. Specifics about versions
will be described further in the sections below.
.SH "ABSTRACT LIST TYPES"
.PP
Additional fields in the Tcl_ObjType descriptor allow for control over
how custom data values can be manipulated using Tcl's List commands
without converting the value to a List type. This requires the custom
type to provide functions that will perform the given operation on the
custom data representation.  Not all functions are required. In the
absence of a particular function (set to NULL), the fallback is to
allow the internal List operation to perform the operation, most
likely causing the value type to be converted to a traditional list.
.SS "SCALAR VALUE TYPES"
.PP
For a custom value type that is scalar or atomic in nature, i.e., not
a divisible collection, version \fBTCL_OBJTYPE_V1\fR is
recommended. In this case, List commands will treat the scalar value
as if it where a list of length 1, and not convert the value to a List
type.
.SS "VERSION 2: ABSTRACT LISTS"
.PP
Version 2, \fBTCL_OBJTYPE_V2\fR, allows full List support when the
functions described below are provided.  This allows for script level
use of the List commands without causing the type of the Tcl_Obj value
to be converted to a list.
.SS "THE LENGTHPROC FIELD"
.PP
The \fBLengthProc\fR function correlates with the \fBllength\fR
command. The function returns the number of elements in the list. It
is used in every List operation and is required for all Abstract List
implementations.

.CS
typedef Tcl_Size
(Tcl_ObjTypeLengthProc) (Tcl_Obj *listPtr);
.CE

.PP
.SS "THE INDEXPROC FIELD"
.PP
The \fBIndexProc\fR function correlates with the \fBlindex\fR
command. The function returns a Tcl_Obj value for the element at the
specified index.
.CS
typedef int
(Tcl_ObjTypeIndexProc) (
    Tcl_Interp *interp,
    Tcl_Obj *listPtr,
    Tcl_Size index,
    Tcl_Obj** elemObj);
.CE
.SS "THE SLICEPROC FIELD"
.PP
The \fBSliceProc\fR correlates with the \fBlrange\fR command,
returning a new List or Abstract List for the portion of the original
list specifed.
.CS
typedef int
(Tcl_ObjTypeSliceProc) (
    Tcl_Interp *interp,
    Tcl_Obj *listPtr,
    Tcl_Size fromIdx,
    Tcl_Size toIdx,
    Tcl_Obj **newObjPtr);
.CE
.SS "THE REVERSEPROC FIELD"
.PP
The \fBReverseProc\fR correlates with the \fBlreverse\fR command,
returning a List or Abstract List that has the same elements as the
input Abstract List, with the elements in the reverse order.
.CS
typedef int
(Tcl_ObjTypeReverseProc) (
    Tcl_Interp *interp,
    Tcl_Obj *listPtr,
    Tcl_Obj **newObjPtr);
.CE
.SS "THE GETELEMENTS FIELD"
.PP
THe \fBGetElements\fR function returns a count and a pointer to an
array of Tcl_Obj values for the entire Abstract List. This is a
correlary to the \fBTcl_ListObjGetElements\fR C API call.
.CS
typedef int
(Tcl_ObjTypeGetElements) (
    Tcl_Interp *interp,
    Tcl_Obj *listPtr,
    Tcl_Size *objcptr,
    Tcl_Obj ***objvptr);
.CE
.SS "THE SETELEMENT FIELD"
.PP
The \fBSetElement\fR function replaces the element within the
specified list at the give index. This function correlates to the
\fBlset\fR command.  typedef Tcl_Obj*
.CS
Tcl_ObjTypeSetElement) (
    Tcl_Interp *interp,
    Tcl_Obj *listPtr,
    Tcl_Size indexCount,
    Tcl_Obj *const indexArray[],
    Tcl_Obj *valueObj);
.CE
.SS "REPLACEPROC FIELD"
.PP
The \fBReplaceProc\fR returns a new list after modfying the list
replacing the elements to be deleted, and adding the elements to be
inserted. This function correlates to the \fBlreplace\fR command.
.CS
typedef int
(Tcl_ObjTypeReplaceProc) (
    Tcl_Interp *interp,
    Tcl_Obj *listObj,
    Tcl_Size first,
    Tcl_Size numToDelete,
    Tcl_Size numToInsert,
    Tcl_Obj *const insertObjs[]);
.CE
.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.

Changes to doc/OpenFileChnl.3.

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
.sp
int
\fBTcl_ReadChars\fR(\fIchannel, readObjPtr, charsToRead, appendFlag\fR)
.sp
int
\fBTcl_Read\fR(\fIchannel, readBuf, bytesToRead\fR)
.sp
size_t
\fBTcl_GetsObj\fR(\fIchannel, lineObjPtr\fR)
.sp
size_t
\fBTcl_Gets\fR(\fIchannel, lineRead\fR)
.sp
size_t
\fBTcl_Ungets\fR(\fIchannel, input, inputLen, addAtEnd\fR)
.sp
size_t
\fBTcl_WriteObj\fR(\fIchannel, writeObjPtr\fR)
.sp
size_t
\fBTcl_WriteChars\fR(\fIchannel, charBuf, bytesToWrite\fR)
.sp
size_t
\fBTcl_Write\fR(\fIchannel, byteBuf, bytesToWrite\fR)
.sp
size_t
\fBTcl_ReadRaw\fR(\fIchannel, readBuf, bytesToRead\fR)
.sp
size_t
\fBTcl_WriteRaw\fR(\fIchannel, byteBuf, bytesToWrite\fR)
.sp
int
\fBTcl_Eof\fR(\fIchannel\fR)
.sp
int
\fBTcl_Flush\fR(\fIchannel\fR)







|


|


|


|


|


|


|


|







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
.sp
int
\fBTcl_ReadChars\fR(\fIchannel, readObjPtr, charsToRead, appendFlag\fR)
.sp
int
\fBTcl_Read\fR(\fIchannel, readBuf, bytesToRead\fR)
.sp
Tcl_Size
\fBTcl_GetsObj\fR(\fIchannel, lineObjPtr\fR)
.sp
Tcl_Size
\fBTcl_Gets\fR(\fIchannel, lineRead\fR)
.sp
Tcl_Size
\fBTcl_Ungets\fR(\fIchannel, input, inputLen, addAtEnd\fR)
.sp
Tcl_Size
\fBTcl_WriteObj\fR(\fIchannel, writeObjPtr\fR)
.sp
Tcl_Size
\fBTcl_WriteChars\fR(\fIchannel, charBuf, bytesToWrite\fR)
.sp
Tcl_Size
\fBTcl_Write\fR(\fIchannel, byteBuf, bytesToWrite\fR)
.sp
Tcl_Size
\fBTcl_ReadRaw\fR(\fIchannel, readBuf, bytesToRead\fR)
.sp
Tcl_Size
\fBTcl_WriteRaw\fR(\fIchannel, byteBuf, bytesToWrite\fR)
.sp
int
\fBTcl_Eof\fR(\fIchannel\fR)
.sp
int
\fBTcl_Flush\fR(\fIchannel\fR)
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
The name of a local or network file.
.AP "const char" *mode in
Specifies how the file is to be accessed.  May have any of the values
allowed for the \fImode\fR argument to the Tcl \fBopen\fR command.
.AP int permissions in
POSIX-style permission flags such as 0644.  If a new file is created, these
permissions will be set on the created file.
.AP size_t argc in
The number of elements in \fIargv\fR.
.AP "const char" **argv in
Arguments for constructing a command pipeline.  These values have the same
meaning as the non-switch arguments to the Tcl \fBexec\fR command.
.AP int flags in
Specifies the disposition of the stdio handles in pipeline: OR-ed
combination of \fBTCL_STDIN\fR, \fBTCL_STDOUT\fR, \fBTCL_STDERR\fR, and







|







115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
The name of a local or network file.
.AP "const char" *mode in
Specifies how the file is to be accessed.  May have any of the values
allowed for the \fImode\fR argument to the Tcl \fBopen\fR command.
.AP int permissions in
POSIX-style permission flags such as 0644.  If a new file is created, these
permissions will be set on the created file.
.AP Tcl_Size argc in
The number of elements in \fIargv\fR.
.AP "const char" **argv in
Arguments for constructing a command pipeline.  These values have the same
meaning as the non-switch arguments to the Tcl \fBexec\fR command.
.AP int flags in
Specifies the disposition of the stdio handles in pipeline: OR-ed
combination of \fBTCL_STDIN\fR, \fBTCL_STDOUT\fR, \fBTCL_STDERR\fR, and
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
The pattern to match on, passed to Tcl_StringMatch, or NULL.
.AP Tcl_Channel channel in
A Tcl channel for input or output.  Must have been the return value
from a procedure such as \fBTcl_OpenFileChannel\fR.
.AP Tcl_Obj *readObjPtr in/out
A pointer to a Tcl value in which to store the characters read from the
channel.
.AP size_t charsToRead in
The number of characters to read from the channel.  If the channel's encoding
is \fBbinary\fR, this is equivalent to the number of bytes to read from the
channel.
.AP int appendFlag in
If non-zero, data read from the channel will be appended to the value.
Otherwise, the data will replace the existing contents of the value.
.AP char *readBuf out
A buffer in which to store the bytes read from the channel.
.AP size_t bytesToRead in
The number of bytes to read from the channel.  The buffer \fIreadBuf\fR must
be large enough to hold this many bytes.
.AP Tcl_Obj *lineObjPtr in/out
A pointer to a Tcl value in which to store the line read from the
channel.  The line read will be appended to the current value of the
value.
.AP Tcl_DString *lineRead in/out
A pointer to a Tcl dynamic string in which to store the line read from the
channel.  Must have been initialized by the caller.  The line read will be
appended to any data already in the dynamic string.
.AP "const char" *input in
The input to add to a channel buffer.
.AP size_t inputLen in
Length of the input
.AP int addAtEnd in
Flag indicating whether the input should be added to the end or
beginning of the channel buffer.
.AP Tcl_Obj *writeObjPtr in
A pointer to a Tcl value whose contents will be output to the channel.
.AP "const char" *charBuf in
A buffer containing the characters to output to the channel.
.AP "const char" *byteBuf in
A buffer containing the bytes to output to the channel.
.AP size_t bytesToWrite in
The number of bytes to consume from \fIcharBuf\fR or \fIbyteBuf\fR and
output to the channel.
.AP "long long" offset in
How far to move the access point in the channel at which the next input or
output operation will be applied, measured in bytes from the position
given by \fIseekMode\fR.  May be either positive or negative.
.AP int seekMode in







|








|












|










|







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
The pattern to match on, passed to Tcl_StringMatch, or NULL.
.AP Tcl_Channel channel in
A Tcl channel for input or output.  Must have been the return value
from a procedure such as \fBTcl_OpenFileChannel\fR.
.AP Tcl_Obj *readObjPtr in/out
A pointer to a Tcl value in which to store the characters read from the
channel.
.AP Tcl_Size charsToRead in
The number of characters to read from the channel.  If the channel's encoding
is \fBbinary\fR, this is equivalent to the number of bytes to read from the
channel.
.AP int appendFlag in
If non-zero, data read from the channel will be appended to the value.
Otherwise, the data will replace the existing contents of the value.
.AP char *readBuf out
A buffer in which to store the bytes read from the channel.
.AP Tcl_Size bytesToRead in
The number of bytes to read from the channel.  The buffer \fIreadBuf\fR must
be large enough to hold this many bytes.
.AP Tcl_Obj *lineObjPtr in/out
A pointer to a Tcl value in which to store the line read from the
channel.  The line read will be appended to the current value of the
value.
.AP Tcl_DString *lineRead in/out
A pointer to a Tcl dynamic string in which to store the line read from the
channel.  Must have been initialized by the caller.  The line read will be
appended to any data already in the dynamic string.
.AP "const char" *input in
The input to add to a channel buffer.
.AP Tcl_Size inputLen in
Length of the input
.AP int addAtEnd in
Flag indicating whether the input should be added to the end or
beginning of the channel buffer.
.AP Tcl_Obj *writeObjPtr in
A pointer to a Tcl value whose contents will be output to the channel.
.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 Tcl_Size bytesToWrite in
The number of bytes to consume from \fIcharBuf\fR or \fIbyteBuf\fR and
output to the channel.
.AP "long long" offset in
How far to move the access point in the channel at which the next input or
output operation will be applied, measured in bytes from the position
given by \fIseekMode\fR.  May be either positive or negative.
.AP int seekMode in
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
.SH "TCL_READCHARS AND TCL_READ"
.PP
\fBTcl_ReadChars\fR consumes bytes from \fIchannel\fR, converting the bytes
to UTF-8 based on the channel's encoding and storing the produced data in
\fIreadObjPtr\fR's string representation.  The return value of
\fBTcl_ReadChars\fR is the number of characters, up to \fIcharsToRead\fR,
that were stored in \fIreadObjPtr\fR.  If an error occurs while reading, the
return value is \-1 and \fBTcl_ReadChars\fR records a POSIX error code that
can be retrieved with \fBTcl_GetErrno\fR.


.PP
Setting \fIcharsToRead\fR to \fB\-1\fR will cause the command to read
all characters currently available (non-blocking) or everything until
eof (blocking mode).
.PP
The return value may be smaller than the value to read, indicating that less
data than requested was available.  This is called a \fIshort read\fR.  In
blocking mode, this can only happen on an end-of-file.  In nonblocking mode,

a short read can also occur if there is not enough input currently
available:  \fBTcl_ReadChars\fR returns a short count rather than waiting
for more data.
.PP
If the channel is in blocking mode, a return value of zero indicates an
end-of-file condition.  If the channel is in nonblocking mode, a return
value of zero indicates either that no input is currently available or an
end-of-file condition.  Use \fBTcl_Eof\fR and \fBTcl_InputBlocked\fR to tell
which of these conditions actually occurred.
.PP







|
|
>
>

|






>
|
|
<







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
.SH "TCL_READCHARS AND TCL_READ"
.PP
\fBTcl_ReadChars\fR consumes bytes from \fIchannel\fR, converting the bytes
to UTF-8 based on the channel's encoding and storing the produced data in
\fIreadObjPtr\fR's string representation.  The return value of
\fBTcl_ReadChars\fR is the number of characters, up to \fIcharsToRead\fR,
that were stored in \fIreadObjPtr\fR.  If an error occurs while reading, the
return value is -1 and \fBTcl_ReadChars\fR records a POSIX error
code that can be retrieved with \fBTcl_GetErrno\fR. If an encoding error happens
while the channel is in blocking mode with -profile strict, the characters
retrieved until the encoding error happened will be stored in \fIreadObjPtr\fR.
.PP
Setting \fIcharsToRead\fR to -1 will cause the command to read
all characters currently available (non-blocking) or everything until
eof (blocking mode).
.PP
The return value may be smaller than the value to read, indicating that less
data than requested was available.  This is called a \fIshort read\fR.  In
blocking mode, this can only happen on an end-of-file.  In nonblocking mode,
a short read can also occur if an encoding error is encountered (with -profile
strict) or if there is not enough input currently available:
\fBTcl_ReadChars\fR returns a short count rather than waiting for more data.

.PP
If the channel is in blocking mode, a return value of zero indicates an
end-of-file condition.  If the channel is in nonblocking mode, a return
value of zero indicates either that no input is currently available or an
end-of-file condition.  Use \fBTcl_Eof\fR and \fBTcl_InputBlocked\fR to tell
which of these conditions actually occurred.
.PP
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
channel is treated as an individual Unicode character.  All of the
characters of the line except for the terminating end-of-line character(s)
are appended to \fIlineObjPtr\fR's string representation.  The end-of-line
character(s) are read and discarded.
.PP
If a line was successfully read, the return value is greater than or equal
to zero and indicates the number of bytes stored in \fIlineObjPtr\fR.  If an
error occurs, \fBTcl_GetsObj\fR returns \-1 and records a POSIX error code
that can be retrieved with \fBTcl_GetErrno\fR.  \fBTcl_GetsObj\fR also
returns \-1 if the end of the file is reached; the \fBTcl_Eof\fR procedure
can be used to distinguish an error from an end-of-file condition.
.PP
If the channel is in nonblocking mode, the return value can also be \-1 if
no data was available or the data that was available did not contain an
end-of-line character.  When \-1 is returned, the \fBTcl_InputBlocked\fR
procedure may be invoked to determine if the channel is blocked because
of input unavailability.
.PP
\fBTcl_Gets\fR is the same as \fBTcl_GetsObj\fR except the resulting
characters are appended to the dynamic string given by
\fIlineRead\fR rather than a Tcl value.
.SH "TCL_UNGETS"
.PP
\fBTcl_Ungets\fR is used to add data to the input queue of a channel,
at either the head or tail of the queue.  The pointer \fIinput\fR points
to the data that is to be added.  The length of the input to add is given
by \fIinputLen\fR.  A non-zero value of \fIaddAtEnd\fR indicates that the
data is to be added at the end of queue; otherwise it will be added at the
head of the queue.  If \fIchannel\fR has a
.QW sticky
EOF set, no data will be
added to the input queue.  \fBTcl_Ungets\fR returns \fIinputLen\fR or
\-1 if an error occurs.
.SH "TCL_WRITECHARS, TCL_WRITEOBJ, AND TCL_WRITE"
.PP
\fBTcl_WriteChars\fR accepts \fIbytesToWrite\fR bytes of character data at
\fIcharBuf\fR.  The UTF-8 characters in the buffer are converted to the
channel's encoding and queued for output to \fIchannel\fR.  If
\fIbytesToWrite\fR is negative, \fBTcl_WriteChars\fR expects \fIcharBuf\fR
to be null-terminated and it outputs everything up to the null.
.PP
Data queued for output may not appear on the output device immediately, due
to internal buffering.  If the data should appear immediately, call
\fBTcl_Flush\fR after the call to \fBTcl_WriteChars\fR, or set the
\fB\-buffering\fR option on the channel to \fBnone\fR.  If you wish the data
to appear as soon as a complete line is accepted for output, set the
\fB\-buffering\fR option on the channel to \fBline\fR mode.
.PP
The return value of \fBTcl_WriteChars\fR is a count of how many bytes were
accepted for output to the channel.  This is either greater than zero to
indicate success or \-1 to indicate that an error occurred.  If an error
occurs, \fBTcl_WriteChars\fR records a POSIX error code that may be
retrieved with \fBTcl_GetErrno\fR.
.PP
Newline characters in the output data are translated to platform-specific
end-of-line sequences according to the \fB\-translation\fR option for the
channel.  This is done even if the channel has no encoding.
.PP
\fBTcl_WriteObj\fR is similar to \fBTcl_WriteChars\fR except it
accepts a Tcl value whose contents will be output to the channel.  The







|

|


|
|
|

















|
















|
|
|
|







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
channel is treated as an individual Unicode character.  All of the
characters of the line except for the terminating end-of-line character(s)
are appended to \fIlineObjPtr\fR's string representation.  The end-of-line
character(s) are read and discarded.
.PP
If a line was successfully read, the return value is greater than or equal
to zero and indicates the number of bytes stored in \fIlineObjPtr\fR.  If an
error occurs, \fBTcl_GetsObj\fR returns -1 and records a POSIX error code
that can be retrieved with \fBTcl_GetErrno\fR.  \fBTcl_GetsObj\fR also
returns -1 if the end of the file is reached; the \fBTcl_Eof\fR procedure
can be used to distinguish an error from an end-of-file condition.
.PP
If the channel is in nonblocking mode, the return value can also be -1
if no data was available or the data that was available did not contain an
end-of-line character.  When -1 is returned, the \fBTcl_InputBlocked\fR
procedure may be invoked to determine if the channel is blocked because
of input unavailability.
.PP
\fBTcl_Gets\fR is the same as \fBTcl_GetsObj\fR except the resulting
characters are appended to the dynamic string given by
\fIlineRead\fR rather than a Tcl value.
.SH "TCL_UNGETS"
.PP
\fBTcl_Ungets\fR is used to add data to the input queue of a channel,
at either the head or tail of the queue.  The pointer \fIinput\fR points
to the data that is to be added.  The length of the input to add is given
by \fIinputLen\fR.  A non-zero value of \fIaddAtEnd\fR indicates that the
data is to be added at the end of queue; otherwise it will be added at the
head of the queue.  If \fIchannel\fR has a
.QW sticky
EOF set, no data will be
added to the input queue.  \fBTcl_Ungets\fR returns \fIinputLen\fR or
-1 if an error occurs.
.SH "TCL_WRITECHARS, TCL_WRITEOBJ, AND TCL_WRITE"
.PP
\fBTcl_WriteChars\fR accepts \fIbytesToWrite\fR bytes of character data at
\fIcharBuf\fR.  The UTF-8 characters in the buffer are converted to the
channel's encoding and queued for output to \fIchannel\fR.  If
\fIbytesToWrite\fR is negative, \fBTcl_WriteChars\fR expects \fIcharBuf\fR
to be null-terminated and it outputs everything up to the null.
.PP
Data queued for output may not appear on the output device immediately, due
to internal buffering.  If the data should appear immediately, call
\fBTcl_Flush\fR after the call to \fBTcl_WriteChars\fR, or set the
\fB\-buffering\fR option on the channel to \fBnone\fR.  If you wish the data
to appear as soon as a complete line is accepted for output, set the
\fB\-buffering\fR option on the channel to \fBline\fR mode.
.PP
The return value of \fBTcl_WriteChars\fR is a count of how many bytes were
accepted for output to the channel.  This is either -1 to
indicate that an error occurred or another number greater than
zero to indicate success.  If an error occurs, \fBTcl_WriteChars\fR records
a POSIX error code that may be retrieved with \fBTcl_GetErrno\fR.
.PP
Newline characters in the output data are translated to platform-specific
end-of-line sequences according to the \fB\-translation\fR option for the
channel.  This is done even if the channel has no encoding.
.PP
\fBTcl_WriteObj\fR is similar to \fBTcl_WriteChars\fR except it
accepts a Tcl value whose contents will be output to the channel.  The
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
\fIoptionName\fR is NULL, the function stores an alternating list of option
names and their values in \fIoptionValue\fR, using a series of calls to
\fBTcl_DStringAppendElement\fR. The various preexisting options and
their possible values are described in the manual entry for the Tcl
\fBfconfigure\fR command. Other options can be added by each channel type.
These channel type specific options are described in the manual entry for
the Tcl command that creates a channel of that type; for example, the
additional options for TCP based channels are described in the manual entry
for the Tcl \fBsocket\fR command.
The procedure normally returns \fBTCL_OK\fR. If an error occurs, it returns
\fBTCL_ERROR\fR and calls \fBTcl_SetErrno\fR to store an appropriate POSIX
error code.
.SH TCL_SETCHANNELOPTION
.PP
\fBTcl_SetChannelOption\fR sets a new value \fInewValue\fR







|







597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
\fIoptionName\fR is NULL, the function stores an alternating list of option
names and their values in \fIoptionValue\fR, using a series of calls to
\fBTcl_DStringAppendElement\fR. The various preexisting options and
their possible values are described in the manual entry for the Tcl
\fBfconfigure\fR command. Other options can be added by each channel type.
These channel type specific options are described in the manual entry for
the Tcl command that creates a channel of that type; for example, the
additional options for TCP-based channels are described in the manual entry
for the Tcl \fBsocket\fR command.
The procedure normally returns \fBTCL_OK\fR. If an error occurs, it returns
\fBTCL_ERROR\fR and calls \fBTcl_SetErrno\fR to store an appropriate POSIX
error code.
.SH TCL_SETCHANNELOPTION
.PP
\fBTcl_SetChannelOption\fR sets a new value \fInewValue\fR

Changes to doc/Panic.3.

23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
.sp
.SH ARGUMENTS
.AS Tcl_PanicProc *panicProc
.AP "const char*" format in
A printf-style format string.
.AP "" arg in
Arguments matching the format string.
.AP va_list argList in
An argument list of arguments matching the format string.
Must have been initialized using \fBva_start\fR,
and cleared using \fBva_end\fR.
.AP Tcl_PanicProc *panicProc in
Procedure to report fatal error message and abort.
.BE
.SH DESCRIPTION
.PP
When the Tcl library detects that its internal data structures are in an
inconsistent state, or that its C procedures have been called in a







<
<
<
<







23
24
25
26
27
28
29




30
31
32
33
34
35
36
.sp
.SH ARGUMENTS
.AS Tcl_PanicProc *panicProc
.AP "const char*" format in
A printf-style format string.
.AP "" arg in
Arguments matching the format string.




.AP Tcl_PanicProc *panicProc in
Procedure to report fatal error message and abort.
.BE
.SH DESCRIPTION
.PP
When the Tcl library detects that its internal data structures are in an
inconsistent state, or that its C procedures have been called in a

Changes to doc/ParseArgs.3.

17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
\fBTcl_ParseArgsObjv\fR(\fIinterp, argTable, objcPtr, objv, remObjv\fR)
.SH ARGUMENTS
.AS "const Tcl_ArgvInfo" ***remObjv in/out
.AP Tcl_Interp *interp out
Where to store error messages.
.AP "const Tcl_ArgvInfo" *argTable in
Pointer to array of option descriptors.
.AP "size_t \&| int" *objcPtr in/out
A pointer to variable holding number of arguments in \fIobjv\fR. Will be
modified to hold number of arguments left in the unprocessed argument list
stored in \fIremObjv\fR.
.AP "Tcl_Obj *const" *objv in
The array of arguments to be parsed.
.AP Tcl_Obj ***remObjv out
Pointer to a variable that will hold the array of unprocessed arguments.







|







17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
\fBTcl_ParseArgsObjv\fR(\fIinterp, argTable, objcPtr, objv, remObjv\fR)
.SH ARGUMENTS
.AS "const Tcl_ArgvInfo" ***remObjv in/out
.AP Tcl_Interp *interp out
Where to store error messages.
.AP "const Tcl_ArgvInfo" *argTable in
Pointer to array of option descriptors.
.AP "Tcl_Size \&| int" *objcPtr in/out
A pointer to variable holding number of arguments in \fIobjv\fR. Will be
modified to hold number of arguments left in the unprocessed argument list
stored in \fIremObjv\fR.
.AP "Tcl_Obj *const" *objv in
The array of arguments to be parsed.
.AP Tcl_Obj ***remObjv out
Pointer to a variable that will hold the array of unprocessed arguments.

Changes to doc/ParseCmd.3.

41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
For procedures other than \fBTcl_FreeParse\fR and
\fBTcl_EvalTokensStandard\fR, used only for error reporting;
if NULL, then no error messages are left after errors.
For \fBTcl_EvalTokensStandard\fR, determines the context for evaluating
the script and also is used for error reporting; must not be NULL.
.AP "const char" *start in
Pointer to first character in string to parse.
.AP size_t numBytes in
Number of bytes in string to parse, not including any terminating null
character.  If less than 0 then the script consists of all characters
following \fIstart\fR up to the first null character.
.AP int nested in
Non-zero means that the script is part of a command substitution so an
unquoted close bracket should be treated as a command terminator.  If zero,
close brackets have no special meaning.







|







41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
For procedures other than \fBTcl_FreeParse\fR and
\fBTcl_EvalTokensStandard\fR, used only for error reporting;
if NULL, then no error messages are left after errors.
For \fBTcl_EvalTokensStandard\fR, determines the context for evaluating
the script and also is used for error reporting; must not be NULL.
.AP "const char" *start in
Pointer to first character in string to parse.
.AP Tcl_Size numBytes in
Number of bytes in string to parse, not including any terminating null
character.  If less than 0 then the script consists of all characters
following \fIstart\fR up to the first null character.
.AP int nested in
Non-zero means that the script is part of a command substitution so an
unquoted close bracket should be treated as a command terminator.  If zero,
close brackets have no special meaning.
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
\fBTcl_ParseCommand\fR, \fBTcl_ParseExpr\fR, \fBTcl_ParseBraces\fR,
\fBTcl_ParseQuotedString\fR, and \fBTcl_ParseVarName\fR
return parse information in two data structures, Tcl_Parse and Tcl_Token:
.PP
.CS
typedef struct Tcl_Parse {
    const char *\fIcommentStart\fR;
    size_t \fIcommentSize\fR;
    const char *\fIcommandStart\fR;
    size_t \fIcommandSize\fR;
    size_t \fInumWords\fR;
    Tcl_Token *\fItokenPtr\fR;
    size_t \fInumTokens\fR;
    ...
} \fBTcl_Parse\fR;

typedef struct Tcl_Token {
    int \fItype\fR;
    const char *\fIstart\fR;
    size_t \fIsize\fR;
    size_t \fInumComponents\fR;
} \fBTcl_Token\fR;
.CE
.PP
The first five fields of a Tcl_Parse structure
are filled in only by \fBTcl_ParseCommand\fR.
These fields are not used by the other parsing procedures.
.PP







|

|
|

|






|
|







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
\fBTcl_ParseCommand\fR, \fBTcl_ParseExpr\fR, \fBTcl_ParseBraces\fR,
\fBTcl_ParseQuotedString\fR, and \fBTcl_ParseVarName\fR
return parse information in two data structures, Tcl_Parse and Tcl_Token:
.PP
.CS
typedef struct Tcl_Parse {
    const char *\fIcommentStart\fR;
    Tcl_Size \fIcommentSize\fR;
    const char *\fIcommandStart\fR;
    Tcl_Size \fIcommandSize\fR;
    Tcl_Size \fInumWords\fR;
    Tcl_Token *\fItokenPtr\fR;
    Tcl_Size \fInumTokens\fR;
    ...
} \fBTcl_Parse\fR;

typedef struct Tcl_Token {
    int \fItype\fR;
    const char *\fIstart\fR;
    Tcl_Size \fIsize\fR;
    Tcl_Size \fInumComponents\fR;
} \fBTcl_Token\fR;
.CE
.PP
The first five fields of a Tcl_Parse structure
are filled in only by \fBTcl_ParseCommand\fR.
These fields are not used by the other parsing procedures.
.PP

Changes to doc/PkgRequire.3.

51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
.AP "const void" *clientData in
Arbitrary value to be associated with the package.
.AP void *clientDataPtr out
Pointer to place to store the value associated with the matching
package. It is only changed if the pointer is not NULL and the
function completed successfully. The storage can be any pointer
type with the same size as a void pointer.
.AP size_t objc in
Number of requirements.
.AP Tcl_Obj* objv[] in
Array of requirements.
.BE
.SH DESCRIPTION
.PP
These procedures provide C-level interfaces to Tcl's package and







|







51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
.AP "const void" *clientData in
Arbitrary value to be associated with the package.
.AP void *clientDataPtr out
Pointer to place to store the value associated with the matching
package. It is only changed if the pointer is not NULL and the
function completed successfully. The storage can be any pointer
type with the same size as a void pointer.
.AP Tcl_Size objc in
Number of requirements.
.AP Tcl_Obj* objv[] in
Array of requirements.
.BE
.SH DESCRIPTION
.PP
These procedures provide C-level interfaces to Tcl's package and

Changes to doc/RegExp.3.

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
by \fBTcl_GetRegExpFromObj\fR or \fBTcl_RegExpCompile\fR.
.AP "const char" *start in
If \fItext\fR is just a portion of some other string, this argument
identifies the beginning of the larger string.
If it is not the same as \fItext\fR, then no
.QW \fB^\fR
matches will be allowed.
.AP size_t index in
Specifies which range is desired:  0 means the range of the entire
match, 1 or greater means the range that matched a parenthesized
sub-expression.
.AP "const char" **startPtr out
The address of the first character in the range is stored here, or
NULL if there is no such range.
.AP "const char" **endPtr out
The address of the character just after the last one in the range
is stored here, or NULL if there is no such range.
.AP int cflags in
OR-ed combination of the compilation flags \fBTCL_REG_ADVANCED\fR,
\fBTCL_REG_EXTENDED\fR, \fBTCL_REG_BASIC\fR, \fBTCL_REG_EXPANDED\fR,
\fBTCL_REG_QUOTE\fR, \fBTCL_REG_NOCASE\fR, \fBTCL_REG_NEWLINE\fR,
\fBTCL_REG_NLSTOP\fR, \fBTCL_REG_NLANCH\fR, \fBTCL_REG_NOSUB\fR, and
\fBTCL_REG_CANMATCH\fR. See below for more information.
.AP size_t offset in
The character offset into the text where matching should begin.
The value of the offset has no impact on \fB^\fR matches.  This
behavior is controlled by \fIeflags\fR.
.AP size_t nmatches in
The number of matching subexpressions that should be remembered for
later use.  If this value is 0, then no subexpression match
information will be computed.  If the value is TCL_INDEX_NONE, then
all of the matching subexpressions will be remembered.  Any other
value will be taken as the maximum number of subexpressions to
remember.
.AP int eflags in
OR-ed combination of the execution flags \fBTCL_REG_NOTBOL\fR and
\fBTCL_REG_NOTEOL\fR. See below for more information.
.AP Tcl_RegExpInfo *infoPtr out







|















|



|


|







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
by \fBTcl_GetRegExpFromObj\fR or \fBTcl_RegExpCompile\fR.
.AP "const char" *start in
If \fItext\fR is just a portion of some other string, this argument
identifies the beginning of the larger string.
If it is not the same as \fItext\fR, then no
.QW \fB^\fR
matches will be allowed.
.AP Tcl_Size index in
Specifies which range is desired:  0 means the range of the entire
match, 1 or greater means the range that matched a parenthesized
sub-expression.
.AP "const char" **startPtr out
The address of the first character in the range is stored here, or
NULL if there is no such range.
.AP "const char" **endPtr out
The address of the character just after the last one in the range
is stored here, or NULL if there is no such range.
.AP int cflags in
OR-ed combination of the compilation flags \fBTCL_REG_ADVANCED\fR,
\fBTCL_REG_EXTENDED\fR, \fBTCL_REG_BASIC\fR, \fBTCL_REG_EXPANDED\fR,
\fBTCL_REG_QUOTE\fR, \fBTCL_REG_NOCASE\fR, \fBTCL_REG_NEWLINE\fR,
\fBTCL_REG_NLSTOP\fR, \fBTCL_REG_NLANCH\fR, \fBTCL_REG_NOSUB\fR, and
\fBTCL_REG_CANMATCH\fR. See below for more information.
.AP Tcl_Size offset in
The character offset into the text where matching should begin.
The value of the offset has no impact on \fB^\fR matches.  This
behavior is controlled by \fIeflags\fR.
.AP Tcl_Size nmatches in
The number of matching subexpressions that should be remembered for
later use.  If this value is 0, then no subexpression match
information will be computed.  If the value is negative, then
all of the matching subexpressions will be remembered.  Any other
value will be taken as the maximum number of subexpressions to
remember.
.AP int eflags in
OR-ed combination of the execution flags \fBTCL_REG_NOTBOL\fR and
\fBTCL_REG_NOTEOL\fR. See below for more information.
.AP Tcl_RegExpInfo *infoPtr out
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
\fBTcl_RegExpGetInfo\fR retrieves information about the last match
performed with a given regular expression \fIregexp\fR.  The
\fIinfoPtr\fR argument contains a pointer to a structure that is
defined as follows:
.PP
.CS
typedef struct Tcl_RegExpInfo {
    size_t \fInsubs\fR;
    Tcl_RegExpIndices *\fImatches\fR;
    size_t \fIextendStart\fR;
} \fBTcl_RegExpInfo\fR;
.CE
.PP
The \fInsubs\fR field contains a count of the number of parenthesized
subexpressions within the regular expression.  If the \fBTCL_REG_NOSUB\fR
was used, then this value will be zero.  The \fImatches\fR field
points to an array of \fInsubs\fR+1 values that indicate the bounds of each
subexpression matched.  The first element in the array refers to the
range matched by the entire regular expression, and subsequent elements
refer to the parenthesized subexpressions in the order that they
appear in the pattern.  Each element is a structure that is defined as
follows:
.PP
.CS
typedef struct Tcl_RegExpIndices {
    size_t \fIstart\fR;
    size_t \fIend\fR;
} \fBTcl_RegExpIndices\fR;
.CE
.PP
The \fIstart\fR and \fIend\fR values are Unicode character indices
relative to the offset location within \fIobjPtr\fR where matching began.
The \fIstart\fR index identifies the first character of the matched
subexpression.  The \fIend\fR index identifies the first character







|

|















|
|







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
\fBTcl_RegExpGetInfo\fR retrieves information about the last match
performed with a given regular expression \fIregexp\fR.  The
\fIinfoPtr\fR argument contains a pointer to a structure that is
defined as follows:
.PP
.CS
typedef struct Tcl_RegExpInfo {
    Tcl_Size \fInsubs\fR;
    Tcl_RegExpIndices *\fImatches\fR;
    Tcl_Size \fIextendStart\fR;
} \fBTcl_RegExpInfo\fR;
.CE
.PP
The \fInsubs\fR field contains a count of the number of parenthesized
subexpressions within the regular expression.  If the \fBTCL_REG_NOSUB\fR
was used, then this value will be zero.  The \fImatches\fR field
points to an array of \fInsubs\fR+1 values that indicate the bounds of each
subexpression matched.  The first element in the array refers to the
range matched by the entire regular expression, and subsequent elements
refer to the parenthesized subexpressions in the order that they
appear in the pattern.  Each element is a structure that is defined as
follows:
.PP
.CS
typedef struct Tcl_RegExpIndices {
    Tcl_Size \fIstart\fR;
    Tcl_Size \fIend\fR;
} \fBTcl_RegExpIndices\fR;
.CE
.PP
The \fIstart\fR and \fIend\fR values are Unicode character indices
relative to the offset location within \fIobjPtr\fR where matching began.
The \fIstart\fR index identifies the first character of the matched
subexpression.  The \fIend\fR index identifies the first character

Changes to doc/SetRecLmt.3.

10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
.BS
.SH NAME
Tcl_SetRecursionLimit \- set maximum allowable nesting depth in interpreter
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
size_t
\fBTcl_SetRecursionLimit\fR(\fIinterp, depth\fR)
.SH ARGUMENTS
.AS Tcl_Interp *interp
.AP Tcl_Interp *interp in
Interpreter whose recursion limit is to be set.
Must be greater than zero.
.AP size_t depth in
New limit for nested calls to \fBTcl_Eval\fR for \fIinterp\fR.
.BE

.SH DESCRIPTION
.PP
At any given time Tcl enforces a limit on the number of recursive
calls that may be active for \fBTcl_Eval\fR and related procedures







|






|







10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
.BS
.SH NAME
Tcl_SetRecursionLimit \- set maximum allowable nesting depth in interpreter
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_Size
\fBTcl_SetRecursionLimit\fR(\fIinterp, depth\fR)
.SH ARGUMENTS
.AS Tcl_Interp *interp
.AP Tcl_Interp *interp in
Interpreter whose recursion limit is to be set.
Must be greater than zero.
.AP Tcl_Size depth in
New limit for nested calls to \fBTcl_Eval\fR for \fIinterp\fR.
.BE

.SH DESCRIPTION
.PP
At any given time Tcl enforces a limit on the number of recursive
calls that may be active for \fBTcl_Eval\fR and related procedures

Changes to doc/SetResult.3.

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
.sp
\fBTcl_TransferResult\fR(\fIsourceInterp, code, targetInterp\fR)
.sp
\fBTcl_AppendElement\fR(\fIinterp, element\fR)
.SH ARGUMENTS
.AS Tcl_FreeProc sourceInterp out
.AP Tcl_Interp *interp out
Interpreter whose result is to be modified or read.
.AP Tcl_Obj *objPtr in
Tcl value to become result for \fIinterp\fR.
.AP char *result in
String value to become result for \fIinterp\fR or to be
appended to the existing result.
.AP "const char" *element in
String value to append as a list element
to the existing result of \fIinterp\fR.
.AP Tcl_FreeProc *freeProc in
Address of procedure to call to release storage at
\fIresult\fR, or \fBTCL_STATIC\fR, \fBTCL_DYNAMIC\fR, or
\fBTCL_VOLATILE\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 Tcl_Interp *sourceInterp in
Interpreter that the result and return options should be transferred from.
.AP Tcl_Interp *targetInterp in
Interpreter that the result and return options should be transferred to.
.AP int code in
Return code value that controls transfer of return options.
.BE
.SH DESCRIPTION
.PP
The procedures described here are utilities for manipulating the
result value in a Tcl interpreter.
The interpreter result may be either a Tcl value or a string.
For example, \fBTcl_SetObjResult\fR and \fBTcl_SetResult\fR
set the interpreter result to, respectively, a value and a string.
Similarly, \fBTcl_GetObjResult\fR and \fBTcl_GetStringResult\fR
return the interpreter result as a value and as a string.
The procedures always keep the string and value forms
of the interpreter result consistent.
For example, if \fBTcl_SetObjResult\fR is called to set
the result to a value,
then \fBTcl_GetStringResult\fR is called,
it will return the value's string representation.

.PP
\fBTcl_SetObjResult\fR
arranges for \fIobjPtr\fR to be the result for \fIinterp\fR,
replacing any existing result.
The result is left pointing to the value
referenced by \fIobjPtr\fR.
\fIobjPtr\fR's reference count is incremented
since there is now a new reference to it from \fIinterp\fR.
The reference count for any old result value
is decremented and the old result value is freed if no
references to it remain.
.PP
\fBTcl_GetObjResult\fR returns the result for \fIinterp\fR as a value.
The value's reference count is not incremented;
if the caller needs to retain a long-term pointer to the value
they should use \fBTcl_IncrRefCount\fR to increment its reference count
in order to keep it from being freed too early or accidentally changed.
.PP
\fBTcl_SetResult\fR
arranges for \fIresult\fR to be the result for the current Tcl
command in \fIinterp\fR, replacing any existing result.
The \fIfreeProc\fR argument specifies how to manage the storage
for the \fIresult\fR argument;
it is discussed in the section
\fBTHE TCL_FREEPROC ARGUMENT TO TCL_SETRESULT\fR below.
If \fIresult\fR is \fBNULL\fR, then \fIfreeProc\fR is ignored
and \fBTcl_SetResult\fR
re-initializes \fIinterp\fR's result to point to an empty string.
.PP
\fBTcl_GetStringResult\fR returns the result for \fIinterp\fR as a string.
If the result was set to a value by a \fBTcl_SetObjResult\fR call,
the value form will be converted to a string and returned.
If the value's string representation contains null bytes,
this conversion will lose information.

For this reason, programmers are encouraged to
write their code to use the new value API procedures
and to call \fBTcl_GetObjResult\fR instead.
.PP
\fBTcl_ResetResult\fR clears the result for \fIinterp\fR
and leaves the result in its normal empty initialized state.
If the result is a value,
its reference count is decremented and the result is left
pointing to an unshared value representing an empty string.
If the result is a dynamically allocated string, its memory is free*d
and the result is left as a empty string.
\fBTcl_ResetResult\fR also clears the error state managed by
\fBTcl_AddErrorInfo\fR, \fBTcl_AddObjErrorInfo\fR,
and \fBTcl_SetErrorCode\fR.
.PP
\fBTcl_AppendResult\fR makes it easy to build up Tcl results in pieces.
It takes each of its \fIresult\fR arguments and appends them in order
to the current result associated with \fIinterp\fR.
If the result is in its initialized empty state (e.g. a command procedure
was just invoked or \fBTcl_ResetResult\fR was just called),
then \fBTcl_AppendResult\fR sets the result to the concatenation of
its \fIresult\fR arguments.
\fBTcl_AppendResult\fR may be called repeatedly as additional pieces
of the result are produced.
\fBTcl_AppendResult\fR takes care of all the
storage management issues associated with managing \fIinterp\fR's
result, such as allocating a larger result area if necessary.
It also manages conversion to and from the \fIresult\fR field of the
\fIinterp\fR so as to handle backward-compatibility with old-style
extensions.
Any number of \fIresult\fR arguments may be passed in a single
call; the last argument in the list must be a NULL pointer.
.PP
\fBTcl_TransferResult\fR transfers interpreter state from \fIsourceInterp\fR
to \fItargetInterp\fR. The two interpreters must have been created in the
same thread.  If \fIsourceInterp\fR and \fItargetInterp\fR are the same,
nothing is done. Otherwise, \fBTcl_TransferResult\fR moves the result
from \fIsourceInterp\fR to \fItargetInterp\fR, and resets the result
in \fIsourceInterp\fR. It also moves the return options dictionary as
controlled by the return code value \fIcode\fR in the same manner
as \fBTcl_GetReturnOptions\fR.


.SH "DEPRECATED INTERFACES"
.SS "OLD STRING PROCEDURES"
.PP
Use of the following procedures is deprecated
since they manipulate the Tcl result as a string.
Procedures such as \fBTcl_SetObjResult\fR
that manipulate the result as a value
can be significantly more efficient.
.PP
\fBTcl_AppendElement\fR is similar to \fBTcl_AppendResult\fR in
that it allows results to be built up in pieces.
However, \fBTcl_AppendElement\fR takes only a single \fIelement\fR
argument and it appends that argument to the current result
as a proper Tcl list element.
\fBTcl_AppendElement\fR adds backslashes or braces if necessary
to ensure that \fIinterp\fR's result can be parsed as a list and that
\fIelement\fR will be extracted as a single element.
Under normal conditions, \fBTcl_AppendElement\fR will add a space
character to \fIinterp\fR's result just before adding the new
list element, so that the list elements in the result are properly
separated.
However if the new list element is the first in a list or sub-list
(i.e. \fIinterp\fR's current result is empty, or consists of the
single character
.QW { ,
or ends in the characters
.QW " {" )
then no space is added.
.SH "THE TCL_FREEPROC ARGUMENT TO TCL_SETRESULT"
.PP
\fBTcl_SetResult\fR's \fIfreeProc\fR argument specifies how
the Tcl system is to manage the storage for the \fIresult\fR argument.
If \fBTcl_SetResult\fR or \fBTcl_SetObjResult\fR are called
at a time when \fIinterp\fR holds a string result,
they do whatever is necessary to dispose of the old string result
(see the \fBTcl_Interp\fR manual entry for details on this).
.PP
If \fIfreeProc\fR is \fBTCL_STATIC\fR it means that \fIresult\fR
refers to an area of static storage that is guaranteed not to be
modified until at least the next call to \fBTcl_Eval\fR.
If \fIfreeProc\fR
is \fBTCL_DYNAMIC\fR it means that \fIresult\fR was allocated with a call
to \fBTcl_Alloc\fR and is now the property of the Tcl system.
\fBTcl_SetResult\fR will arrange for the string's storage to be
released by calling \fBTcl_Free\fR when it is no longer needed.
If \fIfreeProc\fR is \fBTCL_VOLATILE\fR it means that \fIresult\fR
points to an area of memory that is likely to be overwritten when
\fBTcl_SetResult\fR returns (e.g. it points to something in a stack frame).
In this case \fBTcl_SetResult\fR will make a copy of the string in
dynamically allocated storage and arrange for the copy to be the
result for the current Tcl command.
.PP
If \fIfreeProc\fR is not one of the values \fBTCL_STATIC\fR,
\fBTCL_DYNAMIC\fR, and \fBTCL_VOLATILE\fR, then it is the address
of a procedure that Tcl should call to free the string.
This allows applications to use non-standard storage allocators.
When Tcl no longer needs the storage for the string, it will
call \fIfreeProc\fR. \fIFreeProc\fR should have arguments and
result that match the type \fBTcl_FreeProc\fR:
.PP
.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







|

|

<
|

|


|
|
<
<
<
<

|

|





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

|
<

<
<
<
<
<
<
<

|
|
<
<
<

|
<
|
<
<
<
|
|
<
|

|
<
<
|
<
>
|
<
|

<
<
<
<
<
<
|
|
<
|

|
<
|
<
<
<
<
<
|
<
<
|
|
|
<
|
|

|
|
<
<
<
|
|

>
>



<
|
|
<
|

|
<
<
<
|
|
<
<
|
|
|
<
|
|
|






<
<
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<






|
|

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





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
.sp
\fBTcl_TransferResult\fR(\fIsourceInterp, code, targetInterp\fR)
.sp
\fBTcl_AppendElement\fR(\fIinterp, element\fR)
.SH ARGUMENTS
.AS Tcl_FreeProc sourceInterp out
.AP Tcl_Interp *interp out
The interpreter get or set the result for.
.AP Tcl_Obj *objPtr in
A value to set the result to.
.AP char *result in

The string value set the result to, or to append to the existing result.
.AP "const char" *element in
The string value to append as a list element
to the existing result of \fIinterp\fR.
.AP Tcl_FreeProc *freeProc in
Pointer to a procedure to call to release storage at
\fIresult\fR.




.AP Tcl_Interp *sourceInterp in
The interpreter to transfer the result and return options from.
.AP Tcl_Interp *targetInterp in
The interpreter to transfer the result and return options to.
.AP int code in
Return code value that controls transfer of return options.
.BE
.SH DESCRIPTION
.PP
These procedures manipulate the result of an interpreter.  Some procedures
provide a Tcl_Obj interface while others provide a string interface.  For

example, \fBTcl_SetObjResult\fR accepts a Tcl_Obj and \fBTcl_SetResult\fR

accepts a char *.  Similarly, \fBTcl_GetObjResult\fR produces a Tcl_Obj * and

\fBTcl_GetStringResult\fR produces a char *.  The procedures can be mixed and

matched.  For example, if \fBTcl_SetObjResult\fR is called to set the result to

a Tcl_Obj value, and then \fBTcl_GetStringResult\fR is called, it returns a

char * (but see caveats below).
.PP
\fBTcl_SetObjResult\fR sets \fIobjPtr\fR as the result for \fIinterp\fR,

replacing any existing result.







.PP
\fBTcl_GetObjResult\fR returns the result for \fIinterp\fR, without
incrementing its reference count.



.PP
\fBTcl_SetResult\fR sets \fIresult\fR as the result for \fIinterp\fR, replacing

any existing result, and calls \fIfreeProc\fR to free \fIresult\fR.  See \fBTHE



TCL_FREEPROC ARGUMENT TO TCL_SETRESULT\fR below.  If \fIresult\fR is
\fBNULL\fR, ignores \fIfreeProc\fR and sets the result for \fIinterp\fR to

point to the empty string.
.PP
\fBTcl_GetStringResult\fR returns the result for \fIinterp\fR as a string, i.e.


the bytes of the Tcl_Obj for the result, which can be decoded using

\fBTcl_UtfToExternal\fR.  This value is freed when its corresponding Tcl_Obj is
freed.Programmers are encouraged to use the newer Tcl_Obj API procedures, e.g.

to call \fBTcl_GetObjResult\fR instead.
.PP






\fBTcl_ResetResult\fR sets the empty string as the result for \fIinterp\fR and
clears the error state managed by \fBTcl_AddErrorInfo\fR,

\fBTcl_AddObjErrorInfo\fR, and \fBTcl_SetErrorCode\fR.
.PP
\fBTcl_AppendResult\fR builds up a result from smaller pieces, appending each

\fIresult\fR in order to the current result for \fIinterp\fR.  It may be called





repeatedly as additional pieces of the result are produced, and manages the


storage for the \fIinterp\fR's result, allocating a larger result area if
necessary.  It also manages conversion to and from the \fIresult\fR field of
the \fIinterp\fR to handle backward-compatibility with old-style extensions.

Any number of \fIresult\fR arguments may be passed in a single call; the last
argument in the list must be a NULL pointer.
.PP
\fBTcl_TransferResult\fR transfers interpreter state from \fIsourceInterp\fR to
\fItargetInterp\fR, both of which must have been created in the same thread,



resets the result in \fIsourceInterp\fR, and moves the return options
dictionary as controlled by the return code value \fIcode\fR in the same manner
as \fBTcl_GetReturnOptions\fR.
.PP
If \fIsourceInterp\fR and \fItargetInterp\fR are the same, nothing is done.
.SH "DEPRECATED INTERFACES"
.SS "OLD STRING PROCEDURES"
.PP

The following procedures are deprecated since they manipulate the Tcl result as
a string.  Procedures such as \fBTcl_SetObjResult\fR can be significantly more

efficient.
.PP
\fBTcl_AppendElement\fR is like \fBTcl_AppendResult\fR, but it appends only one



piece, and also appends that piece as a list item.
\fBTcl_AppendElement\fR adds backslashes or braces as necessary to ensure that


\fIelement\fR is properly formatted as a list item.  Under normal conditions,
\fBTcl_AppendElement\fR adds a space character to \fIinterp\fR's result just
before adding the new list element, so that the list elements in the result are

properly separated.  However if the new list element is the first item in the
list or sublist (i.e. \fIinterp\fR's current result is empty, or consists of
the single character
.QW { ,
or ends in the characters
.QW " {" )
then no space is added.
.SH "THE TCL_FREEPROC ARGUMENT TO TCL_SETRESULT"
.PP










\fIFreeProc\fR has the following type:


















.PP
.CS
typedef void \fBTcl_FreeProc\fR(
        char *\fIblockPtr\fR);
.CE
.PP
When \fIfreeProc\fR is called, \fIblockPtr\fR is the \fIresult\fR value passed
to \fBTcl_SetResult\fR.



























.SH "SEE ALSO"
Tcl_AddErrorInfo, Tcl_CreateObjCommand, Tcl_SetErrorCode, Tcl_Interp,
Tcl_GetReturnOptions
.SH KEYWORDS
append, command, element, list, value, result, return value, interpreter

Changes to doc/SetVar.3.

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







|
|
|

|
|
<

|

|
|
>






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
.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 is
incremented on success.  On failure, if its reference count is zero, it is
decremented and freed so the caller need do nothing with it.
.PP
The \fIpart1Ptr\fR argument to \fBTcl_ObjSetVar2\fR and \fBTcl_ObjGetVar2\fR can
have any reference count.  These functions never modify it.

.PP
The \fIpart2Ptr\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, and decrementing the reference count
later would leave them pointing to a freed Tcl_Obj.

.SH "SEE ALSO"
Tcl_GetObjResult, Tcl_GetStringResult, Tcl_TraceVar

.SH KEYWORDS
array, get variable, interpreter, scalar, set, unset, value, variable

Changes to doc/SplitList.3.

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
.sp
int
\fBTcl_SplitList\fR(\fIinterp, list, argcPtr, argvPtr\fR)
.sp
char *
\fBTcl_Merge\fR(\fIargc, argv\fR)
.sp
size_t
\fBTcl_ScanElement\fR(\fIsrc, flagsPtr\fR)
.sp
size_t
\fBTcl_ScanCountedElement\fR(\fIsrc, length, flagsPtr\fR)
.sp
size_t
\fBTcl_ConvertElement\fR(\fIsrc, dst, flags\fR)
.sp
size_t
\fBTcl_ConvertCountedElement\fR(\fIsrc, length, dst, flags\fR)
.SH ARGUMENTS
.AS "const char *const" ***argvPtr out
.AP Tcl_Interp *interp out
Interpreter to use for error reporting.  If NULL, then no error message
is left.
.AP "const char" *list in
Pointer to a string with proper list structure.
.AP "size_t \&| int" *argcPtr out
Filled in with number of elements in \fIlist\fR.
.AP "const char" ***argvPtr out
\fI*argvPtr\fR will be filled in with the address of an array of
pointers to the strings that are the extracted elements of \fIlist\fR.
There will be \fI*argcPtr\fR valid entries in the array, followed by
a NULL entry.
.AP size_t argc in
Number of elements in \fIargv\fR.
.AP "const char *const" *argv in
Array of strings to merge together into a single list.
Each string will become a separate element of the list.
.AP "const char" *src in
String that is to become an element of a list.
.AP int *flagsPtr in
Pointer to word to fill in with information about \fIsrc\fR.
The value of *\fIflagsPtr\fR must be passed to \fBTcl_ConvertElement\fR.
.AP size_t length in
Number of bytes in string \fIsrc\fR.
.AP char *dst in
Place to copy converted list element.  Must contain enough characters
to hold converted string.
.AP int flags in
Information about \fIsrc\fR. Must be value returned by previous
call to \fBTcl_ScanElement\fR, possibly OR-ed







|


|


|


|








|






|









|







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
.sp
int
\fBTcl_SplitList\fR(\fIinterp, list, argcPtr, argvPtr\fR)
.sp
char *
\fBTcl_Merge\fR(\fIargc, argv\fR)
.sp
Tcl_Size
\fBTcl_ScanElement\fR(\fIsrc, flagsPtr\fR)
.sp
Tcl_Size
\fBTcl_ScanCountedElement\fR(\fIsrc, length, flagsPtr\fR)
.sp
Tcl_Size
\fBTcl_ConvertElement\fR(\fIsrc, dst, flags\fR)
.sp
Tcl_Size
\fBTcl_ConvertCountedElement\fR(\fIsrc, length, dst, flags\fR)
.SH ARGUMENTS
.AS "const char *const" ***argvPtr out
.AP Tcl_Interp *interp out
Interpreter to use for error reporting.  If NULL, then no error message
is left.
.AP "const char" *list in
Pointer to a string with proper list structure.
.AP "Tcl_Size \&| int" *argcPtr out
Filled in with number of elements in \fIlist\fR.
.AP "const char" ***argvPtr out
\fI*argvPtr\fR will be filled in with the address of an array of
pointers to the strings that are the extracted elements of \fIlist\fR.
There will be \fI*argcPtr\fR valid entries in the array, followed by
a NULL entry.
.AP Tcl_Size argc in
Number of elements in \fIargv\fR.
.AP "const char *const" *argv in
Array of strings to merge together into a single list.
Each string will become a separate element of the list.
.AP "const char" *src in
String that is to become an element of a list.
.AP int *flagsPtr in
Pointer to word to fill in with information about \fIsrc\fR.
The value of *\fIflagsPtr\fR must be passed to \fBTcl_ConvertElement\fR.
.AP Tcl_Size length in
Number of bytes in string \fIsrc\fR.
.AP char *dst in
Place to copy converted list element.  Must contain enough characters
to hold converted string.
.AP int flags in
Information about \fIsrc\fR. Must be value returned by previous
call to \fBTcl_ScanElement\fR, possibly OR-ed
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
addition to the array of pointers, it
also holds copies of all the list elements.  It is the caller's
responsibility to free up all of this storage.
For example, suppose that you have called \fBTcl_SplitList\fR with
the following code:
.PP
.CS
size_t argc;
int code;
char *string;
char **argv;
\&...
code = \fBTcl_SplitList\fR(interp, string, &argc, &argv);
.CE
.PP







|







77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
addition to the array of pointers, it
also holds copies of all the list elements.  It is the caller's
responsibility to free up all of this storage.
For example, suppose that you have called \fBTcl_SplitList\fR with
the following code:
.PP
.CS
Tcl_Size argc;
int code;
char *string;
char **argv;
\&...
code = \fBTcl_SplitList\fR(interp, string, &argc, &argv);
.CE
.PP

Changes to doc/SplitPath.3.

21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Tcl_PathType
\fBTcl_GetPathType\fR(\fIpath\fR)
.SH ARGUMENTS
.AS "const char *const" ***argvPtr in/out
.AP "const char" *path in
File path in a form appropriate for the current platform (see the
\fBfilename\fR manual entry for acceptable forms for path names).
.AP "size_t \&| int" *argcPtr out
Filled in with number of path elements in \fIpath\fR.
.AP "const char" ***argvPtr out
\fI*argvPtr\fR will be filled in with the address of an array of
pointers to the strings that are the extracted elements of \fIpath\fR.
There will be \fI*argcPtr\fR valid entries in the array, followed by
a NULL entry.
.AP size_t argc in
Number of elements in \fIargv\fR.
.AP "const char *const" *argv in
Array of path elements to merge together into a single path.
.AP Tcl_DString *resultPtr in/out
A pointer to an initialized \fBTcl_DString\fR to which the result of
\fBTcl_JoinPath\fR will be appended.
.BE







|






|







21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Tcl_PathType
\fBTcl_GetPathType\fR(\fIpath\fR)
.SH ARGUMENTS
.AS "const char *const" ***argvPtr in/out
.AP "const char" *path in
File path in a form appropriate for the current platform (see the
\fBfilename\fR manual entry for acceptable forms for path names).
.AP "Tcl_Size \&| int" *argcPtr out
Filled in with number of path elements in \fIpath\fR.
.AP "const char" ***argvPtr out
\fI*argvPtr\fR will be filled in with the address of an array of
pointers to the strings that are the extracted elements of \fIpath\fR.
There will be \fI*argcPtr\fR valid entries in the array, followed by
a NULL entry.
.AP Tcl_Size argc in
Number of elements in \fIargv\fR.
.AP "const char *const" *argv in
Array of path elements to merge together into a single path.
.AP Tcl_DString *resultPtr in/out
A pointer to an initialized \fBTcl_DString\fR to which the result of
\fBTcl_JoinPath\fR will be appended.
.BE
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
dynamically allocated; in addition to the array of pointers, it also
holds copies of all the path elements.  It is the caller's
responsibility to free all of this storage.
For example, suppose that you have called \fBTcl_SplitPath\fR with the
following code:
.PP
.CS
size_t argc;
char *path;
char **argv;
\&...
Tcl_SplitPath(string, &argc, &argv);
.CE
.PP
Then you should eventually free the storage with a call like the







|







57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
dynamically allocated; in addition to the array of pointers, it also
holds copies of all the path elements.  It is the caller's
responsibility to free all of this storage.
For example, suppose that you have called \fBTcl_SplitPath\fR with the
following code:
.PP
.CS
Tcl_Size argc;
char *path;
char **argv;
\&...
Tcl_SplitPath(string, &argc, &argv);
.CE
.PP
Then you should eventually free the storage with a call like the

Changes to doc/StringObj.3.

36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
.sp
Tcl_UniChar *
\fBTcl_GetUnicode\fR(\fIobjPtr\fR)
.sp
int
\fBTcl_GetUniChar\fR(\fIobjPtr, index\fR)
.sp
size_t
\fBTcl_GetCharLength\fR(\fIobjPtr\fR)
.sp
Tcl_Obj *
\fBTcl_GetRange\fR(\fIobjPtr, first, last\fR)
.sp
void
\fBTcl_AppendToObj\fR(\fIobjPtr, bytes, length\fR)







|







36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
.sp
Tcl_UniChar *
\fBTcl_GetUnicode\fR(\fIobjPtr\fR)
.sp
int
\fBTcl_GetUniChar\fR(\fIobjPtr, index\fR)
.sp
Tcl_Size
\fBTcl_GetCharLength\fR(\fIobjPtr\fR)
.sp
Tcl_Obj *
\fBTcl_GetRange\fR(\fIobjPtr, first, last\fR)
.sp
void
\fBTcl_AppendToObj\fR(\fIobjPtr, bytes, length\fR)
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
\fBTcl_ConcatObj\fR(\fIobjc, objv\fR)
.SH ARGUMENTS
.AS "const Tcl_UniChar" *appendObjPtr in/out
.AP "const char" *bytes in
Points to the first byte of an array of UTF-8-encoded bytes
used to set or append to a string value.
This byte array may contain embedded null characters
unless \fInumChars\fR is \fBTCL_INDEX_NONE\fR.  (Applications needing null bytes
should represent them as the two-byte sequence \fI\e300\e200\fR, use
\fBTcl_ExternalToUtf\fR to convert, or \fBTcl_NewByteArrayObj\fR if
the string is a collection of uninterpreted bytes.)
.AP size_t length in
The number of bytes to copy from \fIbytes\fR when
initializing, setting, or appending to a string value.
If \fBTCL_INDEX_NONE\fR, all bytes up to the first null are used.
.AP "const Tcl_UniChar" *unicode in
Points to the first byte of an array of Unicode characters
used to set or append to a string value.
This byte array may contain embedded null characters
unless \fInumChars\fR is \fBTCL_INDEX_NONE\fR.
.AP size_t numChars in
The number of Unicode characters to copy from \fIunicode\fR when
initializing, setting, or appending to a string value.
If \fBTCL_INDEX_NONE\fR, all characters up to the first null character are used.
.AP size_t index in
The index of the Unicode character to return.
.AP size_t first in
The index of the first Unicode character in the Unicode range to be
returned as a new value. If \fBTCL_INDEX_NONE\fR, behave the same as if the
value was 0.
.AP size_t last in
The index of the last Unicode character in the Unicode range to be
returned as a new value. If \fBTCL_INDEX_NONE\fR, take all characters up to
the last one available.
.AP Tcl_Obj *objPtr in/out
Points to a value to manipulate.
.AP Tcl_Obj *appendObjPtr in
The value to append to \fIobjPtr\fR in \fBTcl_AppendObjToObj\fR.
.AP "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.
.AP "const char" *ellipsis in
Suffix to append when the limit leads to string truncation.
If NULL is passed then the suffix
.QW "..."
is used.
.AP "const char" *format in
Format control string including % conversion specifiers.
.AP size_t objc in
The number of elements to format or concatenate.
.AP Tcl_Obj *objv[] in
The array of values to format or concatenate.
.AP size_t newLength in
New length for the string value of \fIobjPtr\fR, not including the
final null character.
.BE
.SH DESCRIPTION
.PP
The procedures described in this manual entry allow Tcl values to
be manipulated as string values.  They use the internal representation







|



|


|




|
|


|
|

|

|

|

|


|


|




<
<
<
|








|



|







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
\fBTcl_ConcatObj\fR(\fIobjc, objv\fR)
.SH ARGUMENTS
.AS "const Tcl_UniChar" *appendObjPtr in/out
.AP "const char" *bytes in
Points to the first byte of an array of UTF-8-encoded bytes
used to set or append to a string value.
This byte array may contain embedded null characters
unless \fInumChars\fR is negative.  (Applications needing null bytes
should represent them as the two-byte sequence \fI\e300\e200\fR, use
\fBTcl_ExternalToUtf\fR to convert, or \fBTcl_NewByteArrayObj\fR if
the string is a collection of uninterpreted bytes.)
.AP Tcl_Size length in
The number of bytes to copy from \fIbytes\fR when
initializing, setting, or appending to a string value.
If negative, all bytes up to the first null are used.
.AP "const Tcl_UniChar" *unicode in
Points to the first byte of an array of Unicode characters
used to set or append to a string value.
This byte array may contain embedded null characters
unless \fInumChars\fR is negative.
.AP Tcl_Size numChars in
The number of Unicode characters to copy from \fIunicode\fR when
initializing, setting, or appending to a string value.
If negative, all characters up to the first null character are used.
.AP Tcl_Size index in
The index of the Unicode character to return.
.AP Tcl_Size first in
The index of the first Unicode character in the Unicode range to be
returned as a new value. If negative, behave the same as if the
value was 0.
.AP Tcl_Size last in
The index of the last Unicode character in the Unicode range to be
returned as a new value. If negative, take all characters up to
the last one available.
.AP Tcl_Obj *objPtr in/out
A pointer to a value to read, or to an unshared value to modify.
.AP Tcl_Obj *appendObjPtr in
The value to append to \fIobjPtr\fR in \fBTcl_AppendObjToObj\fR.
.AP "Tcl_Size \&| 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 Tcl_Size limit in
Maximum number of bytes to be appended.
.AP "const char" *ellipsis in
Suffix to append when the limit leads to string truncation.
If NULL is passed then the suffix
.QW "..."
is used.
.AP "const char" *format in
Format control string including % conversion specifiers.
.AP Tcl_Size objc in
The number of elements to format or concatenate.
.AP Tcl_Obj *objv[] in
The array of values to format or concatenate.
.AP Tcl_Size newLength in
New length for the string value of \fIobjPtr\fR, not including the
final null character.
.BE
.SH DESCRIPTION
.PP
The procedures described in this manual entry allow Tcl values to
be manipulated as string values.  They use the internal representation
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
value's Unicode representation. If the index is out of range or
it references a low surrogate preceded by a high surrogate, it returns -1;
.PP
\fBTcl_GetRange\fR returns a newly created value comprised of the
characters between \fIfirst\fR and \fIlast\fR (inclusive) in the value's
Unicode representation.  If the value's Unicode representation
is invalid, the Unicode representation is regenerated from the value's
string representation.  If \fIfirst\fR == TCL_INDEX_NONE, then the returned
string starts at the beginning of the value. If \fIlast\fR == TCL_INDEX_NONE,
then the returned string ends at the end of the value.
.PP
\fBTcl_GetCharLength\fR returns the number of characters (as opposed
to bytes) in the string value.
.PP
\fBTcl_AppendToObj\fR appends the data given by \fIbytes\fR and
\fIlength\fR to the string representation of the value specified by







|
|







206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
value's Unicode representation. If the index is out of range or
it references a low surrogate preceded by a high surrogate, it returns -1;
.PP
\fBTcl_GetRange\fR returns a newly created value comprised of the
characters between \fIfirst\fR and \fIlast\fR (inclusive) in the value's
Unicode representation.  If the value's Unicode representation
is invalid, the Unicode representation is regenerated from the value's
string representation.  If \fIfirst\fR is negative, then the returned
string starts at the beginning of the value. If \fIlast\fR negative,
then the returned string ends at the end of the value.
.PP
\fBTcl_GetCharLength\fR returns the number of characters (as opposed
to bytes) in the string value.
.PP
\fBTcl_AppendToObj\fR appends the data given by \fIbytes\fR and
\fIlength\fR to the string representation of the value specified by
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
end result should be kept short enough to be read.
Bytes from \fIbytes\fR are appended to \fIobjPtr\fR, but no more
than \fIlimit\fR bytes total are to be appended. If the limit prevents
all \fIlength\fR bytes that are available from being appended, then the
appending is done so that the last bytes appended are from the
string \fIellipsis\fR. This allows for an indication of the truncation
to be left in the string.
When \fIlength\fR is \fBTCL_INDEX_NONE\fR, all bytes up to the first zero byte are appended,
subject to the limit. When \fIellipsis\fR is NULL, the default
string \fB...\fR is used. When \fIellipsis\fR is non-NULL, it must point
to a zero-byte-terminated string in Tcl's internal UTF encoding.
The number of bytes appended can be less than the lesser
of \fIlength\fR and \fIlimit\fR when appending fewer
bytes is necessary to append only whole multi-byte characters.
.PP







|







256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
end result should be kept short enough to be read.
Bytes from \fIbytes\fR are appended to \fIobjPtr\fR, but no more
than \fIlimit\fR bytes total are to be appended. If the limit prevents
all \fIlength\fR bytes that are available from being appended, then the
appending is done so that the last bytes appended are from the
string \fIellipsis\fR. This allows for an indication of the truncation
to be left in the string.
When \fIlength\fR is negative, all bytes up to the first zero byte are appended,
subject to the limit. When \fIellipsis\fR is NULL, the default
string \fB...\fR is used. When \fIellipsis\fR is non-NULL, it must point
to a zero-byte-terminated string in Tcl's internal UTF encoding.
The number of bytes appended can be less than the lesser
of \fIlength\fR and \fIlimit\fR when appending fewer
bytes is necessary to append only whole multi-byte characters.
.PP
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
functionality is needed.
.PP
\fBTcl_ObjPrintf\fR serves as a replacement for the common sequence
.PP
.CS
char buf[SOME_SUITABLE_LENGTH];
sprintf(buf, format, ...);
\fBTcl_NewStringObj\fR(buf, \fBTCL_INDEX_NONE\fR);
.CE
.PP
but with greater convenience and no need to
determine \fBSOME_SUITABLE_LENGTH\fR. The formatting is done with the same
core formatting engine used by \fBTcl_Format\fR.  This means the set of
supported conversion specifiers is that of the \fBformat\fR command and
not that of the \fBsprintf\fR routine where the two sets differ. When a







|







299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
functionality is needed.
.PP
\fBTcl_ObjPrintf\fR serves as a replacement for the common sequence
.PP
.CS
char buf[SOME_SUITABLE_LENGTH];
sprintf(buf, format, ...);
\fBTcl_NewStringObj\fR(buf, -1);
.CE
.PP
but with greater convenience and no need to
determine \fBSOME_SUITABLE_LENGTH\fR. The formatting is done with the same
core formatting engine used by \fBTcl_Format\fR.  This means the set of
supported conversion specifiers is that of the \fBformat\fR command and
not that of the \fBsprintf\fR routine where the two sets differ. When a

Changes to doc/SubstObj.3.

20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
.AP Tcl_Interp *interp in
Interpreter in which to execute Tcl scripts and lookup variables.  If
an error occurs, the interpreter's result is modified to hold an error
message.
.AP Tcl_Obj *objPtr in
A Tcl value containing the string to perform substitutions on.
.AP int flags in
ORed combination of flag bits that specify which substitutions to
perform.  The flags \fBTCL_SUBST_COMMANDS\fR,
\fBTCL_SUBST_VARIABLES\fR and \fBTCL_SUBST_BACKSLASHES\fR are
currently supported, and \fBTCL_SUBST_ALL\fR is provided as a
convenience for the common case where all substitutions are desired.
.BE
.SH DESCRIPTION
.PP







|







20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
.AP Tcl_Interp *interp in
Interpreter in which to execute Tcl scripts and lookup variables.  If
an error occurs, the interpreter's result is modified to hold an error
message.
.AP Tcl_Obj *objPtr in
A Tcl value containing the string to perform substitutions on.
.AP int flags in
OR'ed combination of flag bits that specify which substitutions to
perform.  The flags \fBTCL_SUBST_COMMANDS\fR,
\fBTCL_SUBST_VARIABLES\fR and \fBTCL_SUBST_BACKSLASHES\fR are
currently supported, and \fBTCL_SUBST_ALL\fR is provided as a
convenience for the common case where all substitutions are desired.
.BE
.SH DESCRIPTION
.PP

Changes to doc/Tcl.n.

1
2
3

4
5
6
7
8
9
10
11
12
13
14
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
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.

'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl n "8.6" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
.SH NAME
Tcl \- Tool Command Language
.SH SYNOPSIS
Summary of Tcl language syntax.
.BE
.SH DESCRIPTION
.PP
The following rules define the syntax and semantics of the Tcl language:

.IP "[1] \fBCommands.\fR"
A Tcl script is a string containing one or more commands.
Semi-colons and newlines are command separators unless quoted as
described below.
Close brackets are command terminators during command substitution
(see below) unless quoted.
.IP "[2] \fBEvaluation.\fR"
A command is evaluated in two steps.
First, the Tcl interpreter breaks the command into \fIwords\fR
and performs substitutions as described below.


These substitutions are performed in the same way for all
commands.
Secondly, the first word is used to locate a routine to
carry out the command, and the remaining words of the command are


passed to that routine.
The routine is free to interpret each of its words
in any way it likes, such as an integer, variable name, list,
or Tcl script.

Different commands interpret their words differently.







.IP "[3] \fBWords.\fR"
Words of a command are separated by white space (except for


newlines, which are command separators).






.IP "[4] \fBDouble quotes.\fR"
If the first character of a word is double-quote
.PQ \N'34'
then the word is terminated by the next double-quote character.
If semi-colons, close brackets, or white space characters
(including newlines) appear between the quotes then they are treated

as ordinary characters and included in the word.


Command substitution, variable substitution, and backslash substitution
are performed on the characters between the quotes as described below.
The double-quotes are not retained as part of the word.



.IP "[5] \fBArgument expansion.\fR"
If a word starts with the string
.QW {*}
followed by a non-whitespace character, then the leading
.QW {*}
is removed and the rest of the word is parsed and substituted as any other
word. After substitution, the word is parsed as a list (without command or
variable substitutions; backslash substitutions are performed as is normal for
a list and individual internal words may be surrounded by either braces or
double-quote characters), and its words are added to the command being
substituted. For instance,
.QW "cmd a {*}{b [c]} d {*}{$e f {g h}}"

is equivalent to

.QW "cmd a b {[c]} d {$e} f {g h}" .
.IP "[6] \fBBraces.\fR"
If the first character of a word is an open brace
.PQ {

and rule [5] does not apply, then

the word is terminated by the matching close brace
.PQ } "" .
Braces nest within the word: for each additional open
brace there must be an additional close brace (however,
if an open brace or close brace within the word is
quoted with a backslash then it is not counted in locating the
matching close brace).
No substitutions are performed on the characters between the
braces except for backslash-newline substitutions described
below, nor do semi-colons, newlines, close brackets,
or white space receive any special interpretation.
The word will consist of exactly the characters between the
outer braces, not including the braces themselves.

.IP "[7] \fBCommand substitution.\fR"
If a word contains an open bracket
.PQ [
then Tcl performs \fIcommand substitution\fR.
To do this it invokes the Tcl interpreter recursively to process
the characters following the open bracket as a Tcl script.
The script may contain any number of commands and must be terminated
by a close bracket
.PQ ] "" .
The result of the script (i.e. the result of its last command) is
substituted into the word in place of the brackets and all of the
characters between them.
There may be any number of command substitutions in a single word.
Command substitution is not performed on words enclosed in braces.
.IP "[8] \fBVariable substitution.\fR"
If a word contains a dollar-sign
.PQ $
followed by one of the forms
described below, then Tcl performs \fIvariable
substitution\fR:  the dollar-sign and the following characters are


replaced in the word by the value of a variable.
Variable substitution may take any of the following forms:
.RS
.TP 15
\fB$\fIname\fR
.
\fIName\fR is the name of a scalar variable;  the name is a sequence
of one or more characters that are a letter, digit, underscore,
or namespace separators (two or more colons).
Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\(en\fB9\fR,
\fBA\fR\(en\fBZ\fR and \fBa\fR\(en\fBz\fR).
.TP 15
\fB$\fIname\fB(\fIindex\fB)\fR
.
\fIName\fR gives the name of an array variable and \fIindex\fR gives
the name of an element within that array.
\fIName\fR must contain only letters, digits, underscores, and
namespace separators, and may be an empty string.
Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\(en\fB9\fR,
\fBA\fR\(en\fBZ\fR and \fBa\fR\(en\fBz\fR).
Command substitutions, variable substitutions, and backslash
substitutions are performed on the characters of \fIindex\fR.
.TP 15
\fB${\fIname\fB}\fR



.
\fIName\fR is the name of a scalar variable or array element.  It may contain
any characters whatsoever except for close braces.  It indicates an array
element if \fIname\fR is in the form
.QW \fIarrayName\fB(\fIindex\fB)\fR
where \fIarrayName\fR does not contain any open parenthesis characters,
.QW \fB(\fR ,
or close brace characters,
.QW \fB}\fR ,
and \fIindex\fR can be any sequence of characters except for close brace
characters.  No further
substitutions are performed during the parsing of \fIname\fR.
.PP
There may be any number of variable substitutions in a single word.
Variable substitution is not performed on words enclosed in braces.
.PP
Note that variables may contain character sequences other than those listed
above, but in that case other mechanisms must be used to access them (e.g.,
via the \fBset\fR command's single-argument form).
.RE


.IP "[9] \fBBackslash substitution.\fR"
If a backslash
.PQ \e
appears within a word then \fIbackslash substitution\fR occurs.
In all cases but those described below the backslash is dropped and
the following character is treated as an ordinary
character and included in the word.
This allows characters such as double quotes, close brackets,
and dollar signs to be included in words without triggering
special processing.
The following table lists the backslash sequences that are
handled specially, along with the value that replaces each sequence.


.RS
.TP 7
\e\fBa\fR
Audible alert (bell) (Unicode U+000007).
.TP 7
\e\fBb\fR
Backspace (Unicode U+000008).
.TP 7
\e\fBf\fR
Form feed (Unicode U+00000C).
.TP 7
\e\fBn\fR
Newline (Unicode U+00000A).
.TP 7
\e\fBr\fR
Carriage-return (Unicode U+00000D).
.TP 7
\e\fBt\fR
Tab (Unicode U+000009).
.TP 7
\e\fBv\fR
Vertical tab (Unicode U+00000B).
.TP 7
\e\fB<newline>\fIwhiteSpace\fR
.
A single space character replaces the backslash, newline, and all spaces
and tabs after the newline.  This backslash sequence is unique in that it
is replaced in a separate pre-pass before the command is actually parsed.
This means that it will be replaced even when it occurs between braces,
and the resulting space will be treated as a word separator if it is not
in braces or quotes.
.TP 7
\e\e
Backslash
.PQ \e "" .
.TP 7
\e\fIooo\fR
.
The digits \fIooo\fR (one, two, or three of them) give a eight-bit octal
value for the Unicode character that will be inserted, in the range
\fI000\fR\(en\fI377\fR (i.e., the range U+000000\(enU+0000FF).
The parser will stop just before this range overflows, or when
the maximum of three digits is reached.  The upper bits of the Unicode
character will be 0.
.TP 7
\e\fBx\fIhh\fR
.
The hexadecimal digits \fIhh\fR (one or two of them) give an eight-bit
hexadecimal value for the Unicode character that will be inserted.  The upper
bits of the Unicode character will be 0 (i.e., the character will be in the
range U+000000\(enU+0000FF).
.TP 7
\e\fBu\fIhhhh\fR
.
The hexadecimal digits \fIhhhh\fR (one, two, three, or four of them) give a
sixteen-bit hexadecimal value for the Unicode character that will be
inserted.  The upper bits of the Unicode character will be 0 (i.e., the
character will be in the range U+000000\(enU+00FFFF).
.TP 7
\e\fBU\fIhhhhhhhh\fR
.
The hexadecimal digits \fIhhhhhhhh\fR (one up to eight of them) give a
twenty-one-bit hexadecimal value for the Unicode character that will be
inserted, in the range U+000000\(enU+10FFFF.  The parser will stop just
before this range overflows, or when the maximum of eight digits
is reached.  The upper bits of the Unicode character will be 0.
.RS
.PP
The range U+00D800\(enU+00DFFF is reserved for surrogates, which
are illegal on their own. Therefore, such sequences will result in
the replacement character U+FFFD. Surrogate pairs should be
encoded as single \e\fBU\fIhhhhhhhh\fR character.
.RE
.PP
Backslash substitution is not performed on words enclosed in braces,
except for backslash-newline as described above.
.RE
.IP "[10] \fBComments.\fR"
If a hash character
.PQ #
appears at a point where Tcl is
expecting the first character of the first word of a command,
then the hash character and the characters that follow it, up
through the next newline, are treated as a comment and ignored.
The comment character only has significance when it appears
at the beginning of a command.
.IP "[11] \fBOrder of substitution.\fR"
Each character is processed exactly once by the Tcl interpreter
as part of creating the words of a command.
For example, if variable substitution occurs then no further
substitutions are performed on the value of the variable;  the
value is inserted into the word verbatim.
If command substitution occurs then the nested command is
processed entirely by the recursive call to the Tcl interpreter;
no substitutions are performed before making the recursive
call and no additional substitutions are performed on the result
of the nested script.
.RS
.PP
Substitutions take place from left to right, and each substitution is
evaluated completely before attempting to evaluate the next.  Thus, a
sequence like
.PP
.CS
set y [set x 0][incr x][incr x]
.CE
.PP
will always set the variable \fIy\fR to the value, \fI012\fR.
.RE
.IP "[12] \fBSubstitution and word boundaries.\fR"
Substitutions do not affect the word boundaries of a command,
except for argument expansion as specified in rule [5].
For example, during variable substitution the entire value of
the variable becomes part of a single word, even if the variable's
value contains spaces.

.SH KEYWORDS
backslash, command, comment, script, substitution, variable
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:



>















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

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

<
<
|
<
|
|
|
|
|
>

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

|
<
<
<
<
|
|
<
<
<
<
|
|

|
|
<
>
>
|
<




|
|
<
<
<



<
<
<
<
<
<
<
|


>
>
>

<
<
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<

>
>
|
|

<
|
<
|
|
<
<
|
|
>
>



|


|


|


|


|


|


|



|
|
|
<
|
|







<
|
|
|
<
<



|
<
<
|



|
<
<
|



|
<
|
|
<
<
<
<
<
<
<

<
<
<

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

<
<
<
<
<
<
<
<
<

<
<
<
<
<
<
>






1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23



24
25

26
27
28
29
30

31
32
33
34
35

36
37
38
39
40
41
42
43
44
45
46

47
48
49
50
51
52
53
54
55
56
57
58
59

60
61
62
63
64
65


66
67
68
69
70
71


72

73
74
75
76
77
78
79
80
81


82
83
84
85
86

87
88
89






90

91
92
93
94
95




96
97




98
99
100
101
102

103
104
105

106
107
108
109
110
111



112
113
114







115
116
117
118
119
120
121










122







123
124
125
126
127
128

129

130
131


132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163

164
165
166
167
168
169
170
171
172

173
174
175


176
177
178
179


180
181
182
183
184


185
186
187
188
189

190
191







192



193





















194









195






196
197
198
199
200
201
202
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2023 Nathan Coulter
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl n "8.6" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
.SH NAME
Tcl \- Tool Command Language
.SH SYNOPSIS
Summary of Tcl language syntax.
.BE
.SH DESCRIPTION
.PP
The following rules define the syntax and semantics of the Tcl language:
.
.IP "[1] \fBScript.\fR"
A script is composed of zero or more commands delimited by semi-colons or
newlines.



.IP "[2] \fBCommand.\fR"
A command is composed of zero or more words delimited by whitespace.  The

replacement for a substitution is included verbatim in the word. For example, a
space in the replacement is included in the word rather than becoming a
delimiter, and \fI\\\\\fR becomes a single backslash in the word.  Each word is
processed from left to right and each substitution is performed as soon as it
is complete.

For example, the command
.RS
.PP
.CS
set y [set x 0][incr x][incr x]

.CE
.PP
is composed of three words, and sets the value of \fIy\fR to \fI012\fR.
.PP
If hash
.PQ #
is the first character of what would otherwise be the first word of a command,
all characters up to the next newline are ignored.
.RE
.
.IP "[3] \fBBraced word.\fR"

If a word is enclosed in braces
.PQ {
and
.PQ } ""
, the braces are removed and the enclosed characters become the word.  No
substitutions are performed.  Nested pairs of braces may occur within the word.
A brace preceded by an odd number of backslashes is not considered part of a
pair, and neither brace nor the backslashes are removed from the word.
.
.IP "[4] \fBQuoted word.\fR"
If a word is enclosed in double quotes
.PQ \N'34'
, the double quotes are removed and the enclosed characters become the word.

Substitutions are performed.
.
.IP "[5] \fBList.\fR"
A list has the form of a single command.  Newline is whitespace, and semicolon
has no special interpretation.  There is no script evaluation so there is no
argument expansion, variable substitution, or command substitution: Dollar-sign


and open bracket have no special interpretation, and what would be argument
expansion in a script is invalid in a list.
.
.IP "[6] \fBArgument expansion.\fR"
If
.QW {*}


prefixes a word, it is removed.  After any remaining enclosing braces or quotes

are processed and applicable substitutions performed, the word, which must
be a list, is removed from the command, and in its place each word in the
list becomes an additional word in the command.  For example,
.CS
cmd a {*}{b [c]} d {*}{$e f {g h}}
.CE
is equivalent to
.CS
cmd a b {[c]} d {$e} f {g h} .


.CE
.
.IP "[7] \fBEvaluation.\fR"
To evaluate a script, an interpreter evaluates each successive command.  The
first word identifies a procedure, and the remaining words are passed to that

procedure for further evaluation.  The procedure interprets each argument in
its own way, e.g. as an integer, variable name, list, mathematical expression,
script, or in some other arbitrary way.  The result of the last command is the






result of the script.

.
.IP "[8] \fBCommand substitution.\fR"
Each pair of brackets
.PQ [
and




.PQ ] ""
encloses a script and is replaced by the result of that script.




.IP "[9] \fBVariable substitution.\fR"
Each of the following forms begins with dollar sign
.PQ $
and is replaced by the value of the identified variable.  \fIname\fR names the
variable and is composed of ASCII letters (\fBA\fR\(en\fBZ\fR and

\fBa\fR\(en\fBz\fR), digits (\fB0\fR\(en\fB9\fR), underscores, or namespace
delimiters (two or more colons).  \fIindex\fR is the name of an individual
variable within an array variable, and may be empty.

.RS
.TP 15
\fB$\fIname\fR
.
\fIname\fR may not be empty.




.TP 15
\fB$\fIname\fB(\fIindex\fB)\fR
.







\fIname\fR may be empty.  Substitutions are performed on \fIindex\fR.
.TP 15
\fB${\fIname\fB}\fR
\fIname\fR may be empty.
.TP 15
\fB${\fIname(index)\fB}\fR
.










\fIname\fR may be empty. No substitutions are performed.







.RE
Variables that are not accessible through one of the forms above may be
accessed through other mechanisms, e.g. the \fBset\fR command.
.IP "[10] \fBBackslash substitution.\fR"
Each backslash
.PQ \e

that is not part of one of the forms listed below is removed, and the next

character is included in the word verbatim, which allows the inclusion of
characters that would normally be interpreted, namely whitespace, braces,


brackets, double quote, dollar sign, and backslash.  The following sequences
are replaced as described:
.RS
.RS
.RS
.TP 7
\e\fBa\fR
Audible alert (bell) (U+7).
.TP 7
\e\fBb\fR
Backspace (U+8).
.TP 7
\e\fBf\fR
Form feed (U+C).
.TP 7
\e\fBn\fR
Newline (U+A).
.TP 7
\e\fBr\fR
Carriage-return (U+D).
.TP 7
\e\fBt\fR
Tab (U+9).
.TP 7
\e\fBv\fR
Vertical tab (U+B).
.TP 7
\e\fB<newline>\fIwhiteSpace\fR
.
Newline preceded by an odd number of backslashes, along with the consecutive
spaces and tabs that immediately follow it, is replaced by a single space.
Because this happens before the command is split into words, it occurs even

within braced words, and if the resulting space may subsequently be treated as
a word delimiter.
.TP 7
\e\e
Backslash
.PQ \e "" .
.TP 7
\e\fIooo\fR
.

Up to three octal digits form an eight-bit value for a Unicode character in the
range \fI0\fR\(en\fI377\fR, i.e. U+0\(enU+FF.  Only the digits that result in a
number in this range are consumed.


.TP 7
\e\fBx\fIhh\fR
.
Up to two hexadecimal digits form an eight-bit value for a Unicode character in


the range \fI0\fR\(en\fIFF\fR.
.TP 7
\e\fBu\fIhhhh\fR
.
Up to four hexadecimal digits form a 16-bit value for a Unicode character in


the range \fI0\fR\(en\fIFFFF\fR.
.TP 7
\e\fBU\fIhhhhhhhh\fR
.
Up to eight hexadecimal digits form a 21-bit value for a Unicode character in

the range \fI0\fR\(en\fI10FFFF\fR.  Only the digits that result in a number in
this range are consumed.







.RE



.RE





















.PP









.RE






.
.SH KEYWORDS
backslash, command, comment, script, substitution, variable
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/TclZlib.3.

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
section \fBGZIP OPTIONS DICTIONARY\fR for details about the contents of this
dictionary.
.AP "unsigned int" initValue in
The initial value for the checksum algorithm.
.AP "unsigned char" *bytes in
An array of bytes to run the checksum algorithm over, or NULL to get the
recommended initial value for the checksum algorithm.
.AP size_t length in
The number of bytes in the array.
.AP int mode in
What mode to operate the stream in. Should be either
\fBTCL_ZLIB_STREAM_DEFLATE\fR for a compressing stream or
\fBTCL_ZLIB_STREAM_INFLATE\fR for a decompressing stream.
.AP Tcl_ZlibStream *zshandlePtr out
A pointer to a variable in which to write the abstract token for the stream
upon successful creation.
.AP Tcl_ZlibStream zshandle in
The abstract token for the stream to operate on.
.AP int flush in
Whether and how to flush the stream after writing the data to it. Must be one
of: \fBTCL_ZLIB_NO_FLUSH\fR if no flushing is to be done, \fBTCL_ZLIB_FLUSH\fR
if the currently compressed data must be made available for access using
\fBTcl_ZlibStreamGet\fR, \fBTCL_ZLIB_FULLFLUSH\fR if the stream must be put
into a state where the decompressor can recover from on corruption, or
\fBTCL_ZLIB_FINALIZE\fR to ensure that the stream is finished and that any
trailer demanded by the format is written.
.AP size_t count in
The maximum number of bytes to get from the stream, or TCL_INDEX_NONE to get
all remaining bytes from the stream's buffers.
.AP Tcl_Obj *compDict in
A byte array value that is the compression dictionary to use with the stream.
Note that this is \fInot a Tcl dictionary\fR, and it is recommended that this
only ever be used with streams that were created with their \fIformat\fR set
to \fBTCL_ZLIB_FORMAT_ZLIB\fR because the other formats have no mechanism to
indicate whether a compression dictionary was present other than to fail on







|


















|
|







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
section \fBGZIP OPTIONS DICTIONARY\fR for details about the contents of this
dictionary.
.AP "unsigned int" initValue in
The initial value for the checksum algorithm.
.AP "unsigned char" *bytes in
An array of bytes to run the checksum algorithm over, or NULL to get the
recommended initial value for the checksum algorithm.
.AP Tcl_Size length in
The number of bytes in the array.
.AP int mode in
What mode to operate the stream in. Should be either
\fBTCL_ZLIB_STREAM_DEFLATE\fR for a compressing stream or
\fBTCL_ZLIB_STREAM_INFLATE\fR for a decompressing stream.
.AP Tcl_ZlibStream *zshandlePtr out
A pointer to a variable in which to write the abstract token for the stream
upon successful creation.
.AP Tcl_ZlibStream zshandle in
The abstract token for the stream to operate on.
.AP int flush in
Whether and how to flush the stream after writing the data to it. Must be one
of: \fBTCL_ZLIB_NO_FLUSH\fR if no flushing is to be done, \fBTCL_ZLIB_FLUSH\fR
if the currently compressed data must be made available for access using
\fBTcl_ZlibStreamGet\fR, \fBTCL_ZLIB_FULLFLUSH\fR if the stream must be put
into a state where the decompressor can recover from on corruption, or
\fBTCL_ZLIB_FINALIZE\fR to ensure that the stream is finished and that any
trailer demanded by the format is written.
.AP Tcl_Size count in
The maximum number of bytes to get from the stream, or -1 to get
all remaining bytes from the stream's buffers.
.AP Tcl_Obj *compDict in
A byte array value that is the compression dictionary to use with the stream.
Note that this is \fInot a Tcl dictionary\fR, and it is recommended that this
only ever be used with streams that were created with their \fIformat\fR set
to \fBTCL_ZLIB_FORMAT_ZLIB\fR because the other formats have no mechanism to
indicate whether a compression dictionary was present other than to fail on
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
\fBTcl_ZlibStreamSetCompressionDictionary\fR is used to control the
compression dictionary used with the stream, a compression dictionary being an
array of bytes (such as might be created with \fBTcl_NewByteArrayObj\fR) that
is used to initialize the compression engine rather than leaving it to create
it on the fly from the data being compressed. Setting a compression dictionary
allows for more efficient compression in the case where the start of the data
is highly regular, but it does require both the compressor and the
decompressor to agreee on the value to use. Compression dictionaries are only
fully supported for zlib-format data; on compression, they must be set before
any data is sent in with \fBTcl_ZlibStreamPut\fR, and on decompression they
should be set when \fBTcl_ZlibStreamGet\fR produces an \fBerror\fR with its
\fB\-errorcode\fR set to
.QW "\fBZLIB NEED_DICT\fI code\fR" ;
the \fIcode\fR will be the Adler-32 checksum (see \fBTcl_ZlibAdler32\fR) of
the compression dictionary sought. (Note that this is only true for







|







184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
\fBTcl_ZlibStreamSetCompressionDictionary\fR is used to control the
compression dictionary used with the stream, a compression dictionary being an
array of bytes (such as might be created with \fBTcl_NewByteArrayObj\fR) that
is used to initialize the compression engine rather than leaving it to create
it on the fly from the data being compressed. Setting a compression dictionary
allows for more efficient compression in the case where the start of the data
is highly regular, but it does require both the compressor and the
decompressor to agree on the value to use. Compression dictionaries are only
fully supported for zlib-format data; on compression, they must be set before
any data is sent in with \fBTcl_ZlibStreamPut\fR, and on decompression they
should be set when \fBTcl_ZlibStreamGet\fR produces an \fBerror\fR with its
\fB\-errorcode\fR set to
.QW "\fBZLIB NEED_DICT\fI code\fR" ;
the \fIcode\fR will be the Adler-32 checksum (see \fBTcl_ZlibAdler32\fR) of
the compression dictionary sought. (Note that this is only true for

Changes to doc/Tcl_Main.3.

25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
.sp
Tcl_Obj *
\fBTcl_GetStartupScript\fR(\fIencodingPtr\fR)
.sp
\fBTcl_SetMainLoop\fR(\fImainLoopProc\fR)
.SH ARGUMENTS
.AS Tcl_MainLoopProc *mainLoopProc
.AP size_t 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







|







25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
.sp
Tcl_Obj *
\fBTcl_GetStartupScript\fR(\fIencodingPtr\fR)
.sp
\fBTcl_SetMainLoop\fR(\fImainLoopProc\fR)
.SH ARGUMENTS
.AS Tcl_MainLoopProc *mainLoopProc
.AP Tcl_Size 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

Changes to doc/Thread.3.

65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
.AP Tcl_ThreadId id in
Id of the thread waited upon.
.AP Tcl_ThreadCreateProc *proc in
This procedure will act as the \fBmain()\fR of the newly created
thread. The specified \fIclientData\fR will be its sole argument.
.AP void *clientData in
Arbitrary information. Passed as sole argument to the \fIproc\fR.
.AP int stackSize in
The size of the stack given to the new thread.
.AP int flags in
Bitmask containing flags allowing the caller to modify behavior of
the new thread.
.AP int *result out
The referred storage is used to place the exit code of the thread
waited upon into it.







|







65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
.AP Tcl_ThreadId id in
Id of the thread waited upon.
.AP Tcl_ThreadCreateProc *proc in
This procedure will act as the \fBmain()\fR of the newly created
thread. The specified \fIclientData\fR will be its sole argument.
.AP void *clientData in
Arbitrary information. Passed as sole argument to the \fIproc\fR.
.AP size_t stackSize in
The size of the stack given to the new thread.
.AP int flags in
Bitmask containing flags allowing the caller to modify behavior of
the new thread.
.AP int *result out
The referred storage is used to place the exit code of the thread
waited upon into it.

Changes to doc/ToUpper.3.

18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
.sp
int
\fBTcl_UniCharToLower\fR(\fIch\fR)
.sp
int
\fBTcl_UniCharToTitle\fR(\fIch\fR)
.sp
int
\fBTcl_UtfToUpper\fR(\fIstr\fR)
.sp
int
\fBTcl_UtfToLower\fR(\fIstr\fR)
.sp
int
\fBTcl_UtfToTitle\fR(\fIstr\fR)
.SH ARGUMENTS
.AS char *str in/out
.AP int ch in
The Unicode character to be converted.
.AP char *str in/out
Pointer to UTF-8 string to be converted in place.







|


|


|







18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
.sp
int
\fBTcl_UniCharToLower\fR(\fIch\fR)
.sp
int
\fBTcl_UniCharToTitle\fR(\fIch\fR)
.sp
Tcl_Size
\fBTcl_UtfToUpper\fR(\fIstr\fR)
.sp
Tcl_Size
\fBTcl_UtfToLower\fR(\fIstr\fR)
.sp
Tcl_Size
\fBTcl_UtfToTitle\fR(\fIstr\fR)
.SH ARGUMENTS
.AS char *str in/out
.AP int ch in
The Unicode character to be converted.
.AP char *str in/out
Pointer to UTF-8 string to be converted in place.

Changes to doc/Translate.3.

17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
char *
\fBTcl_TranslateFileName\fR(\fIinterp\fR, \fIname\fR, \fIbufferPtr\fR)
.SH ARGUMENTS
.AS Tcl_DString *bufferPtr in/out
.AP Tcl_Interp *interp in
Interpreter in which to report an error, if any.
.AP "const char" *name in
File name, which may start with a
.QW ~ .
.AP Tcl_DString *bufferPtr in/out
If needed, this dynamic string is used to store the new file name.
At the time of the call it should be uninitialized or free.  The
caller must eventually call \fBTcl_DStringFree\fR to free up
anything stored here.
.BE
.SH DESCRIPTION







|
<







17
18
19
20
21
22
23
24

25
26
27
28
29
30
31
char *
\fBTcl_TranslateFileName\fR(\fIinterp\fR, \fIname\fR, \fIbufferPtr\fR)
.SH ARGUMENTS
.AS Tcl_DString *bufferPtr in/out
.AP Tcl_Interp *interp in
Interpreter in which to report an error, if any.
.AP "const char" *name in
File name

.AP Tcl_DString *bufferPtr in/out
If needed, this dynamic string is used to store the new file name.
At the time of the call it should be uninitialized or free.  The
caller must eventually call \fBTcl_DStringFree\fR to free up
anything stored here.
.BE
.SH DESCRIPTION

Changes to doc/Utf.3.

11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Tcl_UniChar, Tcl_UniCharToUtf, Tcl_UtfToUniChar, Tcl_UtfToChar16, Tcl_UtfToWChar, Tcl_UniCharToUtfDString, Tcl_UtfToUniCharDString, Tcl_Char16ToUtfDString, Tcl_UtfToWCharDString, Tcl_UtfToChar16DString, Tcl_WCharLen, Tcl_Char16Len, Tcl_UniCharLen, Tcl_UniCharNcmp, Tcl_UniCharNcasecmp, Tcl_UniCharCaseMatch, Tcl_UtfNcmp, Tcl_UtfNcasecmp, Tcl_UtfCharComplete, Tcl_NumUtfChars, Tcl_UtfFindFirst, Tcl_UtfFindLast, Tcl_UtfNext, Tcl_UtfPrev, Tcl_UniCharAtIndex, Tcl_UtfAtIndex, Tcl_UtfBackslash \- routines for manipulating UTF-8 strings
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
typedef ... \fBTcl_UniChar\fR;
.sp
int
\fBTcl_UniCharToUtf\fR(\fIch, buf\fR)
.sp
int
\fBTcl_UtfToUniChar\fR(\fIsrc, chPtr\fR)
.sp
int
\fBTcl_UtfToChar16\fR(\fIsrc, uPtr\fR)
.sp
int
\fBTcl_UtfToWChar\fR(\fIsrc, wPtr\fR)
.sp
char *
\fBTcl_UniCharToUtfDString\fR(\fIuniStr, uniLength, dsPtr\fR)
.sp
char *
\fBTcl_Char16ToUtfDString\fR(\fIuStr, uniLength, dsPtr\fR)







|


|


|


|







11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Tcl_UniChar, Tcl_UniCharToUtf, Tcl_UtfToUniChar, Tcl_UtfToChar16, Tcl_UtfToWChar, Tcl_UniCharToUtfDString, Tcl_UtfToUniCharDString, Tcl_Char16ToUtfDString, Tcl_UtfToWCharDString, Tcl_UtfToChar16DString, Tcl_WCharLen, Tcl_Char16Len, Tcl_UniCharLen, Tcl_UniCharNcmp, Tcl_UniCharNcasecmp, Tcl_UniCharCaseMatch, Tcl_UtfNcmp, Tcl_UtfNcasecmp, Tcl_UtfCharComplete, Tcl_NumUtfChars, Tcl_UtfFindFirst, Tcl_UtfFindLast, Tcl_UtfNext, Tcl_UtfPrev, Tcl_UniCharAtIndex, Tcl_UtfAtIndex, Tcl_UtfBackslash \- routines for manipulating UTF-8 strings
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
typedef ... \fBTcl_UniChar\fR;
.sp
Tcl_Size
\fBTcl_UniCharToUtf\fR(\fIch, buf\fR)
.sp
Tcl_Size
\fBTcl_UtfToUniChar\fR(\fIsrc, chPtr\fR)
.sp
Tcl_Size
\fBTcl_UtfToChar16\fR(\fIsrc, uPtr\fR)
.sp
Tcl_Size
\fBTcl_UtfToWChar\fR(\fIsrc, wPtr\fR)
.sp
char *
\fBTcl_UniCharToUtfDString\fR(\fIuniStr, uniLength, dsPtr\fR)
.sp
char *
\fBTcl_Char16ToUtfDString\fR(\fIuStr, uniLength, dsPtr\fR)
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
.sp
int
\fBTcl_UniCharAtIndex\fR(\fIsrc, index\fR)
.sp
const char *
\fBTcl_UtfAtIndex\fR(\fIsrc, index\fR)
.sp
size_t
\fBTcl_UtfBackslash\fR(\fIsrc, readPtr, dst\fR)
.SH ARGUMENTS
.AS "const Tcl_UniChar" *uniPattern in/out
.AP char *buf out
Buffer in which the UTF-8 representation of the Tcl_UniChar is stored.  At most
4 bytes are stored in the buffer.
.AP int ch in







|







89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
.sp
int
\fBTcl_UniCharAtIndex\fR(\fIsrc, index\fR)
.sp
const char *
\fBTcl_UtfAtIndex\fR(\fIsrc, index\fR)
.sp
Tcl_Size
\fBTcl_UtfBackslash\fR(\fIsrc, readPtr, dst\fR)
.SH ARGUMENTS
.AS "const Tcl_UniChar" *uniPattern in/out
.AP char *buf out
Buffer in which the UTF-8 representation of the Tcl_UniChar is stored.  At most
4 bytes are stored in the buffer.
.AP int ch in
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
A null-terminated wchar_t string.
.AP "const unsigned short" *utf16s in
A null-terminated utf-16 string.
.AP "const unsigned short" *utf16t in
A null-terminated utf-16 string.
.AP "const unsigned short" *utf16Pattern in
A null-terminated utf-16 string.
.AP size_t length in
The length of the UTF-8 string in bytes (not UTF-8 characters).  If
TCL_INDEX_NONE, all bytes up to the first null byte are used.
.AP size_t uniLength in
The length of the Unicode string in characters.
.AP "Tcl_DString" *dsPtr in/out
A pointer to a previously initialized \fBTcl_DString\fR.
.AP "const char" *start in
Pointer to the beginning of a UTF-8 string.
.AP size_t index in
The index of a character (not byte) in the UTF-8 string.
.AP int *readPtr out
If non-NULL, filled with the number of bytes in the backslash sequence,
including the backslash character.
.AP char *dst out
Buffer in which the bytes represented by the backslash sequence are stored.
At most 4 bytes are stored in the buffer.







|

|
|





|







128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
A null-terminated wchar_t string.
.AP "const unsigned short" *utf16s in
A null-terminated utf-16 string.
.AP "const unsigned short" *utf16t in
A null-terminated utf-16 string.
.AP "const unsigned short" *utf16Pattern in
A null-terminated utf-16 string.
.AP Tcl_Size length in
The length of the UTF-8 string in bytes (not UTF-8 characters).  If
negative, all bytes up to the first null byte are used.
.AP Tcl_Size uniLength in
The length of the Unicode string in characters.
.AP "Tcl_DString" *dsPtr in/out
A pointer to a previously initialized \fBTcl_DString\fR.
.AP "const char" *start in
Pointer to the beginning of a UTF-8 string.
.AP Tcl_Size index in
The index of a character (not byte) in the UTF-8 string.
.AP int *readPtr out
If non-NULL, filled with the number of bytes in the backslash sequence,
including the backslash character.
.AP char *dst out
Buffer in which the bytes represented by the backslash sequence are stored.
At most 4 bytes are stored in the buffer.
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
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 TCL_INDEX_NONE, 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







|







250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
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
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
byte \fIsrc[0]\fR nor the byte \fIstart[-1]\fR nor the byte
\fIsrc[-5]\fR.
.PP
\fBTcl_UniCharAtIndex\fR corresponds to a C string array dereference or the
Pascal Ord() function.  It returns the Unicode character represented at the
specified character (not byte) \fIindex\fR in the UTF-8 string
\fIsrc\fR.  The source string must contain at least \fIindex\fR
characters.  If \fIindex\fR is TCL_INDEX_NONE or \fIindex\fR points
to the second half of a surrogate pair, it returns -1.
.PP
\fBTcl_UtfAtIndex\fR returns a pointer to the specified character (not
byte) \fIindex\fR in the UTF-8 string \fIsrc\fR.  The source string must
contain at least \fIindex\fR characters.  This is equivalent to calling
\fBTcl_UtfToUniChar\fR \fIindex\fR times.  If \fIindex\fR is TCL_INDEX_NONE,
the return pointer points to the first character in the source string.
.PP
\fBTcl_UtfBackslash\fR is a utility procedure used by several of the Tcl
commands.  It parses a backslash sequence and stores the properly formed
UTF-8 character represented by the backslash sequence in the output
buffer \fIdst\fR.  At most 4 bytes are stored in the buffer.
\fBTcl_UtfBackslash\fR modifies \fI*readPtr\fR to contain the number







|





|







295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
byte \fIsrc[0]\fR nor the byte \fIstart[-1]\fR nor the byte
\fIsrc[-5]\fR.
.PP
\fBTcl_UniCharAtIndex\fR corresponds to a C string array dereference or the
Pascal Ord() function.  It returns the Unicode character represented at the
specified character (not byte) \fIindex\fR in the UTF-8 string
\fIsrc\fR.  The source string must contain at least \fIindex\fR
characters.  If \fIindex\fR is negative or \fIindex\fR points
to the second half of a surrogate pair, it returns -1.
.PP
\fBTcl_UtfAtIndex\fR returns a pointer to the specified character (not
byte) \fIindex\fR in the UTF-8 string \fIsrc\fR.  The source string must
contain at least \fIindex\fR characters.  This is equivalent to calling
\fBTcl_UtfToUniChar\fR \fIindex\fR times.  If \fIindex\fR is negative,
the return pointer points to the first character in the source string.
.PP
\fBTcl_UtfBackslash\fR is a utility procedure used by several of the Tcl
commands.  It parses a backslash sequence and stores the properly formed
UTF-8 character represented by the backslash sequence in the output
buffer \fIdst\fR.  At most 4 bytes are stored in the buffer.
\fBTcl_UtfBackslash\fR modifies \fI*readPtr\fR to contain the number

Changes to doc/WrongNumArgs.3.

15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
.sp
\fBTcl_WrongNumArgs\fR(\fIinterp, objc, objv, message\fR)
.SH ARGUMENTS
.AS "Tcl_Obj *const" *message
.AP Tcl_Interp interp in
Interpreter in which error will be reported: error message gets stored
in its result value.
.AP size_t objc in
Number of leading arguments from \fIobjv\fR to include in error
message.
.AP "Tcl_Obj *const" objv[] in
Arguments to command that had the wrong number of arguments.
.AP "const char" *message in
Additional error information to print after leading arguments
from \fIobjv\fR.  This typically gives the acceptable syntax







|







15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
.sp
\fBTcl_WrongNumArgs\fR(\fIinterp, objc, objv, message\fR)
.SH ARGUMENTS
.AS "Tcl_Obj *const" *message
.AP Tcl_Interp interp in
Interpreter in which error will be reported: error message gets stored
in its result value.
.AP Tcl_Size objc in
Number of leading arguments from \fIobjv\fR to include in error
message.
.AP "Tcl_Obj *const" objv[] in
Arguments to command that had the wrong number of arguments.
.AP "const char" *message in
Additional error information to print after leading arguments
from \fIobjv\fR.  This typically gives the acceptable syntax

Changes to doc/binary.n.

237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
.PP
which returns a binary string equivalent to:
.PP
.CS
\fB\e254\fR
.CE
.PP
(i.e. \fB\exac\fR) by
truncating the high-bits of the character, and which is probably not
what is desired.
.RE
.IP \fBA\fR 5
This form is the same as \fBa\fR except that spaces are used for
padding instead of nulls.  For example,
.RS







|







237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
.PP
which returns a binary string equivalent to:
.PP
.CS
\fB\e254\fR
.CE
.PP
(i.e. \fB\exAC\fR) by
truncating the high-bits of the character, and which is probably not
what is desired.
.RE
.IP \fBA\fR 5
This form is the same as \fBa\fR except that spaces are used for
padding instead of nulls.  For example,
.RS
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
.CS
\fBbinary format\fR B5B* 11100 111000011010
.CE
.PP
will return a binary string equivalent to:
.PP
.CS
\fB\exe0\exe1\exa0\fR
.CE
.RE
.IP \fBH\fR 5
Stores a string of \fIcount\fR hexadecimal digits in high-to-low
within each byte in the output binary string.  \fIArg\fR must contain a
sequence of characters in the set
.QW 0123456789abcdefABCDEF .







|







295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
.CS
\fBbinary format\fR B5B* 11100 111000011010
.CE
.PP
will return a binary string equivalent to:
.PP
.CS
\fB\exE0\exE1\exA0\fR
.CE
.RE
.IP \fBH\fR 5
Stores a string of \fIcount\fR hexadecimal digits in high-to-low
within each byte in the output binary string.  \fIArg\fR must contain a
sequence of characters in the set
.QW 0123456789abcdefABCDEF .
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
.CS
\fBbinary format\fR H3H*H2 ab DEF 987
.CE
.PP
will return a binary string equivalent to:
.PP
.CS
\fB\exab\ex00\exde\exf0\ex98\fR
.CE
.RE
.IP \fBh\fR 5
This form is the same as \fBH\fR except that the digits are stored in
low-to-high order within each byte. This is seldom required. For example,
.RS
.PP
.CS
\fBbinary format\fR h3h*h2 AB def 987
.CE
.PP
will return a binary string equivalent to:
.PP
.CS
\fB\exba\ex00\exed\ex0f\ex89\fR
.CE
.RE
.IP \fBc\fR 5
Stores one or more 8-bit integer values in the output string.  If no
\fIcount\fR is specified, then \fIarg\fR must consist of an integer
value. If \fIcount\fR is specified, \fIarg\fR must consist of a list
containing at least that many integers. The low-order 8 bits of each integer







|














|







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
.CS
\fBbinary format\fR H3H*H2 ab DEF 987
.CE
.PP
will return a binary string equivalent to:
.PP
.CS
\fB\exAB\ex00\exDE\exF0\ex98\fR
.CE
.RE
.IP \fBh\fR 5
This form is the same as \fBH\fR except that the digits are stored in
low-to-high order within each byte. This is seldom required. For example,
.RS
.PP
.CS
\fBbinary format\fR h3h*h2 AB def 987
.CE
.PP
will return a binary string equivalent to:
.PP
.CS
\fB\exBA\ex00\exED\ex0F\ex89\fR
.CE
.RE
.IP \fBc\fR 5
Stores one or more 8-bit integer values in the output string.  If no
\fIcount\fR is specified, then \fIarg\fR must consist of an integer
value. If \fIcount\fR is specified, \fIarg\fR must consist of a list
containing at least that many integers. The low-order 8 bits of each integer
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
.CS
\fBbinary format\fR c3cc* {3 -3 128 1} 260 {2 5}
.CE
.PP
will return a binary string equivalent to:
.PP
.CS
\fB\ex03\exfd\ex80\ex04\ex02\ex05\fR
.CE
.PP
whereas:
.PP
.CS
\fBbinary format\fR c {2 5}
.CE







|







359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
.CS
\fBbinary format\fR c3cc* {3 -3 128 1} 260 {2 5}
.CE
.PP
will return a binary string equivalent to:
.PP
.CS
\fB\ex03\exFD\ex80\ex04\ex02\ex05\fR
.CE
.PP
whereas:
.PP
.CS
\fBbinary format\fR c {2 5}
.CE
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
.CS
\fBbinary format\fR s3 {3 -3 258 1}
.CE
.PP
will return a binary string equivalent to:
.PP
.CS
\fB\ex03\ex00\exfd\exff\ex02\ex01\fR
.CE
.RE
.IP \fBS\fR 5
This form is the same as \fBs\fR except that it stores one or more
16-bit integers in big-endian byte order in the output string.  For
example,
.RS
.PP
.CS
\fBbinary format\fR S3 {3 -3 258 1}
.CE
.PP
will return a binary string equivalent to:
.PP
.CS
\fB\ex00\ex03\exff\exfd\ex01\ex02\fR
.CE
.RE
.IP \fBt\fR 5
This form (mnemonically \fItiny\fR) is the same as \fBs\fR and \fBS\fR
except that it stores the 16-bit integers in the output string in the
native byte order of the machine where the Tcl script is running.
To determine what the native byte order of the machine is, refer to







|















|







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
.CS
\fBbinary format\fR s3 {3 -3 258 1}
.CE
.PP
will return a binary string equivalent to:
.PP
.CS
\fB\ex03\ex00\exFD\exFF\ex02\ex01\fR
.CE
.RE
.IP \fBS\fR 5
This form is the same as \fBs\fR except that it stores one or more
16-bit integers in big-endian byte order in the output string.  For
example,
.RS
.PP
.CS
\fBbinary format\fR S3 {3 -3 258 1}
.CE
.PP
will return a binary string equivalent to:
.PP
.CS
\fB\ex00\ex03\exFF\exFD\ex01\ex02\fR
.CE
.RE
.IP \fBt\fR 5
This form (mnemonically \fItiny\fR) is the same as \fBs\fR and \fBS\fR
except that it stores the 16-bit integers in the output string in the
native byte order of the machine where the Tcl script is running.
To determine what the native byte order of the machine is, refer to
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
.CS
\fBbinary format\fR i3 {3 -3 65536 1}
.CE
.PP
will return a binary string equivalent to:
.PP
.CS
\fB\ex03\ex00\ex00\ex00\exfd\exff\exff\exff\ex00\ex00\ex01\ex00\fR
.CE
.RE
.IP \fBI\fR 5
This form is the same as \fBi\fR except that it stores one or more one
or more 32-bit integers in big-endian byte order in the output string.
For example,
.RS
.PP
.CS
\fBbinary format\fR I3 {3 -3 65536 1}
.CE
.PP
will return a binary string equivalent to:
.PP
.CS
\fB\ex00\ex00\ex00\ex03\exff\exff\exff\exfd\ex00\ex01\ex00\ex00\fR
.CE
.RE
.IP \fBn\fR 5
This form (mnemonically \fInumber\fR or \fInormal\fR) is the same as
\fBi\fR and \fBI\fR except that it stores the 32-bit integers in the
output string in the native byte order of the machine where the Tcl
script is running.







|















|







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
.CS
\fBbinary format\fR i3 {3 -3 65536 1}
.CE
.PP
will return a binary string equivalent to:
.PP
.CS
\fB\ex03\ex00\ex00\ex00\exFD\exFF\exFF\exFF\ex00\ex00\ex01\ex00\fR
.CE
.RE
.IP \fBI\fR 5
This form is the same as \fBi\fR except that it stores one or more one
or more 32-bit integers in big-endian byte order in the output string.
For example,
.RS
.PP
.CS
\fBbinary format\fR I3 {3 -3 65536 1}
.CE
.PP
will return a binary string equivalent to:
.PP
.CS
\fB\ex00\ex00\ex00\ex03\exFF\exFF\exFF\exFD\ex00\ex01\ex00\ex00\fR
.CE
.RE
.IP \fBn\fR 5
This form (mnemonically \fInumber\fR or \fInormal\fR) is the same as
\fBi\fR and \fBI\fR except that it stores the 32-bit integers in the
output string in the native byte order of the machine where the Tcl
script is running.
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
.CS
\fBbinary format\fR f2 {1.6 3.4}
.CE
.PP
will return a binary string equivalent to:
.PP
.CS
\fB\excd\excc\excc\ex3f\ex9a\ex99\ex59\ex40\fR
.CE
.RE
.IP \fBr\fR 5
This form (mnemonically \fIreal\fR) is the same as \fBf\fR except that
it stores the single-precision floating point numbers in little-endian
order.  This conversion only produces meaningful output when used on
machines which use the IEEE floating point representation (very







|







506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
.CS
\fBbinary format\fR f2 {1.6 3.4}
.CE
.PP
will return a binary string equivalent to:
.PP
.CS
\fB\exCD\exCC\exCC\ex3F\ex9A\ex99\ex59\ex40\fR
.CE
.RE
.IP \fBr\fR 5
This form (mnemonically \fIreal\fR) is the same as \fBf\fR except that
it stores the single-precision floating point numbers in little-endian
order.  This conversion only produces meaningful output when used on
machines which use the IEEE floating point representation (very
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
.CS
\fBbinary format\fR d1 {1.6}
.CE
.PP
will return a binary string equivalent to:
.PP
.CS
\fB\ex9a\ex99\ex99\ex99\ex99\ex99\exf9\ex3f\fR
.CE
.RE
.IP \fBq\fR 5
This form (mnemonically the mirror of \fBd\fR) is the same as \fBd\fR
except that it stores the double-precision floating point numbers in
little-endian order.  This conversion only produces meaningful output
when used on machines which use the IEEE floating point representation







|







532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
.CS
\fBbinary format\fR d1 {1.6}
.CE
.PP
will return a binary string equivalent to:
.PP
.CS
\fB\ex9A\ex99\ex99\ex99\ex99\ex99\exF9\ex3F\fR
.CE
.RE
.IP \fBq\fR 5
This form (mnemonically the mirror of \fBd\fR) is the same as \fBd\fR
except that it stores the double-precision floating point numbers in
little-endian order.  This conversion only produces meaningful output
when used on machines which use the IEEE floating point representation
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
.QW \fB*\fR ,
then all of the remaining hex digits in \fIstring\fR will be
scanned. If \fIcount\fR is omitted, then one hex digit will be
scanned. For example,
.RS
.PP
.CS
\fBbinary scan\fR \ex07\exC6\ex05\ex1f\ex34 H3H* var1 var2
.CE
.PP
will return \fB2\fR with \fB07c\fR stored in \fIvar1\fR and
\fB051f34\fR stored in \fIvar2\fR.
.RE
.IP \fBh\fR 5
This form is the same as \fBH\fR, except the digits are taken in







|







784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
.QW \fB*\fR ,
then all of the remaining hex digits in \fIstring\fR will be
scanned. If \fIcount\fR is omitted, then one hex digit will be
scanned. For example,
.RS
.PP
.CS
\fBbinary scan\fR \ex07\exC6\ex05\ex1F\ex34 H3H* var1 var2
.CE
.PP
will return \fB2\fR with \fB07c\fR stored in \fIvar1\fR and
\fB051f34\fR stored in \fIvar2\fR.
.RE
.IP \fBh\fR 5
This form is the same as \fBH\fR, except the digits are taken in
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
.QW \fB*\fR ,
then all of the remaining bytes in \fIstring\fR will be scanned.  If
\fIcount\fR is omitted, then one 16-bit integer will be scanned.  For
example,
.RS
.PP
.CS
\fBbinary scan\fR \ex05\ex00\ex07\ex00\exf0\exff s2s* var1 var2
.CE
.PP
will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR
stored in \fIvar2\fR.  Note that the integers returned are signed unless
\fBsu\fR is used in place of \fBs\fR.
.RE
.IP \fBS\fR 5
This form is the same as \fBs\fR except that the data is interpreted
as \fIcount\fR 16-bit integers represented in big-endian byte
order.  For example,
.RS
.PP
.CS
\fBbinary scan\fR \ex00\ex05\ex00\ex07\exff\exf0 S2S* var1 var2
.CE
.PP
will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR
stored in \fIvar2\fR.
.RE
.IP \fBt\fR 5
The data is interpreted as \fIcount\fR 16-bit signed integers







|













|







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
.QW \fB*\fR ,
then all of the remaining bytes in \fIstring\fR will be scanned.  If
\fIcount\fR is omitted, then one 16-bit integer will be scanned.  For
example,
.RS
.PP
.CS
\fBbinary scan\fR \ex05\ex00\ex07\ex00\exF0\exFF s2s* var1 var2
.CE
.PP
will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR
stored in \fIvar2\fR.  Note that the integers returned are signed unless
\fBsu\fR is used in place of \fBs\fR.
.RE
.IP \fBS\fR 5
This form is the same as \fBs\fR except that the data is interpreted
as \fIcount\fR 16-bit integers represented in big-endian byte
order.  For example,
.RS
.PP
.CS
\fBbinary scan\fR \ex00\ex05\ex00\ex07\exFF\exF0 S2S* var1 var2
.CE
.PP
will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR
stored in \fIvar2\fR.
.RE
.IP \fBt\fR 5
The data is interpreted as \fIcount\fR 16-bit signed integers
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
.QW \fB*\fR ,
then all of the remaining bytes in \fIstring\fR will be scanned.  If
\fIcount\fR is omitted, then one 32-bit integer will be scanned.  For
example,
.RS
.PP
.CS
set str \ex05\ex00\ex00\ex00\ex07\ex00\ex00\ex00\exf0\exff\exff\exff
\fBbinary scan\fR $str i2i* var1 var2
.CE
.PP
will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR
stored in \fIvar2\fR.  Note that the integers returned are signed unless
\fBiu\fR is used in place of \fBi\fR.
.RE
.IP \fBI\fR 5
This form is the same as \fBI\fR except that the data is interpreted
as \fIcount\fR 32-bit signed integers represented in big-endian byte
order, or as unsigned if \fBu\fR is placed
immediately after the \fBI\fR.  For example,
.RS
.PP
.CS
set str \ex00\ex00\ex00\ex05\ex00\ex00\ex00\ex07\exff\exff\exff\exf0
\fBbinary scan\fR $str I2I* var1 var2
.CE
.PP
will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR
stored in \fIvar2\fR.
.RE
.IP \fBn\fR 5







|















|







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
.QW \fB*\fR ,
then all of the remaining bytes in \fIstring\fR will be scanned.  If
\fIcount\fR is omitted, then one 32-bit integer will be scanned.  For
example,
.RS
.PP
.CS
set str \ex05\ex00\ex00\ex00\ex07\ex00\ex00\ex00\exF0\exFF\exFF\exFF
\fBbinary scan\fR $str i2i* var1 var2
.CE
.PP
will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR
stored in \fIvar2\fR.  Note that the integers returned are signed unless
\fBiu\fR is used in place of \fBi\fR.
.RE
.IP \fBI\fR 5
This form is the same as \fBI\fR except that the data is interpreted
as \fIcount\fR 32-bit signed integers represented in big-endian byte
order, or as unsigned if \fBu\fR is placed
immediately after the \fBI\fR.  For example,
.RS
.PP
.CS
set str \ex00\ex00\ex00\ex05\ex00\ex00\ex00\ex07\exFF\exFF\exFF\exF0
\fBbinary scan\fR $str I2I* var1 var2
.CE
.PP
will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR
stored in \fIvar2\fR.
.RE
.IP \fBn\fR 5
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
.QW \fB*\fR ,
then all of the remaining bytes in \fIstring\fR will be scanned.  If
\fIcount\fR is omitted, then one 64-bit integer will be scanned.  For
example,
.RS
.PP
.CS
set str \ex05\ex00\ex00\ex00\ex07\ex00\ex00\ex00\exf0\exff\exff\exff
\fBbinary scan\fR $str wi* var1 var2
.CE
.PP
will return \fB2\fR with \fB30064771077\fR stored in \fIvar1\fR and
\fB\-16\fR stored in \fIvar2\fR.
.RE
.IP \fBW\fR 5
This form is the same as \fBw\fR except that the data is interpreted
as \fIcount\fR 64-bit signed integers represented in big-endian byte
order, or as unsigned if \fBu\fR is placed
immediately after the \fBW\fR.  For example,
.RS
.PP
.CS
set str \ex00\ex00\ex00\ex05\ex00\ex00\ex00\ex07\exff\exff\exff\exf0
\fBbinary scan\fR $str WI* var1 var2
.CE
.PP
will return \fB2\fR with \fB21474836487\fR stored in \fIvar1\fR and \fB\-16\fR
stored in \fIvar2\fR.
.RE
.IP \fBm\fR 5







|














|







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
.QW \fB*\fR ,
then all of the remaining bytes in \fIstring\fR will be scanned.  If
\fIcount\fR is omitted, then one 64-bit integer will be scanned.  For
example,
.RS
.PP
.CS
set str \ex05\ex00\ex00\ex00\ex07\ex00\ex00\ex00\exF0\exFF\exFF\exFF
\fBbinary scan\fR $str wi* var1 var2
.CE
.PP
will return \fB2\fR with \fB30064771077\fR stored in \fIvar1\fR and
\fB\-16\fR stored in \fIvar2\fR.
.RE
.IP \fBW\fR 5
This form is the same as \fBw\fR except that the data is interpreted
as \fIcount\fR 64-bit signed integers represented in big-endian byte
order, or as unsigned if \fBu\fR is placed
immediately after the \fBW\fR.  For example,
.RS
.PP
.CS
set str \ex00\ex00\ex00\ex05\ex00\ex00\ex00\ex07\exFF\exFF\exFF\exF0
\fBbinary scan\fR $str WI* var1 var2
.CE
.PP
will return \fB2\fR with \fB21474836487\fR stored in \fIvar1\fR and \fB\-16\fR
stored in \fIvar2\fR.
.RE
.IP \fBm\fR 5
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
bytes that are scanned may vary.  If the data does not represent a
valid floating point number, the resulting value is undefined and
compiler dependent.  For example, on a Windows system running on an
Intel Pentium processor,
.RS
.PP
.CS
\fBbinary scan\fR \ex3f\excc\excc\excd f var1
.CE
.PP
will return \fB1\fR with \fB1.6000000238418579\fR stored in
\fIvar1\fR.
.RE
.IP \fBr\fR 5
This form is the same as \fBf\fR except that the data is interpreted







|







962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
bytes that are scanned may vary.  If the data does not represent a
valid floating point number, the resulting value is undefined and
compiler dependent.  For example, on a Windows system running on an
Intel Pentium processor,
.RS
.PP
.CS
\fBbinary scan\fR \ex3F\exCC\exCC\exCD f var1
.CE
.PP
will return \fB1\fR with \fB1.6000000238418579\fR stored in
\fIvar1\fR.
.RE
.IP \fBr\fR 5
This form is the same as \fBf\fR except that the data is interpreted
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
This form is the same as \fBf\fR except that the data is interpreted
as \fIcount\fR double-precision floating point numbers in the
machine's native representation. For example, on a Windows system
running on an Intel Pentium processor,
.RS
.PP
.CS
\fBbinary scan\fR \ex9a\ex99\ex99\ex99\ex99\ex99\exf9\ex3f d var1
.CE
.PP
will return \fB1\fR with \fB1.6000000000000001\fR
stored in \fIvar1\fR.
.RE
.IP \fBq\fR 5
This form is the same as \fBd\fR except that the data is interpreted







|







986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
This form is the same as \fBf\fR except that the data is interpreted
as \fIcount\fR double-precision floating point numbers in the
machine's native representation. For example, on a Windows system
running on an Intel Pentium processor,
.RS
.PP
.CS
\fBbinary scan\fR \ex9A\ex99\ex99\ex99\ex99\ex99\exF9\ex3F d var1
.CE
.PP
will return \fB1\fR with \fB1.6000000000000001\fR
stored in \fIvar1\fR.
.RE
.IP \fBq\fR 5
This form is the same as \fBd\fR except that the data is interpreted

Changes to doc/cd.n.

24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
\fBcd\fR command changes the working directory for all interpreters
and all threads.
.SH EXAMPLES
.PP
Change to the home directory of the user \fBfred\fR:
.PP
.CS
\fBcd\fR ~fred
.CE
.PP
Change to the directory \fBlib\fR that is a sibling directory of the
current one:
.PP
.CS
\fBcd\fR ../lib







|







24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
\fBcd\fR command changes the working directory for all interpreters
and all threads.
.SH EXAMPLES
.PP
Change to the home directory of the user \fBfred\fR:
.PP
.CS
\fBcd\fR [file home fred]
.CE
.PP
Change to the directory \fBlib\fR that is a sibling directory of the
current one:
.PP
.CS
\fBcd\fR ../lib

Changes to doc/chan.n.

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
.PP
\fBchan close\fR fully flushes any output before closing the write side of a
channel unless it is non-blocking mode, where it returns immediately and the
channel is flushed in the background before finally being closed.
.PP
\fBchan close\fR may return an error if an error occurs while flushing
output.  If a process in a command pipeline created by \fBopen\fR returns an

error, \fBchan close\fR generates an error in the same manner as \fBexec\fR.

.PP
Closing one side of a socket or command pipeline may lead to the shutdown() or
close() of the underlying system resource, leading to a reaction from whatever
is on the other side of the pipeline or socket.
.PP
If the channel for a command pipeline is in blocking mode, \fBchan close\fR
waits for the connected processes to complete.
.PP
\fBchan close\fR only affects the current interpreter.  If the channel is open
in any other interpreter, its state is unchanged there.  See \fBinterp\fR for a
description of channel sharing.
.PP
When the last interpreter sharing a channel is destroyed, the channel is
switched to blocking mode and fully flushed and then closed.











.RE
.TP
\fBchan configure \fIchannelName\fR ?\fIoptionName\fR? ?\fIvalue\fR? ?\fIoptionName value\fR?...
.
Configures or reports the configuration of \fIchannelName\fR.
.RS
.PP







>
|
>














>
>
>
>
>
>
>
>
>
>
>







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
.PP
\fBchan close\fR fully flushes any output before closing the write side of a
channel unless it is non-blocking mode, where it returns immediately and the
channel is flushed in the background before finally being closed.
.PP
\fBchan close\fR may return an error if an error occurs while flushing
output.  If a process in a command pipeline created by \fBopen\fR returns an
error (either by returning a non-zero exit code or writing to its standard
error file descriptor), \fBchan close\fR generates an error in the same
manner as \fBexec\fR.
.PP
Closing one side of a socket or command pipeline may lead to the shutdown() or
close() of the underlying system resource, leading to a reaction from whatever
is on the other side of the pipeline or socket.
.PP
If the channel for a command pipeline is in blocking mode, \fBchan close\fR
waits for the connected processes to complete.
.PP
\fBchan close\fR only affects the current interpreter.  If the channel is open
in any other interpreter, its state is unchanged there.  See \fBinterp\fR for a
description of channel sharing.
.PP
When the last interpreter sharing a channel is destroyed, the channel is
switched to blocking mode and fully flushed and then closed.
.PP
Channels are automatically closed when an interpreter is destroyed and
when the process exits.
From 8.6 on (TIP#398), nonblocking channels are no longer switched to
blocking mode when exiting; this guarantees a timely exit even when the
peer or a communication channel is stalled. To ensure proper flushing of
stalled nonblocking channels on exit, one must now either (a) actively
switch them back to blocking or (b) use the environment variable
\fBTCL_FLUSH_NONBLOCKING_ON_EXIT\fR, which when set and not equal to
.QW \fB0\fR
restores the previous behavior.
.RE
.TP
\fBchan configure \fIchannelName\fR ?\fIoptionName\fR? ?\fIvalue\fR? ?\fIoptionName value\fR?...
.
Configures or reports the configuration of \fIchannelName\fR.
.RS
.PP
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
Sets the encoding of the channel.  \fIname\fR is either one of the names
returned by \fBencoding names\fR, or
.QW \fBbinary\fR
\&. Input is converted from the encoding into Unicode, and output is converted
from Unicode to the encoding.
.RS
.PP
\fBbinary\fR is an alias for \fBiso8859-1\fR: Each byte read from the
channel becomes the Unicode character having the same value as that byte, and
each character written to the channel becomes a single byte in the output,
allowing Tcl to work seamlessly with binary data as long as each "character" in
the data remains in the range of 0 to 255 so that there is no distinction between
binary data and text.  For example, A JPEG image can be read from a
\fBbinary\fR channel, manipulated, and then written back to a \fBbinary\fR
channel.

For working with binary data \fB\-translation binary\fR is usually used
instead, as it sets the encoding to \fBbinary\fR and also disables other
translations on the channel.
.PP
The encoding of a new channel is the value of \fBencoding system\fR,
which returns the platform- and locale-dependent system encoding used to
interface with the operating system,
.RE
.TP
\fB\-eofchar\fR \fIchar\fR
.
\fIchar\fR signals the end of the data when it is encountered in the input.
If \fIchar\fR is the empty string, there is no special character that marks
the end of the data.

The default value is the empty string.  The acceptable range is \ex01 -
\ex7f.  A value outside this range results in an error.










.TP
\fB\-translation\fR \fItranslation\fR
.TP
\fB\-translation\fR \fB{\fIinTranslation outTranslation\fB}\fR
.
In Tcl a single line feed (\en) represents the end of a line.  However,
at the destination the end of a line may be represented differently on







|
<
<
<
<
<
<
<
<
|
<
<













|
>
>
>
>
>
>
>
>
>
>







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
Sets the encoding of the channel.  \fIname\fR is either one of the names
returned by \fBencoding names\fR, or
.QW \fBbinary\fR
\&. Input is converted from the encoding into Unicode, and output is converted
from Unicode to the encoding.
.RS
.PP
\fBbinary\fR is an alias for \fBiso8859-1\fR.  This alone is not sufficient for








working with binary data.  Use \fB\-translation binary\fR instead.


.PP
The encoding of a new channel is the value of \fBencoding system\fR,
which returns the platform- and locale-dependent system encoding used to
interface with the operating system,
.RE
.TP
\fB\-eofchar\fR \fIchar\fR
.
\fIchar\fR signals the end of the data when it is encountered in the input.
If \fIchar\fR is the empty string, there is no special character that marks
the end of the data.

The default value is the empty string.  The acceptable range is \ex01 -
\ex7F.  A value outside this range results in an error.
.VS "TCL8.7 TIP656"
.TP
\fB\-profile\fR \fIprofile\fR
.
Specifies the encoding profile to be used on the channel. The encoding
transforms in use for the channel's input and output will then be subject to the
rules of that profile. Any failures will result in a channel error. See
\fBPROFILES\fR in the \fBencoding(n)\fR documentation for details about encoding
profiles.
.VE "TCL8.7 TIP656"
.TP
\fB\-translation\fR \fItranslation\fR
.TP
\fB\-translation\fR \fB{\fIinTranslation outTranslation\fB}\fR
.
In Tcl a single line feed (\en) represents the end of a line.  However,
at the destination the end of a line may be represented differently on
182
183
184
185
186
187
188
189
190
191
192







193
194
195
196
197
198
199
translated into a line feed.  For output, each line feed is translated into a
platform-specific representation:  For all Unix variants it is \fBlf\fR, and
for all Windows variants it is \fBcrlf\fR, except that for sockets on all
platforms it is \fBcrlf\fR for both input and output.
.TP
\fBbinary\fR
.
Like \fBlf\fR, no end-of-line translation is performed, but in addition,
\fB\-eofchar\fR is set to the empty string to disable it, and \fB\-encoding\fR
is set to \fBbinary\fR.  With this one setting, a channel is fully configured
for binary input and output.







.TP
\fBcr\fR
.
The end of a line is represented in the external data by a single carriage
return character.  For input, each carriage return is translated to a line
feed, and for output each line feed character is translated to a carriage
return.







|
|
|
|
>
>
>
>
>
>
>







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
translated into a line feed.  For output, each line feed is translated into a
platform-specific representation:  For all Unix variants it is \fBlf\fR, and
for all Windows variants it is \fBcrlf\fR, except that for sockets on all
platforms it is \fBcrlf\fR for both input and output.
.TP
\fBbinary\fR
.
Like \fBlf\fR, no end-of-line translation is performed, but in addition, sets
\fB\-eofchar\fR to the empty string to disable it, sets \fB\-encoding\fR to
\fBiso8859-1\fR, and sets \fB-profile\fR to \fBstrict\fR so the the channel is
fully configured for binary input and output:  Each byte read from the channel
becomes the Unicode character having the same value as that byte, and each
character written to the channel becomes a single byte in the output.  This
makes it possible to work seamlessly with binary data as long as each character
in the data remains in the range of 0 to 255 so that there is no distinction
between binary data and text.  For example, A JPEG image can be read from a
such a channel, manipulated, and then written back to such a channel.

.TP
\fBcr\fR
.
The end of a line is represented in the external data by a single carriage
return character.  For input, each carriage return is translated to a line
feed, and for output each line feed character is translated to a carriage
return.
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
translations occur during either input or output.  This translation is
typically used on UNIX platforms,
.RE
.RE
.TP
\fBchan copy \fIinputChan outputChan\fR ?\fB\-size \fIsize\fR? ?\fB\-command \fIcallback\fR?
.
Copies data from \fIinputChan\fR to \fIoutputChan\fR, leveraging internal


buffers to avoid extra copies and to avoid buffering too much data in main
memory when copying large files to slow destinations like network sockets.
.RS
.PP
If \fB\-size\fR is given, the size is in bytes if the two channels have the
same encoding and in characters otherwise, and only that amount is copied.
Otherwise, all data until the end of the file is copied.

\fBchan copy\fR blocks until the copy is complete and returns the number of
bytes or characters written to \fIoutputChan\fR.
.PP
If \fB\-command\fR is given, \fBchan copy\fR returns immediately, the copy is
carried out in the background, and then \fIcallback\fR is called with the
number of bytes written to \fIoutputChan\fR as its first argument, and the
error message for any error that occurred as its second argument.
\fIinputChan\fR and \fIoutputChan\fR are automatically configured for
non-blocking mode if needed.  Background copying only works correctly if the
event loop is active, e.g. via \fBvwait\fR or Tk.
.PP
During a background copy no other read or write operation may be performed on

\fIinputChan\fR or \fIoutputChan\fR.  If either \fIinputChan\fR or



\fIoutputChan\fR is closed while the copy is in progress copying ceases and
\fBno\fR callback is made.  If \fIinputChan\fR is closed all data already queued



































is written to \fIoutputChan\fR.









.PP
The should be no event handler established for \fIinputChan\fR  because it may
become readable during a background copy.  An attempt to read or write

from within an event handler results result in the error,  "channel busy".
.PP

Due to end-of-line translation the number of bytes read from \fIinputChan\fR
may be different than the number of bytes written to \fIoutputChan\fR.  Only

the number of bytes written to \fIoutputChan\fR is reported.

















.PP













\fBChan copy\fR reads the data according to the \fB\-encoding\fR,
\fB\-translation\fR, and \fB\-eofchar\fR of the source and writes to the
destination according to the configuration for that channel.  If the encoding
and translation of both channels is \fBbinary\fR and the \fB\-eofchar\fR of
both channels is the empty string, an identical copy is made.  If only the
encoding of the destination is \fBbinary\fR, Tcl's internal modified UTF-8
representation of the characters read from the source is written to the
destination. If only the encoding of the source is \fBbinary\fR, each byte read
becomes one Unicode character in the range of 0 to 255, and that character is
subject to the encoding and translation of the destination as it is written.



.RE
.TP
\fBchan create \fImode cmdPrefix\fR
.
Creates a new channel, called a \fBreflected\fR channel, with \fIcmdPrefix\fR
as its handler, and returns the name of the channel.  \fBcmdPrefix\fR is the
first words of a command that provides the interface for a \fBrefchan\fR.
.RS
.PP
\fBImode\fR is a list of one or more of the strings
.QW \fBread\fR
or
.QW \fBwrite\fR
, indicating whether the channel is a read channel, a write channel, or both.
It is an error if the handler does not support the chosen mode.
.PP
The handler is called as needed from the global namespace at the top level, and
command resolution happens there at the time of the call.  If the handler is
renamed or deleted any subsequent attempt to call it is an error, which may
not be able to describe the failure.
.PP







|
>
>
|
|


<
<
<
|
<
<

|
|
|
|
|
|
|

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

<
<
>
|

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

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












|
|







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
translations occur during either input or output.  This translation is
typically used on UNIX platforms,
.RE
.RE
.TP
\fBchan copy \fIinputChan outputChan\fR ?\fB\-size \fIsize\fR? ?\fB\-command \fIcallback\fR?
.
Reads characters from \fIinputChan\fR and writes them to \fIoutputChan\fR until
all characters are copied, blocking until the copy is complete and returning
the number of characters copied.  Leverages internal buffers to avoid extra
copies and to avoid buffering too much data in main memory when copying large
files to slow destinations like network sockets.
.RS
.PP



\fB\-size\fR limits the number of characters copied.


.PP
If \fB\-command\fR is given, \fBchan copy\fR returns immediately, works in the
background, and calls \fIcallback\fR when the copy completes, providing as an
additional argument the number of characters written to \fIoutputChan\fR.  If
an error occurs during the background copy, another argument provides message
for the error.  \fIinputChan\fR and \fIoutputChan\fR are automatically
configured for non-blocking mode if needed.  Background copying only works
correctly if events are being processed, e.g. via \fBvwait\fR or Tk.
.PP
During a background copy no other read operation may be performed on
\fIinputChan\fR, and no write operation may be performed on
\fIoutputChan\fR.  However, write operations may by performed on
\fIinputChan\fR and read operations may be performed on \fIoutputChan\fR, as
exhibited by the bidirectional copy example below.
.PP
If either \fIinputChan\fR or \fIoutputChan\fR is closed while the copy is in
progress, copying ceases and \fBno\fR callback is made.  If \fIinputChan\fR is
closed all data already queued is written to \fIoutputChan\fR.
.PP
There should be no event handler established for \fIinputChan\fR  because it
may become readable during a background copy.  An attempt to read or write from
within an event handler results result in the error,  "channel busy".  Any
wrong-sided I/O attempted (by a \fBfileevent\fR handler or otherwise) results
in a
.QW "channel busy"
error.
.PP
.PP
.IP \fBEXAMPLES\fR
.PP
The first example transfers the contents of one channel exactly to
another. Note that when copying one file to another, it is better to
use \fBfile copy\fR which also copies file metadata (e.g. the file
access permissions) where possible.
.PP
.CS
fconfigure $in -translation binary
fconfigure $out -translation binary
\fBfcopy\fR $in $out
.CE
.PP
This second example shows how the callback gets
passed the number of bytes transferred.
It also uses vwait to put the application into the event loop.
Of course, this simplified example could be done without the command
callback.
.PP
.CS
proc Cleanup {in out bytes {error {}}} {
    global total
    set total $bytes
    close $in
    close $out
    if {[string length $error] != 0} {
        # error occurred during the copy
    }
}
set in [open $file1]
set out [socket $server $port]
\fBfcopy\fR $in $out -command [list Cleanup $in $out]
vwait total
.CE
.PP


The third example copies in chunks and tests for end of file
in the command callback.
.PP
.CS
proc CopyMore {in out chunk bytes {error {}}} {

    global total done
    incr total $bytes
    if {([string length $error] != 0) || [eof $in]} {
        set done $total
        close $in
        close $out
    } else {
        \fBfcopy\fR $in $out -size $chunk \e
            -command [list CopyMore $in $out $chunk]
    }
}
set in [open $file1]
set out [socket $server $port]
set chunk 1024
set total 0
\fBfcopy\fR $in $out -size $chunk \e
    -command [list CopyMore $in $out $chunk]
vwait done
.CE
.PP
The fourth example starts an asynchronous, bidirectional fcopy between
two sockets. Those could also be pipes from two [open "|hal 9000" r+]
(though their conversation would remain secret to the script, since
all four fileevent slots are busy).
.PP
.CS
set flows 2
proc Done {dir args} {
     global flows done
     puts "$dir is over."
     incr flows -1
     if {$flows<=0} {set done 1}
}
\fBfcopy\fR $sok1 $sok2 -command [list Done UP]









\fBfcopy\fR $sok2 $sok1 -command [list Done DOWN]
vwait done
.CE
.RE
.TP
\fBchan create \fImode cmdPrefix\fR
.
Creates a new channel, called a \fBreflected\fR channel, with \fIcmdPrefix\fR
as its handler, and returns the name of the channel.  \fBcmdPrefix\fR is the
first words of a command that provides the interface for a \fBrefchan\fR.
.RS
.PP
\fBImode\fR is a list of one or more of the strings
.QW \fBread\fR
or
.QW \fBwrite\fR ,
indicating whether the channel is a read channel, a write channel, or both.
It is an error if the handler does not support the chosen mode.
.PP
The handler is called as needed from the global namespace at the top level, and
command resolution happens there at the time of the call.  If the handler is
renamed or deleted any subsequent attempt to call it is an error, which may
not be able to describe the failure.
.PP

Changes to doc/close.n.

8
9
10
11
12
13
14
15
16
17
18
19

20
21
22
23
24
25
26
.TH close n 7.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
close \- Close an open channel
.SH SYNOPSIS
\fBclose \fIchannelId\fR ?r(ead)|w(rite)?
.BE
.SH DESCRIPTION
.PP
Closes or half-closes the channel given by \fIchannelId\fR.

.PP
\fIChannelId\fR must be an identifier for an open channel such as a
Tcl standard channel (\fBstdin\fR, \fBstdout\fR, or \fBstderr\fR),
the return value from an invocation of \fBopen\fR or \fBsocket\fR, or
the result of a channel creation command provided by a Tcl extension.
.PP
The single-argument form is a simple







|



|
>







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
.TH close n 7.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
close \- Close an open channel
.SH SYNOPSIS
\fBclose \fIchannelId\fR ?\fBr\fR(\fBead\fR)|\fBw\fR(\fBrite\fR)?
.BE
.SH DESCRIPTION
.PP
Closes or half-closes the channel given by \fIchannelId\fR. \fBchan close\fR
is another name for this command.
.PP
\fIChannelId\fR must be an identifier for an open channel such as a
Tcl standard channel (\fBstdin\fR, \fBstdout\fR, or \fBstderr\fR),
the return value from an invocation of \fBopen\fR or \fBsocket\fR, or
the result of a channel creation command provided by a Tcl extension.
.PP
The single-argument form is a simple
45
46
47
48
49
50
51
52







53
54
55
56

57
58
59
60
61
62
63
64
channel.
When the last interpreter in which the channel is registered invokes
\fBclose\fR, the cleanup actions described above occur. See the
\fBinterp\fR command for a description of channel sharing.
.PP
Channels are automatically closed when an interpreter is destroyed and
when the process exits.
From 8.6 on (TIP#398), nonblocking channels are no longer switched to blocking mode when exiting; this guarantees a timely exit even when the peer or a communication channel is stalled. To ensure proper flushing of stalled nonblocking channels on exit, one must now either (a) actively switch them back to blocking or (b) use the environment variable TCL_FLUSH_NONBLOCKING_ON_EXIT,  which when set and not equal to "0" restores the previous behavior.







.PP
The command returns an empty string, and may generate an error if
an error occurs while flushing output.  If a command in a command
pipeline created with \fBopen\fR returns an error, \fBclose\fR

generates an error (similar to the \fBexec\fR command.)
.PP
The two-argument form is a
.QW "half-close" :
given a bidirectional channel like a
socket or command pipeline and a (possibly abbreviated) direction, it closes
only the sub-stream going in that direction. This means a shutdown() on a
socket, and a close() of one end of a pipe for a command pipeline. Then, the







|
>
>
>
>
>
>
>



|
>
|







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
channel.
When the last interpreter in which the channel is registered invokes
\fBclose\fR, the cleanup actions described above occur. See the
\fBinterp\fR command for a description of channel sharing.
.PP
Channels are automatically closed when an interpreter is destroyed and
when the process exits.
From 8.6 on (TIP#398), nonblocking channels are no longer switched to
blocking mode when exiting; this guarantees a timely exit even when the
peer or a communication channel is stalled. To ensure proper flushing of
stalled nonblocking channels on exit, one must now either (a) actively
switch them back to blocking or (b) use the environment variable
\fBTCL_FLUSH_NONBLOCKING_ON_EXIT\fR, which when set and not equal to
.QW \fB0\fR
restores the previous behavior.
.PP
The command returns an empty string, and may generate an error if
an error occurs while flushing output.  If a command in a command
pipeline created with \fBopen\fR returns an error (either by returning a
non-zero exit code or writing to its standard error file descriptor),
\fBclose\fR generates an error (similar to the \fBexec\fR command.)
.PP
The two-argument form is a
.QW "half-close" :
given a bidirectional channel like a
socket or command pipeline and a (possibly abbreviated) direction, it closes
only the sub-stream going in that direction. This means a shutdown() on a
socket, and a close() of one end of a pipe for a command pipeline. Then, the
91
92
93
94
95
96
97
98
99
100
101
102
103
104
        uplevel 1 $script
    } result options
    \fBclose\fR $chan
    return -options $options $result
}
.CE
.SH "SEE ALSO"
file(n), open(n), socket(n), eof(n), Tcl_StandardChannels(3)
.SH KEYWORDS
blocking, channel, close, nonblocking, half-close
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:







|






100
101
102
103
104
105
106
107
108
109
110
111
112
113
        uplevel 1 $script
    } result options
    \fBclose\fR $chan
    return -options $options $result
}
.CE
.SH "SEE ALSO"
chan(n), file(n), open(n), socket(n), eof(n), Tcl_StandardChannels(3)
.SH KEYWORDS
blocking, channel, close, nonblocking, half-close
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Added doc/configurable.n.



























































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
'\"
'\" Copyright © 2019 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH configurable n 0.4 TclOO "TclOO Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
oo::configurable, configure, property \- class that makes configurable classes and objects, and supports making configurable properties
.SH SYNOPSIS
.nf
package require TclOO

\fBoo::configurable create \fIclass\fR ?\fIdefinitionScript\fR?

\fBoo::define \fIclass\fB {\fR
    \fBproperty \fIpropName\fR ?\fIoptions...\fR? ?\fIpropName\fR ?\fIoptions...\fR?...?
\fB}\fR

\fBoo::objdefine \fIobject\fB {\fR
    \fBproperty \fIpropName\fR ?\fIoptions...\fR? ?\fIpropName\fR ?\fIoptions...\fR?...?
\fB}\fR

\fIobjectName \fBconfigure\fR
\fIobjectName \fBconfigure\fR \fI\-prop\fR
\fIobjectName \fBconfigure\fR \fI\-prop value\fR ?\fI\-prop value\fR...
.fi
.SH "CLASS HIERARCHY"
.nf
\fBoo::object\fR
   \(-> \fBoo::class\fR
       \(-> \fBoo::configurable\fR

\fBoo::object\fR
   \(-> \fBoo::class\fR
       \(-> \fBoo::configurablesupport::configurable\fR
.fi
.BE
.SH DESCRIPTION
.PP
Configurable objects are objects that support being configured with a
\fBconfigure\fR method. Each of the configurable entities of the object is
known as a property of the object. Properties may be defined on classes or
instances; when configuring an object, any of the properties defined by its
classes (direct or indirect) or by the instance itself may be configured.
.PP
The \fBoo::configurable\fR metaclass installs basic support for making
configurable objects into a class. This consists of making a \fBproperty\fR
definition command available in definition scripts for the class and instances
(e.g., from the class's constructor, within \fBoo::define\fR and within
\fBoo::objdefine\fR) and making a \fBconfigure\fR method available within the
instances.
.SS "CONFIGURE METHOD"
.PP
The behavior of the \fBconfigure\fR method is modelled after the
\fBfconfigure\fR/\fBchan configure\fR command.
.PP
If passed no additional arguments, the \fBconfigure\fR method returns an
alphabetically sorted dictionary of all \fIreadable\fR and \fIread-write\fR
properties and their current values.
.PP
If passed a single additional argument, that argument to the \fBconfigure\fR
method must be the name of a property to read (or an unambiguous prefix
thereof); its value is returned.
.PP
Otherwise, if passed an even number of arguments then each pair of arguments
specifies a property name (or an unambiguous prefix thereof) and the value to
set it to. The properties will be set in the order specified, including
duplicates. If the setting of any property fails, the overall \fBconfigure\fR
method fails, the preceding pairs (if any) will continue to have been applied,
and the succeeding pairs (if any) will be not applied. On success, the result
of the \fBconfigure\fR method in this mode operation will be an empty string.
.SS "PROPERTY DEFINITIONS"
.PP
When a class has been manufactured by the \fBoo::configurable\fR metaclass (or
one of its subclasses), it gains an extra definition, \fBproperty\fR. The
\fBproperty\fR definition defines one or more properties that will be exposed
by the class's instances.
.PP
The \fBproperty\fR command takes the name of a property to define first,
\fIwithout a leading hyphen\fR, followed by a number of option-value pairs
that modify the basic behavior of the property. This can then be followed by
an arbitrary number of other property definitions. The supported options are:
.TP
\fB\-get \fIgetterScript\fR
.
This defines the implementation of how to read from the property; the
\fIgetterScript\fR will become the body of a method (taking no arguments)
defined on the class, if the kind of the property is such that the property
can be read from. The method will be named
\fB<ReadProp-\fIpropertyName\fB>\fR, and will default to being a simple read
of the instance variable with the same name as the property (e.g.,
.QW "\fBproperty\fR xyz"
will result in a method
.QW <ReadProp-xyz>
being created).
.TP
\fB\-kind \fIpropertyKind\fR
.
This defines what sort of property is being created. The \fIpropertyKind\fR
must be exactly one of \fBreadable\fR, \fBwritable\fR, or \fBreadwrite\fR
(which is the default) which will make the property read-only, write-only or
read-write, respectively.  Read-only properties can only ever be read from,
write-only properties can only ever be written to, and read-write properties
can be both read and written.
.RS
.PP
Note that write-only properties are not particularly discoverable as they are
never reported by the \fBconfigure\fR method other than by error messages when
attempting to write to a property that does not exist.
.RE
.TP
\fB\-set \fIsetterScript\fR
.
This defines the implementation of how to write to the property; the
\fIsetterScript\fR will become the body of a method taking a single argument,
\fIvalue\fR, defined on the class, if the kind of the property is such that
the property can be written to. The method will be named
\fB<WriteProp-\fIpropertyName\fB>\fR, and will default to being a simple write
of the instance variable with the same name as the property (e.g.,
.QW "\fBproperty\fR xyz"
will result in a method
.QW <WriteProp-xyz>
being created).
.PP
Instances of the class that was created by \fBoo::configurable\fR will also
support \fBproperty\fR definitions; the semantics will be exactly as above
except that the properties will be defined on the instance alone.
.PP
Note that the property implementation methods that \fBproperty\fR defines
should not be private, as this makes them inaccessible from the implementation
of \fBconfigure\fR (by design; the property configuration mechanism is
intended for use mainly from outside a class, whereas a class may access
variables directly). The variables accessed by the default implementations of
the properties \fImay\fR be private, if so declared.
.SH "ADVANCED USAGE"
.PP
The configurable class system is comprised of several pieces. The
\fBoo::configurable\fR metaclass works by mixing in a class and setting
definition namespaces during object creation that provide the other bits and
pieces of machinery. The key pieces of the implementation are enumerated here
so that they can be used by other code:
.TP
\fBoo::configuresupport::configurable\fR
.
This is a class that provides the implementation of the \fBconfigure\fR method
(described above in \fBCONFIGURE METHOD\fR).
.TP
\fBoo::configuresupport::configurableclass\fR
.
This is a namespace that contains the definition dialect that provides the
\fBproperty\fR declaration for use in classes (i.e., via \fBoo::define\fR, and
class constructors under normal circumstances), as described above in
\fBPROPERTY DEFINITIONS\fR. It \fBnamespace export\fRs its \fBproperty\fR
command so that it may be used easily in user definition dialects.
.TP
\fBoo::configuresupport::configurableobject\fR
.
This is a namespace that contains the definition dialect that provides the
\fBproperty\fR declaration for use in instance objects (i.e., via
\fBoo::objdefine\fR, and the \fBself\fR declaration in \fBoo::define\fR), as
described above in \fBPROPERTY DEFINITIONS\fR. It \fBnamespace export\fRs its
\fBproperty\fR command so that it may be used easily in user definition
dialects.
.PP
The underlying property discovery mechanism relies on four slots (see
\fBoo::define\fR for what that implies) that list the properties that can be
configured. These slots do not themselves impose any semantics on what the
slots mean other than that they have unique names, no important order, can be
inherited and discovered on classes and instances.
.PP
These slots, and their intended semantics, are:
.TP
\fBoo::configuresupport::readableproperties\fR
.
The set of properties of a class (not including those from its superclasses)
that may be read from when configuring an instance of the class. This slot can
also be read with the \fBinfo class properties\fR command.
.TP
\fBoo::configuresupport::writableproperties\fR
.
The set of properties of a class (not including those from its superclasses)
that may be written to when configuring an instance of the class. This slot
can also be read with the \fBinfo class properties\fR command.
.TP
\fBoo::configuresupport::objreadableproperties\fR
.
The set of properties of an object instance (not including those from its
classes) that may be read from when configuring the object. This slot can
also be read with the \fBinfo object properties\fR command.
.TP
\fBoo::configuresupport::objwritableproperties\fR
.
The set of properties of an object instance (not including those from its
classes) that may be written to when configuring the object. This slot can
also be read with the \fBinfo object properties\fR command.
.PP
Note that though these are slots, they are \fInot\fR in the standard
\fBoo::define\fR or \fBoo::objdefine\fR namespaces; in order to use them
inside a definition script, they need to be referred to by full name. This is
because they are intended to be building bricks of configurable property
system, and not directly used by normal user code.
.SS "IMPLEMENTATION NOTE"
.PP
The implementation of the \fBconfigure\fR method uses
\fBinfo object properties\fR with the \fB\-all\fR option to discover what
properties it may manipulate.
.SH EXAMPLES
.PP
Here we create a simple configurable class and demonstrate how it can be
configured:
.PP
.CS
\fBoo::configurable\fR create Point {
    \fBproperty\fR x y
    constructor args {
        my \fBconfigure\fR -x 0 -y 0 {*}$args
    }
    variable x y
    method print {} {
        puts "x=$x, y=$y"
    }
}

set pt [Point new -x 27]
$pt print;   \fI# x=27, y=0\fR
$pt \fBconfigure\fR -y 42
$pt print;   \fI# x=27, y=42\fR
puts "distance from origin: [expr {
    hypot([$pt \fBconfigure\fR -x], [$pt \fBconfigure\fR -y])
}]";         \fI# distance from origin: 49.92995093127971\fR
puts [$pt \fBconfigure\fR]
             \fI# -x 27 -y 42\fR
.CE
.PP
Such a configurable class can be extended by subclassing, though the subclass
needs to also be created by \fBoo::configurable\fR if it will use the
\fBproperty\fR definition:
.PP
.CS
\fBoo::configurable\fR create Point3D {
    superclass Point
    \fBproperty\fR z
    constructor args {
        next -z 0 {*}$args
    }
}

set pt2 [Point3D new -x 2 -y 3 -z 4]
puts [$pt2 \fBconfigure\fR]
             \fI# -x 2 -y 3 -z 4\fR
.CE
.PP
Once you have a configurable class, you can also add instance properties to
it. (The backing variables for all properties start unset.) Note below that we
are using an unambiguous prefix of a property name when setting it; this is
supported for all properties though full names are normally recommended
because subclasses will not make an unambiguous prefix become ambiguous in
that case.
.PP
.CS
oo::objdefine $pt {
    \fBproperty\fR color
}
$pt \fBconfigure\fR -c bisque
puts [$pt \fBconfigure\fR]
             \fI# -color bisque -x 27 -y 42\fR
.CE
.PP
You can also do derived properties by making them read-only and supplying a
script that computes them.
.PP
.CS
\fBoo::configurable\fR create PointMk2 {
    \fBproperty\fR x y
    \fBproperty\fR distance -kind readable -get {
        return [expr {hypot($x, $y)}]
    }
    variable x y
    constructor args {
        my \fBconfigure\fR -x 0 -y 0 {*}$args
    }
}

set pt3 [PointMk2 new -x 3 -y 4]
puts [$pt3 \fBconfigure\fR -distance]
             \fI# 5.0\fR
$pt3 \fBconfigure\fR -distance 10
             \fI# ERROR: bad property "-distance": must be -x or -y\fR
.CE
.PP
Setters are used to validate the type of a property:
.PP
.CS
\fBoo::configurable\fR create PointMk3 {
    \fBproperty\fR x -set {
        if {![string is double -strict $value]} {
            error "-x property must be a number"
        }
        set x $value
    }
    \fBproperty\fR y -set {
        if {![string is double -strict $value]} {
            error "-y property must be a number"
        }
        set y $value
    }
    variable x y
    constructor args {
        my \fBconfigure\fR -x 0 -y 0 {*}$args
    }
}

set pt4 [PointMk3 new]
puts [$pt4 \fBconfigure\fR]
             \fI# -x 0 -y 0\fR
$pt4 \fBconfigure\fR -x 3 -y 4
puts [$pt4 \fBconfigure\fR]
             \fI# -x 3 -y 4\fR
$pt4 \fBconfigure\fR -x "obviously not a number"
             \fI# ERROR: -x property must be a number\fR
.CE
.SH "SEE ALSO"
info(n), oo::class(n), oo::define(n)
.SH KEYWORDS
class, object, properties, configuration
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:

Changes to doc/cookiejar.n.

174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
The simplest way of using a cookie jar is to just permanently configure it at
the start of the application.
.PP
.CS
package require http
\fBpackage require cookiejar\fR

set cookiedb ~/.tclcookies.db
http::configure -cookiejar [\fBhttp::cookiejar new\fR $cookiedb]

# No further explicit steps are required to use cookies
set tok [http::geturl http://core.tcl-lang.org/]
.CE
.PP
To only allow a particular domain to use cookies, perhaps because you only







|







174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
The simplest way of using a cookie jar is to just permanently configure it at
the start of the application.
.PP
.CS
package require http
\fBpackage require cookiejar\fR

set cookiedb [file join [file home] cookiejar]
http::configure -cookiejar [\fBhttp::cookiejar new\fR $cookiedb]

# No further explicit steps are required to use cookies
set tok [http::geturl http://core.tcl-lang.org/]
.CE
.PP
To only allow a particular domain to use cookies, perhaps because you only
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
    superclass \fBhttp::cookiejar\fR

    method \fBpolicyAllow\fR {operation domain path} {
        return [expr {$domain eq "my.example.com"}]
    }
}

set cookiedb ~/.tclcookies.db
http::configure -cookiejar [MyCookieJar new $cookiedb]

# No further explicit steps are required to use cookies
set tok [http::geturl http://core.tcl-lang.org/]
.CE
.SH "SEE ALSO"
http(n), oo::class(n), sqlite3(n)
.SH KEYWORDS
cookie, internet, security policy, www
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:







|













197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
    superclass \fBhttp::cookiejar\fR

    method \fBpolicyAllow\fR {operation domain path} {
        return [expr {$domain eq "my.example.com"}]
    }
}

set cookiedb [file join [file home] cookiejar]
http::configure -cookiejar [MyCookieJar new $cookiedb]

# No further explicit steps are required to use cookies
set tok [http::geturl http://core.tcl-lang.org/]
.CE
.SH "SEE ALSO"
http(n), oo::class(n), sqlite3(n)
.SH KEYWORDS
cookie, internet, security policy, www
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/define.n.

488
489
490
491
492
493
494






495
496
497
498
499
500
501
of values (class names, variable names, etc.) that comprises the contents of
the slot. The class defines five operations (as methods) that may be done on
the slot:
.TP
\fIslot\fR \fB\-append\fR ?\fImember ...\fR?
.
This appends the given \fImember\fR elements to the slot definition.






.TP
\fIslot\fR \fB\-clear\fR
.
This sets the slot definition to the empty list.
.TP
\fIslot\fR \fB\-prepend\fR ?\fImember ...\fR?
.VS TIP516







>
>
>
>
>
>







488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
of values (class names, variable names, etc.) that comprises the contents of
the slot. The class defines five operations (as methods) that may be done on
the slot:
.TP
\fIslot\fR \fB\-append\fR ?\fImember ...\fR?
.
This appends the given \fImember\fR elements to the slot definition.
.TP
\fIslot\fR \fB\-appendifnew\fR ?\fImember ...\fR?
.VS TIP558
This appends the given \fImember\fR elements to the slot definition if they
do not already exist.
.VE TIP558
.TP
\fIslot\fR \fB\-clear\fR
.
This sets the slot definition to the empty list.
.TP
\fIslot\fR \fB\-prepend\fR ?\fImember ...\fR?
.VS TIP516

Changes to doc/encoding.n.

1
2

3
4
5
6
7
8
9
10
11
12
13
14
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
'\"
'\" 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
.SH NAME
encoding \- Manipulate encodings
.SH SYNOPSIS
\fBencoding \fIoption\fR ?\fIarg arg ...\fR?
.BE
.SH INTRODUCTION
.PP
Strings in Tcl are logically a sequence of Unicode characters.





These strings are represented in memory as a sequence of bytes that
may be in one of several encodings: modified UTF\-8 (which uses 1 to 4

bytes per character), or a custom encoding start as 8 bit binary data.




.PP
Different operating system interfaces or applications may generate
strings in other encodings such as Shift\-JIS.  The \fBencoding\fR


command helps to bridge the gap between Unicode and these other


formats.





.SH DESCRIPTION
.PP
Performs one of several encoding related operations, depending on
\fIoption\fR.  The legal \fIoption\fRs are:
.TP
\fBencoding convertfrom\fR ?\fB-nocomplain\fR? ?\fB-failindex var\fR? ?\fB-strict\fR? ?\fIencoding\fR? \fIdata\fR


.
Convert \fIdata\fR to a Unicode string from the specified \fIencoding\fR.  The
characters in \fIdata\fR are 8 bit binary data.  The resulting
sequence of bytes is a string created by applying the given \fIencoding\fR
to the data. If \fIencoding\fR is not specified, the current
system encoding is used.

.VS "TCL8.7 TIP346, TIP607, TIP601"
.PP
.RS
If the option \fB-nocomplain\fR is given, the command does not fail on
encoding errors.  Instead, any not convertable bytes (like incomplete UTF-8
 sequences, see example below) are put as byte values into the output stream.
If the option \fB-nocomplain\fR is not given, the command will fail with an
appropriate error message.
.PP

If the option \fB-failindex\fR with a variable name is given, the error reporting
is changed in the following manner:
in case of a conversion error, the position of the input byte causing the error
is returned in the given variable.  The return value of the command are the
converted characters until the first error position. No error condition is raised.
In case of no error, the value \fI-1\fR is written to the variable.  This option
may not be used together with \fB-nocomplain\fR.
.PP
The \fB-strict\fR option followes more strict rules in conversion.  Currently, only
the sequence \fB\\xC0\\x80\fR in \fButf-8\fR encoding is disallowed.  Additional rules
may follow.
.VE "TCL8.7 TIP346, TIP607, TIP601"
.RE

.TP
\fBencoding convertto\fR ?\fB-nocomplain\fR? ?\fB-failindex var\fR? ?\fB-strict\fR? ?\fIencoding\fR? \fIstring\fR
.
Convert \fIstring\fR from Unicode to the specified \fIencoding\fR.
The result is a sequence of bytes that represents the converted
string.  Each byte is stored in the lower 8-bits of a Unicode
character (indeed, the resulting string is a binary string as far as
Tcl is concerned, at least initially).  If \fIencoding\fR is not
specified, the current system encoding is used.

.VS "TCL8.7 TIP346, TIP607, TIP601"
.PP
.RS
If the option \fB-nocomplain\fR is given, the command does not fail on
encoding errors.  Instead, the replacement character \fB?\fR is output
for any not representable character (like the dot \fB\\U2022\fR
in \fBiso-8859-1\fR encoding, see example below).
If the option \fB-nocomplain\fR is not given, the command will fail with an
appropriate error message.
.PP
If the option \fB-failindex\fR with a variable name is given, the error reporting
is changed in the following manner:
in case of a conversion error, the position of the input character causing the error
is returned in the given variable.  The return value of the command are the
converted bytes until the first error position. No error condition is raised.
In case of no error, the value \fI-1\fR is written to the variable.  This option
may not be used together with \fB-nocomplain\fR.
.PP
The \fB-strict\fR option followes more strict rules in conversion.  Currently, it has
no effect but may be used in future to add additional encoding checks.
.VE "TCL8.7 TIP346, TIP607, TIP601"
.RE
.TP
\fBencoding dirs\fR ?\fIdirectoryList\fR?
.
Tcl can load encoding data files from the file system that describe
additional encodings for it to work with. This command sets the search
path for \fB*.enc\fR encoding data files to the list of directories
\fIdirectoryList\fR. If \fIdirectoryList\fR is omitted then the
command returns the current list of directories that make up the
search path. It is an error for \fIdirectoryList\fR to not be a valid
list. If, when a search for an encoding data file is happening, an
element in \fIdirectoryList\fR does not refer to a readable,
searchable directory, that element is ignored.
.TP
\fBencoding names\fR
.
Returns a list containing the names of all of the encodings that are
currently available.
The encodings
.QW utf-8
and
.QW iso8859-1
are guaranteed to be present in the list.

.TP





\fBencoding system\fR ?\fIencoding\fR?
.
Set the system encoding to \fIencoding\fR. If \fIencoding\fR is
omitted then the command returns the current system encoding.  The
system encoding is used whenever Tcl passes strings to system calls.







































.SH EXAMPLE
.PP









Example 1: convert a byte sequence in Japanese euc-jp encoding to a TCL string:
.PP
.CS
set s [\fBencoding convertfrom\fR euc-jp "\exA4\exCF"]

.CE
.PP
The result is the unicode codepoint:
.QW "\eu306F" ,
which is the Hiragana letter HA.
.VS "TCL8.7 TIP346, TIP607, TIP601"
.PP
Example 2: detect the error location in an incomplete UTF-8 sequence:
.PP



.CS
% set s [\fBencoding convertfrom\fR -failindex i utf-8 "A\exC3"]
A
% set i
1




.CE
.PP
Example 3: return the incomplete UTF-8 sequence by raw bytes:
.PP
.CS
% set s [\fBencoding convertfrom\fR -nocomplain utf-8 "A\exC3"]



.CE
The result is "A" followed by the byte \exC3.
.PP
Example 4: detect the error location while transforming to ISO8859-1
(ISO-Latin 1):
.PP
.CS
% set s [\fBencoding convertto\fR -failindex i utf-8 "A\eu0141"]




A
% set i
1
.CE
.PP
Example 5: replace a not representable character by the replacement character:
.PP
.CS
% set s [\fBencoding convertto\fR -nocomplain utf-8 "A\eu0141"]
A?
.CE
.VE "TCL8.7 TIP346, TIP607, TIP601"
.PP
.SH "SEE ALSO"
Tcl_GetEncoding(3), fconfigure(n)
.SH KEYWORDS
encoding, unicode
.\" Local Variables:
.\" mode: nroff


>








|

|



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

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


|
<

|
>
>

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

|

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



<
<
|
|
|
|
<
<
|



|
<





>

>
>
>
>
>


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

>
>
>
>
>
>
>
>
>
|


|
>


|


|

|

>
>
>

|
<
<
|
>
>
>
>


|


|
>
>
>

<

|
<


|
>
>
>
>

|


<
<
<
<
<
<
<
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
'\"
'\" Copyright (c) 1998 Scriptics Corporation.
'\" Copyright (c) 2023 Nathan Coulter
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH encoding n "8.1" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
.SH NAME
encoding \- Work with encodings
.SH SYNOPSIS
\fBencoding \fIoperation\fR ?\fIarg arg ...\fR?
.BE
.SH INTRODUCTION
.PP
In Tcl every string is composed of Unicode values.  Text may be encoded into an
encoding such as cp1252, iso8859-1, Shitf\-JIS, utf-8, utf-16, etc. Not every
Unicode vealue is encodable in every encoding, and some encodings can encode
values that are not available in Unicode.
.PP
Even though Unicode is for encoding the written texts of human languages, any
sequence of bytes can be encoded as the first 255 Unicode values.  iso8859-1 an
encoding for a subset of Unicode in which each byte is a Unicode value of 255
or less.  Thus, any sequence of bytes can be considered to be a Unicode string
encoded in iso8859-1.  To work with binary data in Tcl, decode it from
iso8859-1 when reading it in, and encode it into iso8859-1 when writing it out,
ensuring that each character in the string has a value of 255 or less.
Decoding such a string does nothing, and encoding encoding such a string also
does nothing.
.PP


For example, the following is true:
.CS
set text {In Tcl binary data is treated as Unicode text and it just works.}
set encoded [encoding convertto iso8859-1 $text]
expr {$text eq $encoded}; #-> 1
.CE
The following is also true:
.CS
set decoded [encoding convertfrom iso8859-1 $text]
expr {$text eq $decoded}; #-> 1
.CE
.SH DESCRIPTION
.PP
Performs one of the following encoding \fIoperations\fR:

.TP
\fBencoding convertfrom\fR ?\fIencoding\fR? \fIdata\fR
.TP
\fBencoding convertfrom\fR ?\fB-profile \fIprofile\fR? ?\fB-failindex var\fR? \fIencoding\fR \fIdata\fR
.



Decodes \fIdata\fR encoded in \fIencoding\fR. If \fIencoding\fR is not
specified the current system encoding is used.

.VS "TCL8.7 TIP607, TIP656"



\fB-profile\fR determines how invalid data for the encoding are handled.  See




the \fBPROFILES\fR section below for details.  Returns an error if decoding
fails.  However, if \fB-failindex\fR given, returns the result of the

conversion up to the point of termination, and stores in \fBvar\fR the index of

the character that could not be converted. If no errors are encountered the
entire result of the conversion is returned and the value \fB-1\fR is stored in
\fBvar\fR.




.VE "TCL8.7 TIP607, TIP656"
.TP
\fBencoding convertto\fR ?\fIencoding\fR? \fIdata\fR
.TP
\fBencoding convertto\fR ?\fB-profile \fIprofile\fR? ?\fB-failindex var\fR? \fIencoding\fR \fIdata\fR
.




Converts \fIstring\fR to \fIencoding\fR.  If \fIencoding\fR is not given, the
current system encoding is used.

.VS "TCL8.7 TIP607, TIP656"



See \fBencoding convertfrom\fR for the meaning of \fB-profile\fR and \fB-failindex\fR.















.VE "TCL8.7 TIP607, TIP656"

.TP
\fBencoding dirs\fR ?\fIdirectoryList\fR?
.


Sets the search path for \fB*.enc\fR encoding data files to the list of
directories given by \fIdirectoryList\fR.  If \fIdirectoryList\fR is not given,
returns the current list of directories that make up the search path.  It is
not an error for an item in \fIdirectoryList\fR to not refer to a readable,


searchable directory.
.TP
\fBencoding names\fR
.
Returns a list of the names of available encodings.

The encodings
.QW utf-8
and
.QW iso8859-1
are guaranteed to be present in the list.
.VS "TCL8.7 TIP656"
.TP
\fBencoding profiles\fR
Returns a list of names of available encoding profiles. See \fBPROFILES\fR
below.
.VE "TCL8.7 TIP656"
.TP
\fBencoding system\fR ?\fIencoding\fR?
.
Sets the system encoding to \fIencoding\fR. If \fIencoding\fR is not given,
returns the current system encoding.  The system encoding is used to pass
strings to system calls.
.\" Do not put .VS on whole section as that messes up the bullet list alignment
.SH PROFILES
.PP
.VS "TCL8.7 TIP656"
Each \fIprofile\fR is a distinct strategy for dealing with invalid data for an
encoding.
.PP
The following profiles are currently implemented.
.VS "TCL8.7 TIP656"
.TP
\fBtcl8\fR
.
The default profile.  Provides for behaviour identical to that of Tcl 8.6: When
decoding, for encodings \fBother than utf-8\fR, each invalid byte is interpreted
as the Unicode value given by that one byte. For example, the byte 0x80, which
is invalid in the ASCII encoding would be mapped to the Unicode value U+0080.
For \fButf-8\fR, each invalid byte that is a valid CP1252 character is
interpreted as the Unicode value for that character, while each byte that is
not is treated as the Unicode value given by that one byte. For example, byte
0x80 is defined by CP1252 and is therefore mapped to its Unicode equivalent
U+20AC while byte 0x81 which is not defined by CP1252 is mapped to U+0081. As
an additional special case, the sequence 0xC0 0x80 is mapped to U+0000.

When encoding, each character that cannot be represented in the encoding is
replaced by an encoding-dependent character, usually the question mark \fB?\fR.
.TP
\fBstrict\fR
.
The operation fails when invalid data for the encoding are encountered.
.TP
\fBreplace\fR
.
When decoding, invalid bytes are replaced by U+FFFD, the Unicode REPLACEMENT
CHARACTER.

When encoding, Unicode values that cannot be represented in the target encoding
are transformed to an encoding-specific fallback character, U+FFFD REPLACEMENT
CHARACTER for UTF targets, and generally `?` for other encodings.
.VE "TCL8.7 TIP656"
.SH EXAMPLES
.PP
These examples use the utility proc below that prints the Unicode value for
each character in a string.
.PP
.CS
proc codepoints s {join [lmap c [split $s {}] {
    string cat U+ [format %.6X [scan $c %c]]}]
}
.CE
.PP
Example 1: Convert from euc-jp:
.PP
.CS
% codepoints [\fBencoding convertfrom\fR euc-jp \exA4\exCF]
U+00306F
.CE
.PP
The result is the Unicode value
.QW "\eu306F" ,
which is the Hiragana letter HA.
.VS "TCL8.7 TIP607, TIP656"
.PP
Example 2: Error handling based on profiles:
.PP
The letter \fBA\fR is Unicode character U+0041 and the byte "\ex80" is invalid
in ASCII encoding.
.PP
.CS
% codepoints [encoding convertfrom -profile tcl8 ascii A\ex80]


U+000041 U+000080
% codepoints [encoding convertfrom -profile replace ascii A\ex80]
U+000041 U+00FFFD
% codepoints [encoding convertfrom -profile strict ascii A\ex80]
unexpected byte sequence starting at index 1: '\ex80'
.CE
.PP
Example 3: Get partial data and the error location:
.PP
.CS
% codepoints [encoding convertfrom -profile strict -failindex idx ascii AB\ex80]
U+000041 U+000042
% set idx
2
.CE

.PP
Example 4: Encode a character that is not representable in ISO8859-1:

.PP
.CS
% encoding convertto iso8859-1 A\eu0141
A?
% encoding convertto -profile strict iso8859-1 A\eu0141
unexpected character at index 1: 'U+000141'
% encoding convertto -profile strict -failindex idx iso8859-1 A\eu0141
A
% set idx
1
.CE







.VE "TCL8.7 TIP607, TIP656"
.PP
.SH "SEE ALSO"
Tcl_GetEncoding(3), fconfigure(n)
.SH KEYWORDS
encoding, unicode
.\" Local Variables:
.\" mode: nroff

Changes to doc/exec.n.

445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
Many programs on Windows require filename arguments to be passed in with
backslashes as pathname separators. This is done with the help of the
\fBfile nativename\fR command. For example, to make a directory (on NTFS)
encrypted so that only the current user can access it requires use of
the \fICIPHER\fR command, like this:
.PP
.CS
set secureDir "~/Desktop/Secure Directory"
file mkdir $secureDir
\fBexec\fR CIPHER /e /s:[file nativename $secureDir]
.CE
.SH "SEE ALSO"
error(n), file(n), open(n)
.SH KEYWORDS
execute, pipeline, redirection, subprocess







|







445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
Many programs on Windows require filename arguments to be passed in with
backslashes as pathname separators. This is done with the help of the
\fBfile nativename\fR command. For example, to make a directory (on NTFS)
encrypted so that only the current user can access it requires use of
the \fICIPHER\fR command, like this:
.PP
.CS
set secureDir [file join [file home] Desktop/SecureDirectory]
file mkdir $secureDir
\fBexec\fR CIPHER /e /s:[file nativename $secureDir]
.CE
.SH "SEE ALSO"
error(n), file(n), open(n)
.SH KEYWORDS
execute, pipeline, redirection, subprocess

Changes to doc/fconfigure.n.

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
character signals end-of-file when it is encountered during input.
If \fIchar\fR is the empty string, then there is no special end of file
character marker.  The default value for \fB\-eofchar\fR is the empty
string.
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.
.VS "TCL9.0 TIP633"
.TP
\fB\-nocomplainencoding\fR \fIbool\fR
.
Reporting mode of encoding errors.
If set to a \fItrue\fR value, encoding errors are resolved by a replacement
character (output) or verbatim bytes (input). No error is thrown.
If set to a \fIfalse\fR value, errors are thrown in case of encoding errors.
.RS
.PP
The default value is \fIfalse\fR starting from TCL 9.0 and \fItrue\fR on TCL 8.7.
This option was introduced with TCL 8.7 and has the fix value \fItrue\fR.
.PP
See the \fI\-nocomplain\fR option of the \fBencoding\fR command for more information.
.RE
.VE "TCL9.0 TIP633"
.VS "TCL8.7 TIP346"
.TP
\fB\-strictencoding\fR \fIbool\fR
.
Activate additional stricter encoding application rules.
Default value is \fIfalse\fR.
.RS
.PP


See the \fI\-strict\fR option of the \fBencoding\fR command for more information.

.VE "TCL8.7 TIP346"
.RE
.TP
\fB\-translation\fR \fImode\fR
.TP
\fB\-translation\fR \fB{\fIinMode outMode\fB}\fR
.
In Tcl scripts the end of a line is always represented using a single
newline character (\en).  However, in actual files and devices the end of







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|

|

|
<
<
<
>
>
|
>
|
<







108
109
110
111
112
113
114
















115
116
117
118
119



120
121
122
123
124

125
126
127
128
129
130
131
character signals end-of-file when it is encountered during input.
If \fIchar\fR is the empty string, then there is no special end of file
character marker.  The default value for \fB\-eofchar\fR is the empty
string.
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.
















.VS "TCL8.7 TIP656"
.TP
\fB\-profile\fR \fIprofile\fR
.
Specifies the encoding profile to be used on the channel. The encoding



transforms in use for the channel's input and output will then be subject to the
rules of that profile. Any failures will result in a channel error. See
\fBPROFILES\fR in the \fBencoding(n)\fR documentation for details about encoding
profiles.
.VE "TCL8.7 TIP656"

.TP
\fB\-translation\fR \fImode\fR
.TP
\fB\-translation\fR \fB{\fIinMode outMode\fB}\fR
.
In Tcl scripts the end of a line is always represented using a single
newline character (\en).  However, in actual files and devices the end of
295
296
297
298
299
300
301
302
303
304
305
306
close $f
.CE
.SH "SEE ALSO"
close(n), encoding(n), flush(n), gets(n), open(n), puts(n), read(n), socket(n),
Tcl_StandardChannels(3)
.SH KEYWORDS
blocking, buffering, carriage return, end of line, encoding, flushing, linemode,
newline, nonblocking, platform, translation, encoding, filter, byte array,
binary
'\" Local Variables:
'\" mode: nroff
'\" End:







|




278
279
280
281
282
283
284
285
286
287
288
289
close $f
.CE
.SH "SEE ALSO"
close(n), encoding(n), flush(n), gets(n), open(n), puts(n), read(n), socket(n),
Tcl_StandardChannels(3)
.SH KEYWORDS
blocking, buffering, carriage return, end of line, encoding, flushing, linemode,
newline, nonblocking, platform, profile, translation, encoding, filter, byte array,
binary
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to doc/fcopy.n.

8
9
10
11
12
13
14
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
.TH fcopy n 8.0 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
fcopy \- Copy data from one channel to another
.SH SYNOPSIS
\fBfcopy \fIinchan\fR \fIoutchan\fR ?\fB\-size \fIsize\fR? ?\fB\-command \fIcallback\fR?
.BE

.SH DESCRIPTION
.PP
The \fBfcopy\fR command copies data from one I/O channel, \fIinchan\fR to another I/O channel, \fIoutchan\fR.

The \fBfcopy\fR command leverages the buffering in the Tcl I/O system to
avoid extra copies and to avoid buffering too much data in
main memory when copying large files to slow destinations like
network sockets.
.PP
The \fBfcopy\fR
command transfers data from \fIinchan\fR until end of file
or \fIsize\fR bytes or characters have been
transferred; \fIsize\fR is in bytes if the two channels are using the
same encoding, and is in characters otherwise.
If no \fB\-size\fR argument is given,
then the copy goes until end of file.
All the data read from \fIinchan\fR is copied to \fIoutchan\fR.
Without the \fB\-command\fR option, \fBfcopy\fR blocks until the copy is complete
and returns the number of bytes or characters (using the same rules as
for the \fB\-size\fR option) written to \fIoutchan\fR.
.PP
The \fB\-command\fR argument makes \fBfcopy\fR work in the background.
In this case it returns immediately and the \fIcallback\fR is invoked
later when the copy completes.
The \fIcallback\fR is called with
one or two additional
arguments that indicates how many bytes were written to \fIoutchan\fR.
If an error occurred during the background copy, the second argument is the
error string associated with the error.
With a background copy,
it is not necessary to put \fIinchan\fR or \fIoutchan\fR into
non-blocking mode; the \fBfcopy\fR command takes care of that automatically.
However, it is necessary to enter the event loop by using
the \fBvwait\fR command or by using Tk.
.PP
You are not allowed to do other input operations with \fIinchan\fR, or
output operations with \fIoutchan\fR, during a background
\fBfcopy\fR. The converse is entirely legitimate, as exhibited by the



bidirectional fcopy example below.
.PP
If either \fIinchan\fR or \fIoutchan\fR get closed
while the copy is in progress, the current copy is stopped
and the command callback is \fInot\fR made.
If \fIinchan\fR is closed,
then all data already queued for \fIoutchan\fR is written out.
.PP

Note that \fIinchan\fR can become readable during a background copy.
You should turn off any \fBfileevent\fR handlers during a background
copy so those handlers do not interfere with the copy.

Any wrong-sided I/O attempted (by a \fBfileevent\fR handler or otherwise) will get a

.QW "channel busy"
error.
.PP
\fBFcopy\fR translates end-of-line sequences in \fIinchan\fR and \fIoutchan\fR
according to the \fB\-translation\fR option
for these channels.
See the manual entry for \fBfconfigure\fR for details on the
\fB\-translation\fR option.
The translations mean that the number of bytes read from \fIinchan\fR
can be different than the number of bytes written to \fIoutchan\fR.
Only the number of bytes written to \fIoutchan\fR is reported,
either as the return value of a synchronous \fBfcopy\fR or
as the argument to the callback for an asynchronous \fBfcopy\fR.
.PP
\fBFcopy\fR obeys the encodings and character translations configured
for the channels. This
means that the incoming characters are converted internally first
UTF-8 and then into the encoding of the channel \fBfcopy\fR writes
to. See the manual entry for \fBfconfigure\fR for details on the
\fB\-encoding\fR and \fB\-translation\fR options. No conversion is
done if both channels are
set to encoding
.QW binary
and have matching translations. If only the output channel is set to encoding
.QW binary
the system will write the internal UTF-8 representation of the incoming
characters. If only the input channel is set to encoding
.QW binary
the system will assume that the incoming
bytes are valid UTF-8 characters and convert them according to the
output encoding. The behaviour of the system for bytes which are not
valid UTF-8 characters is undefined in this case.
.SH EXAMPLES
.PP
The first example transfers the contents of one channel exactly to
another. Note that when copying one file to another, it is better to
use \fBfile copy\fR which also copies file metadata (e.g. the file
access permissions) where possible.
.PP







|




|
>
|
|
|
<

<
<
<
<
<
|
<
<
<
<
<

|
<
|
<
<
|
|
|
|
<
<
<
|

<
|
<
>
>
>
|

<
|
|
<
|

>
|
<
<
>
|
>


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







8
9
10
11
12
13
14
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
.TH fcopy n 8.0 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
fcopy \- Copy data from one channel to another
.SH SYNOPSIS
\fBfcopy \fIinputChan\fR \fIoutputChan\fR ?\fB\-size \fIsize\fR? ?\fB\-command \fIcallback\fR?
.BE

.SH DESCRIPTION
.PP
Reads characters from \fIinputChan\fR and writes them to \fIoutputChan\fR until
all characters are copied, blocking until the copy is complete and returning
the number of characters copied.  Leverages internal buffers to avoid extra
copies and to avoid buffering too much data in main memory when copying large
files to slow destinations like network sockets.

.PP





\fB\-size\fR limits the number of characters copied.





.PP
\fB\-command\fR makes \fBfcopy\fR return immediately, work in the background,

and call \fIcallback\fR when the copy completes, providing as an additional


argument the number of characters written to \fIoutputChan\fR.  If an error
occurres during the background copy, another argument provides the message for
the error.  \fIinputChan\fR and \fIoutputChan\fR are automatically configured
for non-blocking mode if needed.  Background copying only works correctly if



events are being processed e.g. via \fBvwait\fR or Tk.
.PP

During a background copy no other read operation may be performed on

\fIinputChan\fR, and no other write operation may be performed on
\fIoutputChan\fR.  However, write operations may by performed on
\fIinputChan\fR and read operations may be performed on \fIoutputChan\fR, as
exhibited by the bidirectional copy example below.
.PP

If either \fIinputChan\fR or \fIoutputChan\fR is closed while the copy is in
progress, copying ceases and \fBno\fR callback is made.  If \fIinputChan\fR is

closed all data already queued is written to \fIoutputChan\fR.
.PP
There should be no event handler established for \fIinputChan\fR  because it
may become readable during a background copy.  An attempt to read or write from


within an event handler results result in the error,  "channel busy".  Any
wrong-sided I/O attempted (by a \fBfileevent\fR handler or otherwise) results
in a
.QW "channel busy"
error.






























.SH EXAMPLES
.PP
The first example transfers the contents of one channel exactly to
another. Note that when copying one file to another, it is better to
use \fBfile copy\fR which also copies file metadata (e.g. the file
access permissions) where possible.
.PP
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
    incr total $bytes
    if {([string length $error] != 0) || [eof $in]} {
        set done $total
        close $in
        close $out
    } else {
        \fBfcopy\fR $in $out -size $chunk \e
                -command [list CopyMore $in $out $chunk]
    }
}
set in [open $file1]
set out [socket $server $port]
set chunk 1024
set total 0
\fBfcopy\fR $in $out -size $chunk \e
        -command [list CopyMore $in $out $chunk]
vwait done
.CE
.PP
The fourth example starts an asynchronous, bidirectional fcopy between
two sockets. Those could also be pipes from two [open "|hal 9000" r+]
(though their conversation would remain secret to the script, since
all four fileevent slots are busy).







|







|







94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
    incr total $bytes
    if {([string length $error] != 0) || [eof $in]} {
        set done $total
        close $in
        close $out
    } else {
        \fBfcopy\fR $in $out -size $chunk \e
            -command [list CopyMore $in $out $chunk]
    }
}
set in [open $file1]
set out [socket $server $port]
set chunk 1024
set total 0
\fBfcopy\fR $in $out -size $chunk \e
    -command [list CopyMore $in $out $chunk]
vwait done
.CE
.PP
The fourth example starts an asynchronous, bidirectional fcopy between
two sockets. Those could also be pipes from two [open "|hal 9000" r+]
(though their conversation would remain secret to the script, since
all four fileevent slots are busy).

Changes to doc/file.n.

238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
.QW \fB\-hard\fR .
.PP
On Unix, symbolic links can be made to relative paths, and those paths
must be relative to the actual \fIlinkName\fR's location (not to the
cwd), but on all other platforms where relative links are not supported,
target paths will always be converted to absolute, normalized form
before the link is created (and therefore relative paths are interpreted
as relative to the cwd).  Furthermore,
.QW ~user
paths are always expanded
to absolute form.  When creating links on filesystems that either do not
support any links, or do not support the specific type requested, an
error message will be returned.  Most Unix platforms support both
symbolic and hard links (the latter for files only). Windows
supports symbolic directory links and hard file links on NTFS drives.
.RE
.TP
\fBfile lstat \fIname ?varName?\fR







<
<
<
|







238
239
240
241
242
243
244



245
246
247
248
249
250
251
252
.QW \fB\-hard\fR .
.PP
On Unix, symbolic links can be made to relative paths, and those paths
must be relative to the actual \fIlinkName\fR's location (not to the
cwd), but on all other platforms where relative links are not supported,
target paths will always be converted to absolute, normalized form
before the link is created (and therefore relative paths are interpreted



as relative to the cwd). When creating links on filesystems that either do not
support any links, or do not support the specific type requested, an
error message will be returned.  Most Unix platforms support both
symbolic and hard links (the latter for files only). Windows
supports symbolic directory links and hard file links on NTFS drives.
.RE
.TP
\fBfile lstat \fIname ?varName?\fR
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
On Windows, a file can be
.QW started
easily enough (equivalent to double-clicking on it in the Explorer
interface) but the name passed to the operating system must be in
native format:
.PP
.CS
exec {*}[auto_execok start] {} [\fBfile nativename\fR ~/example.txt]
.CE
.SH "SEE ALSO"
filename(n), open(n), close(n), eof(n), gets(n), tell(n), seek(n),
fblocked(n), flush(n)
.SH KEYWORDS
attributes, copy files, delete files, directory, file, move files, name,
rename files, stat, user
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:







|











564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
On Windows, a file can be
.QW started
easily enough (equivalent to double-clicking on it in the Explorer
interface) but the name passed to the operating system must be in
native format:
.PP
.CS
exec {*}[auto_execok start] {} [\fBfile nativename\fR C:/Users/fred/example.txt]
.CE
.SH "SEE ALSO"
filename(n), open(n), close(n), eof(n), gets(n), tell(n), seek(n),
fblocked(n), flush(n)
.SH KEYWORDS
attributes, copy files, delete files, directory, file, move files, name,
rename files, stat, user
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/glob.n.

68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
named in any \fB\-directory\fR or \fB\-path\fR path specification.
Thus
.QW "\fBglob \-tails \-directory $dir *\fR"
is equivalent to
.QW "\fBset pwd [pwd]; cd $dir; glob *; cd $pwd\fR" .
For \fB\-path\fR specifications, the returned names will include the last
path segment, so
.QW "\fBglob \-tails \-path [file rootname ~/foo.tex] .*\fR"
will return paths like \fBfoo.aux foo.bib foo.tex\fR etc.
.TP
\fB\-types\fR \fItypeList\fR
.
Only list files or directories which match \fItypeList\fR, where the items
in the list have two forms. The first form is like the \-type option of
the Unix find command:







|







68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
named in any \fB\-directory\fR or \fB\-path\fR path specification.
Thus
.QW "\fBglob \-tails \-directory $dir *\fR"
is equivalent to
.QW "\fBset pwd [pwd]; cd $dir; glob *; cd $pwd\fR" .
For \fB\-path\fR specifications, the returned names will include the last
path segment, so
.QW "\fBglob \-tails \-path [file rootname /home/fred/foo.tex] .*\fR"
will return paths like \fBfoo.aux foo.bib foo.tex\fR etc.
.TP
\fB\-types\fR \fItypeList\fR
.
Only list files or directories which match \fItypeList\fR, where the items
in the list have two forms. The first form is like the \-type option of
the Unix find command:
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
and
.QW .. \|
which must be matched explicitly (this is to avoid a recursive pattern like
.QW "glob \-join * * * *"
from recursing up the directory hierarchy as well as down). In addition, all
.QW /
characters must be matched explicitly.
.LP
If the first character in a \fIpattern\fR is
.QW ~
then it refers to the home directory for the user whose name follows the
.QW ~ .
If the
.QW ~
is followed immediately by
.QW /
then the value of the HOME environment variable is used.
.PP
The \fBglob\fR command differs from csh globbing in two ways.
First, it does not sort its result list (use the \fBlsort\fR
command if you want the list sorted).
Second, \fBglob\fR only returns the names of files that actually
exist; in csh no check for existence is made unless a pattern
contains a ?, *, or [] construct.
.SH "WINDOWS PORTABILITY ISSUES"
.PP
For Windows UNC names, the servername and sharename components of the path
may not contain ?, *, or [] constructs. On Windows NT, if \fIpattern\fR is
of the form
.QW \fB~\fIusername\fB@\fIdomain\fR ,
it refers to the home
directory of the user whose account information resides on the specified NT
domain server. Otherwise, user account information is obtained from
the local computer.
.PP
Since the backslash character has a special meaning to the glob
command, glob patterns containing Windows style path separators need
special care. The pattern
.QW \fIC:\e\efoo\e\e*\fR
is interpreted as
.QW \fIC:\efoo\e*\fR







<
<
<
<
<
<
<
<
<
<










|
<
<
<
<
<
<







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
and
.QW .. \|
which must be matched explicitly (this is to avoid a recursive pattern like
.QW "glob \-join * * * *"
from recursing up the directory hierarchy as well as down). In addition, all
.QW /
characters must be matched explicitly.










.PP
The \fBglob\fR command differs from csh globbing in two ways.
First, it does not sort its result list (use the \fBlsort\fR
command if you want the list sorted).
Second, \fBglob\fR only returns the names of files that actually
exist; in csh no check for existence is made unless a pattern
contains a ?, *, or [] construct.
.SH "WINDOWS PORTABILITY ISSUES"
.PP
For Windows UNC names, the servername and sharename components of the path
may not contain ?, *, or [] constructs.






.PP
Since the backslash character has a special meaning to the glob
command, glob patterns containing Windows style path separators need
special care. The pattern
.QW \fIC:\e\efoo\e\e*\fR
is interpreted as
.QW \fIC:\efoo\e*\fR
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
\fBglob\fR *.tcl
.CE
.PP
Find all the Tcl files in the user's home directory, irrespective of
what the current directory is:
.PP
.CS
\fBglob\fR \-directory ~ *.tcl
.CE
.PP
Find all subdirectories of the current directory:
.PP
.CS
\fBglob\fR \-type d *
.CE







|







209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
\fBglob\fR *.tcl
.CE
.PP
Find all the Tcl files in the user's home directory, irrespective of
what the current directory is:
.PP
.CS
\fBglob\fR \-directory [file home] *.tcl
.CE
.PP
Find all subdirectories of the current directory:
.PP
.CS
\fBglob\fR \-type d *
.CE

Changes to doc/info.n.

168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
.TP
\fBeval\fR\0\0\0\0\0\0\0\0
.
The body of a script provided to \fBeval\fR or \fBuplevel\fR.
.TP
\fBprecompiled\fR\0\0\0\0\0\0\0\0
.
A pre-compiled script (loadable by the package
\fBtbcload\fR), and no further information is available.
.RE
.TP
\fBline\fR
.
The line number of of the command inside its script.  Not available for
\fBprecompiled\fR commands.  When the type is \fBsource\fR, the line number is







|







168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
.TP
\fBeval\fR\0\0\0\0\0\0\0\0
.
The body of a script provided to \fBeval\fR or \fBuplevel\fR.
.TP
\fBprecompiled\fR\0\0\0\0\0\0\0\0
.
A precompiled script (loadable by the package
\fBtbcload\fR), and no further information is available.
.RE
.TP
\fBline\fR
.
The line number of of the command inside its script.  Not available for
\fBprecompiled\fR commands.  When the type is \fBsource\fR, the line number is
485
486
487
488
489
490
491























492
493
494
495
496
497
498
definition\fR, and when the result is \fBforward\fR, further information can
be discovered with \fBinfo class forward\fR.
.TP
\fBinfo class mixins\fI class\fR
.
This subcommand returns a list of all classes that have been mixed into the
class named \fIclass\fR.























.TP
\fBinfo class subclasses\fI class\fR ?\fIpattern\fR?
.
This subcommand returns a list of direct subclasses of class \fIclass\fR. If
the optional \fIpattern\fR argument is present, it constrains the list of
returned classes to those that match it according to the rules of
\fBstring match\fR.







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







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
definition\fR, and when the result is \fBforward\fR, further information can
be discovered with \fBinfo class forward\fR.
.TP
\fBinfo class mixins\fI class\fR
.
This subcommand returns a list of all classes that have been mixed into the
class named \fIclass\fR.
.TP
\fBinfo class properties\fI class\fR ?\fIoptions...\fR
.VS "TIP 558"
This subcommand returns a sorted list of properties defined on the class named
\fIclass\fR. The \fIoptions\fR define exactly which properties are returned:
.RS
.TP
\fB\-all\fR
.
With this option, the properties from the superclasses and mixins of the class
are also returned.
.TP
\fB\-readable\fR
.
This option (the default behavior) asks for the readable properties to be
returned. Only readable or writable properties are returned, not both.
.TP
\fB\-writable\fR
.
This option asks for the writable properties to be returned.  Only readable or
writable properties are returned, not both.
.RE
.VE "TIP 558"
.TP
\fBinfo class subclasses\fI class\fR ?\fIpattern\fR?
.
This subcommand returns a list of direct subclasses of class \fIclass\fR. If
the optional \fIpattern\fR argument is present, it constrains the list of
returned classes to those that match it according to the rules of
\fBstring match\fR.
674
675
676
677
678
679
680
























681
682
683
684
685
686
687
This subcommand returns a list of all classes that have been mixed into the
object named \fIobject\fR.
.TP
\fBinfo object namespace\fI object\fR
.
This subcommand returns the name of the internal namespace of the object named
\fIobject\fR.
























.TP
\fBinfo object variables\fI object\fRR ?\fB\-private\fR?
.
This subcommand returns a list of all variables that have been declared for
the object named \fIobject\fR (i.e. that are automatically present in the
object's methods).
.VS TIP500







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







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
This subcommand returns a list of all classes that have been mixed into the
object named \fIobject\fR.
.TP
\fBinfo object namespace\fI object\fR
.
This subcommand returns the name of the internal namespace of the object named
\fIobject\fR.
.TP
\fBinfo object properties\fI object\fR ?\fIoptions...\fR
.VS "TIP 558"
This subcommand returns a sorted list of properties defined on the object
named \fIobject\fR. The \fIoptions\fR define exactly which properties are
returned:
.RS
.TP
\fB\-all\fR
.
With this option, the properties from the class, superclasses and mixins of
the object are also returned.
.TP
\fB\-readable\fR
.
This option (the default behavior) asks for the readable properties to be
returned. Only readable or writable properties are returned, not both.
.TP
\fB\-writable\fR
.
This option asks for the writable properties to be returned. Only readable or
writable properties are returned, not both.
.RE
.VE "TIP 558"
.TP
\fBinfo object variables\fI object\fRR ?\fB\-private\fR?
.
This subcommand returns a list of all variables that have been declared for
the object named \fIobject\fR (i.e. that are automatically present in the
object's methods).
.VS TIP500

Changes to doc/ledit.n.

20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
with the \fIvalue\fR arguments. The resulting list is then stored back in
\fIlistVar\fR and returned as the result of the command.
.PP
Arguments \fIfirst\fR and \fIlast\fR are index values specifying the first and
last elements of the range to replace. They are interpreted
the same as index values for the command \fBstring index\fR,
supporting simple index arithmetic and indices relative to the
end of the list. The index 0 refers to the first element of the
list, and \fBend\fR refers to the last element of the list.
.PP
If either \fIfirst\fR or \fIlast\fR is less than zero, it is considered to
refer to the position before the first element of the list. This allows
elements to be prepended.
.PP
If either \fIfirst\fR or \fIlast\fR indicates a position greater than the







|







20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
with the \fIvalue\fR arguments. The resulting list is then stored back in
\fIlistVar\fR and returned as the result of the command.
.PP
Arguments \fIfirst\fR and \fIlast\fR are index values specifying the first and
last elements of the range to replace. They are interpreted
the same as index values for the command \fBstring index\fR,
supporting simple index arithmetic and indices relative to the
end of the list. The index \fB0\fR refers to the first element of the
list, and \fBend\fR refers to the last element of the list.
.PP
If either \fIfirst\fR or \fIlast\fR is less than zero, it is considered to
refer to the position before the first element of the list. This allows
elements to be prepended.
.PP
If either \fIfirst\fR or \fIlast\fR indicates a position greater than the
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
the list.  If no \fIvalue\fR arguments are specified, then the elements
between \fIfirst\fR and \fIlast\fR are simply deleted.
.SH EXAMPLES
.PP
Prepend to a list.
.PP
.CS
% set lst {c d e f g}
c d e f g
% ledit lst -1 -1 a b
a b c d e f g
.CE
.PP
Append to the list.
.PP
.CS
% ledit lst end+1 end+1 h i
a b c d e f g h i
.CE
.PP
Delete third and fourth elements.
.PP
.CS
% ledit lst 2 3
a b e f g h i
.CE
.PP
Replace two elements with three.
.PP
.CS
% ledit lst 2 3 x y z
a b x y z g h i
% set lst
a b x y z g h i
.CE
.PP
.SH "SEE ALSO"
list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n),
lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n),
lreverse(n), lsearch(n), lseq(n), lset(n), lsort(n),
string(n)
.SH KEYWORDS
element, list, replace
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:







|
|
|
|





|
|





|
|





|
|
|
|













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
the list.  If no \fIvalue\fR arguments are specified, then the elements
between \fIfirst\fR and \fIlast\fR are simply deleted.
.SH EXAMPLES
.PP
Prepend to a list.
.PP
.CS
set lst {c d e f g}
      \fI\(-> c d e f g\fR
\fBledit\fR lst -1 -1 a b
      \fI\(-> a b c d e f g\fR
.CE
.PP
Append to the list.
.PP
.CS
\fBledit\fR lst end+1 end+1 h i
      \fI\(-> a b c d e f g h i\fR
.CE
.PP
Delete third and fourth elements.
.PP
.CS
\fBledit\fR lst 2 3
      \fI\(-> a b e f g h i\fR
.CE
.PP
Replace two elements with three.
.PP
.CS
\fBledit\fR lst 2 3 x y z
      \fI\(-> a b x y z g h i\fR
set lst
      \fI\(-> a b x y z g h i\fR
.CE
.PP
.SH "SEE ALSO"
list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n),
lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n),
lreverse(n), lsearch(n), lseq(n), lset(n), lsort(n),
string(n)
.SH KEYWORDS
element, list, replace
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:

Changes to doc/library.n.

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
and arrange for the other procedures to be loaded on-demand using
the auto-load mechanism defined below.
.SH "COMMAND PROCEDURES"
.PP
The following procedures are provided in the Tcl library:
.TP
\fBauto_execok \fIcmd\fR

Determines whether there is an executable file or shell builtin
by the name \fIcmd\fR.  If so, it returns a list of arguments to be
passed to \fBexec\fR to execute the executable file or shell builtin
named by \fIcmd\fR.  If not, it returns an empty string.  This command
examines the directories in the current search path (given by the PATH
environment variable) in its search for an executable file named
\fIcmd\fR.  On Windows platforms, the search is expanded with the same
directories and file extensions as used by \fBexec\fR. \fBAuto_execok\fR
remembers information about previous searches in an array named
\fBauto_execs\fR;  this avoids the path search in future calls for the
same \fIcmd\fR.  The command \fBauto_reset\fR may be used to force
\fBauto_execok\fR to forget its cached information.





















.TP
\fBauto_import \fIpattern\fR

\fBAuto_import\fR is invoked during \fBnamespace import\fR to see if
the imported commands specified by \fIpattern\fR reside in an
autoloaded library.  If so, the commands are loaded so that they will
be available to the interpreter for creating the import links.  If the
commands do not reside in an autoloaded library, \fBauto_import\fR
does nothing.  The pattern matching is performed according to the
matching rules of \fBnamespace import\fR.




.TP
\fBauto_load \fIcmd\fR

This command attempts to load the definition for a Tcl command named
\fIcmd\fR.  To do this, it searches an \fIauto-load path\fR, which is
a list of one or more directories.  The auto-load path is given by the
global variable \fBauto_path\fR if it exists.  If there is no
\fBauto_path\fR variable, then the TCLLIBPATH environment variable is
used, if it exists.  Otherwise the auto-load path consists of just the
Tcl library directory.  Within each directory in the auto-load path
there must be a file \fBtclIndex\fR that describes one or more
commands defined in that directory and a script to evaluate to load
each of the commands.  The \fBtclIndex\fR file should be generated
with the \fBauto_mkindex\fR command.  If \fIcmd\fR is found in an
index file, then the appropriate script is evaluated to create the
command.  The \fBauto_load\fR command returns 1 if \fIcmd\fR was
successfully created.  The command returns 0 if there was no index
entry for \fIcmd\fR or if the script did not actually define \fIcmd\fR
(e.g. because index information is out of date).  If an error occurs
while processing the script, then that error is returned.
\fBAuto_load\fR only reads the index information once and saves it in
the array \fBauto_index\fR;  future calls to \fBauto_load\fR check for
\fIcmd\fR in the array rather than re-reading the index files.  The
cached index information may be deleted with the command
\fBauto_reset\fR.  This will force the next \fBauto_load\fR command to
reload the index database from disk.





.TP
\fBauto_mkindex \fIdir pattern pattern ...\fR
.
Generates an index suitable for use by \fBauto_load\fR.  The command
searches \fIdir\fR for all files whose names match any of the
\fIpattern\fR arguments (matching is done with the \fBglob\fR
command), generates an index of all the Tcl command procedures defined







>












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


>







>
>
>
>


>




|


















>
>
>
>
>







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
and arrange for the other procedures to be loaded on-demand using
the auto-load mechanism defined below.
.SH "COMMAND PROCEDURES"
.PP
The following procedures are provided in the Tcl library:
.TP
\fBauto_execok \fIcmd\fR
.
Determines whether there is an executable file or shell builtin
by the name \fIcmd\fR.  If so, it returns a list of arguments to be
passed to \fBexec\fR to execute the executable file or shell builtin
named by \fIcmd\fR.  If not, it returns an empty string.  This command
examines the directories in the current search path (given by the PATH
environment variable) in its search for an executable file named
\fIcmd\fR.  On Windows platforms, the search is expanded with the same
directories and file extensions as used by \fBexec\fR. \fBAuto_execok\fR
remembers information about previous searches in an array named
\fBauto_execs\fR;  this avoids the path search in future calls for the
same \fIcmd\fR.  The command \fBauto_reset\fR may be used to force
\fBauto_execok\fR to forget its cached information.
.RS
.PP
For example, to run the \fIumask\fR shell builtin on Linux, you would do:
.PP
.CS
exec {*}[\fBauto_execok\fR umask]
.CE
.PP
To run the \fIDIR\fR shell builtin on Windows, you would do:
.PP
.CS
exec {*}[\fBauto_execok\fR dir]
.CE
.PP
To discover if there is a \fIfrobnicate\fR binary on the user's PATH,
you would do:
.PP
.CS
set mayFrob [expr {[llength [\fBauto_execok\fR frobnicate]] > 0}]
.CE
.RE
.TP
\fBauto_import \fIpattern\fR
.
\fBAuto_import\fR is invoked during \fBnamespace import\fR to see if
the imported commands specified by \fIpattern\fR reside in an
autoloaded library.  If so, the commands are loaded so that they will
be available to the interpreter for creating the import links.  If the
commands do not reside in an autoloaded library, \fBauto_import\fR
does nothing.  The pattern matching is performed according to the
matching rules of \fBnamespace import\fR.
.RS
.PP
It is not normally necessary to call this command directly.
.RE
.TP
\fBauto_load \fIcmd\fR
.
This command attempts to load the definition for a Tcl command named
\fIcmd\fR.  To do this, it searches an \fIauto-load path\fR, which is
a list of one or more directories.  The auto-load path is given by the
global variable \fBauto_path\fR if it exists.  If there is no
\fBauto_path\fR variable, then the \fBTCLLIBPATH\fR environment variable is
used, if it exists.  Otherwise the auto-load path consists of just the
Tcl library directory.  Within each directory in the auto-load path
there must be a file \fBtclIndex\fR that describes one or more
commands defined in that directory and a script to evaluate to load
each of the commands.  The \fBtclIndex\fR file should be generated
with the \fBauto_mkindex\fR command.  If \fIcmd\fR is found in an
index file, then the appropriate script is evaluated to create the
command.  The \fBauto_load\fR command returns 1 if \fIcmd\fR was
successfully created.  The command returns 0 if there was no index
entry for \fIcmd\fR or if the script did not actually define \fIcmd\fR
(e.g. because index information is out of date).  If an error occurs
while processing the script, then that error is returned.
\fBAuto_load\fR only reads the index information once and saves it in
the array \fBauto_index\fR;  future calls to \fBauto_load\fR check for
\fIcmd\fR in the array rather than re-reading the index files.  The
cached index information may be deleted with the command
\fBauto_reset\fR.  This will force the next \fBauto_load\fR command to
reload the index database from disk.
.RS
.PP
It is not normally necessary to call this command directly; the
default \fBunknown\fR handler will do so.
.RE
.TP
\fBauto_mkindex \fIdir pattern pattern ...\fR
.
Generates an index suitable for use by \fBauto_load\fR.  The command
searches \fIdir\fR for all files whose names match any of the
\fIpattern\fR arguments (matching is done with the \fBglob\fR
command), generates an index of all the Tcl command procedures defined
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
Destroys all the information cached by \fBauto_execok\fR and
\fBauto_load\fR.  This information will be re-read from disk the next
time it is needed.  \fBAuto_reset\fR also deletes any procedures
listed in the auto-load index, so that fresh copies of them will be
loaded the next time that they are used.
.TP
\fBauto_qualify \fIcommand namespace\fR

Computes a list of fully qualified names for \fIcommand\fR.  This list
mirrors the path a standard Tcl interpreter follows for command
lookups:  first it looks for the command in the current namespace, and
then in the global namespace.  Accordingly, if \fIcommand\fR is
relative and \fInamespace\fR is not \fB::\fR, the list returned has
two elements:  \fIcommand\fR scoped by \fInamespace\fR, as if it were
a command in the \fInamespace\fR namespace; and \fIcommand\fR as if it
were a command in the global namespace.  Otherwise, if either
\fIcommand\fR is absolute (it begins with \fB::\fR), or
\fInamespace\fR is \fB::\fR, the list contains only \fIcommand\fR as
if it were a command in the global namespace.
.RS
.PP
\fBAuto_qualify\fR is used by the auto-loading facilities in Tcl, both
for producing auto-loading indexes such as \fIpkgIndex.tcl\fR, and for
performing the actual auto-loading of functions at runtime.
.RE
.TP
\fBtcl_findLibrary \fIbasename version patch initScript enVarName varName\fR

This is a standard search procedure for use by extensions during
their initialization.  They call this procedure to look for their
script library in several standard directories.
The last component of the name of the library directory is
normally \fIbasenameversion\fR
(e.g., tk8.0), but it might be
.QW library







>



















>







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
Destroys all the information cached by \fBauto_execok\fR and
\fBauto_load\fR.  This information will be re-read from disk the next
time it is needed.  \fBAuto_reset\fR also deletes any procedures
listed in the auto-load index, so that fresh copies of them will be
loaded the next time that they are used.
.TP
\fBauto_qualify \fIcommand namespace\fR
.
Computes a list of fully qualified names for \fIcommand\fR.  This list
mirrors the path a standard Tcl interpreter follows for command
lookups:  first it looks for the command in the current namespace, and
then in the global namespace.  Accordingly, if \fIcommand\fR is
relative and \fInamespace\fR is not \fB::\fR, the list returned has
two elements:  \fIcommand\fR scoped by \fInamespace\fR, as if it were
a command in the \fInamespace\fR namespace; and \fIcommand\fR as if it
were a command in the global namespace.  Otherwise, if either
\fIcommand\fR is absolute (it begins with \fB::\fR), or
\fInamespace\fR is \fB::\fR, the list contains only \fIcommand\fR as
if it were a command in the global namespace.
.RS
.PP
\fBAuto_qualify\fR is used by the auto-loading facilities in Tcl, both
for producing auto-loading indexes such as \fIpkgIndex.tcl\fR, and for
performing the actual auto-loading of functions at runtime.
.RE
.TP
\fBtcl_findLibrary \fIbasename version patch initScript enVarName varName\fR
.
This is a standard search procedure for use by extensions during
their initialization.  They call this procedure to look for their
script library in several standard directories.
The last component of the name of the library directory is
normally \fIbasenameversion\fR
(e.g., tk8.0), but it might be
.QW library
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
relative to the Tcl library directory;
relative to the executable file in the standard installation
bin or bin/\fIarch\fR directory;
relative to the executable file in the current build tree;
relative to the executable file in a parallel build tree.
.TP
\fBparray \fIarrayName\fR ?\fIpattern\fR?

Prints on standard output the names and values of all the elements in the
array \fIarrayName\fR, or just the names that match \fIpattern\fR (using the
matching rules of \fBstring match\fR) and their values if \fIpattern\fR is
given.
\fIArrayName\fR must be an array accessible to the caller of \fBparray\fR.
It may be either local or global.












.TP
\fBtcl_endOfWord \fIstr start\fR

Returns the index of the first end-of-word location that occurs after
a starting index \fIstart\fR in the string \fIstr\fR.  An end-of-word
location is defined to be the first non-word character following the
first word character after the starting point.  Returns -1 if there
are no more end-of-word locations after the starting point.  See the
description of \fBtcl_wordchars\fR and \fBtcl_nonwordchars\fR below
for more details on how Tcl determines which characters are word
characters.
.TP
\fBtcl_startOfNextWord \fIstr start\fR

Returns the index of the first start-of-word location that occurs
after a starting index \fIstart\fR in the string \fIstr\fR.  A
start-of-word location is defined to be the first word character
following a non-word character.  Returns \-1 if there are no more
start-of-word locations after the starting point.













.TP
\fBtcl_startOfPreviousWord \fIstr start\fR

Returns the index of the first start-of-word location that occurs
before a starting index \fIstart\fR in the string \fIstr\fR.  Returns
\-1 if there are no more start-of-word locations before the starting
point.
.TP
\fBtcl_wordBreakAfter \fIstr start\fR

Returns the index of the first word boundary after the starting index
\fIstart\fR in the string \fIstr\fR.  Returns \-1 if there are no more
boundaries after the starting point in the given string.  The index
returned refers to the second character of the pair that comprises a
boundary.
.TP
\fBtcl_wordBreakBefore \fIstr start\fR

Returns the index of the first word boundary before the starting index
\fIstart\fR in the string \fIstr\fR.  Returns \-1 if there are no more
boundaries before the starting point in the given string.  The index
returned refers to the second character of the pair that comprises a
boundary.
.SH "VARIABLES"
.PP
The following global variables are defined or used by the procedures in
the Tcl library. They fall into two broad classes, handling unknown
commands and packages, and determining what are words.
.SS "AUTOLOADING AND PACKAGE MANAGEMENT VARIABLES"
.TP
\fBauto_execs\fR

Used by \fBauto_execok\fR to record information about whether
particular commands exist as executable files.




.TP
\fBauto_index\fR

Used by \fBauto_load\fR to save the index information read from
disk.




.TP
\fBauto_noexec\fR

If set to any value, then \fBunknown\fR will not attempt to auto-exec
any commands.
.TP
\fBauto_noload\fR

If set to any value, then \fBunknown\fR will not attempt to auto-load
any commands.
.TP
\fBauto_path\fR
.
If set, then it must contain a valid Tcl list giving directories to
search during auto-load operations (including for package index
files when using the default \fBpackage unknown\fR handler).
This variable is initialized during startup to contain, in order:
the directories listed in the \fBTCLLIBPATH\fR environment variable,
the directory named by the \fBtcl_library\fR global variable,
the parent directory of \fBtcl_library\fR,
the directories listed in the \fBtcl_pkgPath\fR variable.
Additional locations to look for files and package indices should
normally be added to this variable using \fBlappend\fR.












.TP
\fBenv(TCL_LIBRARY)\fR

If set, then it specifies the location of the directory containing
library scripts (the value of this variable will be
assigned to the \fBtcl_library\fR variable and therefore returned by
the command \fBinfo library\fR).  If this variable is not set then
a default value is used.






.TP
\fBenv(TCLLIBPATH)\fR

If set, then it must contain a valid Tcl list giving directories to
search during auto-load operations.  Directories must be specified in
Tcl format, using
.QW /
as the path separator, regardless of platform.
This variable is only used when initializing the \fBauto_path\fR variable.









.SS "WORD BOUNDARY DETERMINATION VARIABLES"
These variables are only used in the \fBtcl_endOfWord\fR,
\fBtcl_startOfNextWord\fR, \fBtcl_startOfPreviousWord\fR,
\fBtcl_wordBreakAfter\fR, and \fBtcl_wordBreakBefore\fR commands.
.TP
\fBtcl_nonwordchars\fR

This variable contains a regular expression that is used by routines
like \fBtcl_endOfWord\fR to identify whether a character is part of a
word or not.  If the pattern matches a character, the character is
considered to be a non-word character. The default is "\\W".

.TP
\fBtcl_wordchars\fR

This variable contains a regular expression that is used by routines
like \fBtcl_endOfWord\fR to identify whether a character is part of a
word or not.  If the pattern matches a character, the character is
considered to be a word character. The default is "\\w".

.SH "SEE ALSO"
env(n), info(n), re_syntax(n)
.SH KEYWORDS
auto-exec, auto-load, library, unknown, word, whitespace
'\"Local Variables:
'\"mode: nroff
'\"End:







>






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


>










>





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


>






>







>













>


>
>
>
>


>


>
>
>
>


>




>















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


>





>
>
>
>
>
>


>






>
>
>
>
>
>
>
>
>






>



|
>


>



|
>







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
relative to the Tcl library directory;
relative to the executable file in the standard installation
bin or bin/\fIarch\fR directory;
relative to the executable file in the current build tree;
relative to the executable file in a parallel build tree.
.TP
\fBparray \fIarrayName\fR ?\fIpattern\fR?
.
Prints on standard output the names and values of all the elements in the
array \fIarrayName\fR, or just the names that match \fIpattern\fR (using the
matching rules of \fBstring match\fR) and their values if \fIpattern\fR is
given.
\fIArrayName\fR must be an array accessible to the caller of \fBparray\fR.
It may be either local or global.
The result of this command is the empty string.
.RS
.PP
For example, to print the contents of the \fBtcl_platform\fR array, do:
.PP
.CS
\fBparray\fR tcl_platform
.CE
.RE
.SS "WORD BOUNDARY HELPERS"
.PP
These procedures are mainly used internally by Tk.
.TP
\fBtcl_endOfWord \fIstr start\fR
.
Returns the index of the first end-of-word location that occurs after
a starting index \fIstart\fR in the string \fIstr\fR.  An end-of-word
location is defined to be the first non-word character following the
first word character after the starting point.  Returns -1 if there
are no more end-of-word locations after the starting point.  See the
description of \fBtcl_wordchars\fR and \fBtcl_nonwordchars\fR below
for more details on how Tcl determines which characters are word
characters.
.TP
\fBtcl_startOfNextWord \fIstr start\fR
.
Returns the index of the first start-of-word location that occurs
after a starting index \fIstart\fR in the string \fIstr\fR.  A
start-of-word location is defined to be the first word character
following a non-word character.  Returns \-1 if there are no more
start-of-word locations after the starting point.
.RS
.PP
For example, to print the indices of the starts of each word in a
string according to platform rules:
.PP
.CS
set theString "The quick brown fox"
for {set idx 0} {$idx >= 0} {
        set idx [\fBtcl_startOfNextWord\fR $theString $idx]} {
    puts "Word start index: $idx"
}
.CE
.RE
.TP
\fBtcl_startOfPreviousWord \fIstr start\fR
.
Returns the index of the first start-of-word location that occurs
before a starting index \fIstart\fR in the string \fIstr\fR.  Returns
\-1 if there are no more start-of-word locations before the starting
point.
.TP
\fBtcl_wordBreakAfter \fIstr start\fR
.
Returns the index of the first word boundary after the starting index
\fIstart\fR in the string \fIstr\fR.  Returns \-1 if there are no more
boundaries after the starting point in the given string.  The index
returned refers to the second character of the pair that comprises a
boundary.
.TP
\fBtcl_wordBreakBefore \fIstr start\fR
.
Returns the index of the first word boundary before the starting index
\fIstart\fR in the string \fIstr\fR.  Returns \-1 if there are no more
boundaries before the starting point in the given string.  The index
returned refers to the second character of the pair that comprises a
boundary.
.SH "VARIABLES"
.PP
The following global variables are defined or used by the procedures in
the Tcl library. They fall into two broad classes, handling unknown
commands and packages, and determining what are words.
.SS "AUTOLOADING AND PACKAGE MANAGEMENT VARIABLES"
.TP
\fBauto_execs\fR
.
Used by \fBauto_execok\fR to record information about whether
particular commands exist as executable files.
.RS
.PP
Not normally usefully accessed directly by user code.
.RE
.TP
\fBauto_index\fR
.
Used by \fBauto_load\fR to save the index information read from
disk.
.RS
.PP
Not normally usefully accessed directly by user code.
.RE
.TP
\fBauto_noexec\fR
.
If set to any value, then \fBunknown\fR will not attempt to auto-exec
any commands.
.TP
\fBauto_noload\fR
.
If set to any value, then \fBunknown\fR will not attempt to auto-load
any commands.
.TP
\fBauto_path\fR
.
If set, then it must contain a valid Tcl list giving directories to
search during auto-load operations (including for package index
files when using the default \fBpackage unknown\fR handler).
This variable is initialized during startup to contain, in order:
the directories listed in the \fBTCLLIBPATH\fR environment variable,
the directory named by the \fBtcl_library\fR global variable,
the parent directory of \fBtcl_library\fR,
the directories listed in the \fBtcl_pkgPath\fR variable.
Additional locations to look for files and package indices should
normally be added to this variable using \fBlappend\fR.
.RS
.PP
For example, to add the \fIlib\fR directory next to the running
script, you would do:
.PP
.CS
lappend \fBauto_path\fR [file dirname [info script]]/lib
.CE
.PP
Note that if the script uses \fBcd\fR, it is advisable to ensure that
entries on the \fBauto_path\fR are \fBfile normalize\fRd.
.RE
.TP
\fBenv(TCL_LIBRARY)\fR
.
If set, then it specifies the location of the directory containing
library scripts (the value of this variable will be
assigned to the \fBtcl_library\fR variable and therefore returned by
the command \fBinfo library\fR).  If this variable is not set then
a default value is used.
.RS
.PP
Use of this environment variable is not recommended outside of testing.
Tcl installations should already know where to find their own script
files, as the value is baked in during the build or installation.
.RE
.TP
\fBenv(TCLLIBPATH)\fR
.
If set, then it must contain a valid Tcl list giving directories to
search during auto-load operations.  Directories must be specified in
Tcl format, using
.QW /
as the path separator, regardless of platform.
This variable is only used when initializing the \fBauto_path\fR variable.
.RS
.PP
A key consequence of this variable is that it gives a way to let the user
of a script specify the list of places where that script may use
\fBpackage require\fR to read packages from. It is not normally usefully
settable within a Tcl script itself \fIexcept\fR to influence where other
interpreters load from (whether made with \fBinterp create\fR or launched
as their own threads or subprocesses).
.RE
.SS "WORD BOUNDARY DETERMINATION VARIABLES"
These variables are only used in the \fBtcl_endOfWord\fR,
\fBtcl_startOfNextWord\fR, \fBtcl_startOfPreviousWord\fR,
\fBtcl_wordBreakAfter\fR, and \fBtcl_wordBreakBefore\fR commands.
.TP
\fBtcl_nonwordchars\fR
.
This variable contains a regular expression that is used by routines
like \fBtcl_endOfWord\fR to identify whether a character is part of a
word or not.  If the pattern matches a character, the character is
considered to be a non-word character. The default value is
.QW "\\W" .
.TP
\fBtcl_wordchars\fR
.
This variable contains a regular expression that is used by routines
like \fBtcl_endOfWord\fR to identify whether a character is part of a
word or not.  If the pattern matches a character, the character is
considered to be a word character. The default value is
.QW "\\w" .
.SH "SEE ALSO"
env(n), info(n), re_syntax(n)
.SH KEYWORDS
auto-exec, auto-load, library, unknown, word, whitespace
'\"Local Variables:
'\"mode: nroff
'\"End:

Changes to doc/link.n.

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
oo::class create ABC {
    method Foo {} {
        puts "This is Foo in [self]"
    }

    constructor {} {
        \fBlink\fR Foo
        # The method foo is now directly accessible as foo here
        \fBlink\fR {bar Foo}
        # The method foo is now directly accessible as bar
        \fBlink\fR {::ExternalCall Foo}
        # The method foo is now directly accessible in the global
        # namespace as ExternalCall
    }

    method grill {} {
        puts "Step 1:"
        Foo
        puts "Step 2:"
        bar
    }
}

ABC create abc
abc grill
        \fI\(-> Step 1:\fR
        \fI\(-> This is foo in ::abc\fR
        \fI\(-> Step 2:\fR
        \fI\(-> This is foo in ::abc\fR
# Direct access via the linked command
puts "Step 3:"; ExternalCall
        \fI\(-> Step 3:\fR
        \fI\(-> This is foo in ::abc\fR
.CE
.PP
This example shows that multiple linked commands can be made in a call to
\fBlink\fR, and that they can handle arguments.
.PP
.CS
oo::class create Ex {
    constructor {} {
        \fBlink\fR a b c
        # The methods a, b, and c (defined below) are all now
        # directly acessible within methods under their own names.
    }

    method a {} {
        puts "This is a"
    }
    method b {x} {
        puts "This is b($x)"







|

|

|














|

|



|










|







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
oo::class create ABC {
    method Foo {} {
        puts "This is Foo in [self]"
    }

    constructor {} {
        \fBlink\fR Foo
        # The method Foo is now directly accessible as Foo here
        \fBlink\fR {bar Foo}
        # The method Foo is now directly accessible as bar
        \fBlink\fR {::ExternalCall Foo}
        # The method Foo is now directly accessible in the global
        # namespace as ExternalCall
    }

    method grill {} {
        puts "Step 1:"
        Foo
        puts "Step 2:"
        bar
    }
}

ABC create abc
abc grill
        \fI\(-> Step 1:\fR
        \fI\(-> This is Foo in ::abc\fR
        \fI\(-> Step 2:\fR
        \fI\(-> This is Foo in ::abc\fR
# Direct access via the linked command
puts "Step 3:"; ExternalCall
        \fI\(-> Step 3:\fR
        \fI\(-> This is Foo in ::abc\fR
.CE
.PP
This example shows that multiple linked commands can be made in a call to
\fBlink\fR, and that they can handle arguments.
.PP
.CS
oo::class create Ex {
    constructor {} {
        \fBlink\fR a b c
        # The methods a, b, and c (defined below) are all now
        # directly accessible within methods under their own names.
    }

    method a {} {
        puts "This is a"
    }
    method b {x} {
        puts "This is b($x)"

Changes to doc/lremove.n.

12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
lremove \- Remove elements from a list by index
.SH SYNOPSIS
\fBlremove \fIlist\fR ?\fIindex ...\fR?
.BE
.SH DESCRIPTION
.PP
\fBlremove\fR returns a new list formed by simultaneously removing zero or
more elements of \fIlist\fR at each of the indices given by an arbirary number
of \fIindex\fR arguments. The indices may be in any order and may be repeated;
the element at index will only be removed once.  The index values are
interpreted the same as index values for the command \fBstring index\fR,
supporting simple index arithmetic and indices relative to the end of the
list.  0 refers to the first element of the list, and \fBend\fR refers to the
last element of the list.
.SH EXAMPLES







|







12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
lremove \- Remove elements from a list by index
.SH SYNOPSIS
\fBlremove \fIlist\fR ?\fIindex ...\fR?
.BE
.SH DESCRIPTION
.PP
\fBlremove\fR returns a new list formed by simultaneously removing zero or
more elements of \fIlist\fR at each of the indices given by an arbitrary number
of \fIindex\fR arguments. The indices may be in any order and may be repeated;
the element at index will only be removed once.  The index values are
interpreted the same as index values for the command \fBstring index\fR,
supporting simple index arithmetic and indices relative to the end of the
list.  0 refers to the first element of the list, and \fBend\fR refers to the
last element of the list.
.SH EXAMPLES

Changes to doc/lseq.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
'\"
'\" Copyright (c) 2022 Eric Taylor.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH lseq n 8.7 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
lseq \- Build a numeric sequence returned as a list
.SH SYNOPSIS
\fBlseq \fIStart \fR?(\fB..\fR|\fBto\fR)? \fIEnd\fR ??\fBby\fR? \fIStep\fR?

\fBlseq \fIStart \fBcount\fR \fICount\fR ??\fBby\fR? \fIStep\fR?

\fBlseq \fICount\fR ?\fBby \fIStep\fR?
.BE
.SH DESCRIPTION
.PP
The \fBlseq\fR command creates a sequence of numeric values using the given
parameters \fIStart\fR, \fIEnd\fR, and \fIStep\fR. The \fIoperation\fR
argument ".." or "to" defines the range. The "count" option is used
to define a count of the number of elements in the list. A short form use of
the command, with a
single count value, will create a range from 0 to count-1.


The \fBlseq\fR command can produce both increasing and decreasing sequences. When
both Start and End are provided without a Step value, then if Start <= End,

the sequence will be increasing and if Start > End it will be decreasing. If a
Step vale is included, it's sign should agree with the direction of the
sequence (descending -> negative and ascending -> positive), otherwise an
empty list is returned.  For example:

.CS \"
    % lseq 1 to 5    ;# increasing
    1 2 3 4 5

    % lseq 5 to 1    ;# decreasing
    5 4 3 2 1

    % lseq 6 to 1 by 2   ;# decreasing, step wrong sign, empty list

    % lseq 1 to 5 by 0   ;# all step sizes of 0 produce an empty list














.\"
.CE


The numeric arguments, \fIStart\fR, \fIEnd\fR, \fIStep\fR, and \fICount\fR,
may also be a valid expression. The expression will be evaluate and the
numeric result be used.  An expression that does not evaluate to a number will
produce an invalid argument error.


.SH EXAMPLES
.CS
.\"

 lseq 3
 \(-> 0 1 2

 lseq 3 0
 \(-> 3 2 1 0

 lseq 10 .. 1 by -2
 \(-> 10 8 6 4 2

 set l [lseq 0 -5]
 \(-> 0 -1 -2 -3 -4 -5

 foreach i [lseq [llength $l]] {
   puts l($i)=[lindex $l $i]







 }
 \(-> l(0)=0
    l(1)=-1
    l(2)=-2
    l(3)=-3
    l(4)=-4
    l(5)=-5

 foreach i [lseq [llength $l]-1 0] {
    puts l($i)=[lindex $l $i]
 }
 \(-> l(5)=-5
    l(4)=-4
    l(3)=-3
    l(2)=-2
    l(1)=-1
    l(0)=0










 set sqrs [lmap i [lseq 1 10] {expr $i*$i}]
 \(-> 1 4 9 16 25 36 49 64 81 100
.\"
.CE
.SH "SEE ALSO"
foreach(n), list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n),
lmap(n), lpop(n), lrange(n), lremove(n), lreplace(n),
lreverse(n), lsearch(n), lset(n), lsort(n)
.SH KEYWORDS













|

|

|




|
|
|
<
|
>

|
|
>
|
|




|
|

|
|

|

|
>
>

>
>
>
>
>
>
>
>
>
>
>



>
|
|
|
|
>




<
|
|

|
|

|
|

|
|

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

|
|
|
|
|
|
|

>
>
>
>
>
>
>
>
>
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
'\"
'\" Copyright (c) 2022 Eric Taylor.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH lseq n 8.7 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
lseq \- Build a numeric sequence returned as a list
.SH SYNOPSIS
\fBlseq \fIstart \fR?(\fB..\fR|\fBto\fR)? \fIend\fR ??\fBby\fR? \fIstep\fR?

\fBlseq \fIstart \fBcount\fR \fIcount\fR ??\fBby\fR? \fIstep\fR?

\fBlseq \fIcount\fR ?\fBby \fIstep\fR?
.BE
.SH DESCRIPTION
.PP
The \fBlseq\fR command creates a sequence of numeric values using the given
parameters \fIstart\fR, \fIend\fR, and \fIstep\fR. The \fIoperation\fR
argument "\fB..\fR" or "\fBto\fR" defines the range. The "\fBcount\fR" option
is used to define a count of the number of elements in the list. A short form

use of the command, with a single count value, will create a range from 0 to
count-1.

The \fBlseq\fR command can produce both increasing and decreasing
sequences. When both \fIstart\fR and \fIend\fR are provided without a
\fIstep\fR value, then if \fIstart\fR <= \fIend\fR, the sequence will be
increasing and if \fIstart\fR > \fIend\fR it will be decreasing. If a
\fIstep\fR vale is included, it's sign should agree with the direction of the
sequence (descending -> negative and ascending -> positive), otherwise an
empty list is returned.  For example:

.CS \"
% \fBlseq\fR 1 to 5    ;# increasing
\fI\(-> 1 2 3 4 5

% \fBlseq\fR 5 to 1    ;# decreasing
\fI\(-> 5 4 3 2 1

% \fBlseq\fR 6 to 1 by 2   ;# decreasing, step wrong sign, empty list

% \fBlseq\fR 1 to 5 by 0   ;# all step sizes of 0 produce an empty list
.\"
.CE

The numeric arguments, \fIstart\fR, \fIend\fR, \fIstep\fR, and \fIcount\fR,
may also be a valid expression. The expression will be evaluated and the
numeric result will be used.  An expression that does not evaluate to a number
will produce an invalid argument error.
.PP
\fIStart\fR defines the initial value and \fIend\fR defines the limit, not
necessarily the last value. \fBlseq\fR produces a list with \fIcount\fR
elements, and if \fIcount\fR is not supplied, it is computed as

.CS \"
    \fIcount\fR = int( (\fIend\fR - \fIstart\fR + \fIstep\fR) / \fIstep\fR )
.\"
.CE

.PP
The numeric arguments, \fIstart\fR, \fIend\fR, \fIstep\fR, and \fIcount\fR,
can also be a valid expression. the \fBlseq\fR command will evaluate the
expression (as if with \fBexpr\fR)
and use the numeric result, or return an error as with any invalid argument
value; a non-numeric expression result will result in an error.

.SH EXAMPLES
.CS
.\"

\fBlseq\fR 3
\fI\(-> 0 1 2\fR

\fBlseq\fR 3 0
\fI\(-> 3 2 1 0\fR

\fBlseq\fR 10 .. 1 by -2
\fI\(-> 10 8 6 4 2\fR

set l [\fBlseq\fR 0 -5]
\fI\(-> 0 -1 -2 -3 -4 -5\fR

foreach i [\fBlseq\fR [llength $l]] {
    puts l($i)=[lindex $l $i]
}
\fI\(-> l(0)=0\fR
\fI\(-> l(1)=-1\fR
\fI\(-> l(2)=-2\fR
\fI\(-> l(3)=-3\fR
\fI\(-> l(4)=-4\fR
\fI\(-> l(5)=-5\fR







foreach i [\fBlseq\fR {[llength $l]-1} 0] {

    puts l($i)=[lindex $l $i]
}
\fI\(-> l(5)=-5\fR
\fI\(-> l(4)=-4\fR
\fI\(-> l(3)=-3\fR
\fI\(-> l(2)=-2\fR
\fI\(-> l(1)=-1\fR
\fI\(-> l(0)=0\fR

set i 17
         \fI\(-> 17\fR
if {$i in [\fBlseq\fR 0 50]} { # equivalent to: (0 <= $i && $i <= 50)
    puts "Ok"
} else {
    puts "outside :("
}
\fI\(-> Ok\fR

set sqrs [lmap i [\fBlseq\fR 1 10] { expr {$i*$i} }]
\fI\(-> 1 4 9 16 25 36 49 64 81 100\fR
.\"
.CE
.SH "SEE ALSO"
foreach(n), list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n),
lmap(n), lpop(n), lrange(n), lremove(n), lreplace(n),
lreverse(n), lsearch(n), lset(n), lsort(n)
.SH KEYWORDS

Changes to doc/memory.n.

37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
Tcl began, the current packets allocated (the current
number of calls to \fBTcl_Alloc\fR not met by a corresponding call
to \fBTcl_Free\fR), the current bytes allocated, and the maximum number
of packets and bytes allocated.
.TP
\fBmemory init \fR[\fBon\fR|\fBoff\fR]
.
Turn on or off the pre-initialization of all allocated memory
with bogus bytes.  Useful for detecting the use of uninitialized
values.
.TP
\fBmemory objs \fIfile\fR
.
Causes a list of all allocated Tcl_Obj values to be written to the specified
\fIfile\fR immediately, together with where they were allocated.  Useful for







|







37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
Tcl began, the current packets allocated (the current
number of calls to \fBTcl_Alloc\fR not met by a corresponding call
to \fBTcl_Free\fR), the current bytes allocated, and the maximum number
of packets and bytes allocated.
.TP
\fBmemory init \fR[\fBon\fR|\fBoff\fR]
.
Turn on or off the preinitialization of all allocated memory
with bogus bytes.  Useful for detecting the use of uninitialized
values.
.TP
\fBmemory objs \fIfile\fR
.
Causes a list of all allocated Tcl_Obj values to be written to the specified
\fIfile\fR immediately, together with where they were allocated.  Useful for

Changes to doc/namespace.n.

157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
current namespace that were imported from a different namespace.
For
.QW "qualified patterns" ,
this command first finds the matching exported commands.
It then checks whether any of those commands
were previously imported by the current namespace.
If so, this command deletes the corresponding imported commands.
In effect, this un-does the action of a \fBnamespace import\fR command.
.TP
\fBnamespace import \fR?\fB\-force\fR? ?\fIpattern\fR \fIpattern ...\fR?
.
Imports commands into a namespace, or queries the set of imported
commands in a namespace.  When no arguments are present,
\fBnamespace import\fR returns the list of commands in
the current namespace that have been imported from other







|







157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
current namespace that were imported from a different namespace.
For
.QW "qualified patterns" ,
this command first finds the matching exported commands.
It then checks whether any of those commands
were previously imported by the current namespace.
If so, this command deletes the corresponding imported commands.
In effect, this undoes the action of a \fBnamespace import\fR command.
.TP
\fBnamespace import \fR?\fB\-force\fR? ?\fIpattern\fR \fIpattern ...\fR?
.
Imports commands into a namespace, or queries the set of imported
commands in a namespace.  When no arguments are present,
\fBnamespace import\fR returns the list of commands in
the current namespace that have been imported from other

Changes to doc/next.n.

92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
a filter and once as a normal method.
.PP
Each filter should decide for itself whether to permit the execution to go
forward to the proper implementation of the method (which it does by invoking
the \fBnext\fR command as filters are inserted into the front of the method
call chain) and is responsible for returning the result of \fBnext\fR.
.PP
Filters are invoked when processing an invokation of the \fBunknown\fR
method because of a failure to locate a method implementation, but \fInot\fR
when invoking either constructors or destructors. (Note however that the
\fBdestroy\fR method is a conventional method, and filters are invoked as
normal when it is called.)
.SH EXAMPLES
.PP
This example demonstrates how to use the \fBnext\fR command to call the







|







92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
a filter and once as a normal method.
.PP
Each filter should decide for itself whether to permit the execution to go
forward to the proper implementation of the method (which it does by invoking
the \fBnext\fR command as filters are inserted into the front of the method
call chain) and is responsible for returning the result of \fBnext\fR.
.PP
Filters are invoked when processing an invocation of the \fBunknown\fR
method because of a failure to locate a method implementation, but \fInot\fR
when invoking either constructors or destructors. (Note however that the
\fBdestroy\fR method is a conventional method, and filters are invoked as
normal when it is called.)
.SH EXAMPLES
.PP
This example demonstrates how to use the \fBnext\fR command to call the

Changes to doc/open.n.

124
125
126
127
128
129
130






















131
132
133
134
135
136
137
.
If the file exists it is truncated to zero length.
.PP
If a new file is created as part of opening it, \fIpermissions\fR
(an integer) is used to set the permissions for the new file in
conjunction with the process's file mode creation mask.
\fIPermissions\fR defaults to 0666.






















.SH "COMMAND PIPELINES"
.PP
If the first character of \fIfileName\fR is
.QW \fB|\fR
then the
remaining characters of \fIfileName\fR are treated as a list of arguments
that describe a command pipeline to invoke, in the same style as the







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







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
.
If the file exists it is truncated to zero length.
.PP
If a new file is created as part of opening it, \fIpermissions\fR
(an integer) is used to set the permissions for the new file in
conjunction with the process's file mode creation mask.
\fIPermissions\fR defaults to 0666.
.PP
.VS "8.7, TIP 603"
When the file opened is an ordinary disk file, the \fBchan configure\fR and
\fBfconfigure\fR commands can be used to query this additional configuration
option:
.TP
\fB\-stat\fR
.
This option, when read, returns a dictionary of values much as is obtained
from the \fBfile stat\fR command, where that stat information relates to the
real opened file. Keys in the dictionary may include \fBatime\fR, \fBctime\fR,
\fBdev\fR, \fBgid\fR, \fBino\fR, \fBmode\fR, \fBmtime\fR, \fBnlink\fR,
\fBsize\fR, \fBtype\fR, and \fBuid\fR among others; the \fBmtime\fR,
\fBsize\fR and \fBtype\fR fields are guaranteed to be present and meaningful
on all platforms; other keys may be present too.
.RS
.PP
\fIImplementation note:\fR This option maps to a call to \fBfstat()\fR on
POSIX platforms, and to a call to \fBGetFileInformationByHandle()\fR on
Windows; the information reported is what those system calls produce.
.RE
.VE "8.7, TIP 603"
.SH "COMMAND PIPELINES"
.PP
If the first character of \fIfileName\fR is
.QW \fB|\fR
then the
remaining characters of \fIfileName\fR are treated as a list of arguments
that describe a command pipeline to invoke, in the same style as the

Changes to doc/pkgMkIndex.n.

104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
\fB\-lazy\fR
The generated index will manage to delay loading the package until the
use of one of the commands provided by the package, instead of loading
it immediately upon \fBpackage require\fR.  This is not compatible with
the use of \fIauto_reset\fR, and therefore its use is discouraged.
.TP 15
\fB\-load \fIpkgPat\fR
The index process will pre-load any packages that exist in the
current interpreter and match \fIpkgPat\fR into the child interpreter used to
generate the index.  The pattern match uses string match rules, but without
making case distinctions.
See \fBCOMPLEX CASES\fR below.
.TP 15
\fB\-verbose\fR
Generate output during the indexing process.  Output is via







|







104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
\fB\-lazy\fR
The generated index will manage to delay loading the package until the
use of one of the commands provided by the package, instead of loading
it immediately upon \fBpackage require\fR.  This is not compatible with
the use of \fIauto_reset\fR, and therefore its use is discouraged.
.TP 15
\fB\-load \fIpkgPat\fR
The index process will preload any packages that exist in the
current interpreter and match \fIpkgPat\fR into the child interpreter used to
generate the index.  The pattern match uses string match rules, but without
making case distinctions.
See \fBCOMPLEX CASES\fR below.
.TP 15
\fB\-verbose\fR
Generate output during the indexing process.  Output is via

Changes to doc/refchan.n.

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


14











15
16
17
18
19
20
21
'\"
'\" Copyright (c) 2006 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.
'\"
.TH refchan n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
.\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
refchan \- command handler API of reflected channels
.SH SYNOPSIS


\fBcmdPrefix \fIoption\fR ?\fIarg arg ...\fR?











.BE
.SH DESCRIPTION
.PP
The Tcl-level handler for a reflected channel has to be a command with
subcommands (termed an \fIensemble\fR, as it is a command such as that
created by \fBnamespace ensemble\fR \fBcreate\fR, though the implementation
of handlers for reflected channel \fIis not\fR tied to \fBnamespace













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







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
'\"
'\" Copyright (c) 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.
'\"
.TH refchan n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
.\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
refchan \- command handler API of reflected channels
.SH SYNOPSIS
.nf
\fBchan create \fImode cmdPrefix\fR

\fIcmdPrefix \fBblocking\fR \fIchannelId mode\fR
\fIcmdPrefix \fBcget\fR \fIchannelId option\fR
\fIcmdPrefix \fBcgetall\fR \fIchannelId\fR
\fIcmdPrefix \fBconfigure\fR \fIchannelId option value\fR
\fIcmdPrefix \fBfinalize\fR \fIchannelId\fR
\fIcmdPrefix \fBinitialize\fR \fIchannelId mode\fR
\fIcmdPrefix \fBread\fR \fIchannelId count\fR
\fIcmdPrefix \fBseek\fR \fIchannelId offset base\fR
\fIcmdPrefix \fBwatch\fR \fIchannelId eventspec\fR
\fIcmdPrefix \fBwrite\fR \fIchannelId data\fR
.fi
.BE
.SH DESCRIPTION
.PP
The Tcl-level handler for a reflected channel has to be a command with
subcommands (termed an \fIensemble\fR, as it is a command such as that
created by \fBnamespace ensemble\fR \fBcreate\fR, though the implementation
of handlers for reflected channel \fIis not\fR tied to \fBnamespace
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
(e.g.,\ \fBbreak\fR, etc.) is treated as (and converted to) an error.
.PP
\fBNote:\fR If the creation of the channel was aborted due to failures
here, then the \fBfinalize\fR subcommand will not be called.
.PP
The \fImode\fR argument tells the handler whether the channel was
opened for reading, writing, or both. It is a list containing any of
the strings \fBread\fR or \fBwrite\fR. The list will always
contain at least one element.
.PP
The subcommand must throw an error if the chosen mode is not
supported by the \fIcmdPrefix\fR.
.RE
.TP
\fIcmdPrefix \fBfinalize \fIchannelId\fR
.







|
|







62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
(e.g.,\ \fBbreak\fR, etc.) is treated as (and converted to) an error.
.PP
\fBNote:\fR If the creation of the channel was aborted due to failures
here, then the \fBfinalize\fR subcommand will not be called.
.PP
The \fImode\fR argument tells the handler whether the channel was
opened for reading, writing, or both. It is a list containing any of
the strings \fBread\fR or \fBwrite\fR. The list may be empty, but
will usually contain at least one element.
.PP
The subcommand must throw an error if the chosen mode is not
supported by the \fIcmdPrefix\fR.
.RE
.TP
\fIcmdPrefix \fBfinalize \fIchannelId\fR
.

Changes to doc/tcltest.n.

621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
way to define any conditions required for the test to be possible or
meaningful.  For example, a \fBtest\fR with \fB\-constraints unix\fR
will only be run if the constraint \fBunix\fR is true, which indicates
the test suite is being run on a Unix platform.
.PP
Each \fBtest\fR should include whatever \fB\-constraints\fR are
required to constrain it to run only where appropriate.  Several
constraints are pre-defined in the \fBtcltest\fR package, listed
below.  The registration of user-defined constraints is performed
by the \fBtestConstraint\fR command.  User-defined constraints
may appear within a test file, or within the script specified
by the \fBconfigure \-load\fR or \fBconfigure \-loadfile\fR
options.
.PP
The following is a list of constraints pre-defined by the
\fBtcltest\fR package itself:
.TP
\fIsingleTestInterp\fR
.
This test can only be run if all test files are sourced into a single
interpreter.
.TP







|






|







621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
way to define any conditions required for the test to be possible or
meaningful.  For example, a \fBtest\fR with \fB\-constraints unix\fR
will only be run if the constraint \fBunix\fR is true, which indicates
the test suite is being run on a Unix platform.
.PP
Each \fBtest\fR should include whatever \fB\-constraints\fR are
required to constrain it to run only where appropriate.  Several
constraints are predefined in the \fBtcltest\fR package, listed
below.  The registration of user-defined constraints is performed
by the \fBtestConstraint\fR command.  User-defined constraints
may appear within a test file, or within the script specified
by the \fBconfigure \-load\fR or \fBconfigure \-loadfile\fR
options.
.PP
The following is a list of constraints predefined by the
\fBtcltest\fR package itself:
.TP
\fIsingleTestInterp\fR
.
This test can only be run if all test files are sourced into a single
interpreter.
.TP

Changes to doc/tclvars.n.

69
70
71
72
73
74
75
76
77
78
79
80


81
82
83
84
85
86
87
will not work on Windows and is discouraged for cross-platform usage.
.PP
The following elements of \fBenv\fR are special to Tcl:
.TP
\fBenv(HOME)\fR
.
This environment variable, if set, gives the location of the directory
considered to be the current user's home directory, and to which a
call of \fBcd\fR without arguments or with just
.QW ~
as an argument will change into. Most platforms set this correctly by
default; it does not normally need to be set by user code.


.TP
\fBenv(TCL_LIBRARY)\fR
.
If set, then it specifies the location of the directory containing
library scripts (the value of this variable will be
assigned to the \fBtcl_library\fR variable and therefore returned by
the command \fBinfo library\fR).  If this variable is not set then







|
<
<
|
|
>
>







69
70
71
72
73
74
75
76


77
78
79
80
81
82
83
84
85
86
87
will not work on Windows and is discouraged for cross-platform usage.
.PP
The following elements of \fBenv\fR are special to Tcl:
.TP
\fBenv(HOME)\fR
.
This environment variable, if set, gives the location of the directory
considered to be the current user's home directory. The value of this variable


is returned by the \fBfile home\fR command. Most platforms set this correctly by
default; it does not normally need to be set by user code. On Windows, if not
already set, it is set to the value of the \fBUSERPROFILE\fR environment
variable.
.TP
\fBenv(TCL_LIBRARY)\fR
.
If set, then it specifies the location of the directory containing
library scripts (the value of this variable will be
assigned to the \fBtcl_library\fR variable and therefore returned by
the command \fBinfo library\fR).  If this variable is not set then

Changes to doc/timerate.n.

31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
.PP
The first and second form will evaluate \fIscript\fR until the interval
\fItime\fR given in milliseconds elapses, or for 1000 milliseconds (1 second)
if \fItime\fR is not specified.
.sp
The parameter \fImax-count\fR could additionally impose a further restriction
by the maximal number of iterations to evaluate the script.
If \fImax-count\fR is specified, the evalution will stop either this count of
iterations is reached or the time is exceeded.
.sp
It will then return a canonical tcl-list of the form:
.PP
.CS
\fB0.095977 \(mcs/# 52095836 # 10419167 #/sec 5000.000 net-ms\fR
.CE
.PP
which indicates:
.IP \(bu 3







|


|







31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
.PP
The first and second form will evaluate \fIscript\fR until the interval
\fItime\fR given in milliseconds elapses, or for 1000 milliseconds (1 second)
if \fItime\fR is not specified.
.sp
The parameter \fImax-count\fR could additionally impose a further restriction
by the maximal number of iterations to evaluate the script.
If \fImax-count\fR is specified, the evaluation will stop either this count of
iterations is reached or the time is exceeded.
.sp
It will then return a canonical Tcl-list of the form:
.PP
.CS
\fB0.095977 \(mcs/# 52095836 # 10419167 #/sec 5000.000 net-ms\fR
.CE
.PP
which indicates:
.IP \(bu 3
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
.
The \fB-direct\fR option causes direct execution of the supplied script,
without compilation, in a manner similar to the \fBtime\fR command. It can be
used to measure the cost of \fBTcl_EvalObjEx\fR, of the invocation of canonical
lists, and of the uncompiled versions of bytecoded commands.
.PP
As opposed to the \fBtime\fR commmand, which runs the tested script for a fixed
number of iterations, the timerate command runs it for a fixed time.
Additionally, the compiled variant of the script will be used during the entire
measurement, as if the script were part of a compiled procedure, if the \fB\-direct\fR
option is not specified. The fixed time period and possibility of compilation allow
for more precise results and prevent very long execution times by slow scripts, making
it practical for measuring scripts with highly uncertain execution times.
.SH EXAMPLES
Estimate how fast it takes for a simple Tcl \fBfor\fR loop (including







|







81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
.
The \fB-direct\fR option causes direct execution of the supplied script,
without compilation, in a manner similar to the \fBtime\fR command. It can be
used to measure the cost of \fBTcl_EvalObjEx\fR, of the invocation of canonical
lists, and of the uncompiled versions of bytecoded commands.
.PP
As opposed to the \fBtime\fR commmand, which runs the tested script for a fixed
number of iterations, the \fBtimerate\fR command runs it for a fixed time.
Additionally, the compiled variant of the script will be used during the entire
measurement, as if the script were part of a compiled procedure, if the \fB\-direct\fR
option is not specified. The fixed time period and possibility of compilation allow
for more precise results and prevent very long execution times by slow scripts, making
it practical for measuring scripts with highly uncertain execution times.
.SH EXAMPLES
Estimate how fast it takes for a simple Tcl \fBfor\fR loop (including

Changes to doc/trace.n.

227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
.PP
.CS
\fIcommandPrefix name1 name2 op\fR
.CE
.PP
\fIName1\fR gives the name for the variable being accessed.
This is not necessarily the same as the name used in the
\fBtrace variable\fR command:  the \fBupvar\fR command allows a
procedure to reference a variable under a different name.
If the trace was originally set on an array or array element,
\fIname2\fR provides which index into the array was affected.
This information is present even when \fIname1\fR refers to a
scalar, which may happen if the \fBupvar\fR command was used to
create a reference to a single array element.
If an entire array is being deleted and the trace was registered







|







227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
.PP
.CS
\fIcommandPrefix name1 name2 op\fR
.CE
.PP
\fIName1\fR gives the name for the variable being accessed.
This is not necessarily the same as the name used in the
\fBtrace add variable\fR command:  the \fBupvar\fR command allows a
procedure to reference a variable under a different name.
If the trace was originally set on an array or array element,
\fIname2\fR provides which index into the array was affected.
This information is present even when \fIname1\fR refers to a
scalar, which may happen if the \fBupvar\fR command was used to
create a reference to a single array element.
If an entire array is being deleted and the trace was registered

Changes to doc/transchan.n.

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


14









15
16
17
18
19
20
21
'\"
'\" Copyright (c) 2008 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH transchan n 8.6 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
transchan \- command handler API of channel transforms
.SH SYNOPSIS


\fBcmdPrefix \fIoption\fR ?\fIarg arg ...\fR?









.BE
.SH DESCRIPTION
.PP
The Tcl-level handler for a channel transformation has to be a command with
subcommands (termed an \fIensemble\fR despite not implying that it must be
created with \fBnamespace ensemble create\fR; this mechanism is not tied to
\fBnamespace ensemble\fR in any way). Note that \fIcmdPrefix\fR is whatever













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







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
'\"
'\" Copyright (c) 2008 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH transchan n 8.6 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
transchan \- command handler API of channel transforms
.SH SYNOPSIS
.nf
\fBchan push \fIchannelName cmdPrefix\fR

\fIcmdPrefix \fBclear \fIhandle\fR
\fIcmdPrefix \fBdrain \fIhandle\fR
\fIcmdPrefix \fBfinalize \fIhandle\fR
\fIcmdPrefix \fBflush \fIhandle\fR
\fIcmdPrefix \fBinitialize \fIhandle mode\fR
\fIcmdPrefix \fBlimit? \fIhandle\fR
\fIcmdPrefix \fBread \fIhandle buffer\fR
\fIcmdPrefix \fBwrite \fIhandle buffer\fR
.fi
.BE
.SH DESCRIPTION
.PP
The Tcl-level handler for a channel transformation has to be a command with
subcommands (termed an \fIensemble\fR despite not implying that it must be
created with \fBnamespace ensemble create\fR; this mechanism is not tied to
\fBnamespace ensemble\fR in any way). Note that \fIcmdPrefix\fR is whatever

Changes to doc/upvar.n.

90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
    puts $name
}
proc \fIsetByUpvar\fR { name value } {
    \fBupvar\fR $name localVar
    set localVar $value
}
set originalVar 1
trace variable originalVar w \fItraceproc\fR
\fIsetByUpvar\fR originalVar 2
.CE
.PP
If \fIotherVar\fR refers to an element of an array, then the element
name is passed as the second argument to the trace procedure. This
may be important information in case of traces set on an entire array.
.SH EXAMPLE







|







90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
    puts $name
}
proc \fIsetByUpvar\fR { name value } {
    \fBupvar\fR $name localVar
    set localVar $value
}
set originalVar 1
trace add variable originalVar write \fItraceproc\fR
\fIsetByUpvar\fR originalVar 2
.CE
.PP
If \fIotherVar\fR refers to an element of an array, then the element
name is passed as the second argument to the trace procedure. This
may be important information in case of traces set on an entire array.
.SH EXAMPLE

Changes to generic/regc_nfa.c.

483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
    victim->freechain = from->free;
    from->free = victim;
}

/*
 * changearctarget - flip an arc to have a different to state
 *
 * Caller must have verified that there is no pre-existing duplicate arc.
 *
 * Note that because we store arcs in their from state, we can't easily have
 * a similar changearcsource function.
 */
static void
changearctarget(struct arc * a, struct state * newto)
{







|







483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
    victim->freechain = from->free;
    from->free = victim;
}

/*
 * changearctarget - flip an arc to have a different to state
 *
 * Caller must have verified that there is no preexisting duplicate arc.
 *
 * Note that because we store arcs in their from state, we can't easily have
 * a similar changearcsource function.
 */
static void
changearctarget(struct arc * a, struct state * newto)
{
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525

/*
 - pull - pull a back constraint backward past its source state
 *
 * Returns 1 if successful (which it always is unless the source is the
 * start state or we have an internal error), 0 if nothing happened.
 *
 * A significant property of this function is that it deletes no pre-existing
 * states, and no outarcs of the constraint's from state other than the given
 * constraint arc.  This makes the loops in pullback() safe, at the cost that
 * we may leave useless states behind.  Therefore, we leave it to pullback()
 * to delete such states.
 *
 * If the from state has multiple back-constraint outarcs, and/or multiple
 * compatible constraint inarcs, we only need to create one new intermediate







|







1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525

/*
 - pull - pull a back constraint backward past its source state
 *
 * Returns 1 if successful (which it always is unless the source is the
 * start state or we have an internal error), 0 if nothing happened.
 *
 * A significant property of this function is that it deletes no preexisting
 * states, and no outarcs of the constraint's from state other than the given
 * constraint arc.  This makes the loops in pullback() safe, at the cost that
 * we may leave useless states behind.  Therefore, we leave it to pullback()
 * to delete such states.
 *
 * If the from state has multiple back-constraint outarcs, and/or multiple
 * compatible constraint inarcs, we only need to create one new intermediate
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704

/*
 - push - push a forward constraint forward past its destination state
 *
 * Returns 1 if successful (which it always is unless the destination is the
 * post state or we have an internal error), 0 if nothing happened.
 *
 * A significant property of this function is that it deletes no pre-existing
 * states, and no inarcs of the constraint's to state other than the given
 * constraint arc.  This makes the loops in pushfwd() safe, at the cost that
 * we may leave useless states behind.  Therefore, we leave it to pushfwd()
 * to delete such states.
 *
 * If the to state has multiple forward-constraint inarcs, and/or multiple
 * compatible constraint outarcs, we only need to create one new intermediate







|







1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704

/*
 - push - push a forward constraint forward past its destination state
 *
 * Returns 1 if successful (which it always is unless the destination is the
 * post state or we have an internal error), 0 if nothing happened.
 *
 * A significant property of this function is that it deletes no preexisting
 * states, and no inarcs of the constraint's to state other than the given
 * constraint arc.  This makes the loops in pushfwd() safe, at the cost that
 * we may leave useless states behind.  Therefore, we leave it to pushfwd()
 * to delete such states.
 *
 * If the to state has multiple forward-constraint inarcs, and/or multiple
 * compatible constraint outarcs, we only need to create one new intermediate
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
 * For each cloned successor state, we transiently create a "donemap" that is
 * a boolean array showing which source states we've already visited for this
 * clone state.  This prevents infinite recursion as well as useless repeat
 * visits to the same state subtree (which can add up fast, since typical NFAs
 * have multiple redundant arc pathways).  Each donemap is a char array
 * indexed by state number.  The donemaps are all of the same size "nstates",
 * which is nfa->nstates as of the start of the recursion.  This is enough to
 * have entries for all pre-existing states, but *not* entries for clone
 * states created during the recursion.  That's okay since we have no need to
 * mark those.
 *
 * curdonemap is NULL when recursing to a new sclone state, or sclone's
 * donemap when we are recursing without having created a new state (which we
 * do when we decide we can merge a successor state into the current clone
 * state).  outerdonemap is NULL at the top level and otherwise the parent







|







2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
 * For each cloned successor state, we transiently create a "donemap" that is
 * a boolean array showing which source states we've already visited for this
 * clone state.  This prevents infinite recursion as well as useless repeat
 * visits to the same state subtree (which can add up fast, since typical NFAs
 * have multiple redundant arc pathways).  Each donemap is a char array
 * indexed by state number.  The donemaps are all of the same size "nstates",
 * which is nfa->nstates as of the start of the recursion.  This is enough to
 * have entries for all preexisting states, but *not* entries for clone
 * states created during the recursion.  That's okay since we have no need to
 * mark those.
 *
 * curdonemap is NULL when recursing to a new sclone state, or sclone's
 * donemap when we are recursing without having created a new state (which we
 * do when we decide we can merge a successor state into the current clone
 * state).  outerdonemap is NULL at the top level and otherwise the parent
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
    }
}

/*
 - analyze - ascertain potentially-useful facts about an optimized NFA
 ^ static long analyze(struct nfa *);
 */
static long			/* re_info bits to be ORed in */
analyze(
    struct nfa *nfa)
{
    struct arc *a;
    struct arc *aa;

    if (nfa->pre->outs == NULL) {







|







2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
    }
}

/*
 - analyze - ascertain potentially-useful facts about an optimized NFA
 ^ static long analyze(struct nfa *);
 */
static long			/* re_info bits to be OR'ed in */
analyze(
    struct nfa *nfa)
{
    struct arc *a;
    struct arc *aa;

    if (nfa->pre->outs == NULL) {

Changes to generic/regcomp.c.

2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
     * Big enough for hex int or decimal t->id?
     */

    if (bufsize < sizeof(void*)*2 + 3 || bufsize < sizeof(t->id)*3 + 1) {
	return "unable";
    }
    if (t->id != 0) {
	sprintf(buf, "%d", t->id);
    } else {
	sprintf(buf, "%p", t);
    }
    return buf;
}

#include "regc_lex.c"
#include "regc_color.c"
#include "regc_nfa.c"







|

|







2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
     * Big enough for hex int or decimal t->id?
     */

    if (bufsize < sizeof(void*)*2 + 3 || bufsize < sizeof(t->id)*3 + 1) {
	return "unable";
    }
    if (t->id != 0) {
	snprintf(buf, bufsize, "%d", t->id);
    } else {
	snprintf(buf, bufsize, "%p", t);
    }
    return buf;
}

#include "regc_lex.c"
#include "regc_color.c"
#include "regc_nfa.c"

Changes to generic/regerror.c.

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
    switch (code) {
    case REG_ATOI:		/* Convert name to number */
	for (r = rerrs; r->code >= 0; r++) {
	    if (strcmp(r->name, errbuf) == 0) {
		break;
	    }
	}
	sprintf(convbuf, "%d", r->code); /* -1 for unknown */
	msg = convbuf;
	break;
    case REG_ITOA:		/* Convert number to name */
	icode = atoi(errbuf);	/* Not our problem if this fails */
	for (r = rerrs; r->code >= 0; r++) {
	    if (r->code == icode) {
		break;
	    }
	}
	if (r->code >= 0) {
	    msg = r->name;
	} else {		/* Unknown; tell him the number */
	    sprintf(convbuf, "REG_%u", icode);
	    msg = convbuf;
	}
	break;
    default:			/* A real, normal error code */
	for (r = rerrs; r->code >= 0; r++) {
	    if (r->code == code) {
		break;
	    }
	}
	if (r->code >= 0) {
	    msg = r->explain;
	} else {		/* Unknown; say so */
	    sprintf(convbuf, unk, code);
	    msg = convbuf;
	}
	break;
    }

    len = strlen(msg) + 1;	/* Space needed, including NUL */
    if (errbuf_size > 0) {







|












|












|







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
    switch (code) {
    case REG_ATOI:		/* Convert name to number */
	for (r = rerrs; r->code >= 0; r++) {
	    if (strcmp(r->name, errbuf) == 0) {
		break;
	    }
	}
	snprintf(convbuf, sizeof(convbuf), "%d", r->code); /* -1 for unknown */
	msg = convbuf;
	break;
    case REG_ITOA:		/* Convert number to name */
	icode = atoi(errbuf);	/* Not our problem if this fails */
	for (r = rerrs; r->code >= 0; r++) {
	    if (r->code == icode) {
		break;
	    }
	}
	if (r->code >= 0) {
	    msg = r->name;
	} else {		/* Unknown; tell him the number */
	    snprintf(convbuf, sizeof(convbuf), "REG_%u", icode);
	    msg = convbuf;
	}
	break;
    default:			/* A real, normal error code */
	for (r = rerrs; r->code >= 0; r++) {
	    if (r->code == code) {
		break;
	    }
	}
	if (r->code >= 0) {
	    msg = r->explain;
	} else {		/* Unknown; say so */
	    snprintf(convbuf, sizeof(convbuf), unk, code);
	    msg = convbuf;
	}
	break;
    }

    len = strlen(msg) + 1;	/* Space needed, including NUL */
    if (errbuf_size > 0) {

Changes to generic/regguts.h.

254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
    struct state *next;		/* chain for traversing all */
    struct state *prev;		/* back chain */
    struct arcbatch oas;	/* first arcbatch, avoid malloc in easy case */
    size_t noas;		/* number of arcs used in first arcbatch */
};

struct nfa {
    struct state *pre;		/* pre-initial state */
    struct state *init;		/* initial state */
    struct state *final;	/* final state */
    struct state *post;		/* post-final state */
    size_t nstates;		/* for numbering states */
    struct state *states;	/* state-chain header */
    struct state *slast;	/* tail of the chain */
    struct state *free;		/* free list */
    struct colormap *cm;	/* the color map */
    color bos[2];		/* colors, if any, assigned to BOS and BOL */
    color eos[2];		/* colors, if any, assigned to EOS and EOL */







|


|







254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
    struct state *next;		/* chain for traversing all */
    struct state *prev;		/* back chain */
    struct arcbatch oas;	/* first arcbatch, avoid malloc in easy case */
    size_t noas;		/* number of arcs used in first arcbatch */
};

struct nfa {
    struct state *pre;		/* preinitial state */
    struct state *init;		/* initial state */
    struct state *final;	/* final state */
    struct state *post;		/* postfinal state */
    size_t nstates;		/* for numbering states */
    struct state *states;	/* state-chain header */
    struct state *slast;	/* tail of the chain */
    struct state *free;		/* free list */
    struct colormap *cm;	/* the color map */
    color bos[2];		/* colors, if any, assigned to BOS and BOL */
    color eos[2];		/* colors, if any, assigned to EOS and EOL */

Changes to generic/tcl.decls.

55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
    void Tcl_DbCkfree(void *ptr, const char *file, int line)
}
declare 8 {
    void *Tcl_DbCkrealloc(void *ptr, TCL_HASH_TYPE size,
	    const char *file, int line)
}

# Tcl_CreateFileHandler and Tcl_DeleteFileHandler are only available on unix,
# but they are part of the old generic interface, so we include them here for
# compatibility reasons.

declare 9 {
    void Tcl_CreateFileHandler(int fd, int mask, Tcl_FileProc *proc,
	    void *clientData)
}







|







55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
    void Tcl_DbCkfree(void *ptr, const char *file, int line)
}
declare 8 {
    void *Tcl_DbCkrealloc(void *ptr, TCL_HASH_TYPE size,
	    const char *file, int line)
}

# Tcl_CreateFileHandler and Tcl_DeleteFileHandler are only available on Unix,
# but they are part of the old generic interface, so we include them here for
# compatibility reasons.

declare 9 {
    void Tcl_CreateFileHandler(int fd, int mask, Tcl_FileProc *proc,
	    void *clientData)
}
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
}
declare 32 {
    int Tcl_GetBooleanFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    int *intPtr)
}
# Only available in Tcl 8.x, NULL in Tcl 9.0
declare 33 {
    unsigned char *TclGetByteArrayFromObj(Tcl_Obj *objPtr, int *numBytesPtr)
}
declare 34 {
    int Tcl_GetDouble(Tcl_Interp *interp, const char *src, double *doublePtr)
}
declare 35 {
    int Tcl_GetDoubleFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    double *doublePtr)







|







142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
}
declare 32 {
    int Tcl_GetBooleanFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    int *intPtr)
}
# Only available in Tcl 8.x, NULL in Tcl 9.0
declare 33 {
    unsigned char *TclGetByteArrayFromObj(Tcl_Obj *objPtr, void *numBytesPtr)
}
declare 34 {
    int Tcl_GetDouble(Tcl_Interp *interp, const char *src, double *doublePtr)
}
declare 35 {
    int Tcl_GetDoubleFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    double *doublePtr)
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
declare 39 {
    int Tcl_GetLongFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr)
}
declare 40 {
    const Tcl_ObjType *Tcl_GetObjType(const char *typeName)
}
declare 41 {
    char *TclGetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr)
}
declare 42 {
    void Tcl_InvalidateStringRep(Tcl_Obj *objPtr)
}
declare 43 {
    int Tcl_ListObjAppendList(Tcl_Interp *interp, Tcl_Obj *listPtr,
	    Tcl_Obj *elemListPtr)
}
declare 44 {
    int Tcl_ListObjAppendElement(Tcl_Interp *interp, Tcl_Obj *listPtr,
	    Tcl_Obj *objPtr)
}
declare 45 {
    int TclListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr,
	    int *objcPtr, Tcl_Obj ***objvPtr)
}
declare 46 {
    int Tcl_ListObjIndex(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size index,
	    Tcl_Obj **objPtrPtr)
}
declare 47 {
    int TclListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr,
	    int *lengthPtr)
}
declare 48 {
    int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size first,
	    Tcl_Size count, Tcl_Size objc, Tcl_Obj *const objv[])
}
# Removed in 9.0 (changed to macro):
#declare 49 {







|














|







|







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
declare 39 {
    int Tcl_GetLongFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr)
}
declare 40 {
    const Tcl_ObjType *Tcl_GetObjType(const char *typeName)
}
declare 41 {
    char *TclGetStringFromObj(Tcl_Obj *objPtr, void *lengthPtr)
}
declare 42 {
    void Tcl_InvalidateStringRep(Tcl_Obj *objPtr)
}
declare 43 {
    int Tcl_ListObjAppendList(Tcl_Interp *interp, Tcl_Obj *listPtr,
	    Tcl_Obj *elemListPtr)
}
declare 44 {
    int Tcl_ListObjAppendElement(Tcl_Interp *interp, Tcl_Obj *listPtr,
	    Tcl_Obj *objPtr)
}
declare 45 {
    int TclListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr,
	    void *objcPtr, Tcl_Obj ***objvPtr)
}
declare 46 {
    int Tcl_ListObjIndex(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size index,
	    Tcl_Obj **objPtrPtr)
}
declare 47 {
    int TclListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr,
	    void *lengthPtr)
}
declare 48 {
    int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size first,
	    Tcl_Size count, Tcl_Size objc, Tcl_Obj *const objv[])
}
# Removed in 9.0 (changed to macro):
#declare 49 {
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
	    int isSafe)
}
declare 98 {
    Tcl_TimerToken Tcl_CreateTimerHandler(int milliseconds,
	    Tcl_TimerProc *proc, void *clientData)
}
declare 99 {
    Tcl_Trace Tcl_CreateTrace(Tcl_Interp *interp, int level,
	    Tcl_CmdTraceProc *proc, void *clientData)
}
declare 100 {
    void Tcl_DeleteAssocData(Tcl_Interp *interp, const char *name)
}
declare 101 {
    void Tcl_DeleteChannelHandler(Tcl_Channel chan, Tcl_ChannelProc *proc,







|







384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
	    int isSafe)
}
declare 98 {
    Tcl_TimerToken Tcl_CreateTimerHandler(int milliseconds,
	    Tcl_TimerProc *proc, void *clientData)
}
declare 99 {
    Tcl_Trace Tcl_CreateTrace(Tcl_Interp *interp, Tcl_Size level,
	    Tcl_CmdTraceProc *proc, void *clientData)
}
declare 100 {
    void Tcl_DeleteAssocData(Tcl_Interp *interp, const char *name)
}
declare 101 {
    void Tcl_DeleteChannelHandler(Tcl_Channel chan, Tcl_ChannelProc *proc,
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
declare 240 {
    const char *Tcl_SignalMsg(int sig)
}
declare 241 {
    void Tcl_SourceRCFile(Tcl_Interp *interp)
}
declare 242 {
    int TclSplitList(Tcl_Interp *interp, const char *listStr, int *argcPtr,
	    const char ***argvPtr)
}
# Obsolete, use Tcl_FSSplitPath
declare 243 {
    void TclSplitPath(const char *path, int *argcPtr, const char ***argvPtr)
}
# Removed in 9.0 (stub entry only)
#declare 244  {
#    void Tcl_StaticLibrary(Tcl_Interp *interp, const char *prefix,
#	    Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc)
#}
# Removed in 9.0 (stub entry only)







|




|







877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
declare 240 {
    const char *Tcl_SignalMsg(int sig)
}
declare 241 {
    void Tcl_SourceRCFile(Tcl_Interp *interp)
}
declare 242 {
    int TclSplitList(Tcl_Interp *interp, const char *listStr, void *argcPtr,
	    const char ***argvPtr)
}
# Obsolete, use Tcl_FSSplitPath
declare 243 {
    void TclSplitPath(const char *path, void *argcPtr, const char ***argvPtr)
}
# Removed in 9.0 (stub entry only)
#declare 244  {
#    void Tcl_StaticLibrary(Tcl_Interp *interp, const char *prefix,
#	    Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc)
#}
# Removed in 9.0 (stub entry only)
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
declare 322 {
    int Tcl_UniCharToTitle(int ch)
}
declare 323 {
    int Tcl_UniCharToUpper(int ch)
}
declare 324 {
    int Tcl_UniCharToUtf(int ch, char *buf)
}
declare 325 {
    const char *TclUtfAtIndex(const char *src, Tcl_Size index)
}
declare 326 {
    int TclUtfCharComplete(const char *src, Tcl_Size length)
}







|







1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
declare 322 {
    int Tcl_UniCharToTitle(int ch)
}
declare 323 {
    int Tcl_UniCharToUpper(int ch)
}
declare 324 {
    Tcl_Size Tcl_UniCharToUtf(int ch, char *buf)
}
declare 325 {
    const char *TclUtfAtIndex(const char *src, Tcl_Size index)
}
declare 326 {
    int TclUtfCharComplete(const char *src, Tcl_Size length)
}
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
	    int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr)
}
declare 333 {
    char *Tcl_UtfToExternalDString(Tcl_Encoding encoding,
	    const char *src, Tcl_Size srcLen, Tcl_DString *dsPtr)
}
declare 334 {
    int Tcl_UtfToLower(char *src)
}
declare 335 {
    int Tcl_UtfToTitle(char *src)
}
declare 336 {
    int Tcl_UtfToChar16(const char *src, unsigned short *chPtr)
}
declare 337 {
    int Tcl_UtfToUpper(char *src)
}
declare 338 {
    Tcl_Size Tcl_WriteChars(Tcl_Channel chan, const char *src, Tcl_Size srcLen)
}
declare 339 {
    Tcl_Size Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr)
}







|


|


|


|







1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
	    int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr)
}
declare 333 {
    char *Tcl_UtfToExternalDString(Tcl_Encoding encoding,
	    const char *src, Tcl_Size srcLen, Tcl_DString *dsPtr)
}
declare 334 {
    Tcl_Size Tcl_UtfToLower(char *src)
}
declare 335 {
    Tcl_Size Tcl_UtfToTitle(char *src)
}
declare 336 {
    Tcl_Size Tcl_UtfToChar16(const char *src, unsigned short *chPtr)
}
declare 337 {
    Tcl_Size Tcl_UtfToUpper(char *src)
}
declare 338 {
    Tcl_Size Tcl_WriteChars(Tcl_Channel chan, const char *src, Tcl_Size srcLen)
}
declare 339 {
    Tcl_Size Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr)
}
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
    void Tcl_ConditionFinalize(Tcl_Condition *condPtr)
}
declare 392 {
    void Tcl_MutexFinalize(Tcl_Mutex *mutex)
}
declare 393 {
    int Tcl_CreateThread(Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc,
	    void *clientData, Tcl_Size stackSize, int flags)
}

# Introduced in 8.3.2
declare 394 {
    Tcl_Size Tcl_ReadRaw(Tcl_Channel chan, char *dst, Tcl_Size bytesToRead)
}
declare 395 {







|







1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
    void Tcl_ConditionFinalize(Tcl_Condition *condPtr)
}
declare 392 {
    void Tcl_MutexFinalize(Tcl_Mutex *mutex)
}
declare 393 {
    int Tcl_CreateThread(Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc,
	    void *clientData, TCL_HASH_TYPE stackSize, int flags)
}

# Introduced in 8.3.2
declare 394 {
    Tcl_Size Tcl_ReadRaw(Tcl_Channel chan, char *dst, Tcl_Size bytesToRead)
}
declare 395 {
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
# TIP#10 (thread-aware channels) akupries
declare 433 {
    Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel)
}

# introduced in 8.4a3
declare 434 {
    Tcl_UniChar *TclGetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr)
}

# TIP#15 (math function introspection) dkf
# Removed in 9.0:
#declare 435 {
#    int Tcl_GetMathFuncInfo(Tcl_Interp *interp, const char *name,
#	    int *numArgsPtr, Tcl_ValueType **argTypesPtr,







|







1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
# TIP#10 (thread-aware channels) akupries
declare 433 {
    Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel)
}

# introduced in 8.4a3
declare 434 {
    Tcl_UniChar *TclGetUnicodeFromObj(Tcl_Obj *objPtr, void *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,
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
declare 459 {
    int Tcl_FSConvertToPathType(Tcl_Interp *interp, Tcl_Obj *pathPtr)
}
declare 460 {
    Tcl_Obj *Tcl_FSJoinPath(Tcl_Obj *listObj, Tcl_Size elements)
}
declare 461 {
    Tcl_Obj *TclFSSplitPath(Tcl_Obj *pathPtr, int *lenPtr)
}
declare 462 {
    int Tcl_FSEqualPaths(Tcl_Obj *firstPtr, Tcl_Obj *secondPtr)
}
declare 463 {
    Tcl_Obj *Tcl_FSGetNormalizedPath(Tcl_Interp *interp, Tcl_Obj *pathPtr)
}







|







1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
declare 459 {
    int Tcl_FSConvertToPathType(Tcl_Interp *interp, Tcl_Obj *pathPtr)
}
declare 460 {
    Tcl_Obj *Tcl_FSJoinPath(Tcl_Obj *listObj, Tcl_Size elements)
}
declare 461 {
    Tcl_Obj *TclFSSplitPath(Tcl_Obj *pathPtr, void *lenPtr)
}
declare 462 {
    int Tcl_FSEqualPaths(Tcl_Obj *firstPtr, Tcl_Obj *secondPtr)
}
declare 463 {
    Tcl_Obj *Tcl_FSGetNormalizedPath(Tcl_Interp *interp, Tcl_Obj *pathPtr)
}
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
# TIP#73 (access to current time) kbk
declare 482 {
    void Tcl_GetTime(Tcl_Time *timeBuf)
}

# TIP#32 (object-enabled traces) kbk
declare 483 {
    Tcl_Trace Tcl_CreateObjTrace(Tcl_Interp *interp, int level, int flags,
	    Tcl_CmdObjTraceProc *objProc, void *clientData,
	    Tcl_CmdObjTraceDeleteProc *delProc)
}
declare 484 {
    int Tcl_GetCommandInfoFromToken(Tcl_Command token, Tcl_CmdInfo *infoPtr)
}
declare 485 {







|







1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
# TIP#73 (access to current time) kbk
declare 482 {
    void Tcl_GetTime(Tcl_Time *timeBuf)
}

# TIP#32 (object-enabled traces) kbk
declare 483 {
    Tcl_Trace Tcl_CreateObjTrace(Tcl_Interp *interp, Tcl_Size level, int flags,
	    Tcl_CmdObjTraceProc *objProc, void *clientData,
	    Tcl_CmdObjTraceDeleteProc *delProc)
}
declare 484 {
    int Tcl_GetCommandInfoFromToken(Tcl_Command token, Tcl_CmdInfo *infoPtr)
}
declare 485 {
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
	    Tcl_Obj **valuePtrPtr)
}
declare 496 {
    int Tcl_DictObjRemove(Tcl_Interp *interp, Tcl_Obj *dictPtr,
	    Tcl_Obj *keyPtr)
}
declare 497 {
    int TclDictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, int *sizePtr)
}
declare 498 {
    int Tcl_DictObjFirst(Tcl_Interp *interp, Tcl_Obj *dictPtr,
	    Tcl_DictSearch *searchPtr,
	    Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr, int *donePtr)
}
declare 499 {







|







1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
	    Tcl_Obj **valuePtrPtr)
}
declare 496 {
    int Tcl_DictObjRemove(Tcl_Interp *interp, Tcl_Obj *dictPtr,
	    Tcl_Obj *keyPtr)
}
declare 497 {
    int TclDictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, void *sizePtr)
}
declare 498 {
    int Tcl_DictObjFirst(Tcl_Interp *interp, Tcl_Obj *dictPtr,
	    Tcl_DictSearch *searchPtr,
	    Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr, int *donePtr)
}
declare 499 {
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
    int Tcl_GetEnsembleParameterList(Tcl_Interp *interp, Tcl_Command token,
	    Tcl_Obj **paramListPtr)
}

# TIP#265 (option parser) dkf for Sam Bromley
declare 604 {
    int TclParseArgsObjv(Tcl_Interp *interp, const Tcl_ArgvInfo *argTable,
	    int *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv)
}

# TIP#336 (manipulate the error line) dgp
declare 605 {
    int Tcl_GetErrorLine(Tcl_Interp *interp)
}
declare 606 {







|







2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
    int Tcl_GetEnsembleParameterList(Tcl_Interp *interp, Tcl_Command token,
	    Tcl_Obj **paramListPtr)
}

# TIP#265 (option parser) dkf for Sam Bromley
declare 604 {
    int TclParseArgsObjv(Tcl_Interp *interp, const Tcl_ArgvInfo *argTable,
	    void *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv)
}

# TIP#336 (manipulate the error line) dgp
declare 605 {
    int Tcl_GetErrorLine(Tcl_Interp *interp)
}
declare 606 {
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
declare 645 {
    int Tcl_GetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    Tcl_Size endValue, Tcl_Size *indexPtr)
}

# TIP #548
declare 646 {
    int Tcl_UtfToUniChar(const char *src, int *chPtr)
}
declare 647 {
    char *Tcl_UniCharToUtfDString(const int *uniStr,
	    Tcl_Size uniLength, Tcl_DString *dsPtr)
}
declare 648 {
    int *Tcl_UtfToUniCharDString(const char *src,
	    Tcl_Size length, Tcl_DString *dsPtr)
}

# TIP #568
declare 649 {
    unsigned char *TclGetBytesFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    int *numBytesPtr)
}
declare 650 {
    unsigned char *Tcl_GetBytesFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    size_t *numBytesPtr)
}

# TIP #481
declare 651 {
    char *Tcl_GetStringFromObj(Tcl_Obj *objPtr, size_t *lengthPtr)
}
declare 652 {
    Tcl_UniChar *Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, size_t *lengthPtr)
}
# Only available in Tcl 8.x, NULL in Tcl 9.0
declare 653 {
    unsigned char *Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr, size_t *numBytesPtr)
}

# TIP #575
declare 654 {
    int Tcl_UtfCharComplete(const char *src, Tcl_Size length)
}
declare 655 {
    const char *Tcl_UtfNext(const char *src)
}
declare 656 {
    const char *Tcl_UtfPrev(const char *src, const char *start)
}
declare 657 {
    int Tcl_UniCharIsUnicode(int ch)
}


declare 658 {
    Tcl_Size Tcl_ExternalToUtfDStringEx(Tcl_Encoding encoding,
	    const char *src, Tcl_Size srcLen, int flags, Tcl_DString *dsPtr)

}
declare 659 {
    Tcl_Size Tcl_UtfToExternalDStringEx(Tcl_Encoding encoding,
	    const char *src, Tcl_Size srcLen, int flags, Tcl_DString *dsPtr)

}

# TIP #511
declare 660 {
    int Tcl_AsyncMarkFromSignal(Tcl_AsyncHandler async, int sigNumber)
}

# TIP #616
declare 661 {
    int Tcl_ListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr,
	    size_t *objcPtr, Tcl_Obj ***objvPtr)
}
declare 662 {
    int Tcl_ListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr,
	    size_t *lengthPtr)
}
declare 663 {
    int Tcl_DictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, size_t *sizePtr)
}
declare 664 {
    int Tcl_SplitList(Tcl_Interp *interp, const char *listStr, size_t *argcPtr,
	    const char ***argvPtr)
}
declare 665 {
    void Tcl_SplitPath(const char *path, size_t *argcPtr, const char ***argvPtr)
}
declare 666 {
    Tcl_Obj *Tcl_FSSplitPath(Tcl_Obj *pathPtr, size_t *lenPtr)
}
declare 667 {
    int Tcl_ParseArgsObjv(Tcl_Interp *interp, const Tcl_ArgvInfo *argTable,
	    size_t *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv)
}

# TIP #617
declare 668 {
    Tcl_Size Tcl_UniCharLen(const int *uniStr)
}
declare 669 {







|













|



|




|


|



|















>
>

|
|
>


|
|
>










|



|


|


|



|


|



|







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
declare 645 {
    int Tcl_GetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    Tcl_Size endValue, Tcl_Size *indexPtr)
}

# TIP #548
declare 646 {
    Tcl_Size Tcl_UtfToUniChar(const char *src, int *chPtr)
}
declare 647 {
    char *Tcl_UniCharToUtfDString(const int *uniStr,
	    Tcl_Size uniLength, Tcl_DString *dsPtr)
}
declare 648 {
    int *Tcl_UtfToUniCharDString(const char *src,
	    Tcl_Size length, Tcl_DString *dsPtr)
}

# TIP #568
declare 649 {
    unsigned char *TclGetBytesFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    void *numBytesPtr)
}
declare 650 {
    unsigned char *Tcl_GetBytesFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    Tcl_Size *numBytesPtr)
}

# TIP #481
declare 651 {
    char *Tcl_GetStringFromObj(Tcl_Obj *objPtr, Tcl_Size *lengthPtr)
}
declare 652 {
    Tcl_UniChar *Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, Tcl_Size *lengthPtr)
}
# Only available in Tcl 8.x, NULL in Tcl 9.0
declare 653 {
    unsigned char *Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr, Tcl_Size *numBytesPtr)
}

# TIP #575
declare 654 {
    int Tcl_UtfCharComplete(const char *src, Tcl_Size length)
}
declare 655 {
    const char *Tcl_UtfNext(const char *src)
}
declare 656 {
    const char *Tcl_UtfPrev(const char *src, const char *start)
}
declare 657 {
    int Tcl_UniCharIsUnicode(int ch)
}

# TIP 656
declare 658 {
    int Tcl_ExternalToUtfDStringEx(Tcl_Interp *interp, Tcl_Encoding encoding,
        const char *src, Tcl_Size srcLen, int flags, Tcl_DString *dsPtr,
        Tcl_Size *errorLocationPtr)
}
declare 659 {
    int Tcl_UtfToExternalDStringEx(Tcl_Interp *interp, Tcl_Encoding encoding,
    const char *src, Tcl_Size srcLen, int flags, Tcl_DString *dsPtr,
    Tcl_Size *errorLocationPtr)
}

# TIP #511
declare 660 {
    int Tcl_AsyncMarkFromSignal(Tcl_AsyncHandler async, int sigNumber)
}

# TIP #616
declare 661 {
    int Tcl_ListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr,
	    Tcl_Size *objcPtr, Tcl_Obj ***objvPtr)
}
declare 662 {
    int Tcl_ListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr,
	    Tcl_Size *lengthPtr)
}
declare 663 {
    int Tcl_DictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Size *sizePtr)
}
declare 664 {
    int Tcl_SplitList(Tcl_Interp *interp, const char *listStr, Tcl_Size *argcPtr,
	    const char ***argvPtr)
}
declare 665 {
    void Tcl_SplitPath(const char *path, Tcl_Size *argcPtr, const char ***argvPtr)
}
declare 666 {
    Tcl_Obj *Tcl_FSSplitPath(Tcl_Obj *pathPtr, Tcl_Size *lenPtr)
}
declare 667 {
    int Tcl_ParseArgsObjv(Tcl_Interp *interp, const Tcl_ArgvInfo *argTable,
	    Tcl_Size *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv)
}

# TIP #617
declare 668 {
    Tcl_Size Tcl_UniCharLen(const int *uniStr)
}
declare 669 {
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
declare 676 {
    Tcl_Command Tcl_CreateObjCommand2(Tcl_Interp *interp,
	    const char *cmdName,
	    Tcl_ObjCmdProc2 *proc2, void *clientData,
	    Tcl_CmdDeleteProc *deleteProc)
}
declare 677 {
    Tcl_Trace Tcl_CreateObjTrace2(Tcl_Interp *interp, int level, int flags,
	    Tcl_CmdObjTraceProc2 *objProc2, void *clientData,
	    Tcl_CmdObjTraceDeleteProc *delProc)
}
declare 678 {
    Tcl_Command Tcl_NRCreateCommand2(Tcl_Interp *interp,
	    const char *cmdName, Tcl_ObjCmdProc2 *proc,
	    Tcl_ObjCmdProc2 *nreProc2, void *clientData,
	    Tcl_CmdDeleteProc *deleteProc)
}
declare 679 {
    int Tcl_NRCallObjProc2(Tcl_Interp *interp, Tcl_ObjCmdProc2 *objProc2,
	    void *clientData, size_t objc, Tcl_Obj *const objv[])
}

# TIP #638.
declare 680 {
    int Tcl_GetNumberFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    void **clientDataPtr, int *typePtr)
}
declare 681 {
    int Tcl_GetNumber(Tcl_Interp *interp, const char *bytes, size_t numBytes,
	    void **clientDataPtr, int *typePtr)
}

# TIP #220.
declare 682 {
    int Tcl_RemoveChannelMode(Tcl_Interp *interp, Tcl_Channel chan, int mode)
}

# TIP 643
declare 683 {
   int Tcl_GetEncodingNulLength(Tcl_Encoding encoding)
}

# TIP #636
declare 684 {
    Tcl_AbstractListType * Tcl_AbstractListGetType(Tcl_Obj *objPtr)
}
declare 685 {
    Tcl_Obj *Tcl_AbstractListObjNew(Tcl_Interp *interp, const Tcl_AbstractListType* vTablePtr)

}
declare 686 {
    Tcl_WideInt	Tcl_AbstractListObjLength(Tcl_Obj *abstractListPtr)
}

declare 687 {
    int Tcl_AbstractListObjIndex(Tcl_Interp *interp, Tcl_Obj *abstractListPtr, Tcl_Size index, Tcl_Obj **elemObjPtr)
}
declare 688 {
    int Tcl_AbstractListObjRange(Tcl_Interp *interp, Tcl_Obj *abstractListPtr, Tcl_Size fromIdx, Tcl_Size toIdx, Tcl_Obj **newObjPtr)
}
declare 689 {
    int Tcl_AbstractListObjReverse(Tcl_Interp *interp, Tcl_Obj *abstractListPtr, Tcl_Obj **newObjPtr)
}
declare 690 {
    int Tcl_AbstractListObjGetElements(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size *objcPtr, Tcl_Obj ***objvPtr)

}
declare 691 {
    Tcl_Obj *Tcl_AbstractListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr)
}
declare 692 {
    void *Tcl_AbstractListGetConcreteRep(Tcl_Obj *objPtr)

}
declare 693 {
    Tcl_Obj *Tcl_AbstractListSetElement(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size indexCount, Tcl_Obj *const indexArray[], Tcl_Obj *valueObj)

}

# ----- BASELINE -- FOR -- 8.7.0 ----- #

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

# Define the platform specific public Tcl interface. These functions are only
# available on the designated platform.

interface tclPlat

################################
# Unix specific functions
#   (none)

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

declare 1 {
    int Tcl_MacOSXOpenVersionedBundleResources(Tcl_Interp *interp,
	    const char *bundleName, const char *bundleVersion,
	    int hasResourceFile, size_t maxPathLen, char *libraryPath)
}
declare 2 {
    void Tcl_MacOSXNotifierAddRunLoopMode(const void *runLoopMode)
}

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







|











|








|










|


|

<
<
<
|
>

<
<
|
>
|
|

<
<
|
|
<
<
|
|
>

<
<
|
<
<
>
|
|
<
>

<
<


















|







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
declare 676 {
    Tcl_Command Tcl_CreateObjCommand2(Tcl_Interp *interp,
	    const char *cmdName,
	    Tcl_ObjCmdProc2 *proc2, void *clientData,
	    Tcl_CmdDeleteProc *deleteProc)
}
declare 677 {
    Tcl_Trace Tcl_CreateObjTrace2(Tcl_Interp *interp, Tcl_Size level, int flags,
	    Tcl_CmdObjTraceProc2 *objProc2, void *clientData,
	    Tcl_CmdObjTraceDeleteProc *delProc)
}
declare 678 {
    Tcl_Command Tcl_NRCreateCommand2(Tcl_Interp *interp,
	    const char *cmdName, Tcl_ObjCmdProc2 *proc,
	    Tcl_ObjCmdProc2 *nreProc2, void *clientData,
	    Tcl_CmdDeleteProc *deleteProc)
}
declare 679 {
    int Tcl_NRCallObjProc2(Tcl_Interp *interp, Tcl_ObjCmdProc2 *objProc2,
	    void *clientData, ptrdiff_t objc, Tcl_Obj *const objv[])
}

# TIP #638.
declare 680 {
    int Tcl_GetNumberFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    void **clientDataPtr, int *typePtr)
}
declare 681 {
    int Tcl_GetNumber(Tcl_Interp *interp, const char *bytes, Tcl_Size numBytes,
	    void **clientDataPtr, int *typePtr)
}

# TIP #220.
declare 682 {
    int Tcl_RemoveChannelMode(Tcl_Interp *interp, Tcl_Channel chan, int mode)
}

# TIP 643
declare 683 {
   Tcl_Size Tcl_GetEncodingNulLength(Tcl_Encoding encoding)
}

# TIP #650
declare 684 {



    int Tcl_GetWideUIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    Tcl_WideUInt *uwidePtr)
}



# TIP 651
declare 685 {
    Tcl_Obj *Tcl_DStringToObj(Tcl_DString *dsPtr)
}



# TIP 660


declare 686 {
    int Tcl_GetSizeIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    Tcl_Size *sizePtr)
}





# ----- BASELINE -- FOR -- 8.7.0 / 9.0.0 ----- #

declare 688 {

    void TclUnusedStubEntry(void)
}



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

# Define the platform specific public Tcl interface. These functions are only
# available on the designated platform.

interface tclPlat

################################
# Unix specific functions
#   (none)

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

declare 1 {
    int Tcl_MacOSXOpenVersionedBundleResources(Tcl_Interp *interp,
	    const char *bundleName, const char *bundleVersion,
	    int hasResourceFile, Tcl_Size maxPathLen, char *libraryPath)
}
declare 2 {
    void Tcl_MacOSXNotifierAddRunLoopMode(const void *runLoopMode)
}

################################
# Windows specific functions
2712
2713
2714
2715
2716
2717
2718

2719
2720
2721
2722
}
export {
    const char *Tcl_InitSubsystems(void)
}
export {
    const char *TclZipfs_AppHook(int *argc, char ***argv)
}


# Local Variables:
# mode: tcl
# End:







>




2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
}
export {
    const char *Tcl_InitSubsystems(void)
}
export {
    const char *TclZipfs_AppHook(int *argc, char ***argv)
}


# Local Variables:
# mode: tcl
# End:

Changes to generic/tcl.h.

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
#	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)))
#define Tcl_DoubleAsWide(val)	((Tcl_WideInt)((double)(val)))


#ifdef _WIN32






#   if TCL_MAJOR_VERSION > 8
	typedef struct __stat64 Tcl_StatBuf;

#   elif defined(_WIN64) || defined(_USE_64BIT_TIME_T)
	typedef struct __stat64 Tcl_StatBuf;
#   elif defined(_USE_32BIT_TIME_T)
	typedef struct _stati64	Tcl_StatBuf;
#   else
	typedef struct _stat32i64 Tcl_StatBuf;
#   endif
#elif defined(__CYGWIN__)
    typedef struct {
	dev_t st_dev;
	unsigned short st_ino;
	unsigned short st_mode;
	short st_nlink;
	short st_uid;
	short st_gid;
	/* Here is a 2-byte gap */
	dev_t st_rdev;
	/* Here is a 4-byte gap */
	long long st_size;
#if TCL_MAJOR_VERSION > 8
	struct {long long tv_sec;} st_atim;
	struct {long long tv_sec;} st_mtim;
	struct {long long tv_sec;} st_ctim;
#else
	struct {long tv_sec;} st_atim;
	struct {long tv_sec;} st_mtim;
	struct {long tv_sec;} st_ctim;
	/* Here is a 4-byte gap */
#endif
    } Tcl_StatBuf;
#elif defined(HAVE_STRUCT_STAT64) && !defined(__APPLE__)
    typedef struct stat64 Tcl_StatBuf;
#else
    typedef struct stat Tcl_StatBuf;
#endif








>
>
>
>
>
>
>
>
>
>





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








|






|


<
<
<
<
<



<
<







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
#	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 */
#ifndef TCL_T_MODIFIER
#   if defined(__GNUC__) && !defined(_WIN32)
#	define TCL_T_MODIFIER	"t"
#   elif defined(_WIN64)
#	define TCL_T_MODIFIER	TCL_LL_MODIFIER
#   else
#	define TCL_T_MODIFIER	TCL_Z_MODIFIER
#   endif
#endif /* !TCL_T_MODIFIER */

#define Tcl_WideAsLong(val)	((long)((Tcl_WideInt)(val)))
#define Tcl_LongAsWide(val)	((Tcl_WideInt)((long)(val)))
#define Tcl_WideAsDouble(val)	((double)((Tcl_WideInt)(val)))
#define Tcl_DoubleAsWide(val)	((Tcl_WideInt)((double)(val)))

#if TCL_MAJOR_VERSION < 9
    typedef int Tcl_Size;
#   define TCL_SIZE_MODIFIER ""
#   define TCL_SIZE_MAX INT_MAX
#else
    typedef ptrdiff_t Tcl_Size;
#   define TCL_SIZE_MAX PTRDIFF_MAX
#   define TCL_SIZE_MODIFIER TCL_T_MODIFIER
#endif /* TCL_MAJOR_VERSION */

#ifdef _WIN32
#   if TCL_MAJOR_VERSION > 8 || defined(_WIN64) || defined(_USE_64BIT_TIME_T)
	typedef struct __stat64 Tcl_StatBuf;
#   elif defined(_USE_32BIT_TIME_T)
	typedef struct _stati64	Tcl_StatBuf;
#   else
	typedef struct _stat32i64 Tcl_StatBuf;
#   endif
#elif defined(__CYGWIN__)
    typedef struct {
	unsigned st_dev;
	unsigned short st_ino;
	unsigned short st_mode;
	short st_nlink;
	short st_uid;
	short st_gid;
	/* Here is a 2-byte gap */
	unsigned st_rdev;
	/* Here is a 4-byte gap */
	long long st_size;





	struct {long tv_sec;} st_atim;
	struct {long tv_sec;} st_mtim;
	struct {long tv_sec;} st_ctim;


    } Tcl_StatBuf;
#elif defined(HAVE_STRUCT_STAT64) && !defined(__APPLE__)
    typedef struct stat64 Tcl_StatBuf;
#else
    typedef struct stat Tcl_StatBuf;
#endif

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

/*
 * Structures filled in by Tcl_RegExpInfo. Note that all offset values are
 * relative to the start of the match string, not the beginning of the entire
 * string.
 */

#if TCL_MAJOR_VERSION > 8
typedef struct Tcl_RegExpIndices {

    size_t start;			/* Character offset of first character in
				 * match. */
    size_t end;			/* Character offset of first character after
				 * the match. */
} Tcl_RegExpIndices;

typedef struct Tcl_RegExpInfo {
    size_t nsubs;			/* Number of subexpressions in the compiled
				 * expression. */
    Tcl_RegExpIndices *matches;	/* Array of nsubs match offset pairs. */
    size_t extendStart;		/* The offset at which a subsequent match
				 * might begin. */
} Tcl_RegExpInfo;
#else
typedef struct Tcl_RegExpIndices {
    long start;			/* Character offset of first character in
				 * match. */
    long end;			/* Character offset of first character after
				 * the match. */
} Tcl_RegExpIndices;

typedef struct Tcl_RegExpInfo {
    int nsubs;			/* Number of subexpressions in the compiled
				 * expression. */
    Tcl_RegExpIndices *matches;	/* Array of nsubs match offset pairs. */

    long extendStart;		/* The offset at which a subsequent match
				 * might begin. */


    long reserved;		/* Reserved for later use. */
} Tcl_RegExpInfo;
#endif


/*
 * Picky compilers complain if this typdef doesn't appear before the struct's
 * reference in tclDecls.h.
 */

typedef Tcl_StatBuf *Tcl_Stat_;







<

>
|

|

<
<
<
<
<
<
<
<
<

<
|
<
|
|



|


>
|

>
>

<

>







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

/*
 * Structures filled in by Tcl_RegExpInfo. Note that all offset values are
 * relative to the start of the match string, not the beginning of the entire
 * string.
 */


typedef struct Tcl_RegExpIndices {
#if TCL_MAJOR_VERSION > 8
    Tcl_Size start;			/* Character offset of first character in
				 * match. */
    Tcl_Size end;			/* Character offset of first character after
				 * the match. */









#else

    long start;

    long end;
#endif
} Tcl_RegExpIndices;

typedef struct Tcl_RegExpInfo {
    Tcl_Size nsubs;			/* Number of subexpressions in the compiled
				 * expression. */
    Tcl_RegExpIndices *matches;	/* Array of nsubs match offset pairs. */
#if TCL_MAJOR_VERSION > 8
    Tcl_Size extendStart;		/* The offset at which a subsequent match
				 * might begin. */
#else
    long extendStart;
    long reserved;		/* Reserved for later use. */

#endif
} Tcl_RegExpInfo;

/*
 * Picky compilers complain if this typdef doesn't appear before the struct's
 * reference in tclDecls.h.
 */

typedef Tcl_StatBuf *Tcl_Stat_;
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
typedef void (Tcl_CmdTraceProc) (void *clientData, Tcl_Interp *interp,
	int level, char *command, Tcl_CmdProc *proc,
	void *cmdClientData, int argc, const char *argv[]);
typedef int (Tcl_CmdObjTraceProc) (void *clientData, Tcl_Interp *interp,
	int level, const char *command, Tcl_Command commandInfo, int objc,
	struct Tcl_Obj *const *objv);
typedef int (Tcl_CmdObjTraceProc2) (void *clientData, Tcl_Interp *interp,
	int level, const char *command, Tcl_Command commandInfo, size_t objc,
	struct Tcl_Obj *const *objv);
typedef void (Tcl_CmdObjTraceDeleteProc) (void *clientData);
typedef void (Tcl_DupInternalRepProc) (struct Tcl_Obj *srcPtr,
	struct Tcl_Obj *dupPtr);
typedef int (Tcl_EncodingConvertProc) (void *clientData, const char *src,
	int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst,
	int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr);







|







557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
typedef void (Tcl_CmdTraceProc) (void *clientData, Tcl_Interp *interp,
	int level, char *command, Tcl_CmdProc *proc,
	void *cmdClientData, int argc, const char *argv[]);
typedef int (Tcl_CmdObjTraceProc) (void *clientData, Tcl_Interp *interp,
	int level, const char *command, Tcl_Command commandInfo, int objc,
	struct Tcl_Obj *const *objv);
typedef int (Tcl_CmdObjTraceProc2) (void *clientData, Tcl_Interp *interp,
	Tcl_Size level, const char *command, Tcl_Command commandInfo, Tcl_Size objc,
	struct Tcl_Obj *const *objv);
typedef void (Tcl_CmdObjTraceDeleteProc) (void *clientData);
typedef void (Tcl_DupInternalRepProc) (struct Tcl_Obj *srcPtr,
	struct Tcl_Obj *dupPtr);
typedef int (Tcl_EncodingConvertProc) (void *clientData, const char *src,
	int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst,
	int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr);
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
typedef void (Tcl_IdleProc) (void *clientData);
typedef void (Tcl_InterpDeleteProc) (void *clientData,
	Tcl_Interp *interp);
typedef void (Tcl_NamespaceDeleteProc) (void *clientData);
typedef int (Tcl_ObjCmdProc) (void *clientData, Tcl_Interp *interp,
	int objc, struct Tcl_Obj *const *objv);
typedef int (Tcl_ObjCmdProc2) (void *clientData, Tcl_Interp *interp,
	size_t objc, struct Tcl_Obj *const *objv);
typedef int (Tcl_LibraryInitProc) (Tcl_Interp *interp);
typedef int (Tcl_LibraryUnloadProc) (Tcl_Interp *interp, int flags);
typedef void (Tcl_PanicProc) (const char *format, ...);
typedef void (Tcl_TcpAcceptProc) (void *callbackData, Tcl_Channel chan,
	char *address, int port);
typedef void (Tcl_TimerProc) (void *clientData);
typedef int (Tcl_SetFromAnyProc) (Tcl_Interp *interp, struct Tcl_Obj *objPtr);







|







582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
typedef void (Tcl_IdleProc) (void *clientData);
typedef void (Tcl_InterpDeleteProc) (void *clientData,
	Tcl_Interp *interp);
typedef void (Tcl_NamespaceDeleteProc) (void *clientData);
typedef int (Tcl_ObjCmdProc) (void *clientData, Tcl_Interp *interp,
	int objc, struct Tcl_Obj *const *objv);
typedef int (Tcl_ObjCmdProc2) (void *clientData, Tcl_Interp *interp,
	Tcl_Size objc, struct Tcl_Obj *const *objv);
typedef int (Tcl_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);
601
602
603
604
605
606
607




















608
609
610
611
612
613
614
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

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







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







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

/* Abstract List functions */
typedef	      Tcl_Size	(Tcl_ObjTypeLengthProc)  (struct Tcl_Obj *listPtr);
typedef		   int	(Tcl_ObjTypeIndexProc)   (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
                                             Tcl_Size index, struct Tcl_Obj** elemObj);
typedef		   int	(Tcl_ObjTypeSliceProc)   (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
                                             Tcl_Size fromIdx, Tcl_Size toIdx,
                                             struct Tcl_Obj **newObjPtr);
typedef		   int	(Tcl_ObjTypeReverseProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
					     struct Tcl_Obj **newObjPtr);
typedef		   int	(Tcl_ObjTypeGetElements) (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
					     Tcl_Size *objcptr, struct Tcl_Obj ***objvptr);
typedef	struct Tcl_Obj*	(Tcl_ObjTypeSetElement)  (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
                                             Tcl_Size indexCount,
                                             struct Tcl_Obj *const indexArray[],
                                             struct Tcl_Obj *valueObj);
typedef            int  (Tcl_ObjTypeReplaceProc) (Tcl_Interp *interp, struct Tcl_Obj *listObj,
                                             Tcl_Size first, Tcl_Size numToDelete,
                                             Tcl_Size numToInsert,
                                             struct Tcl_Obj *const insertObjs[]);

#ifndef TCL_NO_DEPRECATED
#   define Tcl_PackageInitProc Tcl_LibraryInitProc
#   define Tcl_PackageUnloadProc Tcl_LibraryUnloadProc
#endif

/*
 *----------------------------------------------------------------------------
629
630
631
632
633
634
635
















636









637
638
639
640
641
642
643
    Tcl_UpdateStringProc *updateStringProc;
				/* Called to update the string rep from the
				 * type's internal representation. */
    Tcl_SetFromAnyProc *setFromAnyProc;
				/* Called to convert the object's internal rep
				 * to this type. Frees the internal rep of the
				 * old type. Returns TCL_ERROR on failure. */
















} Tcl_ObjType;










/*
 * The following structure stores an internal representation (internalrep) for
 * a Tcl value. An internalrep is associated with an Tcl_ObjType when both
 * are stored in the same Tcl_Obj.  The routines of the Tcl_ObjType govern
 * the handling of the internalrep.
 */







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

>
>
>
>
>
>
>
>
>







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
    Tcl_UpdateStringProc *updateStringProc;
				/* Called to update the string rep from the
				 * type's internal representation. */
    Tcl_SetFromAnyProc *setFromAnyProc;
				/* Called to convert the object's internal rep
				 * to this type. Frees the internal rep of the
				 * old type. Returns TCL_ERROR on failure. */
    size_t version;

    /* List emulation functions - ObjType Version 1 */
    Tcl_ObjTypeLengthProc *lengthProc;	     /* Return the [llength] of the
					     ** AbstractList */
    Tcl_ObjTypeIndexProc *indexProc;	     /* Return a value (Tcl_Obj) for
					     ** [lindex $al $index] */
    Tcl_ObjTypeSliceProc *sliceProc;	     /* Return an AbstractList for
					     ** [lrange $al $start $end] */
    Tcl_ObjTypeReverseProc *reverseProc;     /* Return an AbstractList for
					     ** [lreverse $al] */
    Tcl_ObjTypeGetElements *getElementsProc; /* Return an objv[] of all elements in
					     ** the list */
    Tcl_ObjTypeSetElement *setElementProc;   /* Replace the element at the indicie
					     ** with the given valueObj. */
    Tcl_ObjTypeReplaceProc *replaceProc;     /* Replace subset with subset */
} Tcl_ObjType;

#define TCL_OBJTYPE_V0 0,0,0,0,0,0,0,0 /* Pre-Tcl 9 */
#define TCL_OBJTYPE_V1(a) 1,a,0,0,0,0,0,0 /* Tcl 9 Version 1 */

#define TCL_OBJTYPE_V2(a,b,c,d,e,f,g)	 2, \
    a,b,c,d,e,f,g /* Tcl 9 - AbstractLists */

#define TCL_OBJTYPE_CURRENT 2


/*
 * The following structure stores an internal representation (internalrep) for
 * a Tcl value. An internalrep is associated with an Tcl_ObjType when both
 * are stored in the same Tcl_Obj.  The routines of the Tcl_ObjType govern
 * the handling of the internalrep.
 */
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
} Tcl_ObjInternalRep;

/*
 * One of the following structures exists for each object in the Tcl system.
 * An object stores a value as either a string, some internal representation,
 * or both.
 */
#if TCL_MAJOR_VERSION > 8
typedef size_t Tcl_Size;
#else
typedef int Tcl_Size;
#endif


typedef struct Tcl_Obj {
    Tcl_Size refCount;		/* When 0 the object will be freed. */
    char *bytes;		/* This points to the first byte of the
				 * object's string representation. The array
				 * must be followed by a null byte (i.e., at
				 * offset length) but may also contain
				 * embedded null characters. The array's
				 * storage is allocated by Tcl_Alloc. NULL means
				 * the string rep is invalid and must be
				 * regenerated from the internal rep.  Clients
				 * should use Tcl_GetStringFromObj or
				 * Tcl_GetString to get a pointer to the byte
				 * array as a readonly value. */
    Tcl_Size length;			/* The number of bytes at *bytes, not
				 * including the terminating null. */
    const Tcl_ObjType *typePtr;	/* Denotes the object's type. Always
				 * corresponds to the type of the object's
				 * internal rep. NULL indicates the object has
				 * no internal rep (has no type). */
    Tcl_ObjInternalRep internalRep;	/* The internal representation: */
} Tcl_Obj;


/*
 * Abstract List
 *
 *  This structure provides the functions used in List operations to emulate a
 *  List for AbstractList types.
 */

/* Abstract List functions */
typedef struct Tcl_Obj* (Tcl_ALNewObjProc) (Tcl_Size objc, struct Tcl_Obj * const objv[]);
typedef		  void	(Tcl_ALDupRepProc) (struct Tcl_Obj *srcPtr, struct Tcl_Obj *copyPtr);
typedef	   Tcl_WideInt	(Tcl_ALLengthProc) (struct Tcl_Obj *listPtr);
typedef		   int	(Tcl_ALIndexProc)  (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
					    Tcl_Size index, struct Tcl_Obj** elemObj);
typedef		   int	(Tcl_ALSliceProc)  (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
					    Tcl_Size fromIdx, Tcl_Size toIdx,
					    struct Tcl_Obj **newObjPtr);
typedef		   int	(Tcl_ALReverseProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
					     struct Tcl_Obj **newObjPtr);
typedef		   int	(Tcl_ALGetElements) (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
					     Tcl_Size *objcptr, struct Tcl_Obj ***objvptr);
typedef		  void	(Tcl_ALFreeConcreteRep) (struct Tcl_Obj *listPtr);
typedef		  void	(Tcl_ALToStringRep) (struct Tcl_Obj *listPtr);
typedef	struct Tcl_Obj*	(Tcl_ALSetElement) (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
					    Tcl_Size indexCount,
					    struct Tcl_Obj *const indexArray[],
					    struct Tcl_Obj *valueObj);
typedef            int  (Tcl_ALReplaceProc) (Tcl_Interp *interp, struct Tcl_Obj *listObj,
					    Tcl_Size first, Tcl_Size numToDelete,
					    Tcl_Size numToInsert,
					    struct Tcl_Obj *const insertObjs[]);

typedef enum {
    TCL_ABSL_NEW, TCL_ABSL_DUPREP, TCL_ABSL_LENGTH, TCL_ABSL_INDEX,
    TCL_ABSL_SLICE, TCL_ABSL_REVERSE, TCL_ABSL_GETELEMENTS, TCL_ABSL_FREEREP,
    TCL_ABSL_TOSTRING, TCL_ABSL_SETELEMENT, TCL_ABSL_REPLACE
} Tcl_AbstractListProcType;

typedef struct Tcl_AbstractListVersion_ *Tcl_AbstractListVersion;


#define TCL_ABSTRACTLIST_VERSION_1 ((Tcl_AbstractListVersion) 0x1)

/* Virtual function dispatch a la Tcl_ObjType but for AbstractList */
typedef struct Tcl_AbstractListType {
    Tcl_AbstractListVersion version;/* Structure version */
    const char *typeName;	    /* Custom value reference */

    /* List emulation functions */
    Tcl_ALNewObjProc *newObjProc;	/* How to create a new Tcl_Obj of this
					** custom type */
    Tcl_ALDupRepProc *dupRepProc;	/* How to duplicate a internal rep of this
					** custom type */
    Tcl_ALLengthProc *lengthProc;	/* Return the [llength] of the
					** AbstractList */
    Tcl_ALIndexProc *indexProc;		/* Return a value (Tcl_Obj) for
					** [lindex $al $index] */
    Tcl_ALSliceProc *sliceProc;		/* Return an AbstractList for
					** [lrange $al $start $end] */
    Tcl_ALReverseProc *reverseProc;	/* Return an AbstractList for
					** [lreverse $al] */
    Tcl_ALGetElements *getElementsProc; /* Return an objv[] of all elements in
					** the list */
    Tcl_ALFreeConcreteRep *freeRepProc; /* Free ConcreteRep internals if
                                        ** necessary */
    Tcl_ALToStringRep *toStringProc;	/* Optimized "to-string" conversion
                                        ** for updating the string rep */
    Tcl_ALSetElement *setElementProc;   /* Replace the element at the indicie
					** with the given valueObj. */
    Tcl_ALReplaceProc *replaceProc;     /* Replace subset with subset */

} Tcl_AbstractListType;

/*
 * Sets the storage used by the concrete abstract list type
 * Caller has to ensure type is AbstractList. Existing rep will be
 * overwritten so caller has to free previous rep if necessary.
 */
static inline void Tcl_AbstractListSetConcreteRep(
    Tcl_Obj *objPtr,    /* Object of type AbstractList */
    void *repPtr)       /* New representation */
{
    /*  assert(objPtr->typePtr == &tclAbstractListType); */
    objPtr->internalRep.twoPtrValue.ptr1 = repPtr;
}

/*
 *----------------------------------------------------------------------------
 * The following structure contains the state needed by Tcl_SaveResult. No-one
 * outside of Tcl should access any of these fields. This structure is
 * typically allocated on the stack.
 */

#ifndef TCL_NO_DEPRECATED
typedef struct Tcl_SavedResult {
    char *result;
    Tcl_FreeProc *freeProc;
    Tcl_Obj *objResultPtr;
    char *appendResult;
    int appendAvl;
    int appendUsed;
    char resultSpace[200+1];
} Tcl_SavedResult;
#endif

/*
 *----------------------------------------------------------------------------
 * The following definitions support Tcl's namespace facility. Note: the first
 * five fields must match exactly the fields in a Namespace structure (see
 * tclInt.h).
 */








<
<
<
<
<
<














|








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







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

/*
 * One of the following structures exists for each object in the Tcl system.
 * An object stores a value as either a string, some internal representation,
 * or both.
 */







typedef struct Tcl_Obj {
    Tcl_Size refCount;		/* When 0 the object will be freed. */
    char *bytes;		/* This points to the first byte of the
				 * object's string representation. The array
				 * must be followed by a null byte (i.e., at
				 * offset length) but may also contain
				 * embedded null characters. The array's
				 * storage is allocated by Tcl_Alloc. NULL means
				 * the string rep is invalid and must be
				 * regenerated from the internal rep.  Clients
				 * should use Tcl_GetStringFromObj or
				 * Tcl_GetString to get a pointer to the byte
				 * array as a readonly value. */
    Tcl_Size length;		/* The number of bytes at *bytes, not
				 * including the terminating null. */
    const Tcl_ObjType *typePtr;	/* Denotes the object's type. Always
				 * corresponds to the type of the object's
				 * internal rep. NULL indicates the object has
				 * no internal rep (has no type). */
    Tcl_ObjInternalRep internalRep;	/* The internal representation: */
} Tcl_Obj;










































































































/*
 *----------------------------------------------------------------------------
 * The following definitions support Tcl's namespace facility. Note: the first
 * five fields must match exactly the fields in a Namespace structure (see
 * tclInt.h).
 */

873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
 * is set to 1 if an object-based function was registered by
 * Tcl_CreateObjCommand, and to 0 if a string-based function was registered by
 * Tcl_CreateCommand. The other function is typically set to a compatibility
 * wrapper that does string-to-object or object-to-string argument conversions
 * then calls the other function.
 */

typedef struct Tcl_CmdInfo {
    int isNativeObjectProc;	/* 1 if objProc was registered by a call to
				 * Tcl_CreateObjCommand; 2 if objProc was registered by
				 * a call to Tcl_CreateObjCommand2; 0 otherwise.
				 * Tcl_SetCmdInfo does not modify this field. */
    Tcl_ObjCmdProc *objProc;	/* Command's object-based function. */
    void *objClientData;	/* ClientData for object proc. */
    Tcl_CmdProc *proc;		/* Command's string-based function. */







|







810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
 * is set to 1 if an object-based function was registered by
 * Tcl_CreateObjCommand, and to 0 if a string-based function was registered by
 * Tcl_CreateCommand. The other function is typically set to a compatibility
 * wrapper that does string-to-object or object-to-string argument conversions
 * then calls the other function.
 */

typedef struct {
    int isNativeObjectProc;	/* 1 if objProc was registered by a call to
				 * Tcl_CreateObjCommand; 2 if objProc was registered by
				 * a call to Tcl_CreateObjCommand2; 0 otherwise.
				 * Tcl_SetCmdInfo does not modify this field. */
    Tcl_ObjCmdProc *objProc;	/* Command's object-based function. */
    void *objClientData;	/* ClientData for object proc. */
    Tcl_CmdProc *proc;		/* Command's string-based function. */
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
 * macros Tcl_DStringValue and Tcl_DStringLength.
 */

#define TCL_DSTRING_STATIC_SIZE 200
typedef struct Tcl_DString {
    char *string;		/* Points to beginning of string: either
				 * staticSpace below or a malloced array. */
    Tcl_Size length;		/* Number of non-NULL characters in the
				 * string. */
    Tcl_Size spaceAvl;		/* Total number of bytes available for the
				 * string and its terminating NULL char. */
    char staticSpace[TCL_DSTRING_STATIC_SIZE];
				/* Space to use in common case where string is
				 * small. */
} Tcl_DString;








|
|







844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
 * macros Tcl_DStringValue and Tcl_DStringLength.
 */

#define TCL_DSTRING_STATIC_SIZE 200
typedef struct Tcl_DString {
    char *string;		/* Points to beginning of string: either
				 * staticSpace below or a malloced array. */
    Tcl_Size length;		/* Number of bytes in string excluding
				 * terminating nul */
    Tcl_Size spaceAvl;		/* Total number of bytes available for the
				 * string and its terminating NULL char. */
    char staticSpace[TCL_DSTRING_STATIC_SIZE];
				/* Space to use in common case where string is
				 * small. */
} Tcl_DString;

1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
 *				is described by a TCL_TOKEN_SUB_EXPR token
 *				followed by the TCL_TOKEN_OPERATOR token for
 *				the operator, then TCL_TOKEN_SUB_EXPR tokens
 *				for the left then the right operands.
 * TCL_TOKEN_OPERATOR -		The token describes one expression operator.
 *				An operator might be the name of a math
 *				function such as "abs". A TCL_TOKEN_OPERATOR
 *				token is always preceeded by one
 *				TCL_TOKEN_SUB_EXPR token for the operator's
 *				subexpression, and is followed by zero or more
 *				TCL_TOKEN_SUB_EXPR tokens for the operator's
 *				operands. NumComponents is always 0.
 * TCL_TOKEN_EXPAND_WORD -	This token is just like TCL_TOKEN_WORD except
 *				that it marks a word that began with the
 *				literal character prefix "{*}". This word is







|







1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
 *				is described by a TCL_TOKEN_SUB_EXPR token
 *				followed by the TCL_TOKEN_OPERATOR token for
 *				the operator, then TCL_TOKEN_SUB_EXPR tokens
 *				for the left then the right operands.
 * TCL_TOKEN_OPERATOR -		The token describes one expression operator.
 *				An operator might be the name of a math
 *				function such as "abs". A TCL_TOKEN_OPERATOR
 *				token is always preceded by one
 *				TCL_TOKEN_SUB_EXPR token for the operator's
 *				subexpression, and is followed by zero or more
 *				TCL_TOKEN_SUB_EXPR tokens for the operator's
 *				operands. NumComponents is always 0.
 * TCL_TOKEN_EXPAND_WORD -	This token is just like TCL_TOKEN_WORD except
 *				that it marks a word that began with the
 *				literal character prefix "{*}". This word is
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
				/* Function to convert from UTF-8 into
				 * external encoding. */
    Tcl_FreeProc *freeProc;
				/* If non-NULL, function to call when this
				 * encoding is deleted. */
    void *clientData;	/* Arbitrary value associated with encoding
				 * type. Passed to conversion functions. */
    int nullSize;		/* Number of zero bytes that signify
				 * end-of-string in this encoding. This number
				 * is used to determine the source string
				 * length when the srcLen argument is
				 * negative. Must be 1 or 2. */
} Tcl_EncodingType;

/*
 * The following definitions are used as values for the conversion control
 * flags argument when converting text from one character set to another:
 *
 * TCL_ENCODING_START -		Signifies that the source buffer is the first







|



|







1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
				/* Function to convert from UTF-8 into
				 * external encoding. */
    Tcl_FreeProc *freeProc;
				/* If non-NULL, function to call when this
				 * encoding is deleted. */
    void *clientData;	/* Arbitrary value associated with encoding
				 * type. Passed to conversion functions. */
    Tcl_Size nullSize;		/* Number of zero bytes that signify
				 * end-of-string in this encoding. This number
				 * is used to determine the source string
				 * length when the srcLen argument is
				 * negative. Must be 1, 2, or 4. */
} Tcl_EncodingType;

/*
 * The following definitions are used as values for the conversion control
 * flags argument when converting text from one character set to another:
 *
 * TCL_ENCODING_START -		Signifies that the source buffer is the first
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
 *				block in a (potentially multi-block) input
 *				stream. Tells the conversion routine to
 *				perform any finalization that needs to occur
 *				after the last byte is converted and then to
 *				reset to an initial state. If the source
 *				buffer contains the entire input stream to be
 *				converted, this flag should be set.
 * TCL_ENCODING_STRICT -	Be more strict in accepting what
 *				is considered a 'invalid byte sequence'.
 * TCL_ENCODING_STOPONERROR -	Not used any more.
 * TCL_ENCODING_NO_TERMINATE - 	If set, Tcl_ExternalToUtf does not append a
 *				terminating NUL byte.  Since it does not need
 *				an extra byte for a terminating NUL, it fills
 *				all dstLen bytes with encoded UTF-8 content if
 *				needed.  If clear, a byte is reserved in the
 *				dst space for NUL termination, and a
 *				terminating NUL is appended.
 * TCL_ENCODING_CHAR_LIMIT -	If set and dstCharsPtr is not NULL, then
 *				Tcl_ExternalToUtf takes the initial value of
 *				*dstCharsPtr as a limit of the maximum number
 *				of chars to produce in the encoded UTF-8
 *				content.  Otherwise, the number of chars
 *				produced is controlled only by other limiting
 *				factors.
 * TCL_ENCODING_MODIFIED -	Convert NULL bytes to \xC0\x80 in stead of
 *				0x00. Only valid for "utf-8" and "cesu-8".
 *				This flag is implicit for external -> internal conversions,

 *				optional for internal -> external conversions.
 * TCL_ENCODING_NOCOMPLAIN -	If set, the converter
 *				substitutes the problematic character(s) with
 *				one or more "close" characters in the
 *				destination buffer and then continues to
 *				convert the source. If clear, the converter returns
 *				immediately upon encountering an invalid byte sequence
 *				or a source character that has no mapping in the
 *				target encoding. Only for Tcl 9.x.
 */

#define TCL_ENCODING_START		0x01
#define TCL_ENCODING_END		0x02
#if TCL_MAJOR_VERSION > 8
#   define TCL_ENCODING_STRICT			0x04
#   define TCL_ENCODING_STOPONERROR	0x0 /* Not used any more */
#else
#   define TCL_ENCODING_STRICT			0x44
#   define TCL_ENCODING_STOPONERROR	0x04
#endif
#define TCL_ENCODING_NO_TERMINATE	0x08
#define TCL_ENCODING_CHAR_LIMIT		0x10

#define TCL_ENCODING_MODIFIED		0x20





#define TCL_ENCODING_NOCOMPLAIN		0x40








/*
 * The following definitions are the error codes returned by the conversion
 * routines:
 *
 * TCL_OK -			All characters were converted.
 * TCL_CONVERT_NOSPACE -	The output buffer would not have been large
 *				enough for all of the converted data; as many
 *				characters as could fit were converted though.
 * TCL_CONVERT_MULTIBYTE -	The last few bytes in the source string were
 *				the beginning of a multibyte sequence, but
 *				more bytes were needed to complete this
 *				sequence. A subsequent call to the conversion
 *				routine should pass the beginning of this
 *				unconverted sequence plus additional bytes
 *				from the source stream to properly convert the
 *				formerly split-up multibyte sequence.
 * TCL_CONVERT_SYNTAX -		The source stream contained an invalid
 *				character sequence. This may occur if the
 *				input stream has been damaged or if the input
 *				encoding method was misidentified. This error
 *				is reported unless if TCL_ENCODING_NOCOMPLAIN
 *				was specified.
 * TCL_CONVERT_UNKNOWN -	The source string contained a character that
 *				could not be represented in the target
 *				encoding. This error is reported unless if
 *				TCL_ENCODING_NOCOMPLAIN was specified.
 */

#define TCL_CONVERT_MULTIBYTE	(-1)
#define TCL_CONVERT_SYNTAX	(-2)
#define TCL_CONVERT_UNKNOWN	(-3)
#define TCL_CONVERT_NOSPACE	(-4)

/*
 * The maximum number of bytes that are necessary to represent a single
 * Unicode character in UTF-8. The valid values are 3 and 4
 * (or perhaps 1 if we want to support a non-unicode enabled core). If > 3,
 * then Tcl_UniChar must be 4-bytes in size (UCS-4) (the default). If == 3,
 * then Tcl_UniChar must be 2-bytes in size (UTF-16). Since Tcl 9.0, UCS-4
 * mode is the default and recommended mode.
 */

#ifndef TCL_UTF_MAX
#if TCL_MAJOR_VERSION > 8
#define TCL_UTF_MAX		4
#else
#define TCL_UTF_MAX		3
#endif
#endif

/*
 * This represents a Unicode character. Any changes to this should also be
 * reflected in regcustom.h.
 */








<
<















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





<


<




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




















|
<
<


|
<

















|
|
|
|
|







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
 *				block in a (potentially multi-block) input
 *				stream. Tells the conversion routine to
 *				perform any finalization that needs to occur
 *				after the last byte is converted and then to
 *				reset to an initial state. If the source
 *				buffer contains the entire input stream to be
 *				converted, this flag should be set.


 * TCL_ENCODING_STOPONERROR -	Not used any more.
 * TCL_ENCODING_NO_TERMINATE - 	If set, Tcl_ExternalToUtf does not append a
 *				terminating NUL byte.  Since it does not need
 *				an extra byte for a terminating NUL, it fills
 *				all dstLen bytes with encoded UTF-8 content if
 *				needed.  If clear, a byte is reserved in the
 *				dst space for NUL termination, and a
 *				terminating NUL is appended.
 * TCL_ENCODING_CHAR_LIMIT -	If set and dstCharsPtr is not NULL, then
 *				Tcl_ExternalToUtf takes the initial value of
 *				*dstCharsPtr as a limit of the maximum number
 *				of chars to produce in the encoded UTF-8
 *				content.  Otherwise, the number of chars
 *				produced is controlled only by other limiting
 *				factors.
 * TCL_ENCODING_PROFILE_* -	Mutually exclusive encoding profile ids. Note
 *				these are bit masks.

 *
 * NOTE: THESE BIT DEFINITIONS SHOULD NOT OVERLAP WITH INTERNAL USE BITS
 * DEFINED IN tclEncoding.c (ENCODING_INPUT et al). Be cognizant of this


 * when adding bits.




 */

#define TCL_ENCODING_START		0x01
#define TCL_ENCODING_END		0x02
#if TCL_MAJOR_VERSION > 8

#   define TCL_ENCODING_STOPONERROR	0x0 /* Not used any more */
#else

#   define TCL_ENCODING_STOPONERROR	0x04
#endif
#define TCL_ENCODING_NO_TERMINATE	0x08
#define TCL_ENCODING_CHAR_LIMIT		0x10
/* Internal use bits, do not define bits in this space. See above comment */
#define TCL_ENCODING_INTERNAL_USE_MASK  0xFF00
/*
 * Reserve top byte for profile values (disjoint, not a mask). In case of
 * changes, ensure ENCODING_PROFILE_* macros in tclInt.h are modified if
 * necessary.
 */
#define TCL_ENCODING_PROFILE_TCL8     0x01000000
#define TCL_ENCODING_PROFILE_STRICT   0x02000000
#define TCL_ENCODING_PROFILE_REPLACE  0x03000000
#if TCL_MAJOR_VERSION < 9
#define TCL_ENCODING_PROFILE_DEFAULT  TCL_ENCODING_PROFILE_TCL8
#else
#define TCL_ENCODING_PROFILE_DEFAULT  TCL_ENCODING_PROFILE_TCL8
#endif

/*
 * The following definitions are the error codes returned by the conversion
 * routines:
 *
 * TCL_OK -			All characters were converted.
 * TCL_CONVERT_NOSPACE -	The output buffer would not have been large
 *				enough for all of the converted data; as many
 *				characters as could fit were converted though.
 * TCL_CONVERT_MULTIBYTE -	The last few bytes in the source string were
 *				the beginning of a multibyte sequence, but
 *				more bytes were needed to complete this
 *				sequence. A subsequent call to the conversion
 *				routine should pass the beginning of this
 *				unconverted sequence plus additional bytes
 *				from the source stream to properly convert the
 *				formerly split-up multibyte sequence.
 * TCL_CONVERT_SYNTAX -		The source stream contained an invalid
 *				character sequence. This may occur if the
 *				input stream has been damaged or if the input
 *				encoding method was misidentified.


 * TCL_CONVERT_UNKNOWN -	The source string contained a character that
 *				could not be represented in the target
 *				encoding.

 */

#define TCL_CONVERT_MULTIBYTE	(-1)
#define TCL_CONVERT_SYNTAX	(-2)
#define TCL_CONVERT_UNKNOWN	(-3)
#define TCL_CONVERT_NOSPACE	(-4)

/*
 * The maximum number of bytes that are necessary to represent a single
 * Unicode character in UTF-8. The valid values are 3 and 4
 * (or perhaps 1 if we want to support a non-unicode enabled core). If > 3,
 * then Tcl_UniChar must be 4-bytes in size (UCS-4) (the default). If == 3,
 * then Tcl_UniChar must be 2-bytes in size (UTF-16). Since Tcl 9.0, UCS-4
 * mode is the default and recommended mode.
 */

#ifndef TCL_UTF_MAX
#   if TCL_MAJOR_VERSION > 8
#	define TCL_UTF_MAX		4
#   else
#	define TCL_UTF_MAX		3
#   endif
#endif

/*
 * This represents a Unicode character. Any changes to this should also be
 * reflected in regcustom.h.
 */

2354
2355
2356
2357
2358
2359
2360

2361
2362
2363
2364






2365
2366
2367
2368
2369
2370
2371
    TCL_NORETURN1 void Tcl_ConsolePanic(const char *format, ...);
#else
#   define Tcl_ConsolePanic NULL
#endif

#ifdef USE_TCL_STUBS
#if TCL_MAJOR_VERSION < 9

#   define Tcl_InitStubs(interp, version, exact) \
	(Tcl_InitStubs)(interp, version, \
	    (exact)|(TCL_MAJOR_VERSION<<8)|(0xFF<<16), \
	    TCL_STUB_MAGIC)






#elif TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE
#   define Tcl_InitStubs(interp, version, exact) \
	(Tcl_InitStubs)(interp, version, \
	    (exact)|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16), \
	    TCL_STUB_MAGIC)
#else
#   define Tcl_InitStubs(interp, version, exact) \







>




>
>
>
>
>
>







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
    TCL_NORETURN1 void Tcl_ConsolePanic(const char *format, ...);
#else
#   define Tcl_ConsolePanic NULL
#endif

#ifdef USE_TCL_STUBS
#if TCL_MAJOR_VERSION < 9
# if TCL_UTF_MAX < 4
#   define Tcl_InitStubs(interp, version, exact) \
	(Tcl_InitStubs)(interp, version, \
	    (exact)|(TCL_MAJOR_VERSION<<8)|(0xFF<<16), \
	    TCL_STUB_MAGIC)
# else
#   define Tcl_InitStubs(interp, version, exact) \
	(Tcl_InitStubs)(interp, "8.7.0", \
	    (exact)|(TCL_MAJOR_VERSION<<8)|(0xFF<<16), \
	    TCL_STUB_MAGIC)
# endif
#elif TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE
#   define Tcl_InitStubs(interp, version, exact) \
	(Tcl_InitStubs)(interp, version, \
	    (exact)|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16), \
	    TCL_STUB_MAGIC)
#else
#   define Tcl_InitStubs(interp, version, exact) \
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
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(size_t argc, wchar_t **argv,
	    Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
#endif
#if defined(USE_TCL_STUBS) && (TCL_MAJOR_VERSION > 8)
#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 *(*)(size_t, 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 *(*)(size_t, 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)







|












|



|







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
EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv);
#endif
#if defined(_WIN32) && defined(UNICODE)
#ifndef USE_TCL_STUBS
#   define Tcl_FindExecutable(arg) ((Tcl_FindExecutable)((const char *)(arg)))
#endif
#   define Tcl_MainEx Tcl_MainExW
    EXTERN TCL_NORETURN void Tcl_MainExW(Tcl_Size argc, wchar_t **argv,
	    Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
#endif
#if defined(USE_TCL_STUBS) && (TCL_MAJOR_VERSION > 8)
#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 *(*)(Tcl_Size, 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 *(*)(Tcl_Size, 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)
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
 */

#ifndef BUILD_tcl
#   define ckalloc Tcl_Alloc
#   define attemptckalloc Tcl_AttemptAlloc
#   ifdef _MSC_VER
	/* Silence invalid C4090 warnings */
#	define ckfree(a) Tcl_Free((char *)(a))
#	define ckrealloc(a,b) Tcl_Realloc((char *)(a),(b))
#	define attemptckrealloc(a,b) Tcl_AttemptRealloc((char *)(a),(b))
#   else
#	define ckfree Tcl_Free
#	define ckrealloc Tcl_Realloc
#	define attemptckrealloc Tcl_AttemptRealloc
#   endif
#endif








|
|
|







2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
 */

#ifndef BUILD_tcl
#   define ckalloc Tcl_Alloc
#   define attemptckalloc Tcl_AttemptAlloc
#   ifdef _MSC_VER
	/* Silence invalid C4090 warnings */
#	define ckfree(a) Tcl_Free((void *)(a))
#	define ckrealloc(a,b) Tcl_Realloc((void *)(a),(b))
#	define attemptckrealloc(a,b) Tcl_AttemptRealloc((void *)(a),(b))
#   else
#	define ckfree Tcl_Free
#	define ckrealloc Tcl_Realloc
#	define attemptckrealloc Tcl_AttemptRealloc
#   endif
#endif

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
	Tcl_DbIncrRefCount(objPtr, __FILE__, __LINE__)
#   undef Tcl_DecrRefCount
#   define Tcl_DecrRefCount(objPtr) \
	Tcl_DbDecrRefCount(objPtr, __FILE__, __LINE__)
#   undef Tcl_IsShared
#   define Tcl_IsShared(objPtr) \
	Tcl_DbIsShared(objPtr, __FILE__, __LINE__)



















#else
#   undef Tcl_IncrRefCount
#   define Tcl_IncrRefCount(objPtr) \
	++(objPtr)->refCount
    /*
     * Use do/while0 idiom for optimum correctness without compiler warnings.
     * https://wiki.c2.com/?TrivialDoWhileLoop
     */
#   undef Tcl_DecrRefCount
#   define Tcl_DecrRefCount(objPtr) \
	do { \
	    Tcl_Obj *_objPtr = (objPtr); \
	    if (_objPtr->refCount-- <= 1) { \
		TclFreeObj(_objPtr); \
	    } \
	} while(0)
#   undef Tcl_IsShared
#   define Tcl_IsShared(objPtr) \
	((objPtr)->refCount > 1)


















#endif

/*
 * Macros and definitions that help to debug the use of Tcl objects. When
 * TCL_MEM_DEBUG is defined, the Tcl_New declarations are overridden to call
 * debugging versions of the object creation functions.
 */







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



















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







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
	Tcl_DbIncrRefCount(objPtr, __FILE__, __LINE__)
#   undef Tcl_DecrRefCount
#   define Tcl_DecrRefCount(objPtr) \
	Tcl_DbDecrRefCount(objPtr, __FILE__, __LINE__)
#   undef Tcl_IsShared
#   define Tcl_IsShared(objPtr) \
	Tcl_DbIsShared(objPtr, __FILE__, __LINE__)
/*
 * Free the Obj by effectively doing:
 *
 *   Tcl_IncrRefCount(objPtr);
 *   Tcl_DecrRefCount(objPtr);
 *
 * This will free the obj if there are no references to the obj.
 */
#   define Tcl_BumpObj(objPtr) \
    TclBumpObj(objPtr, __FILE__, __LINE__)

static inline void TclBumpObj(Tcl_Obj* objPtr, const char* fn, int line)
{
    if (objPtr) {
        if ((objPtr)->refCount == 0) {
            Tcl_DbDecrRefCount(objPtr, fn, line);
	}
    }
}
#else
#   undef Tcl_IncrRefCount
#   define Tcl_IncrRefCount(objPtr) \
	++(objPtr)->refCount
    /*
     * Use do/while0 idiom for optimum correctness without compiler warnings.
     * https://wiki.c2.com/?TrivialDoWhileLoop
     */
#   undef Tcl_DecrRefCount
#   define Tcl_DecrRefCount(objPtr) \
	do { \
	    Tcl_Obj *_objPtr = (objPtr); \
	    if (_objPtr->refCount-- <= 1) { \
		TclFreeObj(_objPtr); \
	    } \
	} while(0)
#   undef Tcl_IsShared
#   define Tcl_IsShared(objPtr) \
	((objPtr)->refCount > 1)

/*
 * Declare that obj will no longer be used or referenced.
 * This will release the obj if there is no referece count,
 * otherwise let it be.
 */
#   define Tcl_BumpObj(objPtr)     \
    TclBumpObj(objPtr);

static inline void TclBumpObj(Tcl_Obj* objPtr)
{
    if (objPtr) {
        if ((objPtr)->refCount == 0) {
            Tcl_DecrRefCount(objPtr);
	}
    }
}

#endif

/*
 * Macros and definitions that help to debug the use of Tcl objects. When
 * TCL_MEM_DEBUG is defined, the Tcl_New declarations are overridden to call
 * debugging versions of the object creation functions.
 */

Deleted generic/tclAbstractList.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
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
/*
 * tclAbstractList.h --
 *
 *	The AbstractList Obj Type -- a psuedo List
 *
 * Copyright © 2022 by Brian Griffin. 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 "tcl.h"
#include "tclAbstractList.h"


/* -------------------------- AbstractList object ---------------------------- */

/*
 * Prototypes for procedures defined later in this file:
 */

static void		DupAbstractListInternalRep (Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
static void		FreeAbstractListInternalRep (Tcl_Obj *listPtr);
static int		SetAbstractListFromAny (Tcl_Interp *interp, Tcl_Obj *objPtr);
static void		UpdateStringOfAbstractList (Tcl_Obj *listPtr);

/*
 * The structure below defines the AbstractList Tcl object type by means of
 * procedures that can be invoked by generic object code.
 *
 * The abstract list object is a special case of Tcl list represented by a set
 * of functions.
 *
 */

const Tcl_ObjType tclAbstractListType = {
    "abstractlist",			/* name */
    FreeAbstractListInternalRep,	/* freeIntRepProc */
    DupAbstractListInternalRep,		/* dupIntRepProc */
    UpdateStringOfAbstractList,		/* updateStringProc */
    SetAbstractListFromAny		/* setFromAnyProc */
};

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AbstractListLen --
 *
 * 	Compute the length of the equivalent list
 *
 * Results:
 *
 * 	The length of the list generated by the given range,
 * 	that may be zero.
 *
 * Side effects:
 *
 * 	None.
 *
 *----------------------------------------------------------------------
 */
Tcl_WideInt
Tcl_AbstractListObjLength(Tcl_Obj *abstractListObjPtr)
{
    return AbstractListObjLength(abstractListObjPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AbstractListObjNew()
 *
 *	Creates a new AbstractList object. The returned object has
 *	refcount = 0.
 *
 * Results:
 *
 * 	A Tcl_Obj pointer to the created AbstractList object.
 * 	A NULL pointer of the range is invalid.
 *
 * Side Effects:
 *
 * 	None.
 *----------------------------------------------------------------------
 */

Tcl_Obj*
Tcl_AbstractListObjNew(Tcl_Interp *interp, const Tcl_AbstractListType* vTablePtr)
{
    Tcl_Obj *objPtr;
    Tcl_ObjInternalRep itr;
    (void)interp;
    TclNewObj(objPtr);
    Tcl_StoreInternalRep(objPtr, &tclAbstractListType, &itr);
    Tcl_AbstractListSetType(objPtr, (void*)vTablePtr); /* dispatch table for concrete type */
    Tcl_AbstractListSetConcreteRep(objPtr, NULL);
    Tcl_InvalidateStringRep(objPtr);
    return objPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AbstractListObjIndex --
 *
 *	Returns the element with the specified index in the list
 *	represented by the specified Abstract List object.
 *	If the index is out of range, TCL_ERROR is returned,
 *	otherwise TCL_OK is returned and the integer value of the
 *	element is stored in *element.
 *
 * Results:
 *
 * 	Element Tcl_Obj is returned on succes, NULL on index out of range.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_AbstractListObjIndex(
    Tcl_Interp *interp,		 /* Used for error reporting if not NULL. */
    Tcl_Obj *abstractListObjPtr, /* List obj */
    Tcl_Size index,		 /* index to element of interest */
    Tcl_Obj **elemObjPtr)	 /* Return value */
{
    Tcl_AbstractListType *typePtr;

    typePtr = Tcl_AbstractListGetType(abstractListObjPtr);
    /*
     * The general assumption is that the obj is assumed first to be a List,
     * and only ends up here because it has been determinded to be an
     * AbstractList.  If that's not the case, then a mistake has been made. To
     * attempt to try a List call (e.g. shimmer) could potentially loop(?)
     * So: if called from List code, then something has gone wrong; if called
     * from user code, then user has made a mistake.
     */
    if (typePtr == NULL) {
	if (interp) {
	    Tcl_SetObjResult(
		interp,
		Tcl_NewStringObj("Tcl_AbstractListObjIndex called without and AbstractList Obj.", -1));
	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "UNKNOWN", NULL);
	    return TCL_ERROR;
	}
    }
    return typePtr->indexProc(interp, abstractListObjPtr, index, elemObjPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * FreeAbstractListInternalRep --
 *
 *	Deallocate the storage associated with an abstract list object's
 *	internal representation.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Frees abstractListPtr's AbstractList* internal representation and
 *	sets listPtr's	internalRep.twoPtrValue.ptr2 to NULL.
 *
 *----------------------------------------------------------------------
 */

void
FreeAbstractListInternalRep(Tcl_Obj *abstractListObjPtr)
{
    Tcl_AbstractListType *typePtr = Tcl_AbstractListGetType(abstractListObjPtr);

    if (TclAbstractListHasProc(abstractListObjPtr, TCL_ABSL_FREEREP)) {
        /* call the free callback for the concrete rep */
        typePtr->freeRepProc(abstractListObjPtr);
    }
    abstractListObjPtr->internalRep.twoPtrValue.ptr2 = NULL;
    abstractListObjPtr->internalRep.twoPtrValue.ptr1 = NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * DupAbstractListInternalRep --
 *
 *	Initialize the internal representation of a AbstractList Tcl_Obj to a
 *	copy of the internal representation of an existing abstractlist object.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	We set "copyPtr"s internal rep to a pointer to a
 *	newly allocated AbstractList structure.
 *----------------------------------------------------------------------
 */

static void
DupAbstractListInternalRep(
    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
    Tcl_Obj *copyPtr)		/* Object with internal rep to set.
				 * Internal rep must be clear, it is stomped */
{
    Tcl_AbstractListType *typePtr;
    typePtr = Tcl_AbstractListGetType(srcPtr);
    Tcl_AbstractListSetType(copyPtr, typePtr);
    Tcl_AbstractListSetConcreteRep(copyPtr, NULL);

    /* Now do concrete type dup. It is responsible for calling
       Tcl_AbstractListSetConcreteRep to initialize ptr2 */

    if (typePtr->dupRepProc) {
	typePtr->dupRepProc(srcPtr, copyPtr);
    } else {
	/* TODO - or set it to NULL instead? */
	Tcl_AbstractListSetConcreteRep
	    (copyPtr, Tcl_AbstractListGetConcreteRep(srcPtr));
    }

    copyPtr->typePtr = &tclAbstractListType;
}

/*
 *----------------------------------------------------------------------
 *
 * UpdateStringOfAbstractList --
 *
 *	Update the string representation for an abstractlist object.
 *	Note: This procedure does not invalidate an existing old string rep
 *	so storage will be lost if this has not already been done.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The object's string is set to a valid string that results from the
 *	listlike-to-string conversion. This string will be empty if the
 *	AbstractList is empty.
 *
 * Notes:
 *      This simple approach is costly in that it forces a string rep for each
 *      element, which is then tossed.  Improving the performance here may
 *      require implementing a custom size-calculation function for each
 *      subtype of AbstractList.
 *
 *----------------------------------------------------------------------
 */

static void
UpdateStringOfAbstractList(Tcl_Obj *abstractListObjPtr)
{
#   define LOCAL_SIZE 64
    char localFlags[LOCAL_SIZE], *flagPtr = NULL;
    Tcl_AbstractListType *typePtr;
    char *p;
    int bytesNeeded = 0;
    int llen, i;

    /*
     * TODO - this function essentially adapts the UpdateStringOfList function
     * for native lists. Both functions allocate temporary storage for
     * localFlags. I'm not sure if that is the best strategy for performance
     * as well as memory for large list sizes. Revisit to see if growing
     * the allocation on the fly would be better. Essentially combine the
     * TclScanElement and TclConvertElement into one loop, growing the
     * destination allocation if necessary.
     */

    typePtr = Tcl_AbstractListGetType(abstractListObjPtr);

    /*
     * If concrete type has a better way to generate the string,
     * let it do it.
     */
    if (TclAbstractListHasProc(abstractListObjPtr, TCL_ABSL_TOSTRING)) {
	typePtr->toStringProc(abstractListObjPtr);
	return;
    }

    /*
     * TODO - do we need a AbstractList method to mark the list as canonical?
     * Or perhaps are abstract lists always canonical?
     * Mark the list as being canonical; although it will now have a string
     * rep, it is one we derived through proper "canonical" quoting and so
     * it's known to be free from nasties relating to [concat] and [eval].
     *   listRepPtr->canonicalFlag = 1;
     */


    /*
     * Handle empty list case first, so rest of the routine is simpler.
     */
    llen = typePtr->lengthProc(abstractListObjPtr);
    if (llen <= 0) {
	Tcl_InitStringRep(abstractListObjPtr, NULL, 0);
	return;
    }

    /*
     * Pass 1: estimate space.
     */
    if (llen <= LOCAL_SIZE) {
	flagPtr = localFlags;
    } else {
	/* We know numElems <= LIST_MAX, so this is safe. */
	flagPtr = (char *) Tcl_Alloc(llen);
    }
    for (bytesNeeded = 0, i = 0; i < llen; i++) {
        Tcl_Obj *elemObj;
        const char *elemStr;
        int elemLen;
	flagPtr[i] = (i ? TCL_DONT_QUOTE_HASH : 0);
	typePtr->indexProc(NULL, abstractListObjPtr, i, &elemObj);
	Tcl_IncrRefCount(elemObj);
	elemStr = TclGetStringFromObj(elemObj, &elemLen);
        /* Note TclScanElement updates flagPtr[i] */
	bytesNeeded += TclScanElement(elemStr, elemLen, flagPtr+i);
	if (bytesNeeded < 0) {
	    Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
	}
	Tcl_DecrRefCount(elemObj);
    }
    if (bytesNeeded > INT_MAX - llen + 1) {
	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
    }
    bytesNeeded += llen; /* Separating spaces and terminating nul */

    /*
     * Pass 2: generate the string repr.
     */
    abstractListObjPtr->bytes = (char *) Tcl_Alloc(bytesNeeded);
    p = abstractListObjPtr->bytes;
    for (i = 0; i < llen; i++) {
        Tcl_Obj *elemObj;
        const char *elemStr;
        int elemLen;
	flagPtr[i] |= (i ? TCL_DONT_QUOTE_HASH : 0);
	typePtr->indexProc(NULL, abstractListObjPtr, i, &elemObj);
	Tcl_IncrRefCount(elemObj);
	elemStr = TclGetStringFromObj(elemObj, &elemLen);
	p += TclConvertElement(elemStr, elemLen, p, flagPtr[i]);
	*p++ = ' ';
	Tcl_DecrRefCount(elemObj);
    }
    p[-1] = '\0'; /* Overwrite last space added */

    /* Length of generated string */
    abstractListObjPtr->length = p - 1 - abstractListObjPtr->bytes;

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

/*
 *----------------------------------------------------------------------
 *
 * SetAbstractListFromAny --
 *
 * 	The AbstractList object is just a way to optimize
 * 	Lists space complexity, so no one should try to convert
 * 	a string to an AbstractList object.
 *
 * 	This function is here just to populate the Type structure.
 *
 * Results:
 *
 * 	The result is always TCL_ERROR. But see Side Effects.
 *
 * Side effects:
 *
 * 	Tcl Panic if called.
 *
 *----------------------------------------------------------------------
 */

static int
SetAbstractListFromAny(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr)		/* The object to convert. */
{
    (void)interp;
    (void)objPtr;
    /* TODO - at some future point, should just shimmer to a traditional
     * Tcl list (but only when those are implemented under the AbstractList)
     * interface.
     */
    Tcl_Panic("SetAbstractListFromAny: should never be called");
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AbstractListObjCopy --
 *
 *	Makes a "pure AbstractList" copy of an AbstractList value. This
 *	provides for the C level a counterpart of the [lrange $list 0 end]
 *	command, while using internals details to be as efficient as possible.
 *
 * Results:
 *
 *	Normally returns a pointer to a new Tcl_Obj, that contains the same
 *	abstractList value as *abstractListPtr does. The returned Tcl_Obj has a
 *	refCount of zero. If *abstractListPtr does not hold an AbstractList,
 *	NULL is returned, and if interp is non-NULL, an error message is
 *	recorded there.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_AbstractListObjCopy(
    Tcl_Interp *interp,		 /* Used to report errors if not NULL. */
    Tcl_Obj *abstractListObjPtr) /* List object for which an element array is
				  * to be returned. */
{
    Tcl_Obj *copyPtr;

    if (!TclHasInternalRep(abstractListObjPtr, &tclAbstractListType)) {
	if (SetAbstractListFromAny(interp, abstractListObjPtr) != TCL_OK) {
	    /* We know this is going to panic, but it's the message we want */
	    return NULL;
	}
    }

    TclNewObj(copyPtr);
    TclInvalidateStringRep(copyPtr);
    DupAbstractListInternalRep(abstractListObjPtr, copyPtr);
    return copyPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AbstractListObjRange --
 *
 *	Makes a slice of an AbstractList value.
 *      *abstractListObjPtr must be known to be a valid AbstractList.
 *
 * Results:
 *	Returns a pointer to the sliced array.
 *      This may be a new object or the same object if not shared.
 *
 * Side effects:
 *
 *	?The possible conversion of the object referenced by
 *	abstractListObjPtr to a list object.?
 *
 *----------------------------------------------------------------------
 */

int
Tcl_AbstractListObjRange(
    Tcl_Interp *interp,		 /* For error messages. */
    Tcl_Obj *abstractListObjPtr, /* List object to take a range from. */
    Tcl_Size fromIdx,		 /* Index of first element to include. */
    Tcl_Size toIdx,		 /* Index of last element to include. */
    Tcl_Obj **newObjPtr)	 /* return value */
{
    Tcl_AbstractListType *typePtr;
    if (!TclHasInternalRep(abstractListObjPtr, &tclAbstractListType)) {
	if (interp) {
	    Tcl_SetObjResult(
		interp,
		Tcl_NewStringObj("Not an AbstractList.", -1));
	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "UNKNOWN", NULL);
	}
	return TCL_ERROR;
    }
    typePtr = Tcl_AbstractListGetType(abstractListObjPtr);
    /*
     * sliceProc can be NULL, then revert to List.  Note: [lrange]
     * command also checks for NULL sliceProc, and won't call AbstractList
     */
    if (typePtr->sliceProc) {
	return typePtr->sliceProc(interp, abstractListObjPtr, fromIdx, toIdx, newObjPtr);
    } else {
	/* TODO ?shimmer avoided? */
	Tcl_Obj *newObj = TclListObjCopy(NULL, abstractListObjPtr);
	*newObjPtr = (newObj ? TclListObjRange(newObj, (Tcl_Size)fromIdx, (Tcl_Size)toIdx) : NULL);
	return (newObj ? TCL_OK : TCL_ERROR);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AbstractListObjReverse --
 *
 *	Reverses the order of an AbstractList value.
 *      *abstractListObjPtr must be known to be a valid AbstractList.
 *
 * Results:
 *	Returns a pointer to the reversed array.
 *      This may be a new object or the same object if not shared.
 *
 * Side effects:
 *
 *	?The possible conversion of the object referenced by
 *	abstractListObjPtr to a list object.?
 *
 *----------------------------------------------------------------------
 */

int
Tcl_AbstractListObjReverse(
    Tcl_Interp *interp,          /* for reporting errors. */
    Tcl_Obj *abstractListObjPtr, /* List object to take a range from. */
    Tcl_Obj **newObjPtr)         /* New AbstractListObj */
{
    Tcl_AbstractListType *typePtr;

    if (!TclHasInternalRep(abstractListObjPtr, &tclAbstractListType)) {
	if (interp) {
	    Tcl_SetObjResult(
		interp,
		Tcl_NewStringObj("Not an AbstractList.", -1));
	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "UNKNOWN", NULL);
	}
	return TCL_ERROR;
    }
    if (!TclAbstractListHasProc(abstractListObjPtr, TCL_ABSL_REVERSE)) {
	if (interp) {
	    Tcl_SetObjResult(
		interp,
		Tcl_NewStringObj("lreverse not supported!", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREVERSE", NULL);
	}
	return TCL_ERROR;
    }
    typePtr = Tcl_AbstractListGetType(abstractListObjPtr);
    return typePtr->reverseProc(interp, abstractListObjPtr, newObjPtr);
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_AbstractListObjGetElements --
 *
 *	This function returns an (objc,objv) array of the elements in a list
 *	object.
 *
 * Results:
 *	The return value is normally TCL_OK; in this case *objcPtr is set to
 *	the count of list elements and *objvPtr is set to a pointer to an
 *	array of (*objcPtr) pointers to each list element. If listPtr does not
 *	refer to an Abstract List object and the object can not be converted
 *	to one, TCL_ERROR is returned and an error message will be left in the
 *	interpreter's result if interp is not NULL.
 *
 *	The objects referenced by the returned array should be treated as
 *	readonly and their ref counts are _not_ incremented; the caller must
 *	do that if it holds on to a reference. Furthermore, the pointer and
 *	length returned by this function may change as soon as any function is
 *	called on the list object; be careful about retaining the pointer in a
 *	local data structure.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_AbstractListObjGetElements(
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
    Tcl_Obj *objPtr,		/* AbstractList object for which an element
				 * array is to be returned. */
    Tcl_Size *objcPtr,		/* Where to store the count of objects
				 * referenced by objv. */
    Tcl_Obj ***objvPtr)		/* Where to store the pointer to an array of
				 * pointers to the list's objects. */
{

    if (TclHasInternalRep(objPtr,&tclAbstractListType)) {
	Tcl_AbstractListType *typePtr  = Tcl_AbstractListGetType(objPtr);

        if (TclAbstractListHasProc(objPtr, TCL_ABSL_GETELEMENTS)) {
            int status = typePtr->getElementsProc(interp, objPtr, objcPtr, objvPtr);
            return status;
        } else {
            if (interp) {
                Tcl_SetObjResult(
		    interp,
                    Tcl_NewStringObj("GetElements not supported!", -1));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
            }
        }
        return TCL_ERROR;
    } else {
	if (interp != NULL) {
	    Tcl_SetObjResult(
		interp,
		Tcl_ObjPrintf("value is not an abstract list"));
	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "UNKNOWN", NULL);
	}
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 * Returns pointer to the concrete type or NULL if not AbstractList or
 * not abstract list of the same type as concrete type
 */
Tcl_AbstractListType *
Tcl_AbstractListGetType(
    Tcl_Obj *objPtr)         /* Object of type AbstractList */
{
    if (objPtr->typePtr != &tclAbstractListType) {
	return NULL;
    }
    return (Tcl_AbstractListType *) objPtr->internalRep.twoPtrValue.ptr2;
}

/* Returns the storage used by the concrete abstract list type */
void* Tcl_AbstractListGetConcreteRep(
    Tcl_Obj *objPtr)         /* Object of type AbstractList */
{
    /* Public function, must check for NULL */
    if (objPtr == NULL || objPtr->typePtr != &tclAbstractListType) {
	return NULL;
    }
    return objPtr->internalRep.twoPtrValue.ptr1;
}

/* Replace or add the element in the list @indicies with the given new value
 */
Tcl_Obj *
Tcl_AbstractListSetElement(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,
    Tcl_Size indexCount,
    Tcl_Obj *const indexArray[],
    Tcl_Obj *valueObj)
{
    Tcl_Obj *returnObj = NULL;

    if (TclHasInternalRep(objPtr,&tclAbstractListType)) {
	Tcl_AbstractListType *typePtr  = Tcl_AbstractListGetType(objPtr);
        if (TclAbstractListHasProc(objPtr, TCL_ABSL_SETELEMENT)) {
            returnObj = typePtr->setElementProc(interp, objPtr, indexCount, indexArray, valueObj);
        } else {
            if (interp) {
                Tcl_SetObjResult(
		    interp,
                    Tcl_NewStringObj("SetElement not supported!", -1));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
            }
	    returnObj = NULL;
        }
    } else {
	if (interp != NULL) {
	    Tcl_SetObjResult(
		interp,
		Tcl_ObjPrintf("value is not an abstract list"));
	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "UNKNOWN", NULL);
	}
	returnObj = NULL;
    }
    return returnObj;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AbstractListObjReplace --
 *
 *      This function mimics the Tcl_ListObjReplace operation, iff the
 *      concrete abstract list type supports the Replace operation, and if
 *      not, it will return with an error.
 *
 *	This function replaces zero or more elements of the abstract list
 *	referenced by listObj with the objects from an (objc,objv) array. The
 *	objc elements of the array referenced by objv replace the count
 *	elements in listPtr starting at first.
 *
 *	If the argument first is zero or negative, it refers to the first
 *	element. If first is greater than or equal to the number of elements
 *	in the list, then no elements are deleted; the new elements are
 *	appended to the list. Count gives the number of elements to replace.
 *	If count is zero or negative then no elements are deleted; the new
 *	elements are simply inserted before first.
 *
 *	The argument objv refers to an array of objc pointers to the new
 *	elements to be added to listPtr in place of those that were deleted.
 *	If objv is NULL, no new elements are added.
 *
 * Results:
 *	The return value is normally TCL_OK. If listPtr does not support the
 *	Replace opration then TCL_ERROR is returned and an error message will
 *	be left in the interpreter's result if interp is not NULL.
 *
 * Side effects:
 *	The ref counts of the objc elements in objv maybe incremented iff the
 *	concrete type retains a reference to the element(s), otherwise there
 *	will be no change to the ref counts.  Similarly, the ref counts for
 *	replaced objects are decremented. listObj's old string representation,
 *	if any, is freed.
 *
 *----------------------------------------------------------------------
 */
int Tcl_AbstractListObjReplace(
    Tcl_Interp *interp,		  /* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr,		  /* List object whose elements to replace. */
    Tcl_Size first,		  /* Index of first element to replace. */
    Tcl_Size numToDelete,	  /* Number of elements to replace. */
    Tcl_Size numToInsert,	  /* Number of objects to insert. */
    Tcl_Obj *const insertObjs[]) /* Tcl objects to insert */
{
    int status;
    if (TclHasInternalRep(objPtr,&tclAbstractListType)) {
	Tcl_AbstractListType *typePtr  = Tcl_AbstractListGetType(objPtr);
        if (TclAbstractListHasProc(objPtr, TCL_ABSL_REPLACE)) {
            status = typePtr->replaceProc(interp, objPtr, first, numToDelete, numToInsert, insertObjs);
        } else {
            if (interp) {
                Tcl_SetObjResult(
		    interp,
                    Tcl_NewStringObj("Replace not supported!", -1));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
            }
	    status = TCL_ERROR;
        }
    } else {
	if (interp != NULL) {
	    Tcl_SetObjResult(
		interp,
		Tcl_ObjPrintf("value is not an abstract list"));
	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "UNKNOWN", NULL);
	}
	status = TCL_ERROR;
    }
    return status;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<






















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































Deleted generic/tclAbstractList.h.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
/*
 * tclAbstractList.h --
 *
 *	The AbstractList Obj Type -- a psuedo List
 *
 * Copyright © 2022 by Brian Griffin. 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 _TCLABSTRACTLIST
#define _TCLABSTRACTLIST

#include "tclInt.h"

static inline const char*
Tcl_AbstractListTypeName(
    Tcl_Obj *objPtr) /* Should be of type AbstractList */
{
    Tcl_AbstractListType *typePtr;
    typePtr = Tcl_AbstractListGetType(objPtr);
    if (typePtr && typePtr->typeName) {
	return typePtr->typeName;
    } else {
	return "abstractlist";
    }
}

Tcl_Obj *   Tcl_AbstractListObjNew(Tcl_Interp *interp, const Tcl_AbstractListType *vTablePtr);
Tcl_WideInt Tcl_AbstractListObjLength(Tcl_Obj *abstractListPtr);
int	    Tcl_AbstractListObjIndex(Tcl_Interp *interp, Tcl_Obj *abstractListPtr,
		Tcl_Size index, Tcl_Obj **elemObj);
int	    Tcl_AbstractListObjRange(Tcl_Interp *interp, Tcl_Obj *abstractListPtr,
		Tcl_Size fromIdx, Tcl_Size toIdx, Tcl_Obj **newObjPtr);
int	    Tcl_AbstractListObjReverse(Tcl_Interp *interp, Tcl_Obj *abstractListPtr,
		Tcl_Obj **newObjPtr);
int	    Tcl_AbstractListObjGetElements(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size *objcPtr,
		Tcl_Obj ***objvPtr);
Tcl_Obj *   Tcl_AbstractListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr);
void	*   Tcl_AbstractListGetConcreteRep(Tcl_Obj *objPtr);
Tcl_Obj *   Tcl_AbstractListSetElement(Tcl_Interp *interp, Tcl_Obj *listPtr,
		Tcl_Size indexCount, Tcl_Obj *const indexArray[], Tcl_Obj *valueObj);
int	    Tcl_AbstractListObjReplace(Tcl_Interp *interp, Tcl_Obj *listObj,
		Tcl_Size first, Tcl_Size numToDelete, Tcl_Size numToInsert,
		Tcl_Obj *const insertObjs[]);

#endif

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
















































































































Changes to generic/tclAlloc.c.

112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
static struct block *blockList;	/* Tracks the suballocated blocks. */
static struct block bigBlocks={	/* Big blocks aren't suballocated. */
    &bigBlocks, &bigBlocks
};

/*
 * The allocator is protected by a special mutex that must be explicitly
 * initialized. Futhermore, because Tcl_Alloc may be used before anything else
 * in Tcl, we make this module self-initializing after all with the allocInit
 * variable.
 */

#if TCL_THREADS
static Tcl_Mutex *allocMutexPtr;
#endif







|







112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
static struct block *blockList;	/* Tracks the suballocated blocks. */
static struct block bigBlocks={	/* Big blocks aren't suballocated. */
    &bigBlocks, &bigBlocks
};

/*
 * The allocator is protected by a special mutex that must be explicitly
 * initialized. Furthermore, because Tcl_Alloc may be used before anything else
 * in Tcl, we make this module self-initializing after all with the allocInit
 * variable.
 */

#if TCL_THREADS
static Tcl_Mutex *allocMutexPtr;
#endif
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
 *	None.
 *
 *----------------------------------------------------------------------
 */

void *
TclpRealloc(
    void *oldPtr,		/* Pointer to alloced block. */
    size_t numBytes)	/* New size of memory. */
{
    int i;
    union overhead *overPtr;
    struct block *bigBlockPtr;
    int expensive;
    size_t maxSize;







|







506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
 *	None.
 *
 *----------------------------------------------------------------------
 */

void *
TclpRealloc(
    void *oldPtr,		/* Pointer to alloc'ed block. */
    size_t numBytes)	/* New size of memory. */
{
    int i;
    union overhead *overPtr;
    struct block *bigBlockPtr;
    int expensive;
    size_t maxSize;
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
	}
	memcpy(newPtr, oldPtr, numBytes);
	TclpFree(oldPtr);
	return newPtr;
    }

    /*
     * Ok, we don't have to copy, it fits as-is
     */

#ifndef NDEBUG
    overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1);
    BLOCK_END(overPtr) = RMAGIC;
#endif








|







605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
	}
	memcpy(newPtr, oldPtr, numBytes);
	TclpFree(oldPtr);
	return newPtr;
    }

    /*
     * No need to copy. It fits as-is.
     */

#ifndef NDEBUG
    overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1);
    BLOCK_END(overPtr) = RMAGIC;
#endif

Changes to generic/tclArithSeries.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
/*
 * tclArithSeries.c --
 *
 *     This file contains the ArithSeries concrete abstract list
 *     implementation. It implements the inner workings of the lseq command.
 *
 * Copyright © 2022 Brian S. Griffin.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include <assert.h>
#include "tcl.h"
#include "tclInt.h"
#include "tclArithSeries.h"


/*
 * The structure below defines the arithmetic series Tcl Obj Type by means of
 * procedures that can be invoked by generic object code.
 *
 * The arithmetic series object is a Tcl_AbstractList representing an interval
 * of an arithmetic series in constant space.
 *
 * The arithmetic series is internally represented with three integers,
 * *start*, *end*, and *step*, Where the length is calculated with
 * the following algorithm:
 *
 * if RANGE == 0 THEN
 *   ERROR
 * if RANGE > 0
 *   LEN is (((END-START)-1)/STEP) + 1
 * else if RANGE < 0
 *   LEN is (((END-START)-1)/STEP) - 1
 *
 * And where the list's I-th element is calculated
 * as:
 *
 * LIST[i] = START+(STEP*i)
 *
 * Zero elements ranges, like in the case of START=10 END=10 STEP=1
 * are valid and will be equivalent to the empty list.
 */


static inline double ArithSeriesIndexDbl(ArithSeriesDbl *repPtr, double index)
{







    return (repPtr->start + (index * repPtr->step));


}

static inline Tcl_WideInt ArithSeriesIndexInt(ArithSeries *repPtr, Tcl_Size index)
{


    return (repPtr->start + (index * repPtr->step));




}


static int TclArithSeriesObjStep(Tcl_Obj *arithSeriesPtr, Tcl_Obj **stepObj);
static int TclArithSeriesObjIndex(Tcl_Interp *interp, Tcl_Obj *arithSeriesPtr,
			    Tcl_Size index, Tcl_Obj **elemObj);

static Tcl_WideInt TclArithSeriesObjLength(Tcl_Obj *arithSeriesObj);
static int TclArithSeriesObjRange(Tcl_Interp *interp, Tcl_Obj *arithSeriesPtr,
			    Tcl_Size fromIdx, Tcl_Size toIdx, Tcl_Obj **newObjPtr);
static int TclArithSeriesObjReverse(Tcl_Interp *interp, Tcl_Obj *arithSeriesPtr, Tcl_Obj **newObjPtr);
static int TclArithSeriesGetElements(Tcl_Interp *interp,
			    Tcl_Obj *objPtr, Tcl_Size *objcPtr, Tcl_Obj ***objvPtr);
static Tcl_Obj *TclNewArithSeriesInt(Tcl_WideInt start,
			    Tcl_WideInt end, Tcl_WideInt step,
			    Tcl_WideInt len);
static Tcl_Obj *TclNewArithSeriesDbl(double start, double end,
			    double step, Tcl_WideInt len);
static void DupArithSeriesRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
static void FreeArithSeriesRep(Tcl_Obj *arithSeriesObjPtr);
static void UpdateStringOfArithSeries(Tcl_Obj *arithSeriesObjPtr);
static Tcl_Obj *Tcl_NewArithSeriesObj(Tcl_Size objc, Tcl_Obj * const objv[]);

static Tcl_AbstractListType arithSeriesType = {
	TCL_ABSTRACTLIST_VERSION_1,
	"arithseries",
	Tcl_NewArithSeriesObj,
	DupArithSeriesRep,



	TclArithSeriesObjLength,
	TclArithSeriesObjIndex,
	TclArithSeriesObjRange,
	TclArithSeriesObjReverse,
        TclArithSeriesGetElements,
        FreeArithSeriesRep,
	UpdateStringOfArithSeries,
	NULL, // SetElement
	NULL  // Replace
};

/*




















































































 *----------------------------------------------------------------------
 *
 * Arithserieslen --
 *
 * 	Compute the length of the equivalent list where
 * 	every element is generated starting from *start*,
 * 	and adding *step* to generate every successive element
 * 	that's < *end* for positive steps, or > *end* for negative
 * 	steps.
 *
 * Results:
 *
 * 	The length of the list generated by the given range,
 * 	that may be zero.
 * 	The function returns -1 if the list is of length infiite.
 *
 * Side effects:
 *
 * 	None.
 *
 *----------------------------------------------------------------------
 */
static Tcl_WideInt
ArithSeriesLen(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step)
{
    Tcl_WideInt len;

    if (step == 0) return 0;


    len = (step ? (1 + (((end-start))/step)) : 0);
    return (len < 0) ? -1 : len;
}
















/*
 *----------------------------------------------------------------------
 *
 * DupArithSeriesRep --
 *
 *	Initialize the internal representation of a ArithSeries abstract list
 *	Tcl_Obj to a copy of the internal representation of an existing
 *	arithseries object.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	We set "copyPtr"s internal rep to a pointer to a
 *	newly allocated AbstractList structure.
 *----------------------------------------------------------------------
 */

static void
DupArithSeriesRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr)


{
    ArithSeries *srcArithSeries = (ArithSeries*)Tcl_AbstractListGetConcreteRep(srcPtr);
    ArithSeries *copyArithSeries = (ArithSeries *)Tcl_Alloc(sizeof(ArithSeries));




    *copyArithSeries = *srcArithSeries;





    /* Note: we do not have to be worry about existing internal rep because

       copyPtr is supposed to be freshly initialized */


    Tcl_AbstractListSetConcreteRep(copyPtr, copyArithSeries);

}




/*
 *----------------------------------------------------------------------
 *
 * FreeArithSeriesRep --
 *
 *	Free any allocated memory in the ArithSeries Rep
 *
 * Results:
 *	None.
 *
 * Side effects:
 *
 *----------------------------------------------------------------------
 */
static void
FreeArithSeriesRep(Tcl_Obj *arithSeriesObjPtr)  /* Free any allocated memory */
{

    ArithSeries *arithSeriesPtr = (ArithSeries*)Tcl_AbstractListGetConcreteRep(arithSeriesObjPtr);
    if (arithSeriesPtr) {
	if (arithSeriesPtr->elements) {
	    Tcl_WideInt i, len = arithSeriesPtr->len;
	    for (i=0; i<len; i++) {
		Tcl_DecrRefCount(arithSeriesPtr->elements[i]);
	    }
	    Tcl_Free((char*)arithSeriesPtr->elements);
	    arithSeriesPtr->elements = NULL;
	}
	Tcl_Free((char*)arithSeriesPtr);
    }
}


/*
 *----------------------------------------------------------------------
 *
 * TclNewArithSeriesInt --
 *
 *	Creates a new ArithSeries object. The returned object has
 *	refcount = 0.
 *
 * Results:
 *
 * 	A Tcl_Obj pointer to the created ArithSeries object.
 * 	A NULL pointer of the range is invalid.
 *
 * Side Effects:
 *
 * 	None.
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclNewArithSeriesInt(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step, Tcl_WideInt len)
{
    Tcl_WideInt length = (len>=0 ? len : ArithSeriesLen(start, end, step));
    Tcl_Obj *arithSeriesObj;
    ArithSeries *arithSeriesRepPtr;


    if (length <= 0) {

	TclNewObj(arithSeriesObj);


	return arithSeriesObj;
    }

    arithSeriesRepPtr = (ArithSeries*) Tcl_Alloc(sizeof (ArithSeries));
    arithSeriesRepPtr->isDouble = 0;
    arithSeriesRepPtr->start = start;
    arithSeriesRepPtr->end = end;
    arithSeriesRepPtr->step = step;
    arithSeriesRepPtr->len = length;
    arithSeriesRepPtr->elements = NULL;

    arithSeriesObj = Tcl_AbstractListObjNew(NULL, &arithSeriesType);
    Tcl_AbstractListSetConcreteRep(arithSeriesObj, arithSeriesRepPtr);

    if (length > 0)
    	Tcl_InvalidateStringRep(arithSeriesObj);

    return arithSeriesObj;
}

/*
 *----------------------------------------------------------------------
 *
 * TclNewArithSeriesDbl --
 *
 *	Creates a new ArithSeries object with doubles. The returned object has
 *	refcount = 0.
 *
 * Results:
 *
 * 	A Tcl_Obj pointer to the created ArithSeries object.
 * 	A NULL pointer of the range is invalid.
 *
 * Side Effects:
 *
 * 	None.
 *----------------------------------------------------------------------
 */


Tcl_Obj *
TclNewArithSeriesDbl(double start, double end, double step, Tcl_WideInt len)
{
    Tcl_WideInt length = (len>=0 ? len : ArithSeriesLen(start, end, step));
    Tcl_Obj *arithSeriesObj;
    ArithSeriesDbl *arithSeriesRepPtr;


    if (length <= 0) {



	TclNewObj(arithSeriesObj);


	return arithSeriesObj;
    }

    arithSeriesRepPtr = (ArithSeriesDbl*) Tcl_Alloc(sizeof (ArithSeriesDbl));
    arithSeriesRepPtr->isDouble = 1;
    arithSeriesRepPtr->start = start;
    arithSeriesRepPtr->end = end;
    arithSeriesRepPtr->step = step;
    arithSeriesRepPtr->len = length;
    arithSeriesRepPtr->elements = NULL;


    arithSeriesObj = Tcl_AbstractListObjNew(NULL, &arithSeriesType);
    Tcl_AbstractListSetConcreteRep(arithSeriesObj, arithSeriesRepPtr);

    if (length > 0)
    	Tcl_InvalidateStringRep(arithSeriesObj);


    return arithSeriesObj;
}

/*
 *----------------------------------------------------------------------
 *
 * assignNumber --
 *
 *	Create the approprite Tcl_Obj value for the given numeric values.
 *      Used locally only for decoding [lseq] numeric arguments.
 *	refcount = 0.
 *
 * Results:
 *
 * 	A Tcl_Obj pointer.
 *      No assignment on error.
 *
 * Side Effects:
 *
 * 	None.
 *----------------------------------------------------------------------
 */
static void
assignNumber(
    int useDoubles,
    Tcl_WideInt *intNumberPtr,
    double *dblNumberPtr,
    Tcl_Obj *numberObj)
{
    union {
	double d;
	Tcl_WideInt i;
    } *number;
    int tcl_number_type;

    if (Tcl_GetNumberFromObj(NULL, numberObj, (void**)&number, &tcl_number_type) != TCL_OK
	    || tcl_number_type == TCL_NUMBER_BIG) {
	return;
    }
    if (useDoubles) {
	if (tcl_number_type == TCL_NUMBER_DOUBLE) {
	    *dblNumberPtr = number->d;
	} else {
	    *dblNumberPtr = (double)number->i;
	}
    } else {
	if (tcl_number_type == TCL_NUMBER_INT) {
	    *intNumberPtr = number->i;
	} else {
	    *intNumberPtr = (Tcl_WideInt)number->d;
	}
    }
}

/*
 *----------------------------------------------------------------------
 *












<


|
|
|

|
|

|
|












|


|





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

<
|
|
>
|
|

|


<
<
<
<
<
|
|

|

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



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


|











|








|



|
>
>
|


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




|

|
|
<






|




|
>
>

|
|
>
>

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




|











|

>
|
|
|
|

|

|
|

|







|














>

|

|



>
|
>
|
>
>










|
|
<
|









|














>
>

|

|



>
|
>
>
>
|
>
>










|
>
|
|

|

>









|




















<
<
<
|


|




|
|

|



|

|







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

13
14
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
/*
 * tclArithSeries.c --
 *
 *     This file contains the ArithSeries concrete abstract list
 *     implementation. It implements the inner workings of the lseq command.
 *
 * Copyright © 2022 Brian S. Griffin.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */


#include "tcl.h"
#include "tclInt.h"
#include <assert.h>
#include <math.h>

/*
 * The structure below defines the arithmetic series Tcl object type by
 * means of procedures that can be invoked by generic object code.
 *
 * The arithmetic series object is a special case of Tcl list representing
 * an interval of an arithmetic series in constant space.
 *
 * The arithmetic series is internally represented with three integers,
 * *start*, *end*, and *step*, Where the length is calculated with
 * the following algorithm:
 *
 * if RANGE == 0 THEN
 *   ERROR
 * if RANGE > 0
 *   LEN is (((END-START)-1)/STEP) + 1
 * else if RANGE < 0
 *   LEN is (((END-START)-1)/STEP) - 1
 *
 * And where the equivalent's list I-th element is calculated
 * as:
 *
 * LIST[i] = START + (STEP * i)
 *
 * Zero elements ranges, like in the case of START=10 END=10 STEP=1
 * are valid and will be equivalent to the empty list.
 */

/*
 * The structure used for the ArithSeries internal representation.

 * Note that the len can in theory be always computed by start,end,step
 * but it's faster to cache it inside the internal representation.
 */
typedef struct {
    Tcl_Size len;
    Tcl_Obj **elements;
    int isDouble;
    Tcl_WideInt start;
    Tcl_WideInt end;
    Tcl_WideInt step;
} ArithSeries;
typedef struct {
    Tcl_Size len;

    Tcl_Obj **elements;
    int isDouble;
    double start;
    double end;
    double step;
    int precision;
} ArithSeriesDbl;

/* -------------------------- ArithSeries object ---------------------------- */


static int TclArithSeriesObjIndex(TCL_UNUSED(Tcl_Interp *), Tcl_Obj *arithSeriesObj,
				  Tcl_Size index, Tcl_Obj **elemObj);

static Tcl_Size ArithSeriesObjLength(Tcl_Obj *arithSeriesObj);
static int TclArithSeriesObjRange(Tcl_Interp *interp, Tcl_Obj *arithSeriesObj,
			    Tcl_Size fromIdx, Tcl_Size toIdx, Tcl_Obj **newObjPtr);
static int TclArithSeriesObjReverse(Tcl_Interp *interp, Tcl_Obj *arithSeriesObj, Tcl_Obj **newObjPtr);
static int TclArithSeriesGetElements(Tcl_Interp *interp,
			    Tcl_Obj *objPtr, Tcl_Size *objcPtr, Tcl_Obj ***objvPtr);





static void DupArithSeriesInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
static void FreeArithSeriesInternalRep(Tcl_Obj *arithSeriesObjPtr);
static void UpdateStringOfArithSeries(Tcl_Obj *arithSeriesObjPtr);
static int  SetArithSeriesFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);

static const Tcl_ObjType arithSeriesType = {

    "arithseries",			/* name */
    FreeArithSeriesInternalRep,		/* freeIntRepProc */
    DupArithSeriesInternalRep,		/* dupIntRepProc */
    UpdateStringOfArithSeries,		/* updateStringProc */
    SetArithSeriesFromAny,		/* setFromAnyProc */
    TCL_OBJTYPE_V2(
    ArithSeriesObjLength,
    TclArithSeriesObjIndex,
    TclArithSeriesObjRange,
    TclArithSeriesObjReverse,
    TclArithSeriesGetElements,


    NULL, // SetElement
    NULL) // Replace
};

/*
 * Helper functions
 *
 * - ArithRound -- Round doubles to the number of significant fractional
 *                 digits
 * - ArithSeriesIndexDbl -- base list indexing operation for doubles
 * - ArithSeriesIndexInt --   "    "      "        "      "  integers
 * - ArithSeriesGetInternalRep -- Return the internal rep from a Tcl_Obj
 * - Precision -- determine the number of factional digits for the given
 *   double value
 * - maxPrecision -- Using the values provide, determine the longest percision
 *   in the arithSeries
 */
static inline double
ArithRound(double d, unsigned int n) {
    double scalefactor = pow(10, n);
    return round(d*scalefactor)/scalefactor;
}

static inline double
ArithSeriesIndexDbl(
    ArithSeries *arithSeriesRepPtr,
    Tcl_WideInt index)
{
    ArithSeriesDbl *dblRepPtr = (ArithSeriesDbl*)arithSeriesRepPtr;
    if (arithSeriesRepPtr->isDouble) {
        double d = dblRepPtr->start + (index * dblRepPtr->step);
	unsigned n = (dblRepPtr->precision > 0 ? dblRepPtr->precision : 0);
        return ArithRound(d, n);
    } else {
	return (double)(arithSeriesRepPtr->start + (index * arithSeriesRepPtr->step));
    }
}

static inline Tcl_WideInt
ArithSeriesIndexInt(
    ArithSeries *arithSeriesRepPtr,
    Tcl_WideInt index)
{
    ArithSeriesDbl *dblRepPtr = (ArithSeriesDbl*)arithSeriesRepPtr;
    if (arithSeriesRepPtr->isDouble) {
	return (Tcl_WideInt)(dblRepPtr->start + ((index) * dblRepPtr->step));
    } else {
	return (arithSeriesRepPtr->start + (index * arithSeriesRepPtr->step));
    }
}

static inline ArithSeries*
ArithSeriesGetInternalRep(Tcl_Obj *objPtr)
{
    const Tcl_ObjInternalRep *irPtr;
    irPtr = TclFetchInternalRep((objPtr), &arithSeriesType);
    return irPtr ? (ArithSeries *)irPtr->twoPtrValue.ptr1 : NULL;
}

/*
 * Compute number of significant factional digits
 */
static inline int
Precision(double d)
{
    char tmp[TCL_DOUBLE_SPACE+2], *off;
    tmp[0] = 0;
    Tcl_PrintDouble(NULL,d,tmp);
    off = strchr(tmp, '.');
    return (off ? strlen(off+1) : 0);
}

/*
 * Find longest number of digits after the decimal point.
 */
static inline int
maxPrecision(double start, double end, double step)
{
    int dp = Precision(step);
    int i  = Precision(start);
    dp = i>dp ? i : dp;
    i  = Precision(end);
    dp = i>dp ? i : dp;
    return dp;
}

static int TclArithSeriesObjStep(Tcl_Obj *arithSeriesObj, Tcl_Obj **stepObj);

/*
 *----------------------------------------------------------------------
 *
 * ArithSeriesLen --
 *
 * 	Compute the length of the equivalent list where
 * 	every element is generated starting from *start*,
 * 	and adding *step* to generate every successive element
 * 	that's < *end* for positive steps, or > *end* for negative
 * 	steps.
 *
 * Results:
 *
 * 	The length of the list generated by the given range,
 * 	that may be zero.
 * 	The function returns -1 if the list is of length infinite.
 *
 * Side effects:
 *
 * 	None.
 *
 *----------------------------------------------------------------------
 */
static Tcl_WideInt
ArithSeriesLenInt(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step)
{
    Tcl_WideInt len;

    if (step == 0) {
	return 0;
    }
    len = 1 + ((end-start)/step);
    return (len < 0) ? -1 : len;
}

static Tcl_WideInt
ArithSeriesLenDbl(double start, double end, double step, int precision)
{
    double istart, iend, istep, ilen;
    if (step == 0) {
	return 0;
    }
    istart = start * pow(10,precision);
    iend = end * pow(10,precision);
    istep = step * pow(10,precision);
    ilen = ((iend-istart+istep)/istep);
    return floor(ilen);
}


/*
 *----------------------------------------------------------------------
 *
 * DupArithSeriesInternalRep --
 *
 *	Initialize the internal representation of a arithseries Tcl_Obj to a
 *	copy of the internal representation of an existing arithseries object.

 *
 * Results:
 *	None.
 *
 * Side effects:
 *	We set "copyPtr"s internal rep to a pointer to a
 *	newly allocated ArithSeries structure.
 *----------------------------------------------------------------------
 */

static void
DupArithSeriesInternalRep(
    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
    Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
{
    ArithSeries *srcArithSeriesRepPtr =
	(ArithSeries *) srcPtr->internalRep.twoPtrValue.ptr1;
    /*
     * Allocate a new ArithSeries structure. */

    if (srcArithSeriesRepPtr->isDouble) {
	ArithSeriesDbl *srcArithSeriesDblRepPtr =
	    (ArithSeriesDbl *)srcArithSeriesRepPtr;
	ArithSeriesDbl *copyArithSeriesDblRepPtr =
	    (ArithSeriesDbl *) Tcl_Alloc(sizeof(ArithSeriesDbl));
	*copyArithSeriesDblRepPtr = *srcArithSeriesDblRepPtr;
	copyArithSeriesDblRepPtr->elements = NULL;
	copyPtr->internalRep.twoPtrValue.ptr1 = copyArithSeriesDblRepPtr;
    } else {
	ArithSeries *copyArithSeriesRepPtr =
	    (ArithSeries *) Tcl_Alloc(sizeof(ArithSeries));
	*copyArithSeriesRepPtr = *srcArithSeriesRepPtr;
	copyArithSeriesRepPtr->elements = NULL;
	copyPtr->internalRep.twoPtrValue.ptr1 = copyArithSeriesRepPtr;
    }
    copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
    copyPtr->typePtr = &arithSeriesType;
}

/*
 *----------------------------------------------------------------------
 *
 * FreeArithSeriesInternalRep --
 *
 *	Free any allocated memory in the ArithSeries Rep
 *
 * Results:
 *	None.
 *
 * Side effects:
 *
 *----------------------------------------------------------------------
 */
static void
FreeArithSeriesInternalRep(Tcl_Obj *arithSeriesObjPtr)  /* Free any allocated memory */
{
    ArithSeries *arithSeriesRepPtr = (ArithSeries*)arithSeriesObjPtr->internalRep.twoPtrValue.ptr1;

    if (arithSeriesRepPtr) {
	if (arithSeriesRepPtr->elements) {
	    Tcl_WideInt i, len = arithSeriesRepPtr->len;
	    for (i=0; i<len; i++) {
		Tcl_DecrRefCount(arithSeriesRepPtr->elements[i]);
	    }
	    Tcl_Free((char*)arithSeriesRepPtr->elements);
	    arithSeriesRepPtr->elements = NULL;
	}
	Tcl_Free((char*)arithSeriesRepPtr);
    }
}


/*
 *----------------------------------------------------------------------
 *
 * NewArithSeriesInt --
 *
 *	Creates a new ArithSeries object. The returned object has
 *	refcount = 0.
 *
 * Results:
 *
 * 	A Tcl_Obj pointer to the created ArithSeries object.
 * 	A NULL pointer of the range is invalid.
 *
 * Side Effects:
 *
 * 	None.
 *----------------------------------------------------------------------
 */
static
Tcl_Obj *
NewArithSeriesInt(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step, Tcl_WideInt len)
{
    Tcl_WideInt length;
    Tcl_Obj *arithSeriesObj;
    ArithSeries *arithSeriesRepPtr;

    length = len>=0 ? len : -1;
    if (length < 0) length = -1;

    TclNewObj(arithSeriesObj);

    if (length <= 0) {
	return arithSeriesObj;
    }

    arithSeriesRepPtr = (ArithSeries*) Tcl_Alloc(sizeof (ArithSeries));
    arithSeriesRepPtr->isDouble = 0;
    arithSeriesRepPtr->start = start;
    arithSeriesRepPtr->end = end;
    arithSeriesRepPtr->step = step;
    arithSeriesRepPtr->len = length;
    arithSeriesRepPtr->elements = NULL;
    arithSeriesObj->internalRep.twoPtrValue.ptr1 = arithSeriesRepPtr;
    arithSeriesObj->internalRep.twoPtrValue.ptr2 = NULL;

    arithSeriesObj->typePtr = &arithSeriesType;
    if (length > 0)
    	Tcl_InvalidateStringRep(arithSeriesObj);

    return arithSeriesObj;
}

/*
 *----------------------------------------------------------------------
 *
 * NewArithSeriesDbl --
 *
 *	Creates a new ArithSeries object with doubles. The returned object has
 *	refcount = 0.
 *
 * Results:
 *
 * 	A Tcl_Obj pointer to the created ArithSeries object.
 * 	A NULL pointer of the range is invalid.
 *
 * Side Effects:
 *
 * 	None.
 *----------------------------------------------------------------------
 */

static
Tcl_Obj *
NewArithSeriesDbl(double start, double end, double step, Tcl_WideInt len)
{
    Tcl_WideInt length;
    Tcl_Obj *arithSeriesObj;
    ArithSeriesDbl *arithSeriesRepPtr;

    length = len>=0 ? len : -1;
    if (length < 0) {
	length = -1;
    }

    TclNewObj(arithSeriesObj);

    if (length <= 0) {
	return arithSeriesObj;
    }

    arithSeriesRepPtr = (ArithSeriesDbl*) Tcl_Alloc(sizeof (ArithSeriesDbl));
    arithSeriesRepPtr->isDouble = 1;
    arithSeriesRepPtr->start = start;
    arithSeriesRepPtr->end = end;
    arithSeriesRepPtr->step = step;
    arithSeriesRepPtr->len = length;
    arithSeriesRepPtr->elements = NULL;
    arithSeriesRepPtr->precision = maxPrecision(start,end,step);
    arithSeriesObj->internalRep.twoPtrValue.ptr1 = arithSeriesRepPtr;
    arithSeriesObj->internalRep.twoPtrValue.ptr2 = NULL;
    arithSeriesObj->typePtr = &arithSeriesType;

    if (length > 0) {
    	Tcl_InvalidateStringRep(arithSeriesObj);
    }

    return arithSeriesObj;
}

/*
 *----------------------------------------------------------------------
 *
 * assignNumber --
 *
 *	Create the appropriate Tcl_Obj value for the given numeric values.
 *      Used locally only for decoding [lseq] numeric arguments.
 *	refcount = 0.
 *
 * Results:
 *
 * 	A Tcl_Obj pointer.
 *      No assignment on error.
 *
 * Side Effects:
 *
 * 	None.
 *----------------------------------------------------------------------
 */
static void
assignNumber(
    int useDoubles,
    Tcl_WideInt *intNumberPtr,
    double *dblNumberPtr,
    Tcl_Obj *numberObj)
{



    void *clientData;
    int tcl_number_type;

    if (Tcl_GetNumberFromObj(NULL, numberObj, &clientData, &tcl_number_type) != TCL_OK
	    || tcl_number_type == TCL_NUMBER_BIG) {
	return;
    }
    if (useDoubles) {
	if (tcl_number_type != TCL_NUMBER_INT) {
	    *dblNumberPtr = *(double *)clientData;
	} else {
	    *dblNumberPtr = (double)*(Tcl_WideInt *)clientData;
	}
    } else {
	if (tcl_number_type == TCL_NUMBER_INT) {
	    *intNumberPtr = *(Tcl_WideInt *)clientData;
	} else {
	    *intNumberPtr = (Tcl_WideInt)*(double *)clientData;
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
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
 *
 * 	None.
 *----------------------------------------------------------------------
 */

int
TclNewArithSeriesObj(
    Tcl_Interp *interp,        /* For error reporting */
    Tcl_Obj **arithSeriesObj,  /* return value */
    int useDoubles,            /* Promote values to double when true,
                                * int otherwise */
    Tcl_Obj *startObj,         /* First value in list */
    Tcl_Obj *endObj,           /* Upper bound value of list */
    Tcl_Obj *stepObj,          /* Increment amount */
    Tcl_Obj *lenObj)           /* Number of elements */
{
    double dstart, dend, dstep;
    Tcl_WideInt start, end, step;
    Tcl_WideInt len;

    if (startObj) {
	assignNumber(useDoubles, &start, &dstart, startObj);
    } else {
	start = 0;
	dstart = start;
    }
    if (stepObj) {
	assignNumber(useDoubles, &step, &dstep, stepObj);
	if (useDoubles) {
	    step = dstep;
	} else {
	    dstep = step;
	}
	if (dstep == 0) {
	    *arithSeriesObj = Tcl_NewObj();
            return TCL_OK;
	}
    }
    if (endObj) {
	assignNumber(useDoubles, &end, &dend, endObj);
    }
    if (lenObj) {
	if (TCL_OK != Tcl_GetWideIntFromObj(interp, lenObj, &len)) {







|
|
|
|
|
|
|
|



|















|
|







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

int
TclNewArithSeriesObj(
    Tcl_Interp *interp,       /* For error reporting */
    Tcl_Obj **arithSeriesObj, /* return value */
    int useDoubles,           /* Flag indicates values start,
			      ** end, step, are treated as doubles */
    Tcl_Obj *startObj,        /* Starting value */
    Tcl_Obj *endObj,          /* Ending limit */
    Tcl_Obj *stepObj,         /* increment value */
    Tcl_Obj *lenObj)          /* Number of elements */
{
    double dstart, dend, dstep;
    Tcl_WideInt start, end, step;
    Tcl_WideInt len = -1;

    if (startObj) {
	assignNumber(useDoubles, &start, &dstart, startObj);
    } else {
	start = 0;
	dstart = start;
    }
    if (stepObj) {
	assignNumber(useDoubles, &step, &dstep, stepObj);
	if (useDoubles) {
	    step = dstep;
	} else {
	    dstep = step;
	}
	if (dstep == 0) {
	    TclNewObj(*arithSeriesObj);
	    return TCL_OK;
	}
    }
    if (endObj) {
	assignNumber(useDoubles, &end, &dend, endObj);
    }
    if (lenObj) {
	if (TCL_OK != Tcl_GetWideIntFromObj(interp, lenObj, &len)) {
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
		step = (start < end) ? 1 : -1;
		dstep = step;
	    }
	}
	assert(dstep!=0);
	if (!lenObj) {
	    if (useDoubles) {
		len = (dend - dstart + dstep)/dstep;

	    } else {
		len = (end - start + step)/step;
	    }
	}
    }

    if (!endObj) {
	if (useDoubles) {
	    dend = dstart + (dstep * (len-1));
	    end = dend;
	} else {
	    end = start + (step * (len-1));
	    dend = end;
	}
    }

    if (TCL_MAJOR_VERSION < 9 && len > ListSizeT_MAX) {
	Tcl_SetObjResult(
	    interp,
	    Tcl_NewStringObj("max length of a Tcl list exceeded", -1));
	Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	return TCL_ERROR;
    }

    if (arithSeriesObj) {
	*arithSeriesObj = (useDoubles)
	    ? TclNewArithSeriesDbl(dstart, dend, dstep, len)
	    : TclNewArithSeriesInt(start, end, step, len);
    }













































    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclArithSeriesObjLength
 *
 *	Returns the length of the arithmentic series.
 *
 * Results:
 *
 * 	The length of the series as Tcl_WideInt.
 *
 * Side Effects:
 *
 * 	None.
 *
 *----------------------------------------------------------------------
 */
Tcl_WideInt TclArithSeriesObjLength(Tcl_Obj *arithSeriesObj)
{
    ArithSeries *arithSeriesRepPtr = (ArithSeries *)Tcl_AbstractListGetConcreteRep(arithSeriesObj);
    return arithSeriesRepPtr->len;
}

/*
 *----------------------------------------------------------------------
 *
 * TclArithSeriesObjIndex --
 *
 *	Returns the element with the specified index in the list
 *	represented by the specified Arithmentic Sequence object.
 *	If the index is out of range, TCL_ERROR is returned,
 *	otherwise TCL_OK is returned and the integer value of the
 *	element is stored in *element.
 *
 * Results:
 *
 * 	TCL_OK on succes, TCL_ERROR on index out of range.
 *
 * Side Effects:
 *
 * 	On success, the integer pointed by *element is modified.
 *
 *----------------------------------------------------------------------
 */

int
TclArithSeriesObjIndex(
    Tcl_Interp *interp,	     /* Used for error reporting if not NULL. */
    Tcl_Obj *arithSeriesPtr, /* List obj */
    Tcl_Size index,	     /* index to element of interest */
    Tcl_Obj **elemObj)	     /* Return value */
{
    ArithSeries *arithSeriesRepPtr = (ArithSeries *)Tcl_AbstractListGetConcreteRep(arithSeriesPtr);
    (void)interp; // quiet compiler
    if (index < arithSeriesRepPtr->len) {
	/* List[i] = Start + (Step * index) */
	if (arithSeriesRepPtr->isDouble) {
	    *elemObj = Tcl_NewDoubleObj(ArithSeriesIndexDbl((ArithSeriesDbl*)arithSeriesRepPtr, index));
	} else {
	    *elemObj = Tcl_NewWideIntObj(ArithSeriesIndexInt(arithSeriesRepPtr, index));
	}
    } else {
	TclNewObj(*elemObj); // empty value
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclArithSeriesObjStep --
 *







|
>

|














|









|
|

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






|

|











|

|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<







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
		step = (start < end) ? 1 : -1;
		dstep = step;
	    }
	}
	assert(dstep!=0);
	if (!lenObj) {
	    if (useDoubles) {
		int precision = maxPrecision(dstart,dend,dstep);
		len = ArithSeriesLenDbl(dstart, dend, dstep, precision);
	    } else {
		len = ArithSeriesLenInt(start, end, step);
	    }
	}
    }

    if (!endObj) {
	if (useDoubles) {
	    dend = dstart + (dstep * (len-1));
	    end = dend;
	} else {
	    end = start + (step * (len-1));
	    dend = end;
	}
    }

    if (len > TCL_SIZE_MAX) {
	Tcl_SetObjResult(
	    interp,
	    Tcl_NewStringObj("max length of a Tcl list exceeded", -1));
	Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	return TCL_ERROR;
    }

    if (arithSeriesObj) {
	*arithSeriesObj = (useDoubles)
	    ? NewArithSeriesDbl(dstart, dend, dstep, len)
	    : NewArithSeriesInt(start, end, step, len);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclArithSeriesObjIndex --
 *
 *	Returns the element with the specified index in the list
 *	represented by the specified Arithmetic Sequence object.
 *	If the index is out of range, TCL_ERROR is returned,
 *	otherwise TCL_OK is returned and the integer value of the
 *	element is stored in *element.
 *
 * Results:
 *
 * 	TCL_OK on success, TCL_ERROR on index out of range.
 *
 * Side Effects:
 *
 * 	On success, the integer pointed by *element is modified.
 *
 *----------------------------------------------------------------------
 */

int
TclArithSeriesObjIndex(
    TCL_UNUSED(Tcl_Interp *),/* Used for error reporting if not NULL. */
    Tcl_Obj *arithSeriesObj, /* List obj */
    Tcl_Size index,          /* index to element of interest */
    Tcl_Obj **elemObj)       /* Return value */
{
    ArithSeries *arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj);

    if (index < 0 || arithSeriesRepPtr->len <= index) {
	*elemObj = Tcl_NewObj();
    } else {
	/* List[i] = Start + (Step * index) */
	if (arithSeriesRepPtr->isDouble) {
	    *elemObj = Tcl_NewDoubleObj(ArithSeriesIndexDbl(arithSeriesRepPtr, index));
	} else {
	    *elemObj = Tcl_NewWideIntObj(ArithSeriesIndexInt(arithSeriesRepPtr, index));
	}
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ArithSeriesObjLength
 *
 *	Returns the length of the arithmetic series.
 *
 * Results:
 *
 * 	The length of the series as Tcl_WideInt.
 *
 * Side Effects:
 *
 * 	None.
 *
 *----------------------------------------------------------------------
 */
Tcl_Size ArithSeriesObjLength(Tcl_Obj *arithSeriesObj)
{
    ArithSeries *arithSeriesRepPtr = (ArithSeries*)


























	    arithSeriesObj->internalRep.twoPtrValue.ptr1;







    return arithSeriesRepPtr->len;











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

int
TclArithSeriesObjStep(
    Tcl_Obj *arithSeriesPtr,
    Tcl_Obj **stepObj)
{
    ArithSeries *arithSeriesRepPtr = (ArithSeries *)Tcl_AbstractListGetConcreteRep(arithSeriesPtr);
    if (arithSeriesRepPtr->isDouble) {
	*stepObj = Tcl_NewDoubleObj(((ArithSeriesDbl*)(arithSeriesRepPtr))->step);
    } else {
	*stepObj = Tcl_NewWideIntObj(arithSeriesRepPtr->step);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_NewArithSeriesObj --
 *
 *	Creates a new ArithSeries object. The returned object has
 *	refcount = 0.



 *
 * Results:
 *
 * 	A Tcl_Obj pointer to the created ArithSeries object.
 * 	A NULL pointer of the range is invalid.
 *
 * Side Effects:
 *
 * 	None.

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

Tcl_Obj *
Tcl_NewArithSeriesObj(Tcl_Size objc, Tcl_Obj * const objv[])


{
    Tcl_Obj *arithSeriesObj;
    if (objc != 4) return NULL;
    // TODO: Define this use model!
    if (TclNewArithSeriesObj(NULL, &arithSeriesObj, 0/*TODO: int vs double support */,
               objv[0]/*start*/, objv[1]/*end*/,
               objv[2]/*step*/, objv[3]/*len*/) != TCL_OK) {
        arithSeriesObj = NULL;
    }
    return arithSeriesObj;
}

/*
 *----------------------------------------------------------------------
 *
 * TclArithSeriesObjRange --
 *
 *	Makes a slice of an ArithSeries value.
 *      *arithSeriesPtr must be known to be a valid list.
 *
 * Results:
 *	Returns a pointer to the sliced series.
 *      This may be a new object or the same object if not shared.
 *
 * Side effects:
 *	?The possible conversion of the object referenced by listPtr?
 *	?to a list object.?
 *
 *----------------------------------------------------------------------
 */

int
TclArithSeriesObjRange(
    Tcl_Interp *interp,         /* for error messages. */
    Tcl_Obj *arithSeriesPtr,	/* List object to take a range from. */
    Tcl_Size fromIdx,		/* Index of first element to include. */
    Tcl_Size toIdx,		/* Index of last element to include. */
    Tcl_Obj **newObjPtr)        /* return value */
{
    ArithSeries *arithSeriesRepPtr;
    Tcl_Obj *startObj, *endObj, *stepObj;

    (void)interp; /* silence compiler */

    arithSeriesRepPtr = (ArithSeries *)Tcl_AbstractListGetConcreteRep(arithSeriesPtr);

    if (fromIdx == TCL_INDEX_NONE) {
	fromIdx = 0;
    }

    if (toIdx >= arithSeriesRepPtr->len) {
	toIdx = arithSeriesRepPtr->len-1;
    }

    if (fromIdx > toIdx ||
	fromIdx >= arithSeriesRepPtr->len) {
	TclNewObj(*newObjPtr);
	return TCL_OK;
    }











    TclArithSeriesObjIndex(interp, arithSeriesPtr, fromIdx, &startObj);
    Tcl_IncrRefCount(startObj);
    TclArithSeriesObjIndex(interp, arithSeriesPtr, toIdx, &endObj);
    Tcl_IncrRefCount(endObj);
    TclArithSeriesObjStep(arithSeriesPtr, &stepObj);
    Tcl_IncrRefCount(stepObj);

    if (Tcl_IsShared(arithSeriesPtr) ||
	    ((arithSeriesPtr->refCount > 1))) {
        int status = TclNewArithSeriesObj(NULL, newObjPtr,
		         arithSeriesRepPtr->isDouble, startObj, endObj, stepObj, NULL);

        Tcl_DecrRefCount(startObj);
        Tcl_DecrRefCount(endObj);
        Tcl_DecrRefCount(stepObj);
	return status;
    }

    /*
     * In-place is possible.
     */

    /*
     * Even if nothing below cause any changes, we still want the
     * string-canonizing effect of [lrange 0 end].
     */

    TclInvalidateStringRep(arithSeriesPtr);

    if (arithSeriesRepPtr->isDouble) {
	ArithSeriesDbl *arithSeriesDblRepPtr = (ArithSeriesDbl*)arithSeriesPtr;
	double start, end, step;

	Tcl_GetDoubleFromObj(NULL, startObj, &start);
	Tcl_GetDoubleFromObj(NULL, endObj, &end);
	Tcl_GetDoubleFromObj(NULL, stepObj, &step);
	arithSeriesDblRepPtr->start = start;
	arithSeriesDblRepPtr->end = end;
	arithSeriesDblRepPtr->step = step;

	arithSeriesDblRepPtr->len = (end-start+step)/step;

	arithSeriesDblRepPtr->elements = NULL;

    } else {
	Tcl_WideInt start, end, step;
	Tcl_GetWideIntFromObj(NULL, startObj, &start);
	Tcl_GetWideIntFromObj(NULL, endObj, &end);
	Tcl_GetWideIntFromObj(NULL, stepObj, &step);
	arithSeriesRepPtr->start = start;
	arithSeriesRepPtr->end = end;
	arithSeriesRepPtr->step = step;
	arithSeriesRepPtr->len = (end-start+step)/step;
	arithSeriesRepPtr->elements = NULL;
    }

    Tcl_DecrRefCount(startObj);
    Tcl_DecrRefCount(endObj);
    Tcl_DecrRefCount(stepObj);

    *newObjPtr = arithSeriesPtr;

























































































    return TCL_OK;
}

/*


 *  Handle ArithSeries special case - don't shimmer a series into a list

 *  just to reverse it.










 */
int
TclArithSeriesObjReverse(
    Tcl_Interp *interp,         /* For error messages */
    Tcl_Obj *arithSeriesPtr,	/* List object to reverse. */
    Tcl_Obj **newObjPtr)
{
    ArithSeries *arithSeriesRepPtr;
    Tcl_Obj *startObj, *endObj, *stepObj;
    Tcl_Obj *resultObj;
    Tcl_WideInt start, end, step, len;
    double dstart, dend, dstep;
    int isDouble;

    (void)interp;

    if (newObjPtr == NULL) {
	return TCL_ERROR;
    }

    arithSeriesRepPtr = (ArithSeries *)Tcl_AbstractListGetConcreteRep(arithSeriesPtr);

    isDouble = arithSeriesRepPtr->isDouble;
    len = arithSeriesRepPtr->len;

    TclArithSeriesObjIndex(NULL, arithSeriesPtr, (len-1), &startObj);
    Tcl_IncrRefCount(startObj);
    TclArithSeriesObjIndex(NULL, arithSeriesPtr, 0, &endObj);
    Tcl_IncrRefCount(endObj);
    TclArithSeriesObjStep(arithSeriesPtr, &stepObj);
    Tcl_IncrRefCount(stepObj);

    if (isDouble) {
	Tcl_GetDoubleFromObj(NULL, startObj, &dstart);
	Tcl_GetDoubleFromObj(NULL, endObj, &dend);
	Tcl_GetDoubleFromObj(NULL, stepObj, &dstep);
	dstep = -dstep;
	TclSetDoubleObj(stepObj, dstep);
    } else {
	Tcl_GetWideIntFromObj(NULL, startObj, &start);
	Tcl_GetWideIntFromObj(NULL, endObj, &end);
	Tcl_GetWideIntFromObj(NULL, stepObj, &step);
	step = -step;
	TclSetIntObj(stepObj, step);
    }

    Tcl_IncrRefCount(startObj);
    Tcl_IncrRefCount(endObj);
    Tcl_IncrRefCount(stepObj);

    if (Tcl_IsShared(arithSeriesPtr) ||
	    ((arithSeriesPtr->refCount > 1))) {
	Tcl_Obj *lenObj = Tcl_NewWideIntObj(len);

	if (TclNewArithSeriesObj(NULL, &resultObj, isDouble,
                                 startObj, endObj, stepObj, lenObj) != TCL_OK) {
            resultObj = NULL;
        }
        Tcl_DecrRefCount(lenObj);
    } else {

	/*
	 * In-place is possible.
	 */

	TclInvalidateStringRep(arithSeriesPtr);

	if (isDouble) {
	    ArithSeriesDbl *arithSeriesDblRepPtr =
		(ArithSeriesDbl*)arithSeriesRepPtr;
	    arithSeriesDblRepPtr->start = dstart;
	    arithSeriesDblRepPtr->end = dend;
	    arithSeriesDblRepPtr->step = dstep;







|


|







|



|

|
|
>
>
>



|
<

|

|
>



|
|
>
>

|
<
<
<
<
<
<
<
|








|














|
|









|















>
>
>
>
>
>
>
>
>
>
|

|

|


|
|
|
|

|
|
|








|



|


|

>






>
|
>










|







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




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



|
|















|




|

|

|
















<
<
<
<
|
|
|
>

|
|
|
|






|







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

int
TclArithSeriesObjStep(
    Tcl_Obj *arithSeriesObj,
    Tcl_Obj **stepObj)
{
    ArithSeries *arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj);
    if (arithSeriesRepPtr->isDouble) {
	*stepObj = Tcl_NewDoubleObj(((ArithSeriesDbl*)(arithSeriesRepPtr))->step);
    } else {
	*stepObj = Tcl_NewWideIntObj(arithSeriesRepPtr->step);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * SetArithSeriesFromAny --
 *
 * 	The Arithmetic Series object is just an way to optimize
 * 	Lists space complexity, so no one should try to convert
 * 	a string to an Arithmetic Series object.
 *
 * 	This function is here just to populate the Type structure.
 *
 * Results:
 *
 * 	The result is always TCL_ERROR. But see Side Effects.

 *
 * Side effects:
 *
 * 	Tcl Panic if called.
 *
 *----------------------------------------------------------------------
 */

static int
SetArithSeriesFromAny(
    TCL_UNUSED(Tcl_Interp *),		/* Used for error reporting if not NULL. */
    TCL_UNUSED(Tcl_Obj *))		/* The object to convert. */
{
    Tcl_Panic("SetArithSeriesFromAny: should never be called");







    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TclArithSeriesObjRange --
 *
 *	Makes a slice of an ArithSeries value.
 *      *arithSeriesObj must be known to be a valid list.
 *
 * Results:
 *	Returns a pointer to the sliced series.
 *      This may be a new object or the same object if not shared.
 *
 * Side effects:
 *	?The possible conversion of the object referenced by listPtr?
 *	?to a list object.?
 *
 *----------------------------------------------------------------------
 */

int
TclArithSeriesObjRange(
    Tcl_Interp *interp,         /* For error message(s) */
    Tcl_Obj *arithSeriesObj,	/* List object to take a range from. */
    Tcl_Size fromIdx,		/* Index of first element to include. */
    Tcl_Size toIdx,		/* Index of last element to include. */
    Tcl_Obj **newObjPtr)        /* return value */
{
    ArithSeries *arithSeriesRepPtr;
    Tcl_Obj *startObj, *endObj, *stepObj;

    (void)interp; /* silence compiler */

    arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj);

    if (fromIdx == TCL_INDEX_NONE) {
	fromIdx = 0;
    }

    if (toIdx >= arithSeriesRepPtr->len) {
	toIdx = arithSeriesRepPtr->len-1;
    }

    if (fromIdx > toIdx ||
	fromIdx >= arithSeriesRepPtr->len) {
	TclNewObj(*newObjPtr);
	return TCL_OK;
    }

    if (fromIdx < 0) {
	fromIdx = 0;
    }
    if (toIdx < 0) {
	toIdx = 0;
    }
    if (toIdx > arithSeriesRepPtr->len-1) {
	toIdx = arithSeriesRepPtr->len-1;
    }

    TclArithSeriesObjIndex(interp, arithSeriesObj, fromIdx, &startObj);
    Tcl_IncrRefCount(startObj);
    TclArithSeriesObjIndex(interp, arithSeriesObj, toIdx, &endObj);
    Tcl_IncrRefCount(endObj);
    TclArithSeriesObjStep(arithSeriesObj, &stepObj);
    Tcl_IncrRefCount(stepObj);

    if (Tcl_IsShared(arithSeriesObj) ||
	    ((arithSeriesObj->refCount > 1))) {
	int status = TclNewArithSeriesObj(NULL, newObjPtr,
		arithSeriesRepPtr->isDouble, startObj, endObj, stepObj, NULL);

	Tcl_DecrRefCount(startObj);
	Tcl_DecrRefCount(endObj);
	Tcl_DecrRefCount(stepObj);
	return status;
    }

    /*
     * In-place is possible.
     */

    /*
     * Even if nothing below causes any changes, we still want the
     * string-canonizing effect of [lrange 0 end].
     */

    TclInvalidateStringRep(arithSeriesObj);

    if (arithSeriesRepPtr->isDouble) {
	ArithSeriesDbl *arithSeriesDblRepPtr = (ArithSeriesDbl*)arithSeriesRepPtr;
	double start, end, step;

	Tcl_GetDoubleFromObj(NULL, startObj, &start);
	Tcl_GetDoubleFromObj(NULL, endObj, &end);
	Tcl_GetDoubleFromObj(NULL, stepObj, &step);
	arithSeriesDblRepPtr->start = start;
	arithSeriesDblRepPtr->end = end;
	arithSeriesDblRepPtr->step = step;
	arithSeriesDblRepPtr->precision = maxPrecision(start, end, step);
	arithSeriesDblRepPtr->len =
	    ArithSeriesLenDbl(start, end, step, arithSeriesDblRepPtr->precision);
	arithSeriesDblRepPtr->elements = NULL;

    } else {
	Tcl_WideInt start, end, step;
	Tcl_GetWideIntFromObj(NULL, startObj, &start);
	Tcl_GetWideIntFromObj(NULL, endObj, &end);
	Tcl_GetWideIntFromObj(NULL, stepObj, &step);
	arithSeriesRepPtr->start = start;
	arithSeriesRepPtr->end = end;
	arithSeriesRepPtr->step = step;
	arithSeriesRepPtr->len = ArithSeriesLenInt(start, end, step);
	arithSeriesRepPtr->elements = NULL;
    }

    Tcl_DecrRefCount(startObj);
    Tcl_DecrRefCount(endObj);
    Tcl_DecrRefCount(stepObj);

    *newObjPtr = arithSeriesObj;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclArithSeriesGetElements --
 *
 *	This function returns an (objc,objv) array of the elements in a list
 *	object.
 *
 * Results:
 *	The return value is normally TCL_OK; in this case *objcPtr is set to
 *	the count of list elements and *objvPtr is set to a pointer to an
 *	array of (*objcPtr) pointers to each list element. If listPtr does not
 *	refer to an Abstract List object and the object can not be converted
 *	to one, TCL_ERROR is returned and an error message will be left in the
 *	interpreter's result if interp is not NULL.
 *
 *	The objects referenced by the returned array should be treated as
 *	readonly and their ref counts are _not_ incremented; the caller must
 *	do that if it holds on to a reference. Furthermore, the pointer and
 *	length returned by this function may change as soon as any function is
 *	called on the list object; be careful about retaining the pointer in a
 *	local data structure.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclArithSeriesGetElements(
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
    Tcl_Obj *objPtr,		/* ArithSeries object for which an element
				 * array is to be returned. */
    Tcl_Size *objcPtr,		/* Where to store the count of objects
				 * referenced by objv. */
    Tcl_Obj ***objvPtr)		/* Where to store the pointer to an array of
				 * pointers to the list's objects. */
{
    if (TclHasInternalRep(objPtr,&arithSeriesType)) {
	ArithSeries *arithSeriesRepPtr;
	Tcl_Obj **objv;
	int i, objc;

	arithSeriesRepPtr = ArithSeriesGetInternalRep(objPtr);

	objc = arithSeriesRepPtr->len;
	if (objc > 0) {
	    if (arithSeriesRepPtr->elements) {
		/* If this exists, it has already been populated */
		objv = arithSeriesRepPtr->elements;
	    } else {
		/* Construct the elements array */
		objv = (Tcl_Obj **)Tcl_Alloc(sizeof(Tcl_Obj*) * objc);
		if (objv == NULL) {
		    if (interp) {
			Tcl_SetObjResult(
			    interp,
			    Tcl_NewStringObj("max length of a Tcl list exceeded", -1));
			Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
		    }
		    return TCL_ERROR;
		}
		arithSeriesRepPtr->elements = objv;
		for (i = 0; i < objc; i++) {
		    int status = TclArithSeriesObjIndex(interp, objPtr, i, &objv[i]);
		    if (status) {
			return TCL_ERROR;
		    }
		    Tcl_IncrRefCount(objv[i]);
		}
	    }
	} else {
	    objv = NULL;
	}
	*objvPtr = objv;
	*objcPtr = objc;
    } else {
	if (interp != NULL) {
	    Tcl_SetObjResult(
		interp,
		Tcl_ObjPrintf("value is not an arithseries"));
	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "UNKNOWN", NULL);
	}
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclArithSeriesObjReverse --
 *
 *	Reverse the order of the ArithSeries value. The arithSeriesObj is
 *	assumed to be a valid ArithSeries. The new Obj has the Start and End
 *	values appropriately swapped and the Step value sign is changed.
 *
 * Results:
 *      The result will be an ArithSeries in the reverse order.
 *
 * Side effects:
 *      The ogiginal obj will be modified and returned if it is not Shared.
 *
 *----------------------------------------------------------------------
 */
int
TclArithSeriesObjReverse(
    Tcl_Interp *interp,         /* For error message(s) */
    Tcl_Obj *arithSeriesObj,	/* List object to reverse. */
    Tcl_Obj **newObjPtr)
{
    ArithSeries *arithSeriesRepPtr;
    Tcl_Obj *startObj, *endObj, *stepObj;
    Tcl_Obj *resultObj;
    Tcl_WideInt start, end, step, len;
    double dstart, dend, dstep;
    int isDouble;

    (void)interp;

    if (newObjPtr == NULL) {
	return TCL_ERROR;
    }

    arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj);

    isDouble = arithSeriesRepPtr->isDouble;
    len = arithSeriesRepPtr->len;

    TclArithSeriesObjIndex(NULL, arithSeriesObj, (len-1), &startObj);
    Tcl_IncrRefCount(startObj);
    TclArithSeriesObjIndex(NULL, arithSeriesObj, 0, &endObj);
    Tcl_IncrRefCount(endObj);
    TclArithSeriesObjStep(arithSeriesObj, &stepObj);
    Tcl_IncrRefCount(stepObj);

    if (isDouble) {
	Tcl_GetDoubleFromObj(NULL, startObj, &dstart);
	Tcl_GetDoubleFromObj(NULL, endObj, &dend);
	Tcl_GetDoubleFromObj(NULL, stepObj, &dstep);
	dstep = -dstep;
	TclSetDoubleObj(stepObj, dstep);
    } else {
	Tcl_GetWideIntFromObj(NULL, startObj, &start);
	Tcl_GetWideIntFromObj(NULL, endObj, &end);
	Tcl_GetWideIntFromObj(NULL, stepObj, &step);
	step = -step;
	TclSetIntObj(stepObj, step);
    }





    if (Tcl_IsShared(arithSeriesObj) ||
	    ((arithSeriesObj->refCount > 1))) {
	Tcl_Obj *lenObj;
	TclNewIntObj(lenObj, len);
	if (TclNewArithSeriesObj(NULL, &resultObj, isDouble,
		startObj, endObj, stepObj, lenObj) != TCL_OK) {
	    resultObj = NULL;
	}
	Tcl_DecrRefCount(lenObj);
    } else {

	/*
	 * In-place is possible.
	 */

	TclInvalidateStringRep(arithSeriesObj);

	if (isDouble) {
	    ArithSeriesDbl *arithSeriesDblRepPtr =
		(ArithSeriesDbl*)arithSeriesRepPtr;
	    arithSeriesDblRepPtr->start = dstart;
	    arithSeriesDblRepPtr->end = dend;
	    arithSeriesDblRepPtr->step = dstep;
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
	    for (i=0; i<len; i++) {
		Tcl_DecrRefCount(arithSeriesRepPtr->elements[i]);
	    }
	    Tcl_Free((char*)arithSeriesRepPtr->elements);
	}
	arithSeriesRepPtr->elements = NULL;

	resultObj = arithSeriesPtr;
    }

    Tcl_DecrRefCount(startObj);
    Tcl_DecrRefCount(endObj);
    Tcl_DecrRefCount(stepObj);

    *newObjPtr = resultObj;

    return TCL_OK;
}

/*
** Handle ArithSeries GetElements call
*/

int
TclArithSeriesGetElements(
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
    Tcl_Obj *arithSeriesObjPtr,		/* ArithSeries object for which an element
				 * array is to be returned. */
    Tcl_Size *objcPtr,		/* Where to store the count of objects
				 * referenced by objv. */
    Tcl_Obj ***objvPtr)		/* Where to store the pointer to an array of
				 * pointers to the list's objects. */
{
    ArithSeries *arithSeriesRepPtr =
	(ArithSeries*)Tcl_AbstractListGetConcreteRep(arithSeriesObjPtr);
    Tcl_Obj **objv;
    int i, objc;

    objc = arithSeriesRepPtr->len;




    if (objvPtr == NULL) {

	if (objcPtr) {
	    *objcPtr = objc;
	    return TCL_OK;
	}
	return TCL_ERROR;
    }

    if (objc && objvPtr && arithSeriesRepPtr->elements) {



	objv = arithSeriesRepPtr->elements;
    } else if (objc > 0) {
	objv = (Tcl_Obj **)Tcl_Alloc(sizeof(Tcl_Obj*) * objc);
	if (objv == NULL) {
	    if (interp) {
		Tcl_SetObjResult(

		    interp,

		    Tcl_NewStringObj("max length of a Tcl list exceeded", -1));
		Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	    }
	    return TCL_ERROR;
	}
	for (i = 0; i < objc; i++) {
	    if (TclArithSeriesObjIndex(interp, arithSeriesObjPtr, i, &objv[i]) == TCL_OK) {
		Tcl_IncrRefCount(objv[i]);
	    } else {
		// TODO: some cleanup needed here
		return TCL_ERROR;
	    }
	}
    } else {
	objv = NULL;
    }

    arithSeriesRepPtr->elements = objv;



    *objvPtr = objv;
    *objcPtr = objc;
    return TCL_OK;
}

static void
UpdateStringOfArithSeries(Tcl_Obj *arithSeriesObjPtr)
{
    ArithSeries *arithSeriesRepPtr = (ArithSeries*)Tcl_AbstractListGetConcreteRep(arithSeriesObjPtr);
    char *p, *str;
    Tcl_Obj *eleObj;
    Tcl_WideInt length = 0;
    int llen, slen, i;


    /*
     * Pass 1: estimate space.
     */
    llen = arithSeriesRepPtr->len;
    if (llen <= 0) {
	Tcl_InitStringRep(arithSeriesObjPtr, NULL, 0);
	return;


    }

    for (i = 0; i < llen; i++) {
	if (TclArithSeriesObjIndex(NULL, arithSeriesObjPtr, i, &eleObj) == TCL_OK) {
            Tcl_GetStringFromObj(eleObj, &slen);
            length += slen + 1; /* one more for the space char */

            Tcl_DecrRefCount(eleObj);
        } else {
            // TODO: report error?
        }

    }



    /*
     * Pass 2: generate the string repr.
     */

    p = Tcl_InitStringRep(arithSeriesObjPtr, NULL, length);
    for (i = 0; i < llen; i++) {
	if (TclArithSeriesObjIndex(NULL, arithSeriesObjPtr, i, &eleObj) == TCL_OK) {

            str = Tcl_GetStringFromObj(eleObj, &slen);
            strcpy(p, str);
            p[slen] = ' ';
            p += slen+1;
            Tcl_DecrRefCount(eleObj);
        } // else TODO: report error here?
    }
    if (length > 0) arithSeriesObjPtr->bytes[length-1] = '\0';
    arithSeriesObjPtr->length = length-1;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|












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



|
|

<
<
|




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





|
|

>
|
|
|
|
|
|

|
|

|







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
	    for (i=0; i<len; i++) {
		Tcl_DecrRefCount(arithSeriesRepPtr->elements[i]);
	    }
	    Tcl_Free((char*)arithSeriesRepPtr->elements);
	}
	arithSeriesRepPtr->elements = NULL;

	resultObj = arithSeriesObj;
    }

    Tcl_DecrRefCount(startObj);
    Tcl_DecrRefCount(endObj);
    Tcl_DecrRefCount(stepObj);

    *newObjPtr = resultObj;

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

 *

 * UpdateStringOfArithSeries --












 *

 *	Update the string representation for an arithseries object.
 *	Note: This procedure does not invalidate an existing old string rep
 *	so storage will be lost if this has not already been done.
 *

 * Results:
 *	None.





 *

 * Side effects:
 *	The object's string is set to a valid string that results from
 *	the list-to-string conversion. This string will be empty if the
 *	list has no elements. The list internal representation


 *	should not be NULL and we assume it is not NULL.


 *
 * Notes:
 * 	At the cost of overallocation it's possible to estimate
 * 	the length of the string representation and make this procedure















 * 	much faster. Because the programmer shouldn't expect the
 * 	string conversion of a big arithmetic sequence to be fast
 * 	this version takes more care of space than time.
 *
 *----------------------------------------------------------------------
 */




static void
UpdateStringOfArithSeries(Tcl_Obj *arithSeriesObjPtr)
{
    ArithSeries *arithSeriesRepPtr = (ArithSeries*)arithSeriesObjPtr->internalRep.twoPtrValue.ptr1;
    char *p;
    Tcl_Obj *eleObj;


    Tcl_Size i, bytlen = 0;

    /*
     * Pass 1: estimate space.
     */
    if (!arithSeriesRepPtr->isDouble) {
	for (i = 0; i < arithSeriesRepPtr->len; i++) {
	    double d = ArithSeriesIndexDbl(arithSeriesRepPtr, i);

	    size_t slen = d>0 ? log10(d)+1 : d<0 ? log10((0-d))+2 : 1;
	    bytlen += slen;
	}
    } else {
	for (i = 0; i < arithSeriesRepPtr->len; i++) {
	    double d = ArithSeriesIndexDbl(arithSeriesRepPtr, i);

	    char tmp[TCL_DOUBLE_SPACE+2];
	    tmp[0] = 0;
	    Tcl_PrintDouble(NULL,d,tmp);
	    if ((bytlen + strlen(tmp)) > TCL_SIZE_MAX) {
		break; // overflow
	    }
	    bytlen += strlen(tmp);
	}
    }
    bytlen += arithSeriesRepPtr->len; // Space for each separator

    /*
     * Pass 2: generate the string repr.
     */

    p = Tcl_InitStringRep(arithSeriesObjPtr, NULL, bytlen);
    for (i = 0; i < arithSeriesRepPtr->len; i++) {
	if (TclArithSeriesObjIndex(NULL, arithSeriesObjPtr, i, &eleObj) == TCL_OK) {
	    Tcl_Size slen;
	    char *str = Tcl_GetStringFromObj(eleObj, &slen);
	    strcpy(p, str);
	    p[slen] = ' ';
	    p += slen+1;
	    Tcl_DecrRefCount(eleObj);
	} // else TODO: report error here?
    }
    if (bytlen > 0) arithSeriesObjPtr->bytes[bytlen-1] = '\0';
    arithSeriesObjPtr->length = bytlen-1;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Deleted generic/tclArithSeries.h.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
/*
 * tclArithSeries.h --
 *
 *     This file contains the ArithSeries concrete abstract list
 *     implementation. It implements the inner workings of the lseq command.
 *
 * Copyright © 2022 Brian S. Griffin.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * The structure used for the AirthSeries internal representation.
 * Note that the len can in theory be always computed by start,end,step
 * but it's faster to cache it inside the internal representation.
 */
typedef struct ArithSeries {
    Tcl_WideInt start;
    Tcl_WideInt end;
    Tcl_WideInt step;
    Tcl_Size len;
    Tcl_Obj **elements;
    int isDouble;
} ArithSeries;

typedef struct ArithSeriesDbl {
    double start;
    double end;
    double step;
    Tcl_Size len;
    Tcl_Obj **elements;
    int isDouble;
} ArithSeriesDbl;

MODULE_SCOPE int	TclNewArithSeriesObj(Tcl_Interp *interp, Tcl_Obj **arithSeriesPtr,
                            int useDoubles, Tcl_Obj *startObj, Tcl_Obj *endObj,
                            Tcl_Obj *stepObj, Tcl_Obj *lenObj);

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<




























































































Changes to generic/tclAssembly.c.

218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
typedef struct AssemblyEnv {
    CompileEnv* envPtr;		/* Compilation environment being used for code
				 * generation */
    Tcl_Parse* parsePtr;	/* Parse of the current line of source */
    Tcl_HashTable labelHash;	/* Hash table whose keys are labels and whose
				 * values are 'label' objects storing the code
				 * offsets of the labels. */
    size_t cmdLine;		/* Current line number within the assembly
				 * code */
    int* clNext;		/* Invisible continuation line for
				 * [info frame] */
    BasicBlock* head_bb;	/* First basic block in the code */
    BasicBlock* curr_bb;	/* Current basic block */
    int maxDepth;		/* Maximum stack depth encountered */
    int curCatchDepth;		/* Current depth of catches */







|







218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
typedef struct AssemblyEnv {
    CompileEnv* envPtr;		/* Compilation environment being used for code
				 * generation */
    Tcl_Parse* parsePtr;	/* Parse of the current line of source */
    Tcl_HashTable labelHash;	/* Hash table whose keys are labels and whose
				 * values are 'label' objects storing the code
				 * offsets of the labels. */
    Tcl_Size cmdLine;	/* Current line number within the assembly
				 * code */
    int* clNext;		/* Invisible continuation line for
				 * [info frame] */
    BasicBlock* head_bb;	/* First basic block in the code */
    BasicBlock* curr_bb;	/* Current basic block */
    int maxDepth;		/* Maximum stack depth encountered */
    int curCatchDepth;		/* Current depth of catches */
321
322
323
324
325
326
327
328

329
330
331
332
333
334
335
static Tcl_DupInternalRepProc	DupAssembleCodeInternalRep;

static const Tcl_ObjType assembleCodeType = {
    "assemblecode",
    FreeAssembleCodeInternalRep, /* freeIntRepProc */
    DupAssembleCodeInternalRep,	 /* dupIntRepProc */
    NULL,			 /* updateStringProc */
    NULL			 /* setFromAnyProc */

};

/*
 * Source instructions recognized in the Tcl Assembly Language (TAL)
 */

static const TalInstDesc TalInstructionTable[] = {







|
>







321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
static Tcl_DupInternalRepProc	DupAssembleCodeInternalRep;

static const Tcl_ObjType assembleCodeType = {
    "assemblecode",
    FreeAssembleCodeInternalRep, /* freeIntRepProc */
    DupAssembleCodeInternalRep,	 /* dupIntRepProc */
    NULL,			 /* updateStringProc */
    NULL,			 /* setFromAnyProc */
    TCL_OBJTYPE_V0
};

/*
 * Source instructions recognized in the Tcl Assembly Language (TAL)
 */

static const TalInstDesc TalInstructionTable[] = {
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
    CompileEnv compEnv;		/* Compilation environment structure */
    ByteCode *codePtr = NULL;
				/* Bytecode resulting from the assembly */
    Namespace* namespacePtr;	/* Namespace in which variable and command
				 * names in the bytecode resolve */
    int status;			/* Status return from Tcl_AssembleCode */
    const char* source;		/* String representation of the source code */
    size_t sourceLen;		/* Length of the source code in bytes */

    /*
     * Get the expression ByteCode from the object. If it exists, make sure it
     * is valid in the current context.
     */

    ByteCodeGetInternalRep(objPtr, &assembleCodeType, codePtr);







|







853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
    CompileEnv compEnv;		/* Compilation environment structure */
    ByteCode *codePtr = NULL;
				/* Bytecode resulting from the assembly */
    Namespace* namespacePtr;	/* Namespace in which variable and command
				 * names in the bytecode resolve */
    int status;			/* Status return from Tcl_AssembleCode */
    const char* source;		/* String representation of the source code */
    Tcl_Size sourceLen;		/* Length of the source code in bytes */

    /*
     * Get the expression ByteCode from the object. If it exists, make sure it
     * is valid in the current context.
     */

    ByteCodeGetInternalRep(objPtr, &assembleCodeType, codePtr);
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
    Tcl_Obj* instNameObj;	/* Name of the instruction */
    int tblIdx;			/* Index in TalInstructionTable of the
				 * instruction */
    TalInstType instType;	/* Type of the instruction */
    Tcl_Obj* operand1Obj = NULL;
				/* First operand to the instruction */
    const char* operand1;	/* String rep of the operand */
    size_t operand1Len;		/* String length of the operand */
    int opnd;			/* Integer representation of an operand */
    int litIndex;		/* Literal pool index of a constant */
    size_t localVar;		/* LVT index of a local variable */
    int flags;			/* Flags for a basic block */
    JumptableInfo* jtPtr;	/* Pointer to a jumptable */
    int infoIndex;		/* Index of the jumptable in auxdata */
    int status = TCL_ERROR;	/* Return value from this function */

    /*
     * Make sure that the instruction name is known at compile time.







|


|







1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
    Tcl_Obj* instNameObj;	/* Name of the instruction */
    int tblIdx;			/* Index in TalInstructionTable of the
				 * instruction */
    TalInstType instType;	/* Type of the instruction */
    Tcl_Obj* operand1Obj = NULL;
				/* First operand to the instruction */
    const char* operand1;	/* String rep of the operand */
    Tcl_Size operand1Len;	/* String length of the operand */
    int opnd;			/* Integer representation of an operand */
    int litIndex;		/* Literal pool index of a constant */
    Tcl_Size localVar;	/* LVT index of a local variable */
    int flags;			/* Flags for a basic block */
    JumptableInfo* jtPtr;	/* Pointer to a jumptable */
    int infoIndex;		/* Index of the jumptable in auxdata */
    int status = TCL_ERROR;	/* Return value from this function */

    /*
     * Make sure that the instruction name is known at compile time.
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "boolean varName");
	    goto cleanup;
	}
	if (GetBooleanOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
	    goto cleanup;
	}
	localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
	if (localVar == TCL_INDEX_NONE) {
	    goto cleanup;
	}
	BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, 0);
	TclEmitInt4(localVar, envPtr);
	break;

    case ASSEM_CLOCK_READ:







|







1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "boolean varName");
	    goto cleanup;
	}
	if (GetBooleanOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
	    goto cleanup;
	}
	localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
	if (localVar < 0) {
	    goto cleanup;
	}
	BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, 0);
	TclEmitInt4(localVar, envPtr);
	break;

    case ASSEM_CLOCK_READ:
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
	    goto cleanup;
	}
	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
		|| CheckStrictlyPositive(interp, opnd) != TCL_OK) {
	    goto cleanup;
	}
	localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
	if (localVar == TCL_INDEX_NONE) {
	    goto cleanup;
	}
	BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd+1);
	TclEmitInt4(localVar, envPtr);
	break;

    case ASSEM_DICT_UNSET:
	if (parsePtr->numWords != 3) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count varName");
	    goto cleanup;
	}
	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
		|| CheckStrictlyPositive(interp, opnd) != TCL_OK) {
	    goto cleanup;
	}
	localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
	if (localVar == TCL_INDEX_NONE) {
	    goto cleanup;
	}
	BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd);
	TclEmitInt4(localVar, envPtr);
	break;

    case ASSEM_END_CATCH:







|
















|







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
	    goto cleanup;
	}
	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
		|| CheckStrictlyPositive(interp, opnd) != TCL_OK) {
	    goto cleanup;
	}
	localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
	if (localVar < 0) {
	    goto cleanup;
	}
	BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd+1);
	TclEmitInt4(localVar, envPtr);
	break;

    case ASSEM_DICT_UNSET:
	if (parsePtr->numWords != 3) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count varName");
	    goto cleanup;
	}
	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
		|| CheckStrictlyPositive(interp, opnd) != TCL_OK) {
	    goto cleanup;
	}
	localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
	if (localVar < 0) {
	    goto cleanup;
	}
	BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd);
	TclEmitInt4(localVar, envPtr);
	break;

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

    case ASSEM_LVT:
	if (parsePtr->numWords != 2) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname");
	    goto cleanup;
	}
	localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
	if (localVar == TCL_INDEX_NONE) {
	    goto cleanup;
	}
	BBEmitInst1or4(assemEnvPtr, tblIdx, localVar, 0);
	break;

    case ASSEM_LVT1:
	if (parsePtr->numWords != 2) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname");
	    goto cleanup;
	}
	localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
	if (localVar == TCL_INDEX_NONE || CheckOneByte(interp, localVar)) {
	    goto cleanup;
	}
	BBEmitInstInt1(assemEnvPtr, tblIdx, localVar, 0);
	break;

    case ASSEM_LVT1_SINT1:
	if (parsePtr->numWords != 3) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "varName imm8");
	    goto cleanup;
	}
	localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
	if (localVar == TCL_INDEX_NONE || CheckOneByte(interp, localVar)
		|| GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
		|| CheckSignedOneByte(interp, opnd)) {
	    goto cleanup;
	}
	BBEmitInstInt1(assemEnvPtr, tblIdx, localVar, 0);
	TclEmitInt1(opnd, envPtr);
	break;

    case ASSEM_LVT4:
	if (parsePtr->numWords != 2) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname");
	    goto cleanup;
	}
	localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
	if (localVar == TCL_INDEX_NONE) {
	    goto cleanup;
	}
	BBEmitInstInt4(assemEnvPtr, tblIdx, localVar, 0);
	break;

    case ASSEM_OVER:
	if (parsePtr->numWords != 2) {







|











|











|














|







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

    case ASSEM_LVT:
	if (parsePtr->numWords != 2) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname");
	    goto cleanup;
	}
	localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
	if (localVar < 0) {
	    goto cleanup;
	}
	BBEmitInst1or4(assemEnvPtr, tblIdx, localVar, 0);
	break;

    case ASSEM_LVT1:
	if (parsePtr->numWords != 2) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname");
	    goto cleanup;
	}
	localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
	if (localVar < 0 || CheckOneByte(interp, localVar)) {
	    goto cleanup;
	}
	BBEmitInstInt1(assemEnvPtr, tblIdx, localVar, 0);
	break;

    case ASSEM_LVT1_SINT1:
	if (parsePtr->numWords != 3) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "varName imm8");
	    goto cleanup;
	}
	localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
	if (localVar < 0 || CheckOneByte(interp, localVar)
		|| GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
		|| CheckSignedOneByte(interp, opnd)) {
	    goto cleanup;
	}
	BBEmitInstInt1(assemEnvPtr, tblIdx, localVar, 0);
	TclEmitInt1(opnd, envPtr);
	break;

    case ASSEM_LVT4:
	if (parsePtr->numWords != 2) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname");
	    goto cleanup;
	}
	localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
	if (localVar < 0) {
	    goto cleanup;
	}
	BBEmitInstInt4(assemEnvPtr, tblIdx, localVar, 0);
	break;

    case ASSEM_OVER:
	if (parsePtr->numWords != 2) {
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count varName");
	    goto cleanup;
	}
	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
	    goto cleanup;
	}
	localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
	if (localVar == TCL_INDEX_NONE) {
	    goto cleanup;
	}
	BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, 0);
	TclEmitInt4(localVar, envPtr);
	break;

    default:







|







1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count varName");
	    goto cleanup;
	}
	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
	    goto cleanup;
	}
	localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
	if (localVar < 0) {
	    goto cleanup;
	}
	BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, 0);
	TclEmitInt4(localVar, envPtr);
	break;

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

static int
CreateMirrorJumpTable(
    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
    Tcl_Obj* jumps)		/* List of alternating keywords and labels */
{
    size_t objc;			/* Number of elements in the 'jumps' list */
    Tcl_Obj** objv;		/* Pointers to the elements in the list */
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
				/* Tcl interpreter */
    BasicBlock* bbPtr = assemEnvPtr->curr_bb;
				/* Current basic block */
    JumptableInfo* jtPtr;
    Tcl_HashTable* jtHashPtr;	/* Hashtable in the JumptableInfo */
    Tcl_HashEntry* hashEntry;	/* Entry for a key in the hashtable */
    int isNew;			/* Flag==1 if the key is not yet in the
				 * table. */
    size_t i;

    if (TclListObjGetElementsM(interp, jumps, &objc, &objv) != TCL_OK) {
	return TCL_ERROR;
    }
    if (objc % 2 != 0) {
	if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "jump table must have an even number of list elements",
		    -1));
	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADJUMPTABLE", NULL);
	}
	return TCL_ERROR;



    }

    /*
     * Allocate the jumptable.
     */

    jtPtr = (JumptableInfo*)Tcl_Alloc(sizeof(JumptableInfo));







|












|

|










>
>
>







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

static int
CreateMirrorJumpTable(
    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
    Tcl_Obj* jumps)		/* List of alternating keywords and labels */
{
    Tcl_Size objc;			/* Number of elements in the 'jumps' list */
    Tcl_Obj** objv;		/* Pointers to the elements in the list */
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
				/* Tcl interpreter */
    BasicBlock* bbPtr = assemEnvPtr->curr_bb;
				/* Current basic block */
    JumptableInfo* jtPtr;
    Tcl_HashTable* jtHashPtr;	/* Hashtable in the JumptableInfo */
    Tcl_HashEntry* hashEntry;	/* Entry for a key in the hashtable */
    int isNew;			/* Flag==1 if the key is not yet in the
				 * table. */
    Tcl_Size i;

    if (TclListObjLengthM(interp, jumps, &objc) != TCL_OK) {
	return TCL_ERROR;
    }
    if (objc % 2 != 0) {
	if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "jump table must have an even number of list elements",
		    -1));
	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADJUMPTABLE", NULL);
	}
	return TCL_ERROR;
    }
    if (TclListObjGetElementsM(interp, jumps, &objc, &objv) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Allocate the jumptable.
     */

    jtPtr = (JumptableInfo*)Tcl_Alloc(sizeof(JumptableInfo));
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
 *-----------------------------------------------------------------------------
 */

static int
GetListIndexOperand(
    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
    Tcl_Token** tokenPtrPtr,	/* Current token from the parser */
    int* result)		/* OUTPUT: Integer extracted from the token */
{
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
				/* Tcl interpreter */
    Tcl_Token* tokenPtr = *tokenPtrPtr;
				/* INOUT: Pointer to the next token in the







|







2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
 *-----------------------------------------------------------------------------
 */

static int
GetListIndexOperand(
    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
    Tcl_Token** tokenPtrPtr,	/* Current token from the parser */
    int* result)		/* OUTPUT: encoded index derived from the token */
{
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
				/* Tcl interpreter */
    Tcl_Token* tokenPtr = *tokenPtrPtr;
				/* INOUT: Pointer to the next token in the
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
    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
				/* Tcl interpreter */
    Tcl_Token* tokenPtr = *tokenPtrPtr;
				/* INOUT: Pointer to the next token in the
				 * source code. */
    Tcl_Obj* varNameObj;	/* Name of the variable */
    const char* varNameStr;
    size_t varNameLen;
    size_t localVar;		/* Index of the variable in the LVT */

    if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &varNameObj) != TCL_OK) {
	return TCL_INDEX_NONE;
    }
    varNameStr = Tcl_GetStringFromObj(varNameObj, &varNameLen);
    if (CheckNamespaceQualifiers(interp, varNameStr, varNameLen)) {
	Tcl_DecrRefCount(varNameObj);
	return TCL_INDEX_NONE;
    }
    localVar = TclFindCompiledLocal(varNameStr, varNameLen, 1, envPtr);
    Tcl_DecrRefCount(varNameObj);
    if (localVar == TCL_INDEX_NONE) {
	if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "cannot use this instruction to create a variable"
		    " in a non-proc context", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "LVT", NULL);
	}
	return TCL_INDEX_NONE;







|
|











|







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
    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
				/* Tcl interpreter */
    Tcl_Token* tokenPtr = *tokenPtrPtr;
				/* INOUT: Pointer to the next token in the
				 * source code. */
    Tcl_Obj* varNameObj;	/* Name of the variable */
    const char* varNameStr;
    Tcl_Size varNameLen;
    Tcl_Size localVar;		/* Index of the variable in the LVT */

    if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &varNameObj) != TCL_OK) {
	return TCL_INDEX_NONE;
    }
    varNameStr = Tcl_GetStringFromObj(varNameObj, &varNameLen);
    if (CheckNamespaceQualifiers(interp, varNameStr, varNameLen)) {
	Tcl_DecrRefCount(varNameObj);
	return TCL_INDEX_NONE;
    }
    localVar = TclFindCompiledLocal(varNameStr, varNameLen, 1, envPtr);
    Tcl_DecrRefCount(varNameObj);
    if (localVar < 0) {
	if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "cannot use this instruction to create a variable"
		    " in a non-proc context", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "LVT", NULL);
	}
	return TCL_INDEX_NONE;
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327

static int
CheckStack(
    AssemblyEnv* assemEnvPtr)	/* Assembly environment */
{
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    size_t maxDepth;		/* Maximum stack depth overall */

    /*
     * Checking the head block will check all the other blocks recursively.
     */

    assemEnvPtr->maxDepth = 0;
    if (StackCheckBasicBlock(assemEnvPtr, assemEnvPtr->head_bb, NULL,







|







3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331

static int
CheckStack(
    AssemblyEnv* assemEnvPtr)	/* Assembly environment */
{
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    Tcl_Size maxDepth;		/* Maximum stack depth overall */

    /*
     * Checking the head block will check all the other blocks recursively.
     */

    assemEnvPtr->maxDepth = 0;
    if (StackCheckBasicBlock(assemEnvPtr, assemEnvPtr->head_bb, NULL,

Changes to generic/tclBasic.c.

89
90
91
92
93
94
95
96
97
98
99
100
101
102
103

typedef struct {
    Tcl_Interp *interp;		/* Interp this struct belongs to. */
    Tcl_AsyncHandler async;	/* Async handler token for script
				 * cancellation. */
    char *result;		/* The script cancellation result or NULL for
				 * a default result. */
    size_t length;		/* Length of the above error message. */
    void *clientData;		/* Not used. */
    int flags;			/* Additional flags */
} CancelInfo;
static Tcl_HashTable cancelTable;
static int cancelTableInitialized = 0;	/* 0 means not yet initialized. */
TCL_DECLARE_MUTEX(cancelLock);








|







89
90
91
92
93
94
95
96
97
98
99
100
101
102
103

typedef struct {
    Tcl_Interp *interp;		/* Interp this struct belongs to. */
    Tcl_AsyncHandler async;	/* Async handler token for script
				 * cancellation. */
    char *result;		/* The script cancellation result or NULL for
				 * a default result. */
    Tcl_Size length;		/* Length of the above error message. */
    void *clientData;		/* Not used. */
    int flags;			/* Additional flags */
} CancelInfo;
static Tcl_HashTable cancelTable;
static int cancelTableInitialized = 0;	/* 0 means not yet initialized. */
TCL_DECLARE_MUTEX(cancelLock);

216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
 * Magical counts for the number of arguments accepted by a coroutine command
 * after particular kinds of [yield].
 */

#define CORO_ACTIVATE_YIELD    NULL
#define CORO_ACTIVATE_YIELDM   INT2PTR(1)

#define COROUTINE_ARGUMENTS_SINGLE_OPTIONAL     ((size_t)-1)
#define COROUTINE_ARGUMENTS_ARBITRARY           ((size_t)-2)

/*
 * The following structure define the commands in the Tcl core.
 */

typedef struct {
    const char *name;		/* Name of object-based command. */







|
|







216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
 * Magical counts for the number of arguments accepted by a coroutine command
 * after particular kinds of [yield].
 */

#define CORO_ACTIVATE_YIELD    NULL
#define CORO_ACTIVATE_YIELDM   INT2PTR(1)

#define COROUTINE_ARGUMENTS_SINGLE_OPTIONAL     (-1)
#define COROUTINE_ARGUMENTS_ARBITRARY           (-2)

/*
 * The following structure define the commands in the Tcl core.
 */

typedef struct {
    const char *name;		/* Name of object-based command. */
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
    {"lpop",		Tcl_LpopObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"lrange",		Tcl_LrangeObjCmd,	TclCompileLrangeCmd,	NULL,	CMD_IS_SAFE},
    {"lremove", 	Tcl_LremoveObjCmd,	NULL,           	NULL,	CMD_IS_SAFE},
    {"lrepeat",		Tcl_LrepeatObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"lreplace",	Tcl_LreplaceObjCmd,	TclCompileLreplaceCmd,	NULL,	CMD_IS_SAFE},
    {"lreverse",	Tcl_LreverseObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"lsearch",		Tcl_LsearchObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"lseq",		Tcl_LseqObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"lset",		Tcl_LsetObjCmd,		TclCompileLsetCmd,	NULL,	CMD_IS_SAFE},
    {"lsort",		Tcl_LsortObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"package",		Tcl_PackageObjCmd,	NULL,			TclNRPackageObjCmd,	CMD_IS_SAFE},
    {"proc",		procObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"regexp",		Tcl_RegexpObjCmd,	TclCompileRegexpCmd,	NULL,	CMD_IS_SAFE},
    {"regsub",		Tcl_RegsubObjCmd,	TclCompileRegsubCmd,	NULL,	CMD_IS_SAFE},
    {"rename",		Tcl_RenameObjCmd,	NULL,			NULL,	CMD_IS_SAFE},







|







306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
    {"lpop",		Tcl_LpopObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"lrange",		Tcl_LrangeObjCmd,	TclCompileLrangeCmd,	NULL,	CMD_IS_SAFE},
    {"lremove", 	Tcl_LremoveObjCmd,	NULL,           	NULL,	CMD_IS_SAFE},
    {"lrepeat",		Tcl_LrepeatObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"lreplace",	Tcl_LreplaceObjCmd,	TclCompileLreplaceCmd,	NULL,	CMD_IS_SAFE},
    {"lreverse",	Tcl_LreverseObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"lsearch",		Tcl_LsearchObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"lseq",		Tcl_LseqObjCmd,         NULL,                   NULL,   CMD_IS_SAFE},
    {"lset",		Tcl_LsetObjCmd,		TclCompileLsetCmd,	NULL,	CMD_IS_SAFE},
    {"lsort",		Tcl_LsortObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"package",		Tcl_PackageObjCmd,	NULL,			TclNRPackageObjCmd,	CMD_IS_SAFE},
    {"proc",		procObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"regexp",		Tcl_RegexpObjCmd,	TclCompileRegexpCmd,	NULL,	CMD_IS_SAFE},
    {"regsub",		Tcl_RegsubObjCmd,	TclCompileRegsubCmd,	NULL,	CMD_IS_SAFE},
    {"rename",		Tcl_RenameObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
 *----------------------------------------------------------------------
 */

static int
buildInfoObjCmd2(
    void *clientData,
    Tcl_Interp *interp,		/* Current interpreter. */
    size_t objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    if (objc - 1 > 1) {
	Tcl_WrongNumArgs(interp, 1, objv, "?option?");
	return TCL_ERROR;
    }
    if (objc == 2) {
	int len;
	const char *arg = TclGetStringFromObj(objv[1], &len);
	if (len == 7 && !strcmp(arg, "version")) {
	    char buf[80];
	    const char *p = strchr((char *)clientData, '.');
	    if (p) {
		const char *q = strchr(p+1, '.');
		const char *r = strchr(p+1, '+');
		p = (q < r) ? q : r;







|


|




|
|







609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
 *----------------------------------------------------------------------
 */

static int
buildInfoObjCmd2(
    void *clientData,
    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Size objc,		/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?option?");
	return TCL_ERROR;
    }
    if (objc == 2) {
	Tcl_Size len;
	const char *arg = Tcl_GetStringFromObj(objv[1], &len);
	if (len == 7 && !strcmp(arg, "version")) {
	    char buf[80];
	    const char *p = strchr((char *)clientData, '.');
	    if (p) {
		const char *q = strchr(p+1, '.');
		const char *r = strchr(p+1, '+');
		p = (q < r) ? q : r;
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
static int
buildInfoObjCmd(
    void *clientData,
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return buildInfoObjCmd2(clientData, interp, (size_t)objc, objv);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateInterp --
 *







|







698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
static int
buildInfoObjCmd(
    void *clientData,
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return buildInfoObjCmd2(clientData, interp, objc, objv);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateInterp --
 *
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815

    iPtr->legacyResult = NULL;
    /* Special invalid value: Any attempt to free the legacy result
     * will cause a crash. */
    iPtr->legacyFreeProc = (void (*) (void))-1;
    iPtr->errorLine = 0;
    iPtr->stubTable = &tclStubs;
    iPtr->objResultPtr = Tcl_NewObj();
    Tcl_IncrRefCount(iPtr->objResultPtr);
    iPtr->handle = TclHandleCreate(iPtr);
    iPtr->globalNsPtr = NULL;
    iPtr->hiddenCmdTablePtr = NULL;
    iPtr->interpInfo = NULL;

    iPtr->optimizer = TclOptimizeBytecode;







|







801
802
803
804
805
806
807
808
809
810
811
812
813
814
815

    iPtr->legacyResult = NULL;
    /* Special invalid value: Any attempt to free the legacy result
     * will cause a crash. */
    iPtr->legacyFreeProc = (void (*) (void))-1;
    iPtr->errorLine = 0;
    iPtr->stubTable = &tclStubs;
    TclNewObj(iPtr->objResultPtr);
    Tcl_IncrRefCount(iPtr->objResultPtr);
    iPtr->handle = TclHandleCreate(iPtr);
    iPtr->globalNsPtr = NULL;
    iPtr->hiddenCmdTablePtr = NULL;
    iPtr->interpInfo = NULL;

    iPtr->optimizer = TclOptimizeBytecode;
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
    iPtr->flags = 0;
    iPtr->tracePtr = NULL;
    iPtr->tracesForbiddingInline = 0;
    iPtr->activeCmdTracePtr = NULL;
    iPtr->activeInterpTracePtr = NULL;
    iPtr->assocData = NULL;
    iPtr->execEnvPtr = NULL;	/* Set after namespaces initialized. */
    iPtr->emptyObjPtr = Tcl_NewObj();
				/* Another empty object. */
    Tcl_IncrRefCount(iPtr->emptyObjPtr);
    iPtr->threadId = Tcl_GetCurrentThread();

    /* TIP #378 */
#ifdef TCL_INTERP_DEBUG_FRAME
    iPtr->flags |= INTERP_DEBUG_FRAME;







|







886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
    iPtr->flags = 0;
    iPtr->tracePtr = NULL;
    iPtr->tracesForbiddingInline = 0;
    iPtr->activeCmdTracePtr = NULL;
    iPtr->activeInterpTracePtr = NULL;
    iPtr->assocData = NULL;
    iPtr->execEnvPtr = NULL;	/* Set after namespaces initialized. */
    TclNewObj(iPtr->emptyObjPtr);
				/* Another empty object. */
    Tcl_IncrRefCount(iPtr->emptyObjPtr);
    iPtr->threadId = Tcl_GetCurrentThread();

    /* TIP #378 */
#ifdef TCL_INTERP_DEBUG_FRAME
    iPtr->flags |= INTERP_DEBUG_FRAME;
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964

    iPtr->chanMsg = NULL;

    /*
     * TIP #285, Script cancellation support.
     */

    iPtr->asyncCancelMsg = Tcl_NewObj();

    cancelInfo = (CancelInfo *)Tcl_Alloc(sizeof(CancelInfo));
    cancelInfo->interp = interp;

    iPtr->asyncCancel = Tcl_AsyncCreate(CancelEvalProc, cancelInfo);
    cancelInfo->async = iPtr->asyncCancel;
    cancelInfo->result = NULL;







|







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

    iPtr->chanMsg = NULL;

    /*
     * TIP #285, Script cancellation support.
     */

    TclNewObj(iPtr->asyncCancelMsg);

    cancelInfo = (CancelInfo *)Tcl_Alloc(sizeof(CancelInfo));
    cancelInfo->interp = interp;

    iPtr->asyncCancel = Tcl_AsyncCreate(CancelEvalProc, cancelInfo);
    cancelInfo->async = iPtr->asyncCancel;
    cancelInfo->result = NULL;
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
    iPtr->pendingObjDataPtr = NULL;
    iPtr->asyncReadyPtr = TclGetAsyncReadyPtr();
    iPtr->deferredCallbacks = NULL;

    /*
     * Create the core commands. Do it here, rather than calling
     * Tcl_CreateCommand, because it's faster (there's no need to check for a
     * pre-existing command by the same name). If a command has a Tcl_CmdProc
     * but no Tcl_ObjCmdProc, set the Tcl_ObjCmdProc to
     * TclInvokeStringCommand. This is an object-based wrapper function that
     * extracts strings, calls the string function, and creates an object for
     * the result. Similarly, if a command has a Tcl_ObjCmdProc but no
     * Tcl_CmdProc, set the Tcl_CmdProc to TclInvokeObjectCommand.
     */








|







1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
    iPtr->pendingObjDataPtr = NULL;
    iPtr->asyncReadyPtr = TclGetAsyncReadyPtr();
    iPtr->deferredCallbacks = NULL;

    /*
     * Create the core commands. Do it here, rather than calling
     * Tcl_CreateCommand, because it's faster (there's no need to check for a
     * preexisting command by the same name). If a command has a Tcl_CmdProc
     * but no Tcl_ObjCmdProc, set the Tcl_ObjCmdProc to
     * TclInvokeStringCommand. This is an object-based wrapper function that
     * extracts strings, calls the string function, and creates an object for
     * the result. Similarly, if a command has a Tcl_ObjCmdProc but no
     * Tcl_CmdProc, set the Tcl_CmdProc to TclInvokeObjectCommand.
     */

1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
    int *assocDataCounterPtr =
	    (int *)Tcl_GetThreadData(&assocDataCounterKey, sizeof(int));
    int isNew;
    char buffer[32 + TCL_INTEGER_SPACE];
    AssocData *dPtr = (AssocData *)Tcl_Alloc(sizeof(AssocData));
    Tcl_HashEntry *hPtr;

    sprintf(buffer, "Assoc Data Key #%d", *assocDataCounterPtr);
    (*assocDataCounterPtr)++;

    if (iPtr->assocData == NULL) {
	iPtr->assocData = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS);
    }
    hPtr = Tcl_CreateHashEntry(iPtr->assocData, buffer, &isNew);







|







1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
    int *assocDataCounterPtr =
	    (int *)Tcl_GetThreadData(&assocDataCounterKey, sizeof(int));
    int isNew;
    char buffer[32 + TCL_INTEGER_SPACE];
    AssocData *dPtr = (AssocData *)Tcl_Alloc(sizeof(AssocData));
    Tcl_HashEntry *hPtr;

    snprintf(buffer, sizeof(buffer), "Assoc Data Key #%d", *assocDataCounterPtr);
    (*assocDataCounterPtr)++;

    if (iPtr->assocData == NULL) {
	iPtr->assocData = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS);
    }
    hPtr = Tcl_CreateHashEntry(iPtr->assocData, buffer, &isNew);
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
    Tcl_Interp *interp)		/* Interpreter to delete. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    Tcl_HashTable *hTablePtr;
    ResolverScheme *resPtr, *nextResPtr;
    size_t i;

    /*
     * Punt if there is an error in the Tcl_Release/Tcl_Preserve matchup,
	 * unless we are exiting.
     */

    if ((iPtr->numLevels > 0) && !TclInExit()) {







|







1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
    Tcl_Interp *interp)		/* Interpreter to delete. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    Tcl_HashTable *hTablePtr;
    ResolverScheme *resPtr, *nextResPtr;
    Tcl_Size i;

    /*
     * Punt if there is an error in the Tcl_Release/Tcl_Preserve matchup,
	 * unless we are exiting.
     */

    if ((iPtr->numLevels > 0) && !TclInExit()) {
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
                "hidden command named \"%s\" already exists",
                hiddenCmdToken));
        Tcl_SetErrorCode(interp, "TCL", "HIDE", "ALREADY_HIDDEN", NULL);
	return TCL_ERROR;
    }

    /*
     * NB: This code is currently 'like' a rename to a specialy set apart name
     * table. Changes here and in TclRenameCommand must be kept in synch until
     * the common parts are actually factorized out.
     */

    /*
     * Remove the hash entry for the command from the interpreter command
     * table. This is like deleting the command, so bump its command epoch;
     * this invalidates any cached references that point to the command.
     */

    if (cmdPtr->hPtr != NULL) {
	Tcl_DeleteHashEntry(cmdPtr->hPtr);
	cmdPtr->hPtr = NULL;
	cmdPtr->cmdEpoch++;
    }







|






|
|







2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
                "hidden command named \"%s\" already exists",
                hiddenCmdToken));
        Tcl_SetErrorCode(interp, "TCL", "HIDE", "ALREADY_HIDDEN", NULL);
	return TCL_ERROR;
    }

    /*
     * NB: This code is currently 'like' a rename to a special separate name
     * table. Changes here and in TclRenameCommand must be kept in synch until
     * the common parts are actually factorized out.
     */

    /*
     * Remove the hash entry for the command from the interpreter command
     * table. This is like deleting the command, so bump its command epoch
     * to invalidate any cached references that point to the command.
     */

    if (cmdPtr->hPtr != NULL) {
	Tcl_DeleteHashEntry(cmdPtr->hPtr);
	cmdPtr->hPtr = NULL;
	cmdPtr->cmdEpoch++;
    }
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
     * Check that we have a true global namespace command (enforced by
     * Tcl_HideCommand but let's double check. (If it was not, we would not
     * really know how to handle it).
     */

    if (cmdPtr->nsPtr != iPtr->globalNsPtr) {
	/*
	 * This case is theoritically impossible, we might rather Tcl_Panic
	 * than 'nicely' erroring out ?
	 */

	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"trying to expose a non-global command namespace command",
		-1));
	return TCL_ERROR;







|







2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
     * Check that we have a true global namespace command (enforced by
     * Tcl_HideCommand but let's double check. (If it was not, we would not
     * really know how to handle it).
     */

    if (cmdPtr->nsPtr != iPtr->globalNsPtr) {
	/*
	 * This case is theoretically impossible, we might rather Tcl_Panic
	 * than 'nicely' erroring out ?
	 */

	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"trying to expose a non-global command namespace command",
		-1));
	return TCL_ERROR;
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
 *	future calls to Tcl_GetCommandName.
 *
 * Side effects:
 *	If a command named cmdName already exists for interp, it is deleted.
 *	In the future, when cmdName is seen as the name of a command by
 *	Tcl_Eval, proc will be called. To support the bytecode interpreter,
 *	the command is created with a wrapper Tcl_ObjCmdProc
 *	(TclInvokeStringCommand) that eventially calls proc. When the command
 *	is deleted from the table, deleteProc will be called. See the manual
 *	entry for details on the calling sequence.
 *
 *----------------------------------------------------------------------
 */

Tcl_Command







|







2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
 *	future calls to Tcl_GetCommandName.
 *
 * Side effects:
 *	If a command named cmdName already exists for interp, it is deleted.
 *	In the future, when cmdName is seen as the name of a command by
 *	Tcl_Eval, proc will be called. To support the bytecode interpreter,
 *	the command is created with a wrapper Tcl_ObjCmdProc
 *	(TclInvokeStringCommand) that eventually calls proc. When the command
 *	is deleted from the table, deleteProc will be called. See the manual
 *	entry for details on the calling sequence.
 *
 *----------------------------------------------------------------------
 */

Tcl_Command
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
    int objc,
    Tcl_Obj * const *objv)
{
    CmdWrapperInfo *info = (CmdWrapperInfo *)clientData;
    if (objc < 0) {
	objc = -1;
    }
    return info->proc(info->clientData, interp, (size_t)objc, objv);
}

static void cmdWrapperDeleteProc(void *clientData) {
    CmdWrapperInfo *info = (CmdWrapperInfo *)clientData;

    clientData = info->deleteData;
    Tcl_CmdDeleteProc *deleteProc = info->deleteProc;







|







2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
    int objc,
    Tcl_Obj * const *objv)
{
    CmdWrapperInfo *info = (CmdWrapperInfo *)clientData;
    if (objc < 0) {
	objc = -1;
    }
    return info->proc(info->clientData, interp, objc, objv);
}

static void cmdWrapperDeleteProc(void *clientData) {
    CmdWrapperInfo *info = (CmdWrapperInfo *)clientData;

    clientData = info->deleteData;
    Tcl_CmdDeleteProc *deleteProc = info->deleteProc;
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
 *----------------------------------------------------------------------
 */

static int
invokeObj2Command(
    void *clientData,	/* Points to command's Command structure. */
    Tcl_Interp *interp,		/* Current interpreter. */
    size_t objc,		/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int result;
    Command *cmdPtr = (Command *) clientData;

    if (objc > INT_MAX) {
	objc = TCL_INDEX_NONE;
    }
    if (cmdPtr->objProc != NULL) {
	result = cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv);
    } else {
	result = Tcl_NRCallObjProc(interp, cmdPtr->nreProc,
		cmdPtr->objClientData, objc, objv);
    }
    return result;
}

static int cmdWrapper2Proc(void *clientData,
    Tcl_Interp *interp,
    size_t objc,
    Tcl_Obj *const objv[])
{
    Command *cmdPtr = (Command *)clientData;



    return cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv);
}

int
Tcl_SetCommandInfoFromToken(
    Tcl_Command cmd,
    const Tcl_CmdInfo *infoPtr)







|






|












|



>
>
>







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

static int
invokeObj2Command(
    void *clientData,	/* Points to command's Command structure. */
    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Size objc,		/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int result;
    Command *cmdPtr = (Command *) clientData;

    if (objc > INT_MAX) {
	return TclCommandWordLimitError(interp, objc);
    }
    if (cmdPtr->objProc != NULL) {
	result = cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv);
    } else {
	result = Tcl_NRCallObjProc(interp, cmdPtr->nreProc,
		cmdPtr->objClientData, objc, objv);
    }
    return result;
}

static int cmdWrapper2Proc(void *clientData,
    Tcl_Interp *interp,
    Tcl_Size objc,
    Tcl_Obj *const objv[])
{
    Command *cmdPtr = (Command *)clientData;
    if (objc > INT_MAX) {
	return TclCommandWordLimitError(interp, objc);
    }
    return cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv);
}

int
Tcl_SetCommandInfoFromToken(
    Tcl_Command cmd,
    const Tcl_CmdInfo *infoPtr)
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
 *	interpreter is still able to execute further commands after the
 *	cancelation is cleared (unlike if it is deleted).
 *
 * Results:
 *	The value given for the code argument.
 *
 * Side effects:
 *	Transfers a message from the cancelation message to the interpreter.
 *
 *----------------------------------------------------------------------
 */

static int
CancelEvalProc(
    void *clientData,	/* Interp to cancel the script in progress. */







|







3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
 *	interpreter is still able to execute further commands after the
 *	cancelation is cleared (unlike if it is deleted).
 *
 * Results:
 *	The value given for the code argument.
 *
 * Side effects:
 *	Transfers a message from the cancellation message to the interpreter.
 *
 *----------------------------------------------------------------------
 */

static int
CancelEvalProc(
    void *clientData,	/* Interp to cancel the script in progress. */
4195
4196
4197
4198
4199
4200
4201
4202
4203
4204
4205
4206
4207
4208
4209
    /*
     * If the TCL_LEAVE_ERR_MSG flags bit is set, place an error in the
     * interp's result; otherwise, we leave it alone.
     */

    if (flags & TCL_LEAVE_ERR_MSG) {
        const char *id, *message = NULL;
        size_t length;

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

        if (iPtr->asyncCancelMsg != NULL) {







|







4198
4199
4200
4201
4202
4203
4204
4205
4206
4207
4208
4209
4210
4211
4212
    /*
     * If the TCL_LEAVE_ERR_MSG flags bit is set, place an error in the
     * interp's result; otherwise, we leave it alone.
     */

    if (flags & TCL_LEAVE_ERR_MSG) {
        const char *id, *message = NULL;
        Tcl_Size length;

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

        if (iPtr->asyncCancelMsg != NULL) {
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
 *----------------------------------------------------------------------
 */

int
Tcl_EvalObjv(
    Tcl_Interp *interp,		/* Interpreter in which to evaluate the
				 * command. Also used for error reporting. */
    size_t objc,			/* Number of words in command. */
    Tcl_Obj *const objv[],	/* An array of pointers to objects that are
				 * the words that make up the command. */
    int flags)			/* Collection of OR-ed bits that control the
				 * evaluation of the script. Only
				 * TCL_EVAL_GLOBAL, TCL_EVAL_INVOKE and
				 * TCL_EVAL_NOERR are currently supported. */
{
    int result;
    NRE_callback *rootPtr = TOP_CB(interp);

    result = TclNREvalObjv(interp, objc, objv, flags, NULL);
    return TclNRRunCallbacks(interp, result, rootPtr);
}

int
TclNREvalObjv(
    Tcl_Interp *interp,		/* Interpreter in which to evaluate the
				 * command. Also used for error reporting. */
    size_t objc,			/* Number of words in command. */
    Tcl_Obj *const objv[],	/* An array of pointers to objects that are
				 * the words that make up the command. */
    int flags,			/* Collection of OR-ed bits that control the
				 * evaluation of the script. Only
				 * TCL_EVAL_GLOBAL, TCL_EVAL_INVOKE and
				 * TCL_EVAL_NOERR are currently supported. */
    Command *cmdPtr)		/* NULL if the Command is to be looked up







|


















|







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

int
Tcl_EvalObjv(
    Tcl_Interp *interp,		/* Interpreter in which to evaluate the
				 * command. Also used for error reporting. */
    Tcl_Size objc,		/* Number of words in command. */
    Tcl_Obj *const objv[],	/* An array of pointers to objects that are
				 * the words that make up the command. */
    int flags)			/* Collection of OR-ed bits that control the
				 * evaluation of the script. Only
				 * TCL_EVAL_GLOBAL, TCL_EVAL_INVOKE and
				 * TCL_EVAL_NOERR are currently supported. */
{
    int result;
    NRE_callback *rootPtr = TOP_CB(interp);

    result = TclNREvalObjv(interp, objc, objv, flags, NULL);
    return TclNRRunCallbacks(interp, result, rootPtr);
}

int
TclNREvalObjv(
    Tcl_Interp *interp,		/* Interpreter in which to evaluate the
				 * command. Also used for error reporting. */
    Tcl_Size objc,		/* Number of words in command. */
    Tcl_Obj *const objv[],	/* An array of pointers to objects that are
				 * the words that make up the command. */
    int flags,			/* Collection of OR-ed bits that control the
				 * evaluation of the script. Only
				 * TCL_EVAL_GLOBAL, TCL_EVAL_INVOKE and
				 * TCL_EVAL_NOERR are currently supported. */
    Command *cmdPtr)		/* NULL if the Command is to be looked up
4793
4794
4795
4796
4797
4798
4799
4800
4801
4802
4803
4804
4805
4806
4807
    void *data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *listPtr;
    const char *cmdString;
    size_t cmdLen;
    int objc = PTR2INT(data[0]);
    Tcl_Obj **objv = (Tcl_Obj **)data[1];

    if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
	/*
	 * 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







|







4796
4797
4798
4799
4800
4801
4802
4803
4804
4805
4806
4807
4808
4809
4810
    void *data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *listPtr;
    const char *cmdString;
    Tcl_Size cmdLen;
    int objc = PTR2INT(data[0]);
    Tcl_Obj **objv = (Tcl_Obj **)data[1];

    if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
	/*
	 * 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
4822
4823
4824
4825
4826
4827
4828
4829
4830
4831
4832
4833
4834
4835
4836
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[],
    Namespace *lookupNsPtr)
{
    Command * cmdPtr;
    Interp *iPtr = (Interp *) interp;
    size_t i, newObjc, handlerObjc;
    Tcl_Obj **newObjv, **handlerObjv;
    CallFrame *varFramePtr = iPtr->varFramePtr;
    Namespace *currNsPtr = NULL;/* Used to check for and invoke any registered
				 * unknown command handler for the current
				 * namespace (TIP 181). */
    Namespace *savedNsPtr = NULL;








|







4825
4826
4827
4828
4829
4830
4831
4832
4833
4834
4835
4836
4837
4838
4839
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[],
    Namespace *lookupNsPtr)
{
    Command * cmdPtr;
    Interp *iPtr = (Interp *) interp;
    Tcl_Size i, newObjc, handlerObjc;
    Tcl_Obj **newObjv, **handlerObjv;
    CallFrame *varFramePtr = iPtr->varFramePtr;
    Namespace *currNsPtr = NULL;/* Used to check for and invoke any registered
				 * unknown command handler for the current
				 * namespace (TIP 181). */
    Namespace *savedNsPtr = NULL;

4850
4851
4852
4853
4854
4855
4856
4857
4858
4859
4860
4861
4862
4863
4864
    if (currNsPtr->unknownHandlerPtr == NULL) {
	TclNewLiteralStringObj(currNsPtr->unknownHandlerPtr, "::unknown");
	Tcl_IncrRefCount(currNsPtr->unknownHandlerPtr);
    }

    /*
     * Get the list of words for the unknown handler and allocate enough space
     * to hold both the handler prefix and all words of the command invokation
     * itself.
     */

    TclListObjGetElementsM(NULL, currNsPtr->unknownHandlerPtr,
	    &handlerObjc, &handlerObjv);
    newObjc = objc + handlerObjc;
    newObjv = (Tcl_Obj **)TclStackAlloc(interp, sizeof(Tcl_Obj *) * newObjc);







|







4853
4854
4855
4856
4857
4858
4859
4860
4861
4862
4863
4864
4865
4866
4867
    if (currNsPtr->unknownHandlerPtr == NULL) {
	TclNewLiteralStringObj(currNsPtr->unknownHandlerPtr, "::unknown");
	Tcl_IncrRefCount(currNsPtr->unknownHandlerPtr);
    }

    /*
     * Get the list of words for the unknown handler and allocate enough space
     * to hold both the handler prefix and all words of the command invocation
     * itself.
     */

    TclListObjGetElementsM(NULL, currNsPtr->unknownHandlerPtr,
	    &handlerObjc, &handlerObjv);
    newObjc = objc + handlerObjc;
    newObjv = (Tcl_Obj **)TclStackAlloc(interp, sizeof(Tcl_Obj *) * newObjc);
4949
4950
4951
4952
4953
4954
4955
4956
4957
4958
4959
4960
4961
4962
4963
    Command **cmdPtrPtr,
    Tcl_Obj *commandPtr,
    int objc,
    Tcl_Obj *const objv[])
{
    Interp *iPtr = (Interp *) interp;
    Command *cmdPtr = *cmdPtrPtr;
    size_t length, newEpoch, cmdEpoch = cmdPtr->cmdEpoch;
    int traceCode = TCL_OK;
    const char *command = Tcl_GetStringFromObj(commandPtr, &length);

    /*
     * Call trace functions.
     * Execute any command or execution traces. Note that we bump up the
     * command's reference count for the duration of the calling of the







|







4952
4953
4954
4955
4956
4957
4958
4959
4960
4961
4962
4963
4964
4965
4966
    Command **cmdPtrPtr,
    Tcl_Obj *commandPtr,
    int objc,
    Tcl_Obj *const objv[])
{
    Interp *iPtr = (Interp *) interp;
    Command *cmdPtr = *cmdPtrPtr;
    Tcl_Size length, newEpoch, cmdEpoch = cmdPtr->cmdEpoch;
    int traceCode = TCL_OK;
    const char *command = Tcl_GetStringFromObj(commandPtr, &length);

    /*
     * Call trace functions.
     * Execute any command or execution traces. Note that we bump up the
     * command's reference count for the duration of the calling of the
5002
5003
5004
5005
5006
5007
5008
5009
5010
5011
5012
5013
5014
5015
5016
{
    Interp *iPtr = (Interp *) interp;
    int traceCode = TCL_OK;
    int objc = PTR2INT(data[0]);
    Tcl_Obj *commandPtr = (Tcl_Obj *)data[1];
    Command *cmdPtr = (Command *)data[2];
    Tcl_Obj **objv = (Tcl_Obj **)data[3];
    size_t length;
    const char *command = Tcl_GetStringFromObj(commandPtr, &length);

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







|







5005
5006
5007
5008
5009
5010
5011
5012
5013
5014
5015
5016
5017
5018
5019
{
    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];
    Tcl_Size 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);
	}
5085
5086
5087
5088
5089
5090
5091
5092
5093
5094
5095
5096
5097
5098
5099
int
Tcl_EvalTokensStandard(
    Tcl_Interp *interp,		/* Interpreter in which to lookup variables,
				 * execute nested commands, and report
				 * errors. */
    Tcl_Token *tokenPtr,	/* Pointer to first in an array of tokens to
				 * evaluate and concatenate. */
    size_t count)			/* Number of tokens to consider at tokenPtr.
				 * Must be at least 1. */
{
    return TclSubstTokens(interp, tokenPtr, count, /* numLeftPtr */ NULL, 1,
	    NULL, NULL);
}

/*







|







5088
5089
5090
5091
5092
5093
5094
5095
5096
5097
5098
5099
5100
5101
5102
int
Tcl_EvalTokensStandard(
    Tcl_Interp *interp,		/* Interpreter in which to lookup variables,
				 * execute nested commands, and report
				 * errors. */
    Tcl_Token *tokenPtr,	/* Pointer to first in an array of tokens to
				 * evaluate and concatenate. */
    Tcl_Size count)			/* Number of tokens to consider at tokenPtr.
				 * Must be at least 1. */
{
    return TclSubstTokens(interp, tokenPtr, count, /* numLeftPtr */ NULL, 1,
	    NULL, NULL);
}

/*
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
 */

int
Tcl_EvalEx(
    Tcl_Interp *interp,		/* Interpreter in which to evaluate the
				 * script. Also used for error reporting. */
    const char *script,		/* First character of script to evaluate. */
    size_t numBytes,		/* Number of bytes in script. If -1, the
				 * script consists of all bytes up to the
				 * first null character. */
    int flags)			/* Collection of OR-ed bits that control the
				 * evaluation of the script. Only
				 * TCL_EVAL_GLOBAL is currently supported. */
{
    return TclEvalEx(interp, script, numBytes, flags, 1, NULL, script);
}

int
TclEvalEx(
    Tcl_Interp *interp,		/* Interpreter in which to evaluate the
				 * script. Also used for error reporting. */
    const char *script,		/* First character of script to evaluate. */
    size_t numBytes,		/* Number of bytes in script. If -1, the
				 * script consists of all bytes up to the
				 * first NUL character. */
    int flags,			/* Collection of OR-ed bits that control the
				 * evaluation of the script. Only
				 * TCL_EVAL_GLOBAL is currently supported. */
    size_t line,			/* The line the script starts on. */
    int *clNextOuter,		/* Information about an outer context for */
    const char *outerScript)	/* continuation line data. This is set only in
				 * TclSubstTokens(), to properly handle
				 * [...]-nested commands. The 'outerScript'
				 * refers to the most-outer script containing
				 * the embedded command, which is refered to
				 * by 'script'. The 'clNextOuter' refers to
				 * the current entry in the table of
				 * continuation lines in this "main script",
				 * and the character offsets are relative to
				 * the 'outerScript' as well.
				 *
				 * If outerScript == script, then this call is
				 * for the outer-most script/command. See
				 * Tcl_EvalEx() and TclEvalObjEx() for places
				 * generating arguments for which this is
				 * true. */
{
    Interp *iPtr = (Interp *) interp;
    const char *p, *next;
    const unsigned int minObjs = 20;
    Tcl_Obj **objv, **objvSpace;
    int *expand, *lines, *lineSpace;
    Tcl_Token *tokenPtr;
    int bytesLeft, expandRequested, code = TCL_OK;
    size_t commandLength;
    CallFrame *savedVarFramePtr;/* Saves old copy of iPtr->varFramePtr in case
				 * TCL_EVAL_GLOBAL was set. */
    int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);
    int gotParse = 0;
    TCL_HASH_TYPE i, objectsUsed = 0;
				/* These variables keep track of how much
				 * state has been allocated while evaluating
				 * the script, so that it can be freed
				 * properly if an error occurs. */
    Tcl_Parse *parsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse));
    CmdFrame *eeFramePtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame));
    Tcl_Obj **stackObjArray = (Tcl_Obj **)







|














|





|





|














|



|
|




|







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

int
Tcl_EvalEx(
    Tcl_Interp *interp,		/* Interpreter in which to evaluate the
				 * script. Also used for error reporting. */
    const char *script,		/* First character of script to evaluate. */
    Tcl_Size numBytes,		/* Number of bytes in script. If -1, the
				 * script consists of all bytes up to the
				 * first null character. */
    int flags)			/* Collection of OR-ed bits that control the
				 * evaluation of the script. Only
				 * TCL_EVAL_GLOBAL is currently supported. */
{
    return TclEvalEx(interp, script, numBytes, flags, 1, NULL, script);
}

int
TclEvalEx(
    Tcl_Interp *interp,		/* Interpreter in which to evaluate the
				 * script. Also used for error reporting. */
    const char *script,		/* First character of script to evaluate. */
    Tcl_Size numBytes,		/* Number of bytes in script. If -1, the
				 * script consists of all bytes up to the
				 * first NUL character. */
    int flags,			/* Collection of OR-ed bits that control the
				 * evaluation of the script. Only
				 * TCL_EVAL_GLOBAL is currently supported. */
    Tcl_Size line,		/* The line the script starts on. */
    int *clNextOuter,		/* Information about an outer context for */
    const char *outerScript)	/* continuation line data. This is set only in
				 * TclSubstTokens(), to properly handle
				 * [...]-nested commands. The 'outerScript'
				 * refers to the most-outer script containing
				 * the embedded command, which is referred to
				 * by 'script'. The 'clNextOuter' refers to
				 * the current entry in the table of
				 * continuation lines in this "main script",
				 * and the character offsets are relative to
				 * the 'outerScript' as well.
				 *
				 * If outerScript == script, then this call is
				 * for the outer-most script/command. See
				 * Tcl_EvalEx() and TclEvalObjEx() for places
				 * generating arguments for which this is
				 * true. */
{
    Interp *iPtr = (Interp *) interp;
    const char *p, *next;
    const int minObjs = 20;
    Tcl_Obj **objv, **objvSpace;
    int *expand, *lines, *lineSpace;
    Tcl_Token *tokenPtr;
    int expandRequested, code = TCL_OK;
    Tcl_Size bytesLeft, commandLength;
    CallFrame *savedVarFramePtr;/* Saves old copy of iPtr->varFramePtr in case
				 * TCL_EVAL_GLOBAL was set. */
    int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);
    int gotParse = 0;
    Tcl_Size i, objectsUsed = 0;
				/* These variables keep track of how much
				 * state has been allocated while evaluating
				 * the script, so that it can be freed
				 * properly if an error occurs. */
    Tcl_Parse *parsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse));
    CmdFrame *eeFramePtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame));
    Tcl_Obj **stackObjArray = (Tcl_Obj **)
5199
5200
5201
5202
5203
5204
5205
5206
5207
5208
5209
5210
5211
5212
5213
	if (clNextOuter) {
	    clNext = clNextOuter;
	} else {
	    clNext = &iPtr->scriptCLLocPtr->loc[0];
	}
    }

    if (numBytes == TCL_INDEX_NONE) {
	numBytes = strlen(script);
    }
    Tcl_ResetResult(interp);

    savedVarFramePtr = iPtr->varFramePtr;
    if (flags & TCL_EVAL_GLOBAL) {
	iPtr->varFramePtr = iPtr->rootFramePtr;







|







5202
5203
5204
5205
5206
5207
5208
5209
5210
5211
5212
5213
5214
5215
5216
	if (clNextOuter) {
	    clNext = clNextOuter;
	} else {
	    clNext = &iPtr->scriptCLLocPtr->loc[0];
	}
    }

    if (numBytes < 0) {
	numBytes = strlen(script);
    }
    Tcl_ResetResult(interp);

    savedVarFramePtr = iPtr->varFramePtr;
    if (flags & TCL_EVAL_GLOBAL) {
	iPtr->varFramePtr = iPtr->rootFramePtr;
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
	    /*
	     * TIP #280. Track lines within the words of the current
	     * command. We use a separate pointer into the table of
	     * continuation line locations to not lose our position for the
	     * per-command parsing.
	     */

	    size_t wordLine = line;
	    const char *wordStart = parsePtr->commandStart;
	    int *wordCLNext = clNext;
	    unsigned int objectsNeeded = 0;
	    unsigned int numWords = parsePtr->numWords;

	    /*
	     * Generate an array of objects for the words of the command.
	     */

	    if (numWords > minObjs) {
		expand =    (int *)Tcl_Alloc(numWords * sizeof(int));
		objvSpace = (Tcl_Obj **)Tcl_Alloc(numWords * sizeof(Tcl_Obj *));
		lineSpace = (int *)Tcl_Alloc(numWords * sizeof(int));
	    }
	    expandRequested = 0;
	    objv = objvSpace;
	    lines = lineSpace;

	    iPtr->cmdFramePtr = eeFramePtr->nextPtr;
	    for (objectsUsed = 0, tokenPtr = parsePtr->tokenPtr;
		    objectsUsed < numWords;
		    objectsUsed++, tokenPtr += tokenPtr->numComponents+1) {


		/*
		 * TIP #280. Track lines to current word. Save the information
		 * on a per-word basis, signaling dynamic words as needed.
		 * Make the information available to the recursively called
		 * evaluator as well, including the type of context (source
		 * vs. eval).
		 */







|


|
|


















>
>







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
	    /*
	     * TIP #280. Track lines within the words of the current
	     * command. We use a separate pointer into the table of
	     * continuation line locations to not lose our position for the
	     * per-command parsing.
	     */

	    Tcl_Size wordLine = line;
	    const char *wordStart = parsePtr->commandStart;
	    int *wordCLNext = clNext;
	    Tcl_Size objectsNeeded = 0;
	    Tcl_Size numWords = parsePtr->numWords;

	    /*
	     * Generate an array of objects for the words of the command.
	     */

	    if (numWords > minObjs) {
		expand =    (int *)Tcl_Alloc(numWords * sizeof(int));
		objvSpace = (Tcl_Obj **)Tcl_Alloc(numWords * sizeof(Tcl_Obj *));
		lineSpace = (int *)Tcl_Alloc(numWords * sizeof(int));
	    }
	    expandRequested = 0;
	    objv = objvSpace;
	    lines = lineSpace;

	    iPtr->cmdFramePtr = eeFramePtr->nextPtr;
	    for (objectsUsed = 0, tokenPtr = parsePtr->tokenPtr;
		    objectsUsed < numWords;
		    objectsUsed++, tokenPtr += tokenPtr->numComponents+1) {
		Tcl_Size additionalObjsCount;

		/*
		 * TIP #280. Track lines to current word. Save the information
		 * on a per-word basis, signaling dynamic words as needed.
		 * Make the information available to the recursively called
		 * evaluator as well, including the type of context (source
		 * vs. eval).
		 */
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

		if (code != TCL_OK) {
		    break;
		}
		objv[objectsUsed] = Tcl_GetObjResult(interp);
		Tcl_IncrRefCount(objv[objectsUsed]);
		if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
		    size_t numElements;

		    code = TclListObjLengthM(interp, objv[objectsUsed],
			    &numElements);
		    if (code == TCL_ERROR) {
			/*
			 * Attempt to expand a non-list.
			 */

			Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
				"\n    (expanding word %" TCL_Z_MODIFIER "u)", objectsUsed));
			Tcl_DecrRefCount(objv[objectsUsed]);
			break;
		    }
		    expandRequested = 1;
		    expand[objectsUsed] = 1;

		    objectsNeeded += (numElements ? numElements : 1);

		} else {
		    expand[objectsUsed] = 0;





		    objectsNeeded++;



		}


		if (wordCLNext) {
		    TclContinuationsEnterDerived(objv[objectsUsed],
			    wordStart - outerScript, wordCLNext);
		}
	    } /* for loop */
	    iPtr->cmdFramePtr = eeFramePtr;







|
















|
>


>
>
>
>
>
|
>
>
>

>







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

		if (code != TCL_OK) {
		    break;
		}
		objv[objectsUsed] = Tcl_GetObjResult(interp);
		Tcl_IncrRefCount(objv[objectsUsed]);
		if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
		    Tcl_Size numElements;

		    code = TclListObjLengthM(interp, objv[objectsUsed],
			    &numElements);
		    if (code == TCL_ERROR) {
			/*
			 * Attempt to expand a non-list.
			 */

			Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
				"\n    (expanding word %" TCL_Z_MODIFIER "u)", objectsUsed));
			Tcl_DecrRefCount(objv[objectsUsed]);
			break;
		    }
		    expandRequested = 1;
		    expand[objectsUsed] = 1;

		    additionalObjsCount = (numElements ? numElements : 1);

		} else {
		    expand[objectsUsed] = 0;
		    additionalObjsCount = 1;
		}

		/* Currently max command words in INT_MAX */
		if (additionalObjsCount > INT_MAX ||
		    objectsNeeded > (INT_MAX - additionalObjsCount)) {
		    code = TclCommandWordLimitError(interp, -1);
		    Tcl_DecrRefCount(objv[objectsUsed]);
		    break;
		}
		objectsNeeded += additionalObjsCount;

		if (wordCLNext) {
		    TclContinuationsEnterDerived(objv[objectsUsed],
			    wordStart - outerScript, wordCLNext);
		}
	    } /* for loop */
	    iPtr->cmdFramePtr = eeFramePtr;
5411
5412
5413
5414
5415
5416
5417
5418
5419
5420
5421
5422
5423
5424
5425
			    (Tcl_Obj **)Tcl_Alloc(objectsNeeded * sizeof(Tcl_Obj *));
		    lines = lineSpace = (int *)Tcl_Alloc(objectsNeeded * sizeof(int));
		}

		objectsUsed = 0;
		while (wordIdx--) {
		    if (expand[wordIdx]) {
			size_t numElements;
			Tcl_Obj **elements, *temp = copy[wordIdx];

			TclListObjGetElementsM(NULL, temp, &numElements,
				&elements);
			objectsUsed += numElements;
			while (numElements--) {
			    lines[objIdx] = -1;







|







5426
5427
5428
5429
5430
5431
5432
5433
5434
5435
5436
5437
5438
5439
5440
			    (Tcl_Obj **)Tcl_Alloc(objectsNeeded * sizeof(Tcl_Obj *));
		    lines = lineSpace = (int *)Tcl_Alloc(objectsNeeded * sizeof(int));
		}

		objectsUsed = 0;
		while (wordIdx--) {
		    if (expand[wordIdx]) {
			Tcl_Size numElements;
			Tcl_Obj **elements, *temp = copy[wordIdx];

			TclListObjGetElementsM(NULL, temp, &numElements,
				&elements);
			objectsUsed += numElements;
			while (numElements--) {
			    lines[objIdx] = -1;
5604
5605
5606
5607
5608
5609
5610
5611
5612
5613
5614
5615
5616
5617
5618
 *
 * TIP #280
 *----------------------------------------------------------------------
 */

void
TclAdvanceLines(
    size_t *line,
    const char *start,
    const char *end)
{
    const char *p;

    for (p = start; p < end; p++) {
	if (*p == '\n') {







|







5619
5620
5621
5622
5623
5624
5625
5626
5627
5628
5629
5630
5631
5632
5633
 *
 * TIP #280
 *----------------------------------------------------------------------
 */

void
TclAdvanceLines(
    Tcl_Size *line,
    const char *start,
    const char *end)
{
    const char *p;

    for (p = start; p < end; p++) {
	if (*p == '\n') {
5639
5640
5641
5642
5643
5644
5645
5646
5647
5648
5649
5650
5651
5652
5653
 *
 * TIP #280
 *----------------------------------------------------------------------
 */

void
TclAdvanceContinuations(
    size_t *line,
    int **clNextPtrPtr,
    int loc)
{
    /*
     * Track the invisible continuation lines embedded in a script, if any.
     * Here they are just spaces (already). They were removed by
     * TclSubstTokens via TclParseBackslash.







|







5654
5655
5656
5657
5658
5659
5660
5661
5662
5663
5664
5665
5666
5667
5668
 *
 * TIP #280
 *----------------------------------------------------------------------
 */

void
TclAdvanceContinuations(
    Tcl_Size *line,
    int **clNextPtrPtr,
    int loc)
{
    /*
     * Track the invisible continuation lines embedded in a script, if any.
     * Here they are just spaces (already). They were removed by
     * TclSubstTokens via TclParseBackslash.
5711
5712
5713
5714
5715
5716
5717
5718
5719
5720
5721
5722
5723
5724
5725
5726
    Tcl_HashEntry *hPtr;
    CFWord *cfwPtr;

    for (i = 1; i < objc; i++) {
	/*
	 * Ignore argument words without line information (= dynamic). If they
	 * are variables they may have location information associated with
	 * that, either through globally recorded 'set' invokations, or
	 * literals in bytecode. Eitehr way there is no need to record
	 * something here.
	 */

	if (cfPtr->line[i] < 0) {
	    continue;
	}
	hPtr = Tcl_CreateHashEntry(iPtr->lineLAPtr, objv[i], &isNew);







|
|







5726
5727
5728
5729
5730
5731
5732
5733
5734
5735
5736
5737
5738
5739
5740
5741
    Tcl_HashEntry *hPtr;
    CFWord *cfwPtr;

    for (i = 1; i < objc; i++) {
	/*
	 * Ignore argument words without line information (= dynamic). If they
	 * are variables they may have location information associated with
	 * that, either through globally recorded 'set' invocations, or
	 * literals in bytecode. Either way there is no need to record
	 * something here.
	 */

	if (cfPtr->line[i] < 0) {
	    continue;
	}
	hPtr = Tcl_CreateHashEntry(iPtr->lineLAPtr, objv[i], &isNew);
5819
5820
5821
5822
5823
5824
5825
5826
5827
5828
5829
5830
5831
5832
5833
TclArgumentBCEnter(
    Tcl_Interp *interp,
    Tcl_Obj *objv[],
    int objc,
    void *codePtr,
    CmdFrame *cfPtr,
    int cmd,
    size_t pc)
{
    ExtCmdLoc *eclPtr;
    int word;
    ECL *ePtr;
    CFWordBC *lastPtr = NULL;
    Interp *iPtr = (Interp *) interp;
    Tcl_HashEntry *hePtr =







|







5834
5835
5836
5837
5838
5839
5840
5841
5842
5843
5844
5845
5846
5847
5848
TclArgumentBCEnter(
    Tcl_Interp *interp,
    Tcl_Obj *objv[],
    int objc,
    void *codePtr,
    CmdFrame *cfPtr,
    int cmd,
    Tcl_Size pc)
{
    ExtCmdLoc *eclPtr;
    int word;
    ECL *ePtr;
    CFWordBC *lastPtr = NULL;
    Interp *iPtr = (Interp *) interp;
    Tcl_HashEntry *hePtr =
5848
5849
5850
5851
5852
5853
5854
5855
5856
5857
5858
5859
5860
5861
5862
     * ensemble dispatch.  Ensemble subcommands that lead to script
     * evaluation are not supposed to get compiled, because a command
     * such as [info level] in the script can expose some of the dispatch
     * shenanigans.  This means that we don't have to tend to the
     * housekeeping, and can escape now.
     */

    if (ePtr->nline != (size_t)objc) {
        return;
    }

    /*
     * Having disposed of the ensemble cases, we can state...
     * A few truths ...
     * (1) ePtr->nline == objc







|







5863
5864
5865
5866
5867
5868
5869
5870
5871
5872
5873
5874
5875
5876
5877
     * ensemble dispatch.  Ensemble subcommands that lead to script
     * evaluation are not supposed to get compiled, because a command
     * such as [info level] in the script can expose some of the dispatch
     * shenanigans.  This means that we don't have to tend to the
     * housekeeping, and can escape now.
     */

    if (ePtr->nline != objc) {
        return;
    }

    /*
     * Having disposed of the ensemble cases, we can state...
     * A few truths ...
     * (1) ePtr->nline == objc
6108
6109
6110
6111
6112
6113
6114
6115
6116
6117
6118
6119
6120
6121
6122
     * This function consists of three independent blocks for: direct
     * evaluation of canonical lists, compilation and bytecode execution and
     * finally direct evaluation. Precisely one of these blocks will be run.
     */

    if (TclListObjIsCanonical(objPtr)) {
	CmdFrame *eoFramePtr = NULL;
	size_t objc;
	Tcl_Obj *listPtr, **objv;

	/*
	 * Canonical List Optimization:  In this case, we
	 * can safely use Tcl_EvalObjv instead and get an appreciable
	 * improvement in execution speed. This is because it allows us to
	 * avoid a setFromAny step that would just pack everything into a







|







6123
6124
6125
6126
6127
6128
6129
6130
6131
6132
6133
6134
6135
6136
6137
     * This function consists of three independent blocks for: direct
     * evaluation of canonical lists, compilation and bytecode execution and
     * finally direct evaluation. Precisely one of these blocks will be run.
     */

    if (TclListObjIsCanonical(objPtr)) {
	CmdFrame *eoFramePtr = NULL;
	Tcl_Size objc;
	Tcl_Obj *listPtr, **objv;

	/*
	 * Canonical List Optimization:  In this case, we
	 * can safely use Tcl_EvalObjv instead and get an appreciable
	 * improvement in execution speed. This is because it allows us to
	 * avoid a setFromAny step that would just pack everything into a
6133
6134
6135
6136
6137
6138
6139
6140




6141
6142
6143
6144
6145
6146
6147
	 * both listPtr and objPtr.
	 *
	 * TODO: Create a test to demo this need, or eliminate it.
	 * FIXME OPT: preserve just the internal rep?
	 */

	Tcl_IncrRefCount(objPtr);
	listPtr = TclListObjCopy(interp, objPtr);




	Tcl_IncrRefCount(listPtr);

	if (word != INT_MIN) {
	    /*
	     * TIP #280 Structures for tracking lines. As we know that this is
	     * dynamic execution we ignore the invoker, even if known.
	     *







|
>
>
>
>







6148
6149
6150
6151
6152
6153
6154
6155
6156
6157
6158
6159
6160
6161
6162
6163
6164
6165
6166
	 * both listPtr and objPtr.
	 *
	 * TODO: Create a test to demo this need, or eliminate it.
	 * FIXME OPT: preserve just the internal rep?
	 */

	Tcl_IncrRefCount(objPtr);
	listPtr = TclDuplicatePureObj(interp, objPtr, &tclListType);
	if (!listPtr) {
	    Tcl_DecrRefCount(objPtr);
	    return TCL_ERROR;
	}
	Tcl_IncrRefCount(listPtr);

	if (word != INT_MIN) {
	    /*
	     * TIP #280 Structures for tracking lines. As we know that this is
	     * dynamic execution we ignore the invoker, even if known.
	     *
6218
6219
6220
6221
6222
6223
6224
6225
6226
6227
6228
6229
6230
6231
6232
	/*
	 * We're not supposed to use the compiler or byte-code
	 * interpreter. Let Tcl_EvalEx evaluate the command directly (and
	 * probably more slowly).
	 */

	const char *script;
	size_t numSrcBytes;

	/*
	 * Now we check if we have data about invisible continuation lines for
	 * the script, and make it available to the direct script parser and
	 * evaluator we are about to call, if so.
	 *
	 * It may be possible that the script Tcl_Obj* can be free'd while the







|







6237
6238
6239
6240
6241
6242
6243
6244
6245
6246
6247
6248
6249
6250
6251
	/*
	 * We're not supposed to use the compiler or byte-code
	 * interpreter. Let Tcl_EvalEx evaluate the command directly (and
	 * probably more slowly).
	 */

	const char *script;
	Tcl_Size numSrcBytes;

	/*
	 * Now we check if we have data about invisible continuation lines for
	 * the script, and make it available to the direct script parser and
	 * evaluator we are about to call, if so.
	 *
	 * It may be possible that the script Tcl_Obj* can be free'd while the
6272
6273
6274
6275
6276
6277
6278
6279
6280
6281
6282
6283
6284
6285
6286

    if (iPtr->numLevels == 0) {
	if (result == TCL_RETURN) {
	    result = TclUpdateReturnInfo(iPtr);
	}
	if ((result != TCL_OK) && (result != TCL_ERROR) && !allowExceptions) {
	    const char *script;
	    size_t numSrcBytes;

	    ProcessUnexpectedResult(interp, result);
	    result = TCL_ERROR;
	    script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
	    Tcl_LogCommandInfo(interp, script, script, numSrcBytes);
	}








|







6291
6292
6293
6294
6295
6296
6297
6298
6299
6300
6301
6302
6303
6304
6305

    if (iPtr->numLevels == 0) {
	if (result == TCL_RETURN) {
	    result = TclUpdateReturnInfo(iPtr);
	}
	if ((result != TCL_OK) && (result != TCL_ERROR) && !allowExceptions) {
	    const char *script;
	    Tcl_Size numSrcBytes;

	    ProcessUnexpectedResult(interp, result);
	    result = TCL_ERROR;
	    script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
	    Tcl_LogCommandInfo(interp, script, script, numSrcBytes);
	}

6365
6366
6367
6368
6369
6370
6371
6372
6373
6374
6375
6376
6377
6378
6379
    } else if (returnCode == TCL_CONTINUE) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"invoked \"continue\" outside of a loop", -1));
    } else {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"command returned bad code: %d", returnCode));
    }
    sprintf(buf, "%d", returnCode);
    Tcl_SetErrorCode(interp, "TCL", "UNEXPECTED_RESULT_CODE", buf, NULL);
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_ExprLong, Tcl_ExprDouble, Tcl_ExprBoolean --







|







6384
6385
6386
6387
6388
6389
6390
6391
6392
6393
6394
6395
6396
6397
6398
    } else if (returnCode == TCL_CONTINUE) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"invoked \"continue\" outside of a loop", -1));
    } else {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"command returned bad code: %d", returnCode));
    }
    snprintf(buf, sizeof(buf), "%d", returnCode);
    Tcl_SetErrorCode(interp, "TCL", "UNEXPECTED_RESULT_CODE", buf, NULL);
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_ExprLong, Tcl_ExprDouble, Tcl_ExprBoolean --
6806
6807
6808
6809
6810
6811
6812
6813
6814
6815
6816
6817
6818
6819
6820

void
Tcl_AppendObjToErrorInfo(
    Tcl_Interp *interp,		/* Interpreter to which error information
				 * pertains. */
    Tcl_Obj *objPtr)		/* Message to record. */
{
    size_t length;
    const char *message = Tcl_GetStringFromObj(objPtr, &length);
    Interp *iPtr = (Interp *) interp;

    Tcl_IncrRefCount(objPtr);

    /*
     * If we are just starting to log an error, errorInfo is initialized from







|







6825
6826
6827
6828
6829
6830
6831
6832
6833
6834
6835
6836
6837
6838
6839

void
Tcl_AppendObjToErrorInfo(
    Tcl_Interp *interp,		/* Interpreter to which error information
				 * pertains. */
    Tcl_Obj *objPtr)		/* Message to record. */
{
    Tcl_Size 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
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
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
Tcl_SetRecursionLimit(
    Tcl_Interp *interp,		/* Interpreter whose nesting limit is to be
				 * set. */
    size_t depth)			/* New value for maximimum depth. */
{
    Interp *iPtr = (Interp *) interp;
    size_t old;

    old = iPtr->maxNestingDepth;
    if (depth + 1 > 1) {
	iPtr->maxNestingDepth = depth;
    }
    return old;
}

/*
 *----------------------------------------------------------------------







|



|


|


|







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

Tcl_Size
Tcl_SetRecursionLimit(
    Tcl_Interp *interp,		/* Interpreter whose nesting limit is to be
				 * set. */
    Tcl_Size depth)		/* New value for maximimum depth. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Size old;

    old = iPtr->maxNestingDepth;
    if (depth > 0) {
	iPtr->maxNestingDepth = depth;
    }
    return old;
}

/*
 *----------------------------------------------------------------------
7390
7391
7392
7393
7394
7395
7396
7397
7398
7399
7400
7401
7402
7403
7404
    if (type == TCL_NUMBER_INT) {
	Tcl_WideInt l = *((const Tcl_WideInt *) ptr);

	if (l > 0) {
	    goto unChanged;
	} else if (l == 0) {
	    if (TclHasStringRep(objv[1])) {
		size_t numBytes;
		const char *bytes = Tcl_GetStringFromObj(objv[1], &numBytes);

		while (numBytes) {
		    if (*bytes == '-') {
			Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0));
			return TCL_OK;
		    }







|







7409
7410
7411
7412
7413
7414
7415
7416
7417
7418
7419
7420
7421
7422
7423
    if (type == TCL_NUMBER_INT) {
	Tcl_WideInt l = *((const Tcl_WideInt *) ptr);

	if (l > 0) {
	    goto unChanged;
	} else if (l == 0) {
	    if (TclHasStringRep(objv[1])) {
		Tcl_Size numBytes;
		const char *bytes = Tcl_GetStringFromObj(objv[1], &numBytes);

		while (numBytes) {
		    if (*bytes == '-') {
			Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0));
			return TCL_OK;
		    }
8470
8471
8472
8473
8474
8475
8476
8477
8478
8479
8480
8481
8482
8483
8484
 */

int
Tcl_NRCallObjProc(
    Tcl_Interp *interp,
    Tcl_ObjCmdProc *objProc,
    void *clientData,
    size_t objc,
    Tcl_Obj *const objv[])
{
    NRE_callback *rootPtr = TOP_CB(interp);

    TclNRAddCallback(interp, Dispatch, objProc, clientData,
	    INT2PTR(objc), objv);
    return TclNRRunCallbacks(interp, TCL_OK, rootPtr);







|







8489
8490
8491
8492
8493
8494
8495
8496
8497
8498
8499
8500
8501
8502
8503
 */

int
Tcl_NRCallObjProc(
    Tcl_Interp *interp,
    Tcl_ObjCmdProc *objProc,
    void *clientData,
    Tcl_Size objc,
    Tcl_Obj *const objv[])
{
    NRE_callback *rootPtr = TOP_CB(interp);

    TclNRAddCallback(interp, Dispatch, objProc, clientData,
	    INT2PTR(objc), objv);
    return TclNRRunCallbacks(interp, TCL_OK, rootPtr);
8493
8494
8495
8496
8497
8498
8499
8500
8501
8502
8503
8504
8505
8506
8507
8508
8509
8510
8511
8512
8513
8514
8515
    CmdWrapperInfo *info = (CmdWrapperInfo *)clientData;
    clientData = info->clientData;
    Tcl_ObjCmdProc2 *proc = info->proc;
    Tcl_Free(info);
    if (objc < 0) {
	objc = -1;
    }
    return proc(clientData, interp, (size_t)objc, objv);
}

int
Tcl_NRCallObjProc2(
    Tcl_Interp *interp,
    Tcl_ObjCmdProc2 *objProc,
    void *clientData,
    size_t objc,
    Tcl_Obj *const objv[])
{
    if (objc > INT_MAX) {
	Tcl_WrongNumArgs(interp, 1, objv, "?args?");
	return TCL_ERROR;
    }








|







|







8512
8513
8514
8515
8516
8517
8518
8519
8520
8521
8522
8523
8524
8525
8526
8527
8528
8529
8530
8531
8532
8533
8534
    CmdWrapperInfo *info = (CmdWrapperInfo *)clientData;
    clientData = info->clientData;
    Tcl_ObjCmdProc2 *proc = info->proc;
    Tcl_Free(info);
    if (objc < 0) {
	objc = -1;
    }
    return proc(clientData, interp, (Tcl_Size)objc, objv);
}

int
Tcl_NRCallObjProc2(
    Tcl_Interp *interp,
    Tcl_ObjCmdProc2 *objProc,
    void *clientData,
    ptrdiff_t objc,
    Tcl_Obj *const objv[])
{
    if (objc > INT_MAX) {
	Tcl_WrongNumArgs(interp, 1, objv, "?args?");
	return TCL_ERROR;
    }

8557
8558
8559
8560
8561
8562
8563
8564
8565
8566
8567
8568
8569
8570
8571
    int objc,
    Tcl_Obj *const objv[])
{
    CmdWrapperInfo *info = (CmdWrapperInfo *)clientData;
    if (objc < 0) {
	objc = -1;
    }
    return info->nreProc(info->clientData, interp, (size_t)objc, objv);
}

Tcl_Command
Tcl_NRCreateCommand2(
    Tcl_Interp *interp,		/* Token for command interpreter (returned by
				 * previous call to Tcl_CreateInterp). */
    const char *cmdName,	/* Name of command. If it contains namespace







|







8576
8577
8578
8579
8580
8581
8582
8583
8584
8585
8586
8587
8588
8589
8590
    int objc,
    Tcl_Obj *const objv[])
{
    CmdWrapperInfo *info = (CmdWrapperInfo *)clientData;
    if (objc < 0) {
	objc = -1;
    }
    return info->nreProc(info->clientData, interp, objc, objv);
}

Tcl_Command
Tcl_NRCreateCommand2(
    Tcl_Interp *interp,		/* Token for command interpreter (returned by
				 * previous call to Tcl_CreateInterp). */
    const char *cmdName,	/* Name of command. If it contains namespace
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
    return TclNREvalObjEx(interp, objPtr, flags, NULL, INT_MIN);
}

int
Tcl_NREvalObjv(
    Tcl_Interp *interp,		/* Interpreter in which to evaluate the
				 * command. Also used for error reporting. */
    size_t objc,			/* Number of words in command. */
    Tcl_Obj *const objv[],	/* An array of pointers to objects that are
				 * the words that make up the command. */
    int flags)			/* Collection of OR-ed bits that control the
				 * evaluation of the script. Only
				 * TCL_EVAL_GLOBAL, TCL_EVAL_INVOKE and
				 * TCL_EVAL_NOERR are currently supported. */
{
    return TclNREvalObjv(interp, objc, objv, flags, NULL);
}

int
Tcl_NRCmdSwap(
    Tcl_Interp *interp,
    Tcl_Command cmd,
    size_t objc,
    Tcl_Obj *const objv[],
    int flags)
{
    return TclNREvalObjv(interp, objc, objv, flags|TCL_EVAL_NOERR,
	    (Command *) cmd);
}








|














|







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
    return TclNREvalObjEx(interp, objPtr, flags, NULL, INT_MIN);
}

int
Tcl_NREvalObjv(
    Tcl_Interp *interp,		/* Interpreter in which to evaluate the
				 * command. Also used for error reporting. */
    Tcl_Size objc,			/* Number of words in command. */
    Tcl_Obj *const objv[],	/* An array of pointers to objects that are
				 * the words that make up the command. */
    int flags)			/* Collection of OR-ed bits that control the
				 * evaluation of the script. Only
				 * TCL_EVAL_GLOBAL, TCL_EVAL_INVOKE and
				 * TCL_EVAL_NOERR are currently supported. */
{
    return TclNREvalObjv(interp, objc, objv, flags, NULL);
}

int
Tcl_NRCmdSwap(
    Tcl_Interp *interp,
    Tcl_Command cmd,
    Tcl_Size objc,
    Tcl_Obj *const objv[],
    int flags)
{
    return TclNREvalObjv(interp, objc, objv, flags|TCL_EVAL_NOERR,
	    (Command *) cmd);
}

8860
8861
8862
8863
8864
8865
8866
8867
8868
8869
8870
8871
8872
8873
8874
    void *data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *listPtr = (Tcl_Obj *)data[0], *nsObjPtr;
    Tcl_Namespace *nsPtr;
    size_t objc;
    Tcl_Obj **objv;

    TclListObjGetElementsM(interp, listPtr, &objc, &objv);
    nsObjPtr = objv[0];

    if (result == TCL_OK) {
	result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr);







|







8879
8880
8881
8882
8883
8884
8885
8886
8887
8888
8889
8890
8891
8892
8893
    void *data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *listPtr = (Tcl_Obj *)data[0], *nsObjPtr;
    Tcl_Namespace *nsPtr;
    Tcl_Size objc;
    Tcl_Obj **objv;

    TclListObjGetElementsM(interp, listPtr, &objc, &objv);
    nsObjPtr = objv[0];

    if (result == TCL_OK) {
	result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr);
9025
9026
9027
9028
9029
9030
9031

9032
9033
9034
9035
9036
9037
9038
    TclListObjSetElement(interp, listPtr, 0, nsObjPtr);

    /*
     * Add the callback in the caller's env, then instruct TEBC to yield.
     */

    iPtr->execEnvPtr = corPtr->callerEEPtr;

    TclSetTailcall(interp, listPtr);
    corPtr->yieldPtr = listPtr;
    iPtr->execEnvPtr = corPtr->eePtr;

    return TclNRYieldObjCmd(CORO_ACTIVATE_YIELDM, interp, 1, objv);
}








>







9044
9045
9046
9047
9048
9049
9050
9051
9052
9053
9054
9055
9056
9057
9058
    TclListObjSetElement(interp, listPtr, 0, nsObjPtr);

    /*
     * Add the callback in the caller's env, then instruct TEBC to yield.
     */

    iPtr->execEnvPtr = corPtr->callerEEPtr;
    /* Not calling Tcl_IncrRefCount(listPtr) here because listPtr is private */
    TclSetTailcall(interp, listPtr);
    corPtr->yieldPtr = listPtr;
    iPtr->execEnvPtr = corPtr->eePtr;

    return TclNRYieldObjCmd(CORO_ACTIVATE_YIELDM, interp, 1, objv);
}

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

        /*
         * Record the stackLevel at which the resume is happening, then swap
         * the interp's environment to make it suitable to run this coroutine.
         */

        corPtr->stackLevel = &corPtr;
        size_t numLevels = corPtr->auxNumLevels;
        corPtr->auxNumLevels = iPtr->numLevels;

        SAVE_CONTEXT(corPtr->caller);
        corPtr->callerEEPtr = iPtr->execEnvPtr;
        RESTORE_CONTEXT(corPtr->running);
        iPtr->execEnvPtr = corPtr->eePtr;
        iPtr->numLevels += numLevels;
    } else {
        /*
         * Coroutine is active: yield
         */

        if (corPtr->stackLevel != &corPtr) {
	    NRE_callback *runPtr;

	    iPtr->execEnvPtr = corPtr->callerEEPtr;
	    if (corPtr->yieldPtr) {
		for (runPtr = TOP_CB(interp); runPtr; runPtr = runPtr->nextPtr) {
		    if (runPtr->data[1] == corPtr->yieldPtr) {

			runPtr->data[1] = NULL;
			Tcl_DecrRefCount(corPtr->yieldPtr);
			corPtr->yieldPtr = NULL;
			break;
		    }
		}
	    }
	    iPtr->execEnvPtr = corPtr->eePtr;








|



















>

<







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

        /*
         * Record the stackLevel at which the resume is happening, then swap
         * the interp's environment to make it suitable to run this coroutine.
         */

        corPtr->stackLevel = &corPtr;
        Tcl_Size numLevels = corPtr->auxNumLevels;
        corPtr->auxNumLevels = iPtr->numLevels;

        SAVE_CONTEXT(corPtr->caller);
        corPtr->callerEEPtr = iPtr->execEnvPtr;
        RESTORE_CONTEXT(corPtr->running);
        iPtr->execEnvPtr = corPtr->eePtr;
        iPtr->numLevels += numLevels;
    } else {
        /*
         * Coroutine is active: yield
         */

        if (corPtr->stackLevel != &corPtr) {
	    NRE_callback *runPtr;

	    iPtr->execEnvPtr = corPtr->callerEEPtr;
	    if (corPtr->yieldPtr) {
		for (runPtr = TOP_CB(interp); runPtr; runPtr = runPtr->nextPtr) {
		    if (runPtr->data[1] == corPtr->yieldPtr) {
			Tcl_DecrRefCount((Tcl_Obj *)runPtr->data[1]);
			runPtr->data[1] = NULL;

			corPtr->yieldPtr = NULL;
			break;
		    }
		}
	    }
	    iPtr->execEnvPtr = corPtr->eePtr;

9256
9257
9258
9259
9260
9261
9262
9263
9264
9265
9266
9267
9268
9269
9270
        } else {
            Tcl_Panic("Yield received an option which is not implemented");
        }

	corPtr->yieldPtr = NULL;
        corPtr->stackLevel = NULL;

        size_t numLevels = iPtr->numLevels;
        iPtr->numLevels = corPtr->auxNumLevels;
        corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels;

        iPtr->execEnvPtr = corPtr->callerEEPtr;
    }

    return TCL_OK;







|







9276
9277
9278
9279
9280
9281
9282
9283
9284
9285
9286
9287
9288
9289
9290
        } else {
            Tcl_Panic("Yield received an option which is not implemented");
        }

	corPtr->yieldPtr = NULL;
        corPtr->stackLevel = NULL;

        Tcl_Size numLevels = iPtr->numLevels;
        iPtr->numLevels = corPtr->auxNumLevels;
        corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels;

        iPtr->execEnvPtr = corPtr->callerEEPtr;
    }

    return TCL_OK;
9283
9284
9285
9286
9287
9288
9289
9290
9291
9292
9293
9294
9295
9296
9297

static int
TclNREvalList(
    void *data[],
    Tcl_Interp *interp,
    TCL_UNUSED(int) /*result*/)
{
    size_t objc;
    Tcl_Obj **objv;
    Tcl_Obj *listPtr = (Tcl_Obj *)data[0];

    Tcl_IncrRefCount(listPtr);

    TclMarkTailcall(interp);
    TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL,NULL);







|







9303
9304
9305
9306
9307
9308
9309
9310
9311
9312
9313
9314
9315
9316
9317

static int
TclNREvalList(
    void *data[],
    Tcl_Interp *interp,
    TCL_UNUSED(int) /*result*/)
{
    Tcl_Size objc;
    Tcl_Obj **objv;
    Tcl_Obj *listPtr = (Tcl_Obj *)data[0];

    Tcl_IncrRefCount(listPtr);

    TclMarkTailcall(interp);
    TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL,NULL);
9499
9500
9501
9502
9503
9504
9505
9506
9507
9508
9509
9510
9511
9512
9513

    /*
     * Record the stackLevel at which the resume is happening, then swap
     * the interp's environment to make it suitable to run this coroutine.
     */

    corPtr->stackLevel = &corPtr;
    size_t numLevels = corPtr->auxNumLevels;
    corPtr->auxNumLevels = iPtr->numLevels;

    /*
     * Do the actual stack swap.
     */

    SAVE_CONTEXT(corPtr->caller);







|







9519
9520
9521
9522
9523
9524
9525
9526
9527
9528
9529
9530
9531
9532
9533

    /*
     * Record the stackLevel at which the resume is happening, then swap
     * the interp's environment to make it suitable to run this coroutine.
     */

    corPtr->stackLevel = &corPtr;
    Tcl_Size numLevels = corPtr->auxNumLevels;
    corPtr->auxNumLevels = iPtr->numLevels;

    /*
     * Do the actual stack swap.
     */

    SAVE_CONTEXT(corPtr->caller);
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
InjectHandler(
    void *data[],
    Tcl_Interp *interp,
    TCL_UNUSED(int) /*result*/)
{
    CoroutineData *corPtr = (CoroutineData *)data[0];
    Tcl_Obj *listPtr = (Tcl_Obj *)data[1];
    size_t nargs = PTR2INT(data[2]);
    void *isProbe = data[3];
    size_t objc;
    Tcl_Obj **objv;

    if (!isProbe) {
        /*
         * If this is [coroinject], add the extra arguments now.
         */

        if (nargs == COROUTINE_ARGUMENTS_SINGLE_OPTIONAL) {
            Tcl_ListObjAppendElement(NULL, listPtr,
                    Tcl_NewStringObj("yield", -1));
        } else if (nargs == COROUTINE_ARGUMENTS_ARBITRARY) {
            Tcl_ListObjAppendElement(NULL, listPtr,
                    Tcl_NewStringObj("yieldto", -1));
        } else {
            /*
             * I don't think this is reachable...
             */


            Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewWideIntObj((Tcl_WideInt)(nargs + 1U) - 1));
        }
        Tcl_ListObjAppendElement(NULL, listPtr, Tcl_GetObjResult(interp));
    }

    /*
     * Call the user's script; we're in the right place.
     */

    Tcl_IncrRefCount(listPtr);







|

|



|
|
|

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







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
InjectHandler(
    void *data[],
    Tcl_Interp *interp,
    TCL_UNUSED(int) /*result*/)
{
    CoroutineData *corPtr = (CoroutineData *)data[0];
    Tcl_Obj *listPtr = (Tcl_Obj *)data[1];
    Tcl_Size nargs = PTR2INT(data[2]);
    void *isProbe = data[3];
    Tcl_Size objc;
    Tcl_Obj **objv;

    if (!isProbe) {
	/*
	 * If this is [coroinject], add the extra arguments now.
	 */

	if (nargs == COROUTINE_ARGUMENTS_SINGLE_OPTIONAL) {
	    Tcl_ListObjAppendElement(NULL, listPtr,
		    Tcl_NewStringObj("yield", TCL_INDEX_NONE));
	} else if (nargs == COROUTINE_ARGUMENTS_ARBITRARY) {
	    Tcl_ListObjAppendElement(NULL, listPtr,
		    Tcl_NewStringObj("yieldto", TCL_INDEX_NONE));
	} else {
	    /*
	     * I don't think this is reachable...
	     */
	    Tcl_Obj *nargsObj;
	    TclNewIndexObj(nargsObj, nargs);
	    Tcl_ListObjAppendElement(NULL, listPtr, nargsObj);
	}
	Tcl_ListObjAppendElement(NULL, listPtr, Tcl_GetObjResult(interp));
    }

    /*
     * Call the user's script; we're in the right place.
     */

    Tcl_IncrRefCount(listPtr);
9589
9590
9591
9592
9593
9594
9595
9596
9597
9598
9599
9600
9601
9602
9603
InjectHandlerPostCall(
    void *data[],
    Tcl_Interp *interp,
    int result)
{
    CoroutineData *corPtr = (CoroutineData *)data[0];
    Tcl_Obj *listPtr = (Tcl_Obj *)data[1];
    size_t nargs = PTR2INT(data[2]);
    void *isProbe = data[3];

    /*
     * Delete the command words for what we just executed.
     */

    Tcl_DecrRefCount(listPtr);







|







9610
9611
9612
9613
9614
9615
9616
9617
9618
9619
9620
9621
9622
9623
9624
InjectHandlerPostCall(
    void *data[],
    Tcl_Interp *interp,
    int result)
{
    CoroutineData *corPtr = (CoroutineData *)data[0];
    Tcl_Obj *listPtr = (Tcl_Obj *)data[1];
    Tcl_Size nargs = PTR2INT(data[2]);
    void *isProbe = data[3];

    /*
     * Delete the command words for what we just executed.
     */

    Tcl_DecrRefCount(listPtr);
9612
9613
9614
9615
9616
9617
9618
9619
9620
9621
9622
9623
9624
9625
9626
    if (isProbe) {
        if (result == TCL_ERROR) {
            Tcl_AddErrorInfo(interp,
                    "\n    (injected coroutine probe command)");
        }
        corPtr->nargs = nargs;
        corPtr->stackLevel = NULL;
        size_t numLevels = iPtr->numLevels;
        iPtr->numLevels = corPtr->auxNumLevels;
        corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels;
        iPtr->execEnvPtr = corPtr->callerEEPtr;
    }
    return result;
}








|







9633
9634
9635
9636
9637
9638
9639
9640
9641
9642
9643
9644
9645
9646
9647
    if (isProbe) {
        if (result == TCL_ERROR) {
            Tcl_AddErrorInfo(interp,
                    "\n    (injected coroutine probe command)");
        }
        corPtr->nargs = nargs;
        corPtr->stackLevel = NULL;
        Tcl_Size numLevels = iPtr->numLevels;
        iPtr->numLevels = corPtr->auxNumLevels;
        corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels;
        iPtr->execEnvPtr = corPtr->callerEEPtr;
    }
    return result;
}

9708
9709
9710
9711
9712
9713
9714
9715
9716
9717
9718
9719
9720
9721
9722
            Tcl_SetObjResult(interp, objv[1]);
        } else if (objc > 2) {
            Tcl_WrongNumArgs(interp, 1, objv, "?arg?");
            return TCL_ERROR;
        }
        break;
    default:
        if (corPtr->nargs + 1 != (size_t)objc) {
            Tcl_SetObjResult(interp,
                    Tcl_NewStringObj("wrong coro nargs; how did we get here? "
                    "not implemented!", -1));
            Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
            return TCL_ERROR;
        }
        /* fallthrough */







|







9729
9730
9731
9732
9733
9734
9735
9736
9737
9738
9739
9740
9741
9742
9743
            Tcl_SetObjResult(interp, objv[1]);
        } else if (objc > 2) {
            Tcl_WrongNumArgs(interp, 1, objv, "?arg?");
            return TCL_ERROR;
        }
        break;
    default:
        if (corPtr->nargs + 1 != objc) {
            Tcl_SetObjResult(interp,
                    Tcl_NewStringObj("wrong coro nargs; how did we get here? "
                    "not implemented!", -1));
            Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
            return TCL_ERROR;
        }
        /* fallthrough */
9829
9830
9831
9832
9833
9834
9835

9836
9837
9838
9839
9840
9841
9842

    corPtr->running.framePtr = iPtr->rootFramePtr;
    corPtr->running.varFramePtr = iPtr->rootFramePtr;
    corPtr->running.cmdFramePtr = NULL;
    corPtr->running.lineLABCPtr = corPtr->lineLABCPtr;
    corPtr->stackLevel = NULL;
    corPtr->auxNumLevels = 0;


    /*
     * Create the coro's execEnv, switch to it to push the exit and coro
     * command callbacks, then switch back.
     */

    corPtr->eePtr = TclCreateExecEnv(interp, CORO_STACK_INITIAL_SIZE);







>







9850
9851
9852
9853
9854
9855
9856
9857
9858
9859
9860
9861
9862
9863
9864

    corPtr->running.framePtr = iPtr->rootFramePtr;
    corPtr->running.varFramePtr = iPtr->rootFramePtr;
    corPtr->running.cmdFramePtr = NULL;
    corPtr->running.lineLABCPtr = corPtr->lineLABCPtr;
    corPtr->stackLevel = NULL;
    corPtr->auxNumLevels = 0;
    corPtr->yieldPtr = NULL;

    /*
     * Create the coro's execEnv, switch to it to push the exit and coro
     * command callbacks, then switch back.
     */

    corPtr->eePtr = TclCreateExecEnv(interp, CORO_STACK_INITIAL_SIZE);

Changes to generic/tclBinary.c.

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
#include <assert.h>

/*
 * The following constants are used by GetFormatSpec to indicate various
 * special conditions in the parsing of a format specifier.
 */

#define BINARY_ALL ((size_t)-1)		/* Use all elements in the argument. */
#define BINARY_NOCOUNT ((size_t)-2)	/* No count was specified in format. */

/*
 * The following flags may be ORed together and returned by GetFormatSpec
 */

#define BINARY_SIGNED 0		/* Field to be read as signed data */
#define BINARY_UNSIGNED 1	/* Field to be read as unsigned data */

/*
 * The following defines the maximum number of different (integer) numbers
 * placed in the object cache by 'binary scan' before it bails out and
 * switches back to Plan A (creating a new object for each value.)
 * Theoretically, it would be possible to keep the cache about for the values
 * that are already in it, but that makes the code slower in practise when
 * overflow happens, and makes little odds the rest of the time (as measured
 * on my machine.) It is also slower (on the sample I tried at least) to grow
 * the cache to hold all items we might want to put in it; presumably the
 * extra cost of managing the memory for the enlarged table outweighs the
 * benefit from allocating fewer objects. This is probably because as the
 * number of objects increases, the likelihood of reuse of any particular one
 * drops, and there is very little gain from larger maximum cache sizes (the







|
|


|










|







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
#include <assert.h>

/*
 * The following constants are used by GetFormatSpec to indicate various
 * special conditions in the parsing of a format specifier.
 */

#define BINARY_ALL -1		/* Use all elements in the argument. */
#define BINARY_NOCOUNT -2	/* No count was specified in format. */

/*
 * The following flags may be OR'ed together and returned by GetFormatSpec
 */

#define BINARY_SIGNED 0		/* Field to be read as signed data */
#define BINARY_UNSIGNED 1	/* Field to be read as unsigned data */

/*
 * The following defines the maximum number of different (integer) numbers
 * placed in the object cache by 'binary scan' before it bails out and
 * switches back to Plan A (creating a new object for each value.)
 * Theoretically, it would be possible to keep the cache about for the values
 * that are already in it, but that makes the code slower in practice when
 * overflow happens, and makes little odds the rest of the time (as measured
 * on my machine.) It is also slower (on the sample I tried at least) to grow
 * the cache to hold all items we might want to put in it; presumably the
 * extra cost of managing the memory for the enlarged table outweighs the
 * benefit from allocating fewer objects. This is probably because as the
 * number of objects increases, the likelihood of reuse of any particular one
 * drops, and there is very little gain from larger maximum cache sizes (the
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74

static void		DupProperByteArrayInternalRep(Tcl_Obj *srcPtr,
			    Tcl_Obj *copyPtr);
static int		FormatNumber(Tcl_Interp *interp, int type,
			    Tcl_Obj *src, unsigned char **cursorPtr);
static void		FreeProperByteArrayInternalRep(Tcl_Obj *objPtr);
static int		GetFormatSpec(const char **formatPtr, char *cmdPtr,
			    size_t *countPtr, int *flagsPtr);
static Tcl_Obj *	ScanNumber(unsigned char *buffer, int type,
			    int flags, Tcl_HashTable **numberCachePtr);
static int		SetByteArrayFromAny(Tcl_Interp *interp, size_t limit,
			    Tcl_Obj *objPtr);
static void		UpdateStringOfByteArray(Tcl_Obj *listPtr);
static void		DeleteScanNumberCache(Tcl_HashTable *numberCachePtr);
static int		NeedReversing(int format);
static void		CopyNumber(const void *from, void *to,
			    size_t length, int type);
/* Binary ensemble commands */







|


|







57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74

static void		DupProperByteArrayInternalRep(Tcl_Obj *srcPtr,
			    Tcl_Obj *copyPtr);
static int		FormatNumber(Tcl_Interp *interp, int type,
			    Tcl_Obj *src, unsigned char **cursorPtr);
static void		FreeProperByteArrayInternalRep(Tcl_Obj *objPtr);
static int		GetFormatSpec(const char **formatPtr, char *cmdPtr,
			    Tcl_Size *countPtr, int *flagsPtr);
static Tcl_Obj *	ScanNumber(unsigned char *buffer, int type,
			    int flags, Tcl_HashTable **numberCachePtr);
static int		SetByteArrayFromAny(Tcl_Interp *interp, Tcl_Size limit,
			    Tcl_Obj *objPtr);
static void		UpdateStringOfByteArray(Tcl_Obj *listPtr);
static void		DeleteScanNumberCache(Tcl_HashTable *numberCachePtr);
static int		NeedReversing(int format);
static void		CopyNumber(const void *from, void *to,
			    size_t length, int type);
/* Binary ensemble commands */
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
 */

static const Tcl_ObjType properByteArrayType = {
    "bytearray",
    FreeProperByteArrayInternalRep,
    DupProperByteArrayInternalRep,
    UpdateStringOfByteArray,
    NULL

};

/*
 * The following structure is the internal rep for a ByteArray object. Keeps
 * track of how much memory has been used and how much has been allocated for
 * the byte array to enable growing and shrinking of the ByteArray object with
 * fewer mallocs.
 */

typedef struct {
    size_t used;		/* The number of bytes used in the byte
				 * array. */
    size_t allocated;		/* The amount of space actually allocated
				 * minus 1 byte. */
    unsigned char bytes[TCLFLEXARRAY];	/* The array of bytes. The actual size of this
				 * field depends on the 'allocated' field
				 * above. */
} ByteArray;


#define BYTEARRAY_SIZE(len) \
	( (offsetof(ByteArray, bytes) + (len) < offsetof(ByteArray, bytes)) \

	? (Tcl_Panic("max size of a Tcl value exceeded"), 0) \
	: (offsetof(ByteArray, bytes) + (len)) )
#define GET_BYTEARRAY(irPtr) ((ByteArray *) (irPtr)->twoPtrValue.ptr1)
#define SET_BYTEARRAY(irPtr, baPtr) \
		(irPtr)->twoPtrValue.ptr1 = (baPtr)

int
TclIsPureByteArray(







|
>










|

|






>

<
>
|







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

static const Tcl_ObjType properByteArrayType = {
    "bytearray",
    FreeProperByteArrayInternalRep,
    DupProperByteArrayInternalRep,
    UpdateStringOfByteArray,
    NULL,
    TCL_OBJTYPE_V0
};

/*
 * The following structure is the internal rep for a ByteArray object. Keeps
 * track of how much memory has been used and how much has been allocated for
 * the byte array to enable growing and shrinking of the ByteArray object with
 * fewer mallocs.
 */

typedef struct {
    Tcl_Size used;		/* The number of bytes used in the byte
				 * array. */
    Tcl_Size allocated;		/* The amount of space actually allocated
				 * minus 1 byte. */
    unsigned char bytes[TCLFLEXARRAY];	/* The array of bytes. The actual size of this
				 * field depends on the 'allocated' field
				 * above. */
} ByteArray;

#define BYTEARRAY_MAX_LEN (TCL_SIZE_MAX - (Tcl_Size)offsetof(ByteArray, bytes))
#define BYTEARRAY_SIZE(len) \

        ( (len < 0 || BYTEARRAY_MAX_LEN < (len)) \
	? (Tcl_Panic("negative length specified or max size of a Tcl value exceeded"), 0) \
	: (offsetof(ByteArray, bytes) + (len)) )
#define GET_BYTEARRAY(irPtr) ((ByteArray *) (irPtr)->twoPtrValue.ptr1)
#define SET_BYTEARRAY(irPtr, baPtr) \
		(irPtr)->twoPtrValue.ptr1 = (baPtr)

int
TclIsPureByteArray(
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231

#undef Tcl_NewByteArrayObj

Tcl_Obj *
Tcl_NewByteArrayObj(
    const unsigned char *bytes,	/* The array of bytes used to initialize the
				 * new object. */
    size_t numBytes)		/* Number of bytes in the array */
{
#ifdef TCL_MEM_DEBUG
    return Tcl_DbNewByteArrayObj(bytes, numBytes, "unknown", 0);
#else /* if not TCL_MEM_DEBUG */
    Tcl_Obj *objPtr;

    TclNewObj(objPtr);







|







219
220
221
222
223
224
225
226
227
228
229
230
231
232
233

#undef Tcl_NewByteArrayObj

Tcl_Obj *
Tcl_NewByteArrayObj(
    const unsigned char *bytes,	/* The array of bytes used to initialize the
				 * new object. */
    Tcl_Size numBytes)		/* Number of bytes in the array */
{
#ifdef TCL_MEM_DEBUG
    return Tcl_DbNewByteArrayObj(bytes, numBytes, "unknown", 0);
#else /* if not TCL_MEM_DEBUG */
    Tcl_Obj *objPtr;

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

#ifdef TCL_MEM_DEBUG
Tcl_Obj *
Tcl_DbNewByteArrayObj(
    const unsigned char *bytes,	/* The array of bytes used to initialize the
				 * new object. */
    size_t numBytes,		/* Number of bytes in the array */
    const char *file,		/* The name of the source file calling this
				 * procedure; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
    Tcl_Obj *objPtr;

    TclDbNewObj(objPtr, file, line);
    Tcl_SetByteArrayObj(objPtr, bytes, numBytes);
    return objPtr;
}
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
Tcl_DbNewByteArrayObj(
    const unsigned char *bytes,	/* The array of bytes used to initialize the
				 * new object. */
    size_t numBytes,		/* Number of bytes in the array */
    TCL_UNUSED(const char *) /*file*/,
    TCL_UNUSED(int) /*line*/)
{
    return Tcl_NewByteArrayObj(bytes, numBytes);
}
#endif /* TCL_MEM_DEBUG */








|
















|







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

#ifdef TCL_MEM_DEBUG
Tcl_Obj *
Tcl_DbNewByteArrayObj(
    const unsigned char *bytes,	/* The array of bytes used to initialize the
				 * new object. */
    Tcl_Size numBytes,		/* Number of bytes in the array */
    const char *file,		/* The name of the source file calling this
				 * procedure; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
    Tcl_Obj *objPtr;

    TclDbNewObj(objPtr, file, line);
    Tcl_SetByteArrayObj(objPtr, bytes, numBytes);
    return objPtr;
}
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
Tcl_DbNewByteArrayObj(
    const unsigned char *bytes,	/* The array of bytes used to initialize the
				 * new object. */
    Tcl_Size numBytes,		/* Number of bytes in the array */
    TCL_UNUSED(const char *) /*file*/,
    TCL_UNUSED(int) /*line*/)
{
    return Tcl_NewByteArrayObj(bytes, numBytes);
}
#endif /* TCL_MEM_DEBUG */

308
309
310
311
312
313
314
315

316
317
318
319
320
321
322
323
324

325
326
327
328
329
330
331
 */

void
Tcl_SetByteArrayObj(
    Tcl_Obj *objPtr,		/* Object to initialize as a ByteArray. */
    const unsigned char *bytes,	/* The array of bytes to use as the new value.
				 * May be NULL even if numBytes > 0. */
    size_t numBytes)		/* Number of bytes in the array */

{
    ByteArray *byteArrayPtr;
    Tcl_ObjInternalRep ir;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayObj");
    }
    TclInvalidateStringRep(objPtr);


    byteArrayPtr = (ByteArray *)Tcl_Alloc(BYTEARRAY_SIZE(numBytes));
    byteArrayPtr->used = numBytes;
    byteArrayPtr->allocated = numBytes;

    if ((bytes != NULL) && (numBytes > 0)) {
	memcpy(byteArrayPtr->bytes, bytes, numBytes);
    }







|
>









>







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

void
Tcl_SetByteArrayObj(
    Tcl_Obj *objPtr,		/* Object to initialize as a ByteArray. */
    const unsigned char *bytes,	/* The array of bytes to use as the new value.
				 * May be NULL even if numBytes > 0. */
    Tcl_Size numBytes)		/* Number of bytes in the array.
				 * Must be >= 0 */
{
    ByteArray *byteArrayPtr;
    Tcl_ObjInternalRep ir;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayObj");
    }
    TclInvalidateStringRep(objPtr);

    assert(numBytes >= 0);
    byteArrayPtr = (ByteArray *)Tcl_Alloc(BYTEARRAY_SIZE(numBytes));
    byteArrayPtr->used = numBytes;
    byteArrayPtr->allocated = numBytes;

    if ((bytes != NULL) && (numBytes > 0)) {
	memcpy(byteArrayPtr->bytes, bytes, numBytes);
    }
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
 */

#undef Tcl_GetBytesFromObj
unsigned char *
Tcl_GetBytesFromObj(
    Tcl_Interp *interp,		/* For error reporting */
    Tcl_Obj *objPtr,		/* Value to extract from */
    size_t *numBytesPtr)	/* If non-NULL, write the number of bytes
				 * in the array here */
{
    ByteArray *baPtr;
    const Tcl_ObjInternalRep *irPtr
	    = TclFetchInternalRep(objPtr, &properByteArrayType);

    if (irPtr == NULL) {
	if (TCL_ERROR == SetByteArrayFromAny(interp, TCL_INDEX_NONE, objPtr)) {
	    return NULL;
	}
	irPtr = TclFetchInternalRep(objPtr, &properByteArrayType);
    }
    baPtr = GET_BYTEARRAY(irPtr);

    if (numBytesPtr != NULL) {
	*numBytesPtr = baPtr->used;
    }
    return baPtr->bytes;
}


unsigned char *
TclGetBytesFromObj(
    Tcl_Interp *interp,		/* For error reporting */
    Tcl_Obj *objPtr,		/* Value to extract from */
    int *numBytesPtr)		/* If non-NULL, write the number of bytes
				 * in the array here */
{
    size_t numBytes = 0;
    unsigned char *bytes = Tcl_GetBytesFromObj(interp, objPtr, &numBytes);

    if (bytes && numBytesPtr) {
	if (numBytes > INT_MAX) {
	    /* Caller asked for numBytes to be written to an int, but the
	     * value is outside the int range. */

	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"byte sequence length exceeds INT_MAX", -1));
		Tcl_SetErrorCode(interp, "TCL", "API", "OUTDATED", NULL);
	    }
	    return NULL;
	} else {
	    *numBytesPtr = (int) numBytes;
	}
    }
    return bytes;
}

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







|




















>




|


|














|




>







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

#undef Tcl_GetBytesFromObj
unsigned char *
Tcl_GetBytesFromObj(
    Tcl_Interp *interp,		/* For error reporting */
    Tcl_Obj *objPtr,		/* Value to extract from */
    Tcl_Size *numBytesPtr)	/* If non-NULL, write the number of bytes
				 * in the array here */
{
    ByteArray *baPtr;
    const Tcl_ObjInternalRep *irPtr
	    = TclFetchInternalRep(objPtr, &properByteArrayType);

    if (irPtr == NULL) {
	if (TCL_ERROR == SetByteArrayFromAny(interp, TCL_INDEX_NONE, objPtr)) {
	    return NULL;
	}
	irPtr = TclFetchInternalRep(objPtr, &properByteArrayType);
    }
    baPtr = GET_BYTEARRAY(irPtr);

    if (numBytesPtr != NULL) {
	*numBytesPtr = baPtr->used;
    }
    return baPtr->bytes;
}

#if !defined(TCL_NO_DEPRECATED)
unsigned char *
TclGetBytesFromObj(
    Tcl_Interp *interp,		/* For error reporting */
    Tcl_Obj *objPtr,		/* Value to extract from */
    void *numBytesPtr)		/* If non-NULL, write the number of bytes
				 * in the array here */
{
    Tcl_Size numBytes = 0;
    unsigned char *bytes = Tcl_GetBytesFromObj(interp, objPtr, &numBytes);

    if (bytes && numBytesPtr) {
	if (numBytes > INT_MAX) {
	    /* Caller asked for numBytes to be written to an int, but the
	     * value is outside the int range. */

	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"byte sequence length exceeds INT_MAX", -1));
		Tcl_SetErrorCode(interp, "TCL", "API", "OUTDATED", NULL);
	    }
	    return NULL;
	} else {
	    *(int *)numBytesPtr = (int) numBytes;
	}
    }
    return bytes;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetByteArrayLength --
 *
 *	This procedure changes the length of the byte array for this object.
426
427
428
429
430
431
432
433

434
435
436
437

438
439
440
441
442
443
444
 *
 *----------------------------------------------------------------------
 */

unsigned char *
Tcl_SetByteArrayLength(
    Tcl_Obj *objPtr,		/* The ByteArray object. */
    size_t numBytes)		/* Number of bytes in resized array */

{
    ByteArray *byteArrayPtr;
    Tcl_ObjInternalRep *irPtr;


    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayLength");
    }

    irPtr = TclFetchInternalRep(objPtr, &properByteArrayType);
    if (irPtr == NULL) {
	if (TCL_ERROR == SetByteArrayFromAny(NULL, numBytes, objPtr)) {







|
>




>







432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
 *
 *----------------------------------------------------------------------
 */

unsigned char *
Tcl_SetByteArrayLength(
    Tcl_Obj *objPtr,		/* The ByteArray object. */
    Tcl_Size numBytes)		/* Number of bytes in resized array
                                 * Must be >= 0 */
{
    ByteArray *byteArrayPtr;
    Tcl_ObjInternalRep *irPtr;

    assert(numBytes >= 0);
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayLength");
    }

    irPtr = TclFetchInternalRep(objPtr, &properByteArrayType);
    if (irPtr == NULL) {
	if (TCL_ERROR == SetByteArrayFromAny(NULL, numBytes, objPtr)) {
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

/*
 *----------------------------------------------------------------------
 *
 * MakeByteArray --
 *
 *	Generate a ByteArray internal rep from the string rep of objPtr.
 *	The generated byte sequence may have no more than limit bytes. The
 *	value of TCL_INDEX_NONE for limit indicates no limit imposed. If
 *	boolean argument demandProper is true, then no byte sequence should
 *	be output to the caller (write NULL instead). When no bytes sequence
 *	is output and interp is not NULL, leave an error message and error
 *	code in interp explaining why a proper byte sequence could not be
 *	made.
 *
 * Results:
 *	Returns a boolean indicating whether the bytes generated (up to
 *	limit bytes) are a proper representation of (a limited prefix of)
 *	the string. Writes a pointer to the generated ByteArray to
 *	*byteArrayPtrPtr. If not NULL it needs to be released with Tcl_Free().
 *
 *----------------------------------------------------------------------
 */

static int
MakeByteArray(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,
    size_t limit,
    int demandProper,
    ByteArray **byteArrayPtrPtr)
{
    size_t length;
    const char *src = Tcl_GetStringFromObj(objPtr, &length);
    size_t numBytes
	    = (limit != TCL_INDEX_NONE && limit < length) ? limit : length;
    ByteArray *byteArrayPtr = (ByteArray *)Tcl_Alloc(BYTEARRAY_SIZE(numBytes));
    unsigned char *dst = byteArrayPtr->bytes;
    unsigned char *dstEnd = dst + numBytes;
    const char *srcEnd = src + length;
    int proper = 1;

    for (; src < srcEnd && dst < dstEnd; ) {







|
|



















|



|

<
|







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

/*
 *----------------------------------------------------------------------
 *
 * MakeByteArray --
 *
 *	Generate a ByteArray internal rep from the string rep of objPtr.
 *	The generated byte sequence may have no more than limit bytes.
 *	A negative value for limit indicates no limit imposed. If
 *	boolean argument demandProper is true, then no byte sequence should
 *	be output to the caller (write NULL instead). When no bytes sequence
 *	is output and interp is not NULL, leave an error message and error
 *	code in interp explaining why a proper byte sequence could not be
 *	made.
 *
 * Results:
 *	Returns a boolean indicating whether the bytes generated (up to
 *	limit bytes) are a proper representation of (a limited prefix of)
 *	the string. Writes a pointer to the generated ByteArray to
 *	*byteArrayPtrPtr. If not NULL it needs to be released with Tcl_Free().
 *
 *----------------------------------------------------------------------
 */

static int
MakeByteArray(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,
    Tcl_Size limit,
    int demandProper,
    ByteArray **byteArrayPtrPtr)
{
    Tcl_Size length;
    const char *src = Tcl_GetStringFromObj(objPtr, &length);

    Tcl_Size numBytes = (limit >= 0 && limit < length) ? limit : length;
    ByteArray *byteArrayPtr = (ByteArray *)Tcl_Alloc(BYTEARRAY_SIZE(numBytes));
    unsigned char *dst = byteArrayPtr->bytes;
    unsigned char *dstEnd = dst + numBytes;
    const char *srcEnd = src + length;
    int proper = 1;

    for (; src < srcEnd && dst < dstEnd; ) {
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
    byteArrayPtr->used = dst - byteArrayPtr->bytes;
    byteArrayPtr->allocated = numBytes;

    *byteArrayPtrPtr = byteArrayPtr;
    return proper;
}

Tcl_Obj *
TclNarrowToBytes(
    Tcl_Obj *objPtr)
{
    if (NULL == TclFetchInternalRep(objPtr, &properByteArrayType)) {
	Tcl_ObjInternalRep ir;
	ByteArray *byteArrayPtr;








|







532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
    byteArrayPtr->used = dst - byteArrayPtr->bytes;
    byteArrayPtr->allocated = numBytes;

    *byteArrayPtrPtr = byteArrayPtr;
    return proper;
}

static Tcl_Obj *
TclNarrowToBytes(
    Tcl_Obj *objPtr)
{
    if (NULL == TclFetchInternalRep(objPtr, &properByteArrayType)) {
	Tcl_ObjInternalRep ir;
	ByteArray *byteArrayPtr;

564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
 *
 *----------------------------------------------------------------------
 */

static int
SetByteArrayFromAny(
    Tcl_Interp *interp,		/* For error reporting. */
    size_t limit,		/* Create no more than this many bytes */
    Tcl_Obj *objPtr)		/* The object to convert to type ByteArray. */
{
    ByteArray *byteArrayPtr;
    Tcl_ObjInternalRep ir;

    if (0 == MakeByteArray(interp, objPtr, limit, 1, &byteArrayPtr)) {
	return TCL_ERROR;







|







571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
 *
 *----------------------------------------------------------------------
 */

static int
SetByteArrayFromAny(
    Tcl_Interp *interp,		/* For error reporting. */
    Tcl_Size limit,		/* Create no more than this many bytes */
    Tcl_Obj *objPtr)		/* The object to convert to type ByteArray. */
{
    ByteArray *byteArrayPtr;
    Tcl_ObjInternalRep ir;

    if (0 == MakeByteArray(interp, objPtr, limit, 1, &byteArrayPtr)) {
	return TCL_ERROR;
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
 */

static void
DupProperByteArrayInternalRep(
    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
    Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
{
    size_t length;
    ByteArray *srcArrayPtr, *copyArrayPtr;
    Tcl_ObjInternalRep ir;

    srcArrayPtr = GET_BYTEARRAY(TclFetchInternalRep(srcPtr, &properByteArrayType));
    length = srcArrayPtr->used;

    copyArrayPtr = (ByteArray *)Tcl_Alloc(BYTEARRAY_SIZE(length));







|







632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
 */

static void
DupProperByteArrayInternalRep(
    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
    Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
{
    Tcl_Size length;
    ByteArray *srcArrayPtr, *copyArrayPtr;
    Tcl_ObjInternalRep ir;

    srcArrayPtr = GET_BYTEARRAY(TclFetchInternalRep(srcPtr, &properByteArrayType));
    length = srcArrayPtr->used;

    copyArrayPtr = (ByteArray *)Tcl_Alloc(BYTEARRAY_SIZE(length));
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
UpdateStringOfByteArray(
    Tcl_Obj *objPtr)		/* ByteArray object whose string rep to
				 * update. */
{
    const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, &properByteArrayType);
    ByteArray *byteArrayPtr = GET_BYTEARRAY(irPtr);
    unsigned char *src = byteArrayPtr->bytes;
    size_t i, length = byteArrayPtr->used;
    size_t size = length;

    /*
     * How much space will string rep need?
     */

    for (i = 0; i < length; i++) {
	if ((src[i] == 0) || (src[i] > 127)) {







|
|







673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
UpdateStringOfByteArray(
    Tcl_Obj *objPtr)		/* ByteArray object whose string rep to
				 * update. */
{
    const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, &properByteArrayType);
    ByteArray *byteArrayPtr = GET_BYTEARRAY(irPtr);
    unsigned char *src = byteArrayPtr->bytes;
    Tcl_Size i, length = byteArrayPtr->used;
    Tcl_Size size = length;

    /*
     * How much space will string rep need?
     */

    for (i = 0; i < length; i++) {
	if ((src[i] == 0) || (src[i] > 127)) {
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
 *----------------------------------------------------------------------
 */

void
TclAppendBytesToByteArray(
    Tcl_Obj *objPtr,
    const unsigned char *bytes,
    size_t len)
{
    ByteArray *byteArrayPtr;
    size_t needed;
    Tcl_ObjInternalRep *irPtr;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray");
    }
    if (len == TCL_INDEX_NONE) {
	Tcl_Panic("%s must be called with definite number of bytes to append",
		"TclAppendBytesToByteArray");
    }
    if (len == 0) {
	/*
	 * Append zero bytes is a no-op.
	 */







|


|





|







723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
 *----------------------------------------------------------------------
 */

void
TclAppendBytesToByteArray(
    Tcl_Obj *objPtr,
    const unsigned char *bytes,
    Tcl_Size len)
{
    ByteArray *byteArrayPtr;
    Tcl_Size needed;
    Tcl_ObjInternalRep *irPtr;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray");
    }
    if (len < 0) {
	Tcl_Panic("%s must be called with definite number of bytes to append",
		"TclAppendBytesToByteArray");
    }
    if (len == 0) {
	/*
	 * Append zero bytes is a no-op.
	 */
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
    }
    byteArrayPtr = GET_BYTEARRAY(irPtr);

    /*
     * If we need to, resize the allocated space in the byte array.
     */

    needed = byteArrayPtr->used + len;
    if (needed < byteArrayPtr->used) {
	/* Wrapped around SIZE_MAX!! */
	Tcl_Panic("max size of a Tcl value exceeded");
    }

    if (needed > byteArrayPtr->allocated) {
	ByteArray *ptr = NULL;

        /*
	 * Try to allocate double the total space that is needed.
	 */

	size_t attempt = 2 * needed;

	/* Protection just in case we wrapped around SIZE_MAX */
	if (attempt >= needed) {
	    ptr = (ByteArray *) Tcl_AttemptRealloc(byteArrayPtr,
		    BYTEARRAY_SIZE(attempt));
	}
	if (ptr == NULL) {
	    /*
	     * Try to allocate double the increment that is needed (plus).
	     */

	    attempt = needed + len + TCL_MIN_GROWTH;
	    if (attempt >= needed) {
		ptr = (ByteArray *) Tcl_AttemptRealloc(byteArrayPtr,
			BYTEARRAY_SIZE(attempt));
	    }
	}
	if (ptr == NULL) {
	    /*
	     * Last chance: Try to allocate exactly what is needed.
	     */

	    attempt = needed;
	    ptr = (ByteArray *)Tcl_Realloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
	}
	byteArrayPtr = ptr;
	byteArrayPtr->allocated = attempt;
	SET_BYTEARRAY(irPtr, byteArrayPtr);
    }

    if (bytes) {
	memcpy(byteArrayPtr->bytes + byteArrayPtr->used, bytes, len);
    }
    byteArrayPtr->used += len;







<
|
|
|

>

<
|
<
<
<
|
<
|
<
|
<
<
<
<
<
<
<
|
<
<
|
<
<
<
<
<
<
<
|
<
<
<
<
|







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
    }
    byteArrayPtr = GET_BYTEARRAY(irPtr);

    /*
     * If we need to, resize the allocated space in the byte array.
     */


    if ((BYTEARRAY_MAX_LEN - byteArrayPtr->used) < len) {
	/* Will wrap around !! */
	Tcl_Panic("max size of a byte array exceeded");
    }
    needed = byteArrayPtr->used + len;
    if (needed > byteArrayPtr->allocated) {

	Tcl_Size newCapacity;



	byteArrayPtr =

	    (ByteArray *)TclReallocElemsEx(byteArrayPtr,

					   needed,







					   1,


					   offsetof(ByteArray, bytes),







					   &newCapacity);




	byteArrayPtr->allocated = newCapacity;
	SET_BYTEARRAY(irPtr, byteArrayPtr);
    }

    if (bytes) {
	memcpy(byteArrayPtr->bytes + byteArrayPtr->used, bytes, len);
    }
    byteArrayPtr->used += len;
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
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int arg;			/* Index of next argument to consume. */
    int value = 0;		/* Current integer value to be packed.
				 * Initialized to avoid compiler warning. */
    char cmd;			/* Current format character. */
    size_t count;			/* Count associated with current format
				 * character. */
    int flags;			/* Format field flags */
    const char *format;		/* Pointer to current position in format
				 * string. */
    Tcl_Obj *resultPtr = NULL;	/* Object holding result buffer. */
    unsigned char *buffer;	/* Start of result buffer. */
    unsigned char *cursor;	/* Current position within result buffer. */
    unsigned char *maxPos;	/* Greatest position within result buffer that
				 * cursor has visited.*/
    const char *errorString;
    const char *errorValue, *str;
    size_t offset, size, length;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "formatString ?arg ...?");
	return TCL_ERROR;
    }

    /*







|











|







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
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int arg;			/* Index of next argument to consume. */
    int value = 0;		/* Current integer value to be packed.
				 * Initialized to avoid compiler warning. */
    char cmd;			/* Current format character. */
    Tcl_Size count;		/* Count associated with current format
				 * character. */
    int flags;			/* Format field flags */
    const char *format;		/* Pointer to current position in format
				 * string. */
    Tcl_Obj *resultPtr = NULL;	/* Object holding result buffer. */
    unsigned char *buffer;	/* Start of result buffer. */
    unsigned char *cursor;	/* Current position within result buffer. */
    unsigned char *maxPos;	/* Greatest position within result buffer that
				 * cursor has visited.*/
    const char *errorString;
    const char *errorValue, *str;
    Tcl_Size offset, size, length;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "formatString ?arg ...?");
	return TCL_ERROR;
    }

    /*
907
908
909
910
911
912
913
914
915
916

917
918
919
920
921
922
923
	     * of bytes in a single argument.
	     */

	    if (arg >= objc) {
		goto badIndex;
	    }
	    if (count == BINARY_ALL) {
		Tcl_Obj *copy = TclNarrowToBytes(objv[arg]);
		(void)Tcl_GetByteArrayFromObj(copy, &count);
		Tcl_DecrRefCount(copy);

	    } else if (count == BINARY_NOCOUNT) {
		count = 1;
	    }
	    arg++;
	    if (cmd == 'a' || cmd == 'A') {
		offset += count;
	    } else if (cmd == 'b' || cmd == 'B') {







<
|
|
>







888
889
890
891
892
893
894

895
896
897
898
899
900
901
902
903
904
	     * of bytes in a single argument.
	     */

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

		if (Tcl_GetByteArrayFromObj(objv[arg], &count) == NULL) {
		    count = Tcl_GetCharLength(objv[arg]);
		}
	    } else if (count == BINARY_NOCOUNT) {
		count = 1;
	    }
	    arg++;
	    if (cmd == 'a' || cmd == 'A') {
		offset += count;
	    } else if (cmd == 'b' || cmd == 'B') {
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
	     * non-list value.
	     */

	    if (count == BINARY_NOCOUNT) {
		arg++;
		count = 1;
	    } else {
		size_t listc;
		Tcl_Obj **listv;

		/*
		 * The macro evals its args more than once: avoid arg++
		 */

		if (TclListObjGetElementsM(interp, objv[arg], &listc,
			&listv) != TCL_OK) {
		    return TCL_ERROR;
		}
		arg++;

		if (count == BINARY_ALL) {
		    count = listc;
		} else if (count > listc) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "number of elements in list does not match count",
			    -1));
		    return TCL_ERROR;
		}





	    }
	    offset += count*size;
	    break;

	case 'x':
	    if (count == BINARY_ALL) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(







|






|
|


<









>
>
>
>
>







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
	     * non-list value.
	     */

	    if (count == BINARY_NOCOUNT) {
		arg++;
		count = 1;
	    } else {
		Tcl_Size listc;
		Tcl_Obj **listv;

		/*
		 * The macro evals its args more than once: avoid arg++
		 */

		if (TclListObjLengthM(interp, objv[arg], &listc
			) != TCL_OK) {
		    return TCL_ERROR;
		}


		if (count == BINARY_ALL) {
		    count = listc;
		} else if (count > listc) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "number of elements in list does not match count",
			    -1));
		    return TCL_ERROR;
		}
		if (TclListObjGetElementsM(interp, objv[arg], &listc,
			&listv) != TCL_OK) {
		    return TCL_ERROR;
		}
		arg++;
	    }
	    offset += count*size;
	    break;

	case 'x':
	    if (count == BINARY_ALL) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
	length = offset;
    }
    if (length == 0) {
	return TCL_OK;
    }

    /*
     * Prepare the result object by preallocating the caclulated number of
     * bytes and filling with nulls.
     */

    TclNewObj(resultPtr);
    buffer = Tcl_SetByteArrayLength(resultPtr, length);
    memset(buffer, 0, length);








|







1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
	length = offset;
    }
    if (length == 0) {
	return TCL_OK;
    }

    /*
     * Prepare the result object by preallocating the calculated number of
     * bytes and filling with nulls.
     */

    TclNewObj(resultPtr);
    buffer = Tcl_SetByteArrayLength(resultPtr, length);
    memset(buffer, 0, length);

1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
	case 'W':
	case 'r':
	case 'R':
	case 'd':
	case 'q':
	case 'Q':
	case 'f': {
	    size_t listc, i;
	    Tcl_Obj **listv;

	    if (count == BINARY_NOCOUNT) {
		/*
		 * Note that we are casting away the const-ness of objv, but
		 * this is safe since we aren't going to modify the array.
		 */







|







1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
	case 'W':
	case 'r':
	case 'R':
	case 'd':
	case 'q':
	case 'Q':
	case 'f': {
	    Tcl_Size listc, i;
	    Tcl_Obj **listv;

	    if (count == BINARY_NOCOUNT) {
		/*
		 * Note that we are casting away the const-ness of objv, but
		 * this is safe since we aren't going to modify the array.
		 */
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
	case 'X':
	    if (cursor > maxPos) {
		maxPos = cursor;
	    }
	    if (count == BINARY_NOCOUNT) {
		count = 1;
	    }
	    if ((count == BINARY_ALL) || (count > (size_t)(cursor - buffer))) {
		cursor = buffer;
	    } else {
		cursor -= count;
	    }
	    break;
	case '@':
	    if (cursor > maxPos) {







|







1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
	case 'X':
	    if (cursor > maxPos) {
		maxPos = cursor;
	    }
	    if (count == BINARY_NOCOUNT) {
		count = 1;
	    }
	    if ((count == BINARY_ALL) || (count > (cursor - buffer))) {
		cursor = buffer;
	    } else {
		cursor -= count;
	    }
	    break;
	case '@':
	    if (cursor > maxPos) {
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int arg;			/* Index of next argument to consume. */
    int value = 0;		/* Current integer value to be packed.
				 * Initialized to avoid compiler warning. */
    char cmd;			/* Current format character. */
    size_t count;			/* Count associated with current format
				 * character. */
    int flags;			/* Format field flags */
    const char *format;		/* Pointer to current position in format
				 * string. */
    Tcl_Obj *resultPtr = NULL;	/* Object holding result buffer. */
    unsigned char *buffer;	/* Start of result buffer. */
    const char *errorString;
    const char *str;
    size_t offset, size, length = 0, i;

    Tcl_Obj *valuePtr, *elementPtr;
    Tcl_HashTable numberCacheHash;
    Tcl_HashTable *numberCachePtr;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv,







|








|







1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int arg;			/* Index of next argument to consume. */
    int value = 0;		/* Current integer value to be packed.
				 * Initialized to avoid compiler warning. */
    char cmd;			/* Current format character. */
    Tcl_Size count;		/* Count associated with current format
				 * character. */
    int flags;			/* Format field flags */
    const char *format;		/* Pointer to current position in format
				 * string. */
    Tcl_Obj *resultPtr = NULL;	/* Object holding result buffer. */
    unsigned char *buffer;	/* Start of result buffer. */
    const char *errorString;
    const char *str;
    Tcl_Size offset, size, length = 0, i;

    Tcl_Obj *valuePtr, *elementPtr;
    Tcl_HashTable numberCacheHash;
    Tcl_HashTable *numberCachePtr;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv,
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
	    }
	    if (count == BINARY_ALL) {
		count = (length - offset) * 8;
	    } else {
		if (count == BINARY_NOCOUNT) {
		    count = 1;
		}
		if (count > (size_t)(length - offset) * 8) {
		    goto done;
		}
	    }
	    src = buffer + offset;
	    TclNewObj(valuePtr);
	    Tcl_SetObjLength(valuePtr, count);
	    dest = TclGetString(valuePtr);







|







1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
	    }
	    if (count == BINARY_ALL) {
		count = (length - offset) * 8;
	    } else {
		if (count == BINARY_NOCOUNT) {
		    count = 1;
		}
		if (count > (length - offset) * 8) {
		    goto done;
		}
	    }
	    src = buffer + offset;
	    TclNewObj(valuePtr);
	    Tcl_SetObjLength(valuePtr, count);
	    dest = TclGetString(valuePtr);
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628

	scanNumber:
	    if (arg >= objc) {
		DeleteScanNumberCache(numberCachePtr);
		goto badIndex;
	    }
	    if (count == BINARY_NOCOUNT) {
		if (length < (size_t)size + offset) {
		    goto done;
		}
		valuePtr = ScanNumber(buffer+offset, cmd, flags,
			&numberCachePtr);
		offset += size;
	    } else {
		if (count == BINARY_ALL) {







|







1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613

	scanNumber:
	    if (arg >= objc) {
		DeleteScanNumberCache(numberCachePtr);
		goto badIndex;
	    }
	    if (count == BINARY_NOCOUNT) {
		if (length < size + offset) {
		    goto done;
		}
		valuePtr = ScanNumber(buffer+offset, cmd, flags,
			&numberCachePtr);
		offset += size;
	    } else {
		if (count == BINARY_ALL) {
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
 *----------------------------------------------------------------------
 */

static int
GetFormatSpec(
    const char **formatPtr,	/* Pointer to format string. */
    char *cmdPtr,		/* Pointer to location of command char. */
    size_t *countPtr,		/* Pointer to repeat count value. */
    int *flagsPtr)		/* Pointer to field flags */
{
    /*
     * Skip any leading blanks.
     */

    while (**formatPtr == ' ') {







|







1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
 *----------------------------------------------------------------------
 */

static int
GetFormatSpec(
    const char **formatPtr,	/* Pointer to format string. */
    char *cmdPtr,		/* Pointer to location of command char. */
    Tcl_Size *countPtr,		/* Pointer to repeat count value. */
    int *flagsPtr)		/* Pointer to field flags */
{
    /*
     * Skip any leading blanks.
     */

    while (**formatPtr == ' ') {
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
	(*formatPtr)++;
	*flagsPtr |= BINARY_UNSIGNED;
    }
    if (**formatPtr == '*') {
	(*formatPtr)++;
	*countPtr = BINARY_ALL;
    } else if (isdigit(UCHAR(**formatPtr))) { /* INTL: digit */
	unsigned long count;

	errno = 0;
	count = strtoul(*formatPtr, (char **) formatPtr, 10);
	if (errno || (count > (unsigned long) INT_MAX)) {
	    *countPtr = INT_MAX;
	} else {
	    *countPtr = (int) count;
	}
    } else {
	*countPtr = BINARY_NOCOUNT;
    }
    return 1;
}

/*
 *----------------------------------------------------------------------
 *
 * NeedReversing --
 *
 *	This routine determines, if bytes of a number need to be re-ordered,
 *	and returns a numeric code indicating the re-ordering to be done.
 *	This depends on the endiannes of the machine and the desired format.
 *	It is in effect a table (whose contents depend on the endianness of
 *	the system) describing whether a value needs reversing or not. Anyone
 *	porting the code to a big-endian platform should take care to make
 *	sure that they define WORDS_BIGENDIAN though this is already done by
 *	configure for the Unix build; little-endian platforms (including
 *	Windows) don't need to do anything.
 *







|


|
|
|

|














|







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
	(*formatPtr)++;
	*flagsPtr |= BINARY_UNSIGNED;
    }
    if (**formatPtr == '*') {
	(*formatPtr)++;
	*countPtr = BINARY_ALL;
    } else if (isdigit(UCHAR(**formatPtr))) { /* INTL: digit */
	unsigned long long count;

	errno = 0;
	count = strtoull(*formatPtr, (char **) formatPtr, 10);
	if (errno || (count > TCL_SIZE_MAX)) {
	    *countPtr = TCL_SIZE_MAX;
	} else {
	    *countPtr = count;
	}
    } else {
	*countPtr = BINARY_NOCOUNT;
    }
    return 1;
}

/*
 *----------------------------------------------------------------------
 *
 * NeedReversing --
 *
 *	This routine determines, if bytes of a number need to be re-ordered,
 *	and returns a numeric code indicating the re-ordering to be done.
 *	This depends on the endianness of the machine and the desired format.
 *	It is in effect a table (whose contents depend on the endianness of
 *	the system) describing whether a value needs reversing or not. Anyone
 *	porting the code to a big-endian platform should take care to make
 *	sure that they define WORDS_BIGENDIAN though this is already done by
 *	configure for the Unix build; little-endian platforms (including
 *	Windows) don't need to do anything.
 *
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *resultObj = NULL;
    unsigned char *data = NULL;
    unsigned char *cursor = NULL;
    size_t offset = 0, count = 0;

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

    data = Tcl_GetBytesFromObj(interp, objv[1], &count);







|







2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *resultObj = NULL;
    unsigned char *data = NULL;
    unsigned char *cursor = NULL;
    Tcl_Size offset = 0, count = 0;

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

    data = Tcl_GetBytesFromObj(interp, objv[1], &count);
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *resultObj = NULL;
    unsigned char *data, *datastart, *dataend;
    unsigned char *begin, *cursor, c;
    int i, index, value, pure = 1, strict = 0;
    size_t size, cut = 0, count = 0;
    int ucs4;
    enum {OPT_STRICT };
    static const char *const optStrings[] = { "-strict", NULL };

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?options? data");
	return TCL_ERROR;







|







2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *resultObj = NULL;
    unsigned char *data, *datastart, *dataend;
    unsigned char *begin, *cursor, c;
    int i, index, value, pure = 1, strict = 0;
    Tcl_Size size, cut = 0, count = 0;
    int ucs4;
    enum {OPT_STRICT };
    static const char *const optStrings[] = { "-strict", NULL };

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?options? data");
	return TCL_ERROR;
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
	case OPT_STRICT:
	    strict = 1;
	    break;
	}
    }

    TclNewObj(resultObj);
    data = Tcl_GetBytesFromObj(NULL, objv[objc - 1], &count);
    if (data == NULL) {
	pure = 0;
	data = (unsigned char *) Tcl_GetStringFromObj(objv[objc - 1], &count);
    }
    datastart = data;
    dataend = data + count;
    size = (count + 1) / 2;







|







2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
	case OPT_STRICT:
	    strict = 1;
	    break;
	}
    }

    TclNewObj(resultObj);
    data = Tcl_GetByteArrayFromObj(objv[objc - 1], &count);
    if (data == NULL) {
	pure = 0;
	data = (unsigned char *) Tcl_GetStringFromObj(objv[objc - 1], &count);
    }
    datastart = data;
    dataend = data + count;
    size = (count + 1) / 2;
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
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *resultObj;
    unsigned char *data, *limit;
    int maxlen = 0;
    const char *wrapchar = "\n";
    size_t wrapcharlen = 1;
    int i, index, size, outindex = 0, purewrap = 1;
    size_t offset, count = 0;
    enum { OPT_MAXLEN, OPT_WRAPCHAR };
    static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL };

    if (objc < 2 || objc % 2 != 0) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-maxlen len? ?-wrapchar char? data");
	return TCL_ERROR;
    }
    for (i = 1; i < objc - 1; i += 2) {
	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
		TCL_EXACT, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (index) {
	case OPT_MAXLEN:
	    if (Tcl_GetIntFromObj(interp, objv[i + 1], &maxlen) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (maxlen < 0) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"line length out of range", -1));
		Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE",
			"LINE_LENGTH", NULL);
		return TCL_ERROR;
	    }
	    break;
	case OPT_WRAPCHAR:
	    wrapchar = (const char *)Tcl_GetBytesFromObj(NULL,
		    objv[i + 1], &wrapcharlen);
	    if (wrapchar == NULL) {
		purewrap = 0;
		wrapchar = Tcl_GetStringFromObj(objv[i + 1], &wrapcharlen);
	    }
	    break;
	}







|

|
|
|















|











|







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
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *resultObj;
    unsigned char *data, *limit;
    Tcl_Size maxlen = 0;
    const char *wrapchar = "\n";
    Tcl_Size wrapcharlen = 1;
    int index, purewrap = 1;
    Tcl_Size i, offset, size, outindex = 0, count = 0;
    enum { OPT_MAXLEN, OPT_WRAPCHAR };
    static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL };

    if (objc < 2 || objc % 2 != 0) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-maxlen len? ?-wrapchar char? data");
	return TCL_ERROR;
    }
    for (i = 1; i < objc - 1; i += 2) {
	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
		TCL_EXACT, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (index) {
	case OPT_MAXLEN:
	    if (TclGetSizeIntFromObj(interp, objv[i + 1], &maxlen) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (maxlen < 0) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"line length out of range", -1));
		Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE",
			"LINE_LENGTH", NULL);
		return TCL_ERROR;
	    }
	    break;
	case OPT_WRAPCHAR:
	    wrapchar = (const char *)Tcl_GetByteArrayFromObj(
		    objv[i + 1], &wrapcharlen);
	    if (wrapchar == NULL) {
		purewrap = 0;
		wrapchar = Tcl_GetStringFromObj(objv[i + 1], &wrapcharlen);
	    }
	    break;
	}
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *resultObj;
    unsigned char *data, *start, *cursor;
    int rawLength, i, bits, index;
    unsigned int n;
    int lineLength = 61;
    const unsigned char SingleNewline[] = { UCHAR('\n') };
    const unsigned char *wrapchar = SingleNewline;
    size_t j, offset, count = 0, wrapcharlen = sizeof(SingleNewline);
    enum { OPT_MAXLEN, OPT_WRAPCHAR };
    static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL };

    if (objc < 2 || objc % 2 != 0) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-maxlen len? ?-wrapchar char? data");
	return TCL_ERROR;







|




|







2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *resultObj;
    unsigned char *data, *start, *cursor;
    int i, bits, index;
    unsigned int n;
    int lineLength = 61;
    const unsigned char SingleNewline[] = { UCHAR('\n') };
    const unsigned char *wrapchar = SingleNewline;
    Tcl_Size j, rawLength, offset, count = 0, wrapcharlen = sizeof(SingleNewline);
    enum { OPT_MAXLEN, OPT_WRAPCHAR };
    static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL };

    if (objc < 2 || objc % 2 != 0) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-maxlen len? ?-wrapchar char? data");
	return TCL_ERROR;
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
	    lineLength = ((lineLength - 1) & -4) + 1; /* 5, 9, 13 ... */
	    break;
	case OPT_WRAPCHAR:
	    wrapchar = (const unsigned char *) Tcl_GetStringFromObj(
		    objv[i + 1], &wrapcharlen);
	    {
		const unsigned char *p = wrapchar;
		size_t numBytes = wrapcharlen;

		while (numBytes) {
		    switch (*p) {
			case '\t':
			case '\v':
			case '\f':
			case '\r':







|







2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
	    lineLength = ((lineLength - 1) & -4) + 1; /* 5, 9, 13 ... */
	    break;
	case OPT_WRAPCHAR:
	    wrapchar = (const unsigned char *) Tcl_GetStringFromObj(
		    objv[i + 1], &wrapcharlen);
	    {
		const unsigned char *p = wrapchar;
		Tcl_Size numBytes = wrapcharlen;

		while (numBytes) {
		    switch (*p) {
			case '\t':
			case '\v':
			case '\f':
			case '\r':
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
     * Encode the data. Each output line first has the length of raw data
     * encoded by the output line described in it by one encoded byte, then
     * the encoded data follows (encoding each 6 bits as one character).
     * Encoded lines are always terminated by a newline.
     */

    while (offset < count) {
	int lineLen = count - offset;

	if (lineLen > rawLength) {
	    lineLen = rawLength;
	}
	*cursor++ = UueDigits[lineLen];
	for (i = 0 ; i < lineLen ; i++) {
	    n <<= 8;







|







2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
     * Encode the data. Each output line first has the length of raw data
     * encoded by the output line described in it by one encoded byte, then
     * the encoded data follows (encoding each 6 bits as one character).
     * Encoded lines are always terminated by a newline.
     */

    while (offset < count) {
	Tcl_Size lineLen = count - offset;

	if (lineLen > rawLength) {
	    lineLen = rawLength;
	}
	*cursor++ = UueDigits[lineLen];
	for (i = 0 ; i < lineLen ; i++) {
	    n <<= 8;
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *resultObj = NULL;
    unsigned char *data, *datastart, *dataend;
    unsigned char *begin, *cursor;
    int i, index, pure = 1, strict = 0, lineLen;
    size_t size, count = 0;
    unsigned char c;
    int ucs4;
    enum { OPT_STRICT };
    static const char *const optStrings[] = { "-strict", NULL };

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?options? data");







|







2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *resultObj = NULL;
    unsigned char *data, *datastart, *dataend;
    unsigned char *begin, *cursor;
    int i, index, pure = 1, strict = 0, lineLen;
    Tcl_Size size, count = 0;
    unsigned char c;
    int ucs4;
    enum { OPT_STRICT };
    static const char *const optStrings[] = { "-strict", NULL };

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?options? data");
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
	case OPT_STRICT:
	    strict = 1;
	    break;
	}
    }

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







|







2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
	case OPT_STRICT:
	    strict = 1;
	    break;
	}
    }

    TclNewObj(resultObj);
    data = Tcl_GetByteArrayFromObj(objv[objc - 1], &count);
    if (data == NULL) {
	pure = 0;
	data = (unsigned char *) Tcl_GetStringFromObj(objv[objc - 1], &count);
    }
    datastart = data;
    dataend = data + count;
    size = ((count + 3) & ~3) * 3 / 4;
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
{
    Tcl_Obj *resultObj = NULL;
    unsigned char *data, *datastart, *dataend, c = '\0';
    unsigned char *begin = NULL;
    unsigned char *cursor = NULL;
    int pure = 1, strict = 0;
    int i, index, cut = 0;
    size_t size, count = 0;
    int ucs4;
    enum { OPT_STRICT };
    static const char *const optStrings[] = { "-strict", NULL };

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?options? data");
	return TCL_ERROR;







|







3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
{
    Tcl_Obj *resultObj = NULL;
    unsigned char *data, *datastart, *dataend, c = '\0';
    unsigned char *begin = NULL;
    unsigned char *cursor = NULL;
    int pure = 1, strict = 0;
    int i, index, cut = 0;
    Tcl_Size size, count = 0;
    int ucs4;
    enum { OPT_STRICT };
    static const char *const optStrings[] = { "-strict", NULL };

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?options? data");
	return TCL_ERROR;
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
	case OPT_STRICT:
	    strict = 1;
	    break;
	}
    }

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







|







3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
	case OPT_STRICT:
	    strict = 1;
	    break;
	}
    }

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

Changes to generic/tclCkalloc.c.

12
13
14
15
16
17
18

19
20
21
22
23
24
25
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * This code contributed by Karl Lehenbauer and Mark Diekhans
 */

#include "tclInt.h"


#define FALSE	0
#define TRUE	1

#undef Tcl_Alloc
#undef Tcl_Free
#undef Tcl_Realloc







>







12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * This code contributed by Karl Lehenbauer and Mark Diekhans
 */

#include "tclInt.h"
#include <assert.h>

#define FALSE	0
#define TRUE	1

#undef Tcl_Alloc
#undef Tcl_Free
#undef Tcl_Realloc
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
    int flags)
{
    char buf[1024];

    if (clientData == NULL) {
        return 0;
    }
    sprintf(buf,
	    "total mallocs             %10" TCL_Z_MODIFIER "u\n"
	    "total frees               %10" TCL_Z_MODIFIER "u\n"
	    "current packets allocated %10" TCL_Z_MODIFIER "u\n"
	    "current bytes allocated   %10" TCL_Z_MODIFIER "u\n"
	    "maximum packets allocated %10" TCL_Z_MODIFIER "u\n"
	    "maximum bytes allocated   %10" TCL_Z_MODIFIER "u\n",
	    total_mallocs,







|







169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
    int flags)
{
    char buf[1024];

    if (clientData == NULL) {
        return 0;
    }
    snprintf(buf, sizeof(buf),
	    "total mallocs             %10" TCL_Z_MODIFIER "u\n"
	    "total frees               %10" TCL_Z_MODIFIER "u\n"
	    "current packets allocated %10" TCL_Z_MODIFIER "u\n"
	    "current bytes allocated   %10" TCL_Z_MODIFIER "u\n"
	    "maximum packets allocated %10" TCL_Z_MODIFIER "u\n"
	    "maximum bytes allocated   %10" TCL_Z_MODIFIER "u\n",
	    total_mallocs,
1228
1229
1230
1231
1232
1233
1234














































































































































1235
1236
1237
1238
1239
1240
1241
    TCL_UNUSED(void *),
    TCL_UNUSED(int) /*flags*/)
{
    return 1;
}

#endif	/* TCL_MEM_DEBUG */















































































































































/*
 *---------------------------------------------------------------------------
 *
 * TclFinalizeMemorySubsystem --
 *
 *	This procedure is called to finalize all the structures that are used







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







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
    TCL_UNUSED(void *),
    TCL_UNUSED(int) /*flags*/)
{
    return 1;
}

#endif	/* TCL_MEM_DEBUG */

/*
 *------------------------------------------------------------------------
 *
 * TclAllocElemsEx --
 *
 *    See TclAttemptAllocElemsEx. This function differs in that it panics
 *    on failure.
 *
 * Results:
 *    Non-NULL pointer to allocated memory block.
 *
 * Side effects:
 *    Panics if memory of at least the requested size could not be
 *    allocated.
 *
 *------------------------------------------------------------------------
 */
void *
TclAllocElemsEx(
    Tcl_Size elemCount,     /* Allocation will store at least these many... */
    Tcl_Size elemSize,	    /* ...elements of this size */
    Tcl_Size leadSize,      /* Additional leading space in bytes */
    Tcl_Size *capacityPtr) /* OUTPUT: Actual capacity is stored
			       here if non-NULL. Only modified on success */
{
    void *ptr = TclAttemptReallocElemsEx(
	NULL, elemCount, elemSize, leadSize, capacityPtr);
    if (ptr == NULL) {
	Tcl_Panic("Failed to allocate %" TCL_SIZE_MODIFIER
		  "d elements of size %" TCL_SIZE_MODIFIER "d bytes.",
		  elemCount,
		  elemSize);
    }
    return ptr;
}

/*
 *------------------------------------------------------------------------
 *
 * TclAttemptReallocElemsEx --
 *
 *    Attempts to allocate (oldPtr == NULL) or reallocate memory of the
 *    requested size plus some more for future growth. The amount of
 *    reallocation is adjusted depending on on failure.
 *
 *
 * Results:
 *    Pointer to allocated memory block which is at least as large
 *    as the requested size or NULL if allocation failed.
 *
 *------------------------------------------------------------------------
 */
void *
TclAttemptReallocElemsEx(
    void *oldPtr,	    /* Pointer to memory block to reallocate or
			     * NULL to indicate this is a new allocation */
    Tcl_Size elemCount,     /* Allocation will store at least these many... */
    Tcl_Size elemSize,	    /* ...elements of this size */
    Tcl_Size leadSize,      /* Additional leading space in bytes */
    Tcl_Size *capacityPtr) /* OUTPUT: Actual capacity is stored
			       here if non-NULL. Only modified on success */
{
    void *ptr;
    Tcl_Size limit;
    Tcl_Size attempt;

    assert(elemCount > 0);
    assert(elemSize > 0);
    assert(elemSize < TCL_SIZE_MAX);
    assert(leadSize >= 0);
    assert(leadSize < TCL_SIZE_MAX);

    limit = (TCL_SIZE_MAX - leadSize) / elemSize;
    if (elemCount > limit) {
	return NULL;
    }
    /* Loop trying for extra space, reducing request each time */
    attempt = TclUpsizeAlloc(0, elemCount, limit);
    ptr = NULL;
    while (attempt > elemCount) {
	if (oldPtr) {
	    ptr = Tcl_AttemptRealloc(oldPtr, leadSize + attempt * elemSize);
	} else {
	    ptr = Tcl_AttemptAlloc(leadSize + attempt * elemSize);
	}
	if (ptr) {
	    break;
	}
	attempt = TclUpsizeRetry(elemCount, attempt);
    }
    /* Try exact size as a last resort */
    if (ptr == NULL) {
	attempt = elemCount;
	if (oldPtr) {
	    ptr = Tcl_AttemptRealloc(oldPtr, leadSize + attempt * elemSize);
	} else {
	    ptr = Tcl_AttemptAlloc(leadSize + attempt * elemSize);
	}
    }
    if (ptr && capacityPtr) {
	*capacityPtr = attempt;
    }
    return ptr;
}

/*
 *------------------------------------------------------------------------
 *
 * TclReallocElemsEx --
 *
 *    See TclAttemptReallocElemsEx. This function differs in that it panics
 *    on failure.
 *
 * Results:
 *    Non-NULL pointer to allocated memory block.
 *
 * Side effects:
 *    Panics if memory of at least the requested size could not be
 *    allocated.
 *
 *------------------------------------------------------------------------
 */
void *
TclReallocElemsEx(
    void *oldPtr,	    /* Pointer to memory block to reallocate */
    Tcl_Size elemCount,     /* Allocation will store at least these many... */
    Tcl_Size elemSize,	    /* ...elements of this size */
    Tcl_Size leadSize,      /* Additional leading space in bytes */
    Tcl_Size *capacityPtr) /* OUTPUT: Actual capacity is stored
			       here if non-NULL. Only modified on success */
{
    void *ptr = TclAttemptReallocElemsEx(
	oldPtr, elemCount, elemSize, leadSize, capacityPtr);
    if (ptr == NULL) {
	Tcl_Panic("Failed to reallocate %" TCL_SIZE_MODIFIER
		  "d elements of size %" TCL_SIZE_MODIFIER "d bytes.",
		  elemCount,
		  elemSize);
    }
    return ptr;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclFinalizeMemorySubsystem --
 *
 *	This procedure is called to finalize all the structures that are used

Changes to generic/tclClock.c.

10
11
12
13
14
15
16

17
18
19
20
21
22
23
 * 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"


/*
 * Windows has mktime. The configurators do not check.
 */

#ifdef _WIN32
#define HAVE_MKTIME 1







>







10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
 * 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 "tclTomMath.h"

/*
 * Windows has mktime. The configurators do not check.
 */

#ifdef _WIN32
#define HAVE_MKTIME 1
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
/*
 * Function prototypes for local procedures in this file:
 */

static int		ConvertUTCToLocal(Tcl_Interp *,
			    TclDateFields *, Tcl_Obj *, int);
static int		ConvertUTCToLocalUsingTable(Tcl_Interp *,
			    TclDateFields *, size_t, Tcl_Obj *const[]);
static int		ConvertUTCToLocalUsingC(Tcl_Interp *,
			    TclDateFields *, int);
static int		ConvertLocalToUTC(Tcl_Interp *,
			    TclDateFields *, Tcl_Obj *, int);
static int		ConvertLocalToUTCUsingTable(Tcl_Interp *,
			    TclDateFields *, size_t, Tcl_Obj *const[]);
static int		ConvertLocalToUTCUsingC(Tcl_Interp *,
			    TclDateFields *, int);
static Tcl_Obj *	LookupLastTransition(Tcl_Interp *, Tcl_WideInt,
			    size_t, Tcl_Obj *const *);
static void		GetYearWeekDay(TclDateFields *, int);
static void		GetGregorianEraYearDay(TclDateFields *, int);
static void		GetMonthDay(TclDateFields *);
static void		GetJulianDayFromEraYearWeekDay(TclDateFields *, int);
static void		GetJulianDayFromEraYearMonthDay(TclDateFields *, int);
static int		IsGregorianLeapYear(TclDateFields *);
static int		WeekdayOnOrBefore(int, int);







|





|



|







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
/*
 * Function prototypes for local procedures in this file:
 */

static int		ConvertUTCToLocal(Tcl_Interp *,
			    TclDateFields *, Tcl_Obj *, int);
static int		ConvertUTCToLocalUsingTable(Tcl_Interp *,
			    TclDateFields *, Tcl_Size, Tcl_Obj *const[]);
static int		ConvertUTCToLocalUsingC(Tcl_Interp *,
			    TclDateFields *, int);
static int		ConvertLocalToUTC(Tcl_Interp *,
			    TclDateFields *, Tcl_Obj *, int);
static int		ConvertLocalToUTCUsingTable(Tcl_Interp *,
			    TclDateFields *, Tcl_Size, Tcl_Obj *const[]);
static int		ConvertLocalToUTCUsingC(Tcl_Interp *,
			    TclDateFields *, int);
static Tcl_Obj *	LookupLastTransition(Tcl_Interp *, Tcl_WideInt,
			    Tcl_Size, Tcl_Obj *const *);
static void		GetYearWeekDay(TclDateFields *, int);
static void		GetGregorianEraYearDay(TclDateFields *, int);
static void		GetMonthDay(TclDateFields *);
static void		GetJulianDayFromEraYearWeekDay(TclDateFields *, int);
static void		GetJulianDayFromEraYearMonthDay(TclDateFields *, int);
static int		IsGregorianLeapYear(TclDateFields *);
static int		WeekdayOnOrBefore(int, int);
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
static int
ConvertLocalToUTC(
    Tcl_Interp *interp,		/* Tcl interpreter */
    TclDateFields *fields,	/* Fields of the time */
    Tcl_Obj *tzdata,		/* Time zone data */
    int changeover)		/* Julian Day of the Gregorian transition */
{
    size_t rowc;			/* Number of rows in tzdata */
    Tcl_Obj **rowv;		/* Pointers to the rows */

    /*
     * Unpack the tz data.
     */

    if (TclListObjGetElementsM(interp, tzdata, &rowc, &rowv) != TCL_OK) {







|







724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
static int
ConvertLocalToUTC(
    Tcl_Interp *interp,		/* Tcl interpreter */
    TclDateFields *fields,	/* Fields of the time */
    Tcl_Obj *tzdata,		/* Time zone data */
    int changeover)		/* Julian Day of the Gregorian transition */
{
    Tcl_Size rowc;			/* Number of rows in tzdata */
    Tcl_Obj **rowv;		/* Pointers to the rows */

    /*
     * Unpack the tz data.
     */

    if (TclListObjGetElementsM(interp, tzdata, &rowc, &rowv) != TCL_OK) {
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
 *----------------------------------------------------------------------
 */

static int
ConvertLocalToUTCUsingTable(
    Tcl_Interp *interp,		/* Tcl interpreter */
    TclDateFields *fields,	/* Time to convert, with 'seconds' filled in */
    size_t rowc,			/* Number of points at which time changes */
    Tcl_Obj *const rowv[])	/* Points at which time changes */
{
    Tcl_Obj *row;
    size_t cellc;
    Tcl_Obj **cellv;
    int have[8];
    int nHave = 0;
    int i;
    int found;

    /*







|



|







769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
 *----------------------------------------------------------------------
 */

static int
ConvertLocalToUTCUsingTable(
    Tcl_Interp *interp,		/* Tcl interpreter */
    TclDateFields *fields,	/* Time to convert, with 'seconds' filled in */
    Tcl_Size rowc,			/* Number of points at which time changes */
    Tcl_Obj *const rowv[])	/* Points at which time changes */
{
    Tcl_Obj *row;
    Tcl_Size cellc;
    Tcl_Obj **cellv;
    int have[8];
    int nHave = 0;
    int i;
    int found;

    /*
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
static int
ConvertUTCToLocal(
    Tcl_Interp *interp,		/* Tcl interpreter */
    TclDateFields *fields,	/* Fields of the time */
    Tcl_Obj *tzdata,		/* Time zone data */
    int changeover)		/* Julian Day of the Gregorian transition */
{
    size_t rowc;			/* Number of rows in tzdata */
    Tcl_Obj **rowv;		/* Pointers to the rows */

    /*
     * Unpack the tz data.
     */

    if (TclListObjGetElementsM(interp, tzdata, &rowc, &rowv) != TCL_OK) {







|







927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
static int
ConvertUTCToLocal(
    Tcl_Interp *interp,		/* Tcl interpreter */
    TclDateFields *fields,	/* Fields of the time */
    Tcl_Obj *tzdata,		/* Time zone data */
    int changeover)		/* Julian Day of the Gregorian transition */
{
    Tcl_Size rowc;			/* Number of rows in tzdata */
    Tcl_Obj **rowv;		/* Pointers to the rows */

    /*
     * Unpack the tz data.
     */

    if (TclListObjGetElementsM(interp, tzdata, &rowc, &rowv) != TCL_OK) {
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
 *----------------------------------------------------------------------
 */

static int
ConvertUTCToLocalUsingTable(
    Tcl_Interp *interp,		/* Tcl interpreter */
    TclDateFields *fields,	/* Fields of the date */
    size_t rowc,			/* Number of rows in the conversion table
				 * (>= 1) */
    Tcl_Obj *const rowv[])	/* Rows of the conversion table */
{
    Tcl_Obj *row;		/* Row containing the current information */
    size_t cellc;			/* Count of cells in the row (must be 4) */
    Tcl_Obj **cellv;		/* Pointers to the cells */

    /*
     * Look up the nearest transition time.
     */

    row = LookupLastTransition(interp, fields->seconds, rowc, rowv);







|




|







972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
 *----------------------------------------------------------------------
 */

static int
ConvertUTCToLocalUsingTable(
    Tcl_Interp *interp,		/* Tcl interpreter */
    TclDateFields *fields,	/* Fields of the date */
    Tcl_Size rowc,			/* Number of rows in the conversion table
				 * (>= 1) */
    Tcl_Obj *const rowv[])	/* Rows of the conversion table */
{
    Tcl_Obj *row;		/* Row containing the current information */
    Tcl_Size cellc;			/* Count of cells in the row (must be 4) */
    Tcl_Obj **cellv;		/* Pointers to the cells */

    /*
     * Look up the nearest transition time.
     */

    row = LookupLastTransition(interp, fields->seconds, rowc, rowv);
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
    fields->tzOffset = diff;
    if (diff < 0) {
	*buffer = '-';
	diff = -diff;
    } else {
	*buffer = '+';
    }
    sprintf(buffer+1, "%02d", diff / 3600);
    diff %= 3600;
    sprintf(buffer+3, "%02d", diff / 60);
    diff %= 60;
    if (diff > 0) {
	sprintf(buffer+5, "%02d", diff);
    }
    fields->tzName = Tcl_NewStringObj(buffer, -1);
    Tcl_IncrRefCount(fields->tzName);
    return TCL_OK;
}

/*







|

|


|







1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
    fields->tzOffset = diff;
    if (diff < 0) {
	*buffer = '-';
	diff = -diff;
    } else {
	*buffer = '+';
    }
    snprintf(buffer+1, sizeof(buffer) - 1, "%02d", diff / 3600);
    diff %= 3600;
    snprintf(buffer+3, sizeof(buffer) - 3, "%02d", diff / 60);
    diff %= 60;
    if (diff > 0) {
	snprintf(buffer+5, sizeof(buffer) - 5, "%02d", diff);
    }
    fields->tzName = Tcl_NewStringObj(buffer, -1);
    Tcl_IncrRefCount(fields->tzName);
    return TCL_OK;
}

/*
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
 *----------------------------------------------------------------------
 */

static Tcl_Obj *
LookupLastTransition(
    Tcl_Interp *interp,		/* Interpreter for error messages */
    Tcl_WideInt tick,		/* Time from the epoch */
    size_t rowc,			/* Number of rows of tzdata */
    Tcl_Obj *const *rowv)	/* Rows in tzdata */
{
    size_t l;
    size_t u;
    Tcl_Obj *compObj;
    Tcl_WideInt compVal;

    /*
     * Examine the first row to make sure we're in bounds.
     */








|


|
|







1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
 *----------------------------------------------------------------------
 */

static Tcl_Obj *
LookupLastTransition(
    Tcl_Interp *interp,		/* Interpreter for error messages */
    Tcl_WideInt tick,		/* Time from the epoch */
    Tcl_Size rowc,			/* Number of rows of tzdata */
    Tcl_Obj *const *rowv)	/* Rows in tzdata */
{
    Tcl_Size l;
    Tcl_Size u;
    Tcl_Obj *compObj;
    Tcl_WideInt compVal;

    /*
     * Examine the first row to make sure we're in bounds.
     */

1800
1801
1802
1803
1804
1805
1806

1807
1808
1809
1810
1811
1812
1813
1814

1815
1816
1817
1818
1819
1820
1821
ClockMillisecondsObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const *objv)	/* Parameter values */
{
    Tcl_Time now;


    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }
    Tcl_GetTime(&now);
    Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)
	    now.sec * 1000 + now.usec / 1000));

    return TCL_OK;
}

/*----------------------------------------------------------------------
 *
 * ClockMicrosecondsObjCmd -
 *







>






|
|
>







1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
ClockMillisecondsObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const *objv)	/* Parameter values */
{
    Tcl_Time now;
    Tcl_Obj *timeObj;

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }
    Tcl_GetTime(&now);
    TclNewUIntObj(timeObj, (Tcl_WideUInt)
	    now.sec * 1000 + now.usec / 1000);
    Tcl_SetObjResult(interp, timeObj);
    return TCL_OK;
}

/*----------------------------------------------------------------------
 *
 * ClockMicrosecondsObjCmd -
 *
1988
1989
1990
1991
1992
1993
1994

1995
1996
1997
1998
1999
2000


2001
2002
2003
2004
2005
2006
2007
2008
ClockSecondsObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const *objv)	/* Parameter values */
{
    Tcl_Time now;


    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }
    Tcl_GetTime(&now);


    Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) now.sec));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TzsetIfNecessary --







>






>
>
|







1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
ClockSecondsObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const *objv)	/* Parameter values */
{
    Tcl_Time now;
    Tcl_Obj *timeObj;

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }
    Tcl_GetTime(&now);
    TclNewUIntObj(timeObj, (Tcl_WideUInt)now.sec);

    Tcl_SetObjResult(interp, timeObj);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TzsetIfNecessary --

Changes to generic/tclCmdAH.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
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
 * 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"
#include "tclAbstractList.h"

#ifdef _WIN32
#   include "tclWinInt.h"
#endif

/*
 * The state structure used by [foreach]. Note that the actual structure has
 * all its working arrays appended afterwards so they can be allocated and
 * freed in a single step.
 */

struct ForeachState {
    Tcl_Obj *bodyPtr;		/* The script body of the command. */
    int bodyIdx;		/* The argument index of the body. */
    int j, maxj;		/* Number of loop iterations. */
    int numLists;		/* Count of value lists. */
    size_t *index;			/* Array of value list indices. */
    size_t *varcList;		/* # loop variables per list. */
    Tcl_Obj ***varvList;	/* Array of var name lists. */
    Tcl_Obj **vCopyList;	/* Copies of var name list arguments. */
    size_t *argcList;		/* Array of value list sizes. */
    Tcl_Obj ***argvList;	/* Array of value lists. */
    Tcl_Obj **aCopyList;	/* Copies of value list arguments. */
    Tcl_Obj *resultList;	/* List of result values from the loop body,
				 * or NULL if we're not collecting them
				 * ([lmap] vs [foreach]). */
};

/*
 * Prototypes for local procedures defined in this file:
 */

static int		CheckAccess(Tcl_Interp *interp, Tcl_Obj *pathPtr,
			    int mode);
static Tcl_ObjCmdProc	EncodingConvertfromObjCmd;
static Tcl_ObjCmdProc	EncodingConverttoObjCmd;
static Tcl_ObjCmdProc	EncodingDirsObjCmd;
static Tcl_ObjCmdProc	EncodingNamesObjCmd;

static Tcl_ObjCmdProc	EncodingSystemObjCmd;
static inline int	ForeachAssignments(Tcl_Interp *interp,
			    struct ForeachState *statePtr);
static inline void	ForeachCleanup(Tcl_Interp *interp,
			    struct ForeachState *statePtr);
static int		GetStatBuf(Tcl_Interp *interp, Tcl_Obj *pathPtr,
			    Tcl_FSStatProc *statProc, Tcl_StatBuf *statPtr);







|
>












|
|
|
|
|


|

















>







8
9
10
11
12
13
14
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 © 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"
#include "tclIO.h"
#include "tclTomMath.h"
#ifdef _WIN32
#   include "tclWinInt.h"
#endif

/*
 * The state structure used by [foreach]. Note that the actual structure has
 * all its working arrays appended afterwards so they can be allocated and
 * freed in a single step.
 */

struct ForeachState {
    Tcl_Obj *bodyPtr;		/* The script body of the command. */
    Tcl_Size bodyIdx;		/* The argument index of the body. */
    Tcl_Size j, maxj;		/* Number of loop iterations. */
    Tcl_Size numLists;		/* Count of value lists. */
    Tcl_Size *index;		/* Array of value list indices. */
    Tcl_Size *varcList; 	/* # loop variables per list. */
    Tcl_Obj ***varvList;	/* Array of var name lists. */
    Tcl_Obj **vCopyList;	/* Copies of var name list arguments. */
    Tcl_Size *argcList;		/* Array of value list sizes. */
    Tcl_Obj ***argvList;	/* Array of value lists. */
    Tcl_Obj **aCopyList;	/* Copies of value list arguments. */
    Tcl_Obj *resultList;	/* List of result values from the loop body,
				 * or NULL if we're not collecting them
				 * ([lmap] vs [foreach]). */
};

/*
 * Prototypes for local procedures defined in this file:
 */

static int		CheckAccess(Tcl_Interp *interp, Tcl_Obj *pathPtr,
			    int mode);
static Tcl_ObjCmdProc	EncodingConvertfromObjCmd;
static Tcl_ObjCmdProc	EncodingConverttoObjCmd;
static Tcl_ObjCmdProc	EncodingDirsObjCmd;
static Tcl_ObjCmdProc	EncodingNamesObjCmd;
static Tcl_ObjCmdProc	EncodingProfilesObjCmd;
static Tcl_ObjCmdProc	EncodingSystemObjCmd;
static inline int	ForeachAssignments(Tcl_Interp *interp,
			    struct ForeachState *statePtr);
static inline void	ForeachCleanup(Tcl_Interp *interp,
			    struct ForeachState *statePtr);
static int		GetStatBuf(Tcl_Interp *interp, Tcl_Obj *pathPtr,
			    Tcl_FSStatProc *statProc, Tcl_StatBuf *statPtr);
381
382
383
384
385
386
387

388
389
390
391
392
393
394










































































































395
396
397
398
399
400
401
    Tcl_Interp* interp)		/* Tcl interpreter */
{
    static const EnsembleImplMap encodingImplMap[] = {
	{"convertfrom", EncodingConvertfromObjCmd, TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
	{"convertto",   EncodingConverttoObjCmd,   TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
	{"dirs",        EncodingDirsObjCmd,        TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
	{"names",       EncodingNamesObjCmd,       TclCompileBasic0ArgCmd,    NULL, NULL, 0},

	{"system",      EncodingSystemObjCmd,      TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
	{NULL,          NULL,                      NULL,                      NULL, NULL, 0}
    };

    return TclMakeEnsemble(interp, "encoding", encodingImplMap);
}











































































































/*
 *----------------------------------------------------------------------
 *
 * EncodingConvertfromObjCmd --
 *
 *	This command converts a byte array in an external encoding into a
 *	Tcl string







>







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







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
    Tcl_Interp* interp)		/* Tcl interpreter */
{
    static const EnsembleImplMap encodingImplMap[] = {
	{"convertfrom", EncodingConvertfromObjCmd, TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
	{"convertto",   EncodingConverttoObjCmd,   TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
	{"dirs",        EncodingDirsObjCmd,        TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
	{"names",       EncodingNamesObjCmd,       TclCompileBasic0ArgCmd,    NULL, NULL, 0},
	{"profiles",    EncodingProfilesObjCmd,    TclCompileBasic0ArgCmd,    NULL, NULL, 0},
	{"system",      EncodingSystemObjCmd,      TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
	{NULL,          NULL,                      NULL,                      NULL, NULL, 0}
    };

    return TclMakeEnsemble(interp, "encoding", encodingImplMap);
}

/*
 *------------------------------------------------------------------------
 *
 * EncodingConvertParseOptions --
 *
 *    Common routine for parsing arguments passed to encoding convertfrom
 *    and encoding convertto.
 *
 * Results:
 *    TCL_OK or TCL_ERROR.
 *
 * Side effects:
 *    On success,
 *    - *encPtr is set to the encoding. Must be freed with Tcl_FreeEncoding
 *      if non-NULL
 *    - *dataObjPtr is set to the Tcl_Obj containing the data to encode or
 *      decode
 *    - *profilePtr is set to encoding error handling profile
 *    - *failVarPtr is set to -failindex option value or NULL
 *    On error, all of the above are uninitialized.
 *
 *------------------------------------------------------------------------
 */
static int
EncodingConvertParseOptions (
    Tcl_Interp *interp,    /* For error messages. May be NULL */
    int objc,		   /* Number of arguments */
    Tcl_Obj *const objv[], /* Argument objects as passed to command. */
    Tcl_Encoding *encPtr,  /* Where to store the encoding */
    Tcl_Obj **dataObjPtr,  /* Where to store ptr to Tcl_Obj containing data */
    int *profilePtr,         /* Bit mask of encoding option profile */
    Tcl_Obj **failVarPtr   /* Where to store -failindex option value */
)
{
    static const char *const options[] = {"-profile", "-failindex", NULL};
    enum convertfromOptions { PROFILE, FAILINDEX } optIndex;
    Tcl_Encoding encoding;
    Tcl_Obj *dataObj;
    Tcl_Obj *failVarObj;
    int profile = TCL_ENCODING_PROFILE_TCL8;

    /*
     * Possible combinations:
     * 1) data						-> objc = 2
     * 2) ?options? encoding data			-> objc >= 3
     * It is intentional that specifying option forces encoding to be
     * specified. Less prone to user error. This should have always been
     * the case even in 8.6 imho where there were no options (ie (1)
     * should never have been allowed)
     */

    if (objc == 1) {
numArgsError: /* ONLY jump here if nothing needs to be freed!!! */
	Tcl_WrongNumArgs(interp,
			 1,
			 objv,
			 "?-profile profile? ?-failindex var? encoding data");
	((Interp *)interp)->flags |= INTERP_ALTERNATE_WRONG_ARGS;
	Tcl_WrongNumArgs(interp, 1, objv, "data");
	return TCL_ERROR;
    }

    failVarObj = NULL;
    if (objc == 2) {
	encoding = Tcl_GetEncoding(interp, NULL);
	dataObj = objv[1];
    } else {
	int argIndex;
	for (argIndex = 1; argIndex < (objc-2); ++argIndex) {
	    if (Tcl_GetIndexFromObj(
		    interp, objv[argIndex], options, "option", 0, &optIndex)
		!= TCL_OK) {
		return TCL_ERROR;
	    }
	    if (++argIndex == (objc - 2)) {
		goto numArgsError;
	    }
	    switch (optIndex) {
	    case PROFILE:
		if (TclEncodingProfileNameToId(interp,
					       Tcl_GetString(objv[argIndex]),
					       &profile) != TCL_OK) {
		    return TCL_ERROR;
		}
		break;
	    case FAILINDEX:
		failVarObj = objv[argIndex];
		break;
	    }
	}
	/* Get encoding after opts so no need to free it on option error */
	if (Tcl_GetEncodingFromObj(interp, objv[objc - 2], &encoding)
	    != TCL_OK) {
	    return TCL_ERROR;
	}
	dataObj = objv[objc - 1];
    }

    *encPtr = encoding;
    *dataObjPtr = dataObj;
    *profilePtr = profile;
    *failVarPtr = failVarObj;

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * EncodingConvertfromObjCmd --
 *
 *	This command converts a byte array in an external encoding into a
 *	Tcl string
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
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *data;		/* Byte array to convert */
    Tcl_DString ds;		/* Buffer to hold the string */
    Tcl_Encoding encoding;	/* Encoding to use */
    size_t length = 0;			/* Length of the byte array being converted */
    const char *bytesPtr;	/* Pointer to the first byte of the array */
    int flags = 0;
    size_t result;
    Tcl_Obj *failVarObj = NULL;
    /*
     * Decode parameters:
     * Possible combinations:
     * 1) data						-> objc = 2
     * 2) encoding data					-> objc = 3
     * 3) -nocomplain data				-> objc = 3
     * 4) -nocomplain encoding data			-> objc = 4
     * 5) -strict data				-> objc = 3
     * 6) -strict encoding data			-> objc = 4
     * 7) -failindex val data				-> objc = 4
     * 8) -failindex val encoding data			-> objc = 5
     */

    if (objc == 2) {
	encoding = Tcl_GetEncoding(interp, NULL);
	data = objv[1];
    } else if (objc > 2 && objc < 6) {
	int objcUnprocessed = objc;
	data = objv[objc - 1];
	bytesPtr = Tcl_GetString(objv[1]);
	if (bytesPtr[0] == '-' && bytesPtr[1] == 'n'
		&& !strncmp(bytesPtr, "-nocomplain", strlen(bytesPtr))) {
	    flags = TCL_ENCODING_NOCOMPLAIN;
	    objcUnprocessed--;
	} else if (bytesPtr[0] == '-' && bytesPtr[1] == 's'
		&& !strncmp(bytesPtr, "-strict", strlen(bytesPtr))) {
	    flags = TCL_ENCODING_STRICT;
	    objcUnprocessed--;
	} else if (bytesPtr[0] == '-' && bytesPtr[1] == 'f'
		&& !strncmp(bytesPtr, "-failindex", strlen(bytesPtr))) {
	    /* at least two additional arguments needed */
	    if (objc < 4) {
		goto encConvFromError;
	    }
	    failVarObj = objv[2];
	    objcUnprocessed -= 2;
	}
	switch (objcUnprocessed) {
	    case 3:
		if (Tcl_GetEncodingFromObj(interp, objv[objc - 2], &encoding) != TCL_OK) {
		    return TCL_ERROR;
		}
		break;
	    case 2:
		encoding = Tcl_GetEncoding(interp, NULL);
		break;
	    default:
		goto encConvFromError;
	}
    } else {
    encConvFromError:
	Tcl_WrongNumArgs(interp, 1, objv, "?-nocomplain? ?-strict? ?-failindex var? ?encoding? data");
	return TCL_ERROR;
    }

    /*
     * Convert the string into a byte array in 'ds'
     */
    bytesPtr = (char *) Tcl_GetBytesFromObj(interp, data, &length);

    if (bytesPtr == NULL) {
	return TCL_ERROR;
    }
    result = Tcl_ExternalToUtfDStringEx(encoding, bytesPtr, length,
	    flags, &ds);
    if ((!(flags & TCL_ENCODING_NOCOMPLAIN) || ((flags & TCL_ENCODING_STRICT) == TCL_ENCODING_STRICT)) && (result != TCL_INDEX_NONE)) {
	if (failVarObj != NULL) {

	    if (Tcl_ObjSetVar2(interp, failVarObj, NULL, Tcl_NewWideIntObj(result), TCL_LEAVE_ERR_MSG) == NULL) {






		return TCL_ERROR;
	    }
	} else {
	    char buf[TCL_INTEGER_SPACE];
	    sprintf(buf, "%" TCL_Z_MODIFIER "u", result);
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf("unexpected byte sequence starting at index %"
		    TCL_Z_MODIFIER "u: '\\x%X'", result, UCHAR(bytesPtr[result])));
	    Tcl_SetErrorCode(interp, "TCL", "ENCODING", "ILLEGALSEQUENCE",






		    buf, NULL);
	    Tcl_DStringFree(&ds);
	    return TCL_ERROR;
	}







    } else if (failVarObj != NULL) {


	if (Tcl_ObjSetVar2(interp, failVarObj, NULL, Tcl_NewIntObj(-1), TCL_LEAVE_ERR_MSG) == NULL) {





	    return TCL_ERROR;
	}
    }

    /*
     * Note that we cannot use Tcl_DStringResult here because it will
     * truncate the string at the first null byte.
     */

    Tcl_SetObjResult(interp, TclDStringToObj(&ds));

    /*
     * We're done with the encoding
     */

    Tcl_FreeEncoding(encoding);
    return TCL_OK;

}

/*







|

|
|
|
<
<
|
<
<
<
<
<
<
<
<
<

<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<




|


>



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


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



<





|

<
|
<







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
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *data;		/* Byte array to convert */
    Tcl_DString ds;		/* Buffer to hold the string */
    Tcl_Encoding encoding;	/* Encoding to use */
    Tcl_Size length = 0;			/* Length of the byte array being converted */
    const char *bytesPtr;	/* Pointer to the first byte of the array */
    int flags;
    int result;
    Tcl_Obj *failVarObj;


    Tcl_Size errorLocation;











    if (EncodingConvertParseOptions(



















	    interp, objc, objv, &encoding, &data, &flags, &failVarObj)





	!= TCL_OK) {











	return TCL_ERROR;
    }

    /*
     * Convert the string into a byte array in 'ds'.
     */
    bytesPtr = (char *) Tcl_GetBytesFromObj(interp, data, &length);

    if (bytesPtr == NULL) {
	return TCL_ERROR;
    }
    result = Tcl_ExternalToUtfDStringEx(interp, encoding, bytesPtr, length, flags,


                                        &ds, failVarObj ? &errorLocation : NULL);
    /* NOTE: ds must be freed beyond this point even on error */
    switch (result) {
    case TCL_OK:
        errorLocation = TCL_INDEX_NONE;
        break;
    case TCL_ERROR:
	/* Error in parameters. Should not happen. interp will have error */
        Tcl_DStringFree(&ds);
	return TCL_ERROR;

    default:





	/*
	 * One of the TCL_CONVERT_* errors. If we were not interested in the
	 * error location, interp result would already have been filled in
	 * and we can just return the error. Otherwise, we have to return
	 * what could be decoded and the returned error location.
	 */
	if (failVarObj == NULL) {
            Tcl_DStringFree(&ds);
	    return TCL_ERROR;
	}
        break;
    }

    /*
     * TCL_OK or a TCL_CONVERT_* error where the caller wants back as much
     * data as was converted.
     */
    if (failVarObj) {
	Tcl_Obj *failIndex;
	TclNewIndexObj(failIndex, errorLocation);
	if (Tcl_ObjSetVar2(interp,
			   failVarObj,
			   NULL,
			   failIndex,
			   TCL_LEAVE_ERR_MSG) == NULL) {
	    Tcl_DStringFree(&ds);
	    return TCL_ERROR;
	}
    }

    /*
     * Note that we cannot use Tcl_DStringResult here because it will
     * truncate the string at the first null byte.
     */

    Tcl_SetObjResult(interp, Tcl_DStringToObj(&ds));


    /* We're done with the encoding */


    Tcl_FreeEncoding(encoding);
    return TCL_OK;

}

/*
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
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *data;		/* String to convert */
    Tcl_DString ds;		/* Buffer to hold the byte array */
    Tcl_Encoding encoding;	/* Encoding to use */
    size_t length;			/* Length of the string being converted */
    const char *stringPtr;	/* Pointer to the first byte of the string */
    size_t result;
    int flags = 0;
    Tcl_Obj *failVarObj = NULL;

    /*
     * Decode parameters:
     * Possible combinations:
     * 1) data						-> objc = 2
     * 2) encoding data					-> objc = 3
     * 3) -nocomplain data				-> objc = 3
     * 4) -nocomplain encoding data			-> objc = 4
     * 5) -failindex val data				-> objc = 4
     * 6) -failindex val encoding data			-> objc = 5
     */

    if (objc == 2) {
	encoding = Tcl_GetEncoding(interp, NULL);
	data = objv[1];
    } else if (objc > 2 && objc < 6) {
	int objcUnprocessed = objc;
	data = objv[objc - 1];
	stringPtr = Tcl_GetString(objv[1]);
	if (stringPtr[0] == '-' && stringPtr[1] == 'n'
		&& !strncmp(stringPtr, "-nocomplain", strlen(stringPtr))) {
	    flags = TCL_ENCODING_NOCOMPLAIN;
	    objcUnprocessed--;
	} else if (stringPtr[0] == '-' && stringPtr[1] == 's'
		&& !strncmp(stringPtr, "-strict", strlen(stringPtr))) {
	    flags = TCL_ENCODING_STRICT;
	    objcUnprocessed--;
	} else if (stringPtr[0] == '-' && stringPtr[1] == 'f'
		&& !strncmp(stringPtr, "-failindex", strlen(stringPtr))) {
	    /* at least two additional arguments needed */
	    if (objc < 4) {
		goto encConvToError;
	    }
	    failVarObj = objv[2];
	    objcUnprocessed -= 2;
	}
	switch (objcUnprocessed) {
	    case 3:
		if (Tcl_GetEncodingFromObj(interp, objv[objc - 2], &encoding) != TCL_OK) {
		    return TCL_ERROR;
		}
		break;
	    case 2:
		encoding = Tcl_GetEncoding(interp, NULL);
		break;
	    default:
		goto encConvToError;
	}
    } else {
    encConvToError:
	Tcl_WrongNumArgs(interp, 1, objv, "?-nocomplain? ?-strict? ?-failindex var? ?encoding? data");
	return TCL_ERROR;
    }

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

    stringPtr = Tcl_GetStringFromObj(data, &length);
    result = Tcl_UtfToExternalDStringEx(encoding, stringPtr, length,
	    flags, &ds);
    if ((!(flags & TCL_ENCODING_NOCOMPLAIN) || ((flags & TCL_ENCODING_STRICT) == TCL_ENCODING_STRICT)) && (result != TCL_INDEX_NONE)) {
	if (failVarObj != NULL) {
	    /* I hope, wide int will cover size_t data type */
	    if (Tcl_ObjSetVar2(interp, failVarObj, NULL, Tcl_NewWideIntObj(result), TCL_LEAVE_ERR_MSG) == NULL) {
		return TCL_ERROR;

	    }

	} else {
	    size_t pos = Tcl_NumUtfChars(stringPtr, result);
	    int ucs4;

	    char buf[TCL_INTEGER_SPACE];

	    TclUtfToUCS4(&stringPtr[result], &ucs4);
	    sprintf(buf, "%" TCL_Z_MODIFIER "u", result);


	    Tcl_SetObjResult(interp, Tcl_ObjPrintf("unexpected character at index %"
		    TCL_Z_MODIFIER "u: 'U+%06X'", pos, ucs4));
	    Tcl_SetErrorCode(interp, "TCL", "ENCODING", "ILLEGALSEQUENCE",


		    buf, NULL);
	    Tcl_DStringFree(&ds);
	    return TCL_ERROR;
	}






    } else if (failVarObj != NULL) {


	if (Tcl_ObjSetVar2(interp, failVarObj, NULL, Tcl_NewIntObj(-1), TCL_LEAVE_ERR_MSG) == NULL) {





	    return TCL_ERROR;
	}
    }

    Tcl_SetObjResult(interp,
		     Tcl_NewByteArrayObj((unsigned char*) Tcl_DStringValue(&ds),
					 Tcl_DStringLength(&ds)));
    Tcl_DStringFree(&ds);

    /*
     * We're done with the encoding
     */

    Tcl_FreeEncoding(encoding);
    return TCL_OK;

}

/*







|

|
|
|
|
<
<
<
<
<
<
<
<
<
<

<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<








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


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



>





<
|
<







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
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *data;		/* String to convert */
    Tcl_DString ds;		/* Buffer to hold the byte array */
    Tcl_Encoding encoding;	/* Encoding to use */
    Tcl_Size length;			/* Length of the string being converted */
    const char *stringPtr;	/* Pointer to the first byte of the string */
    int result;
    int flags;
    Tcl_Obj *failVarObj;
    Tcl_Size errorLocation;












    if (EncodingConvertParseOptions(



















	    interp, objc, objv, &encoding, &data, &flags, &failVarObj)





	!= TCL_OK) {











	return TCL_ERROR;
    }

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

    stringPtr = Tcl_GetStringFromObj(data, &length);
    result = Tcl_UtfToExternalDStringEx(interp, encoding, stringPtr, length, flags,


                                        &ds, failVarObj ? &errorLocation : NULL);



    /* NOTE: ds must be freed beyond this point even on error */

    switch (result) {
    case TCL_OK:
	errorLocation = TCL_INDEX_NONE;

	break;
    case TCL_ERROR:
	/* Error in parameters. Should not happen. interp will have error */
        Tcl_DStringFree(&ds);
	return TCL_ERROR;
    default:
	/*
	 * One of the TCL_CONVERT_* errors. If we were not interested in the
	 * error location, interp result would already have been filled in
	 * and we can just return the error. Otherwise, we have to return
	 * what could be decoded and the returned error location.
	 */
	if (failVarObj == NULL) {
            Tcl_DStringFree(&ds);
	    return TCL_ERROR;
	}
        break;
    }
    /*
     * TCL_OK or a TCL_CONVERT_* error where the caller wants back as much
     * data as was converted.
     */
    if (failVarObj) {
	Tcl_Obj *failIndex;
	TclNewIndexObj(failIndex, errorLocation);
	if (Tcl_ObjSetVar2(interp,
			   failVarObj,
			   NULL,
			   failIndex,
			   TCL_LEAVE_ERR_MSG) == NULL) {
	    Tcl_DStringFree(&ds);
	    return TCL_ERROR;
	}
    }

    Tcl_SetObjResult(interp,
		     Tcl_NewByteArrayObj((unsigned char*) Tcl_DStringValue(&ds),
					 Tcl_DStringLength(&ds)));
    Tcl_DStringFree(&ds);


    /* We're done with the encoding */


    Tcl_FreeEncoding(encoding);
    return TCL_OK;

}

/*
720
721
722
723
724
725
726




























727
728
729
730
731
732
733
    if (objc > 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }
    Tcl_GetEncodingNames(interp);
    return TCL_OK;
}





























/*
 *-----------------------------------------------------------------------------
 *
 * EncodingSystemObjCmd --
 *
 *	This command retrieves or changes the system encoding







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







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
    if (objc > 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }
    Tcl_GetEncodingNames(interp);
    return TCL_OK;
}

/*
 *-----------------------------------------------------------------------------
 *
 * EncodingProfilesObjCmd --
 *
 *	This command returns a list of the available encoding profiles
 *
 * Results:
 *	Returns a standard Tcl result
 *
 *-----------------------------------------------------------------------------
 */

int
EncodingProfilesObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp* interp,	    /* Tcl interpreter */
    int objc,		    /* Number of command line args */
    Tcl_Obj* const objv[])  /* Vector of command line args */
{
    if (objc > 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }
    TclGetEncodingProfiles(interp);
    return TCL_OK;
}

/*
 *-----------------------------------------------------------------------------
 *
 * EncodingSystemObjCmd --
 *
 *	This command retrieves or changes the system encoding
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    if (Tcl_TranslateFileName(interp, TclGetString(objv[1]), &ds) == NULL) {
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, TclDStringToObj(&ds));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * PathNormalizeCmd --







|







1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    if (Tcl_TranslateFileName(interp, TclGetString(objv[1]), &ds) == NULL) {
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_DStringToObj(&ds));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * PathNormalizeCmd --
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
{
    Tcl_Obj *res;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    res = Tcl_FSSplitPath(objv[1], (size_t *)NULL);
    if (res == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"could not read \"%s\": no such file or directory",
		TclGetString(objv[1])));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PATHSPLIT", "NONESUCH",
		NULL);
	return TCL_ERROR;







|







2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
{
    Tcl_Obj *res;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    res = Tcl_FSSplitPath(objv[1], NULL);
    if (res == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"could not read \"%s\": no such file or directory",
		TclGetString(objv[1])));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PATHSPLIT", "NONESUCH",
		NULL);
	return TCL_ERROR;
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
    Tcl_StatBuf *statPtr)	/* Pointer to buffer containing stat data to
				 * store in varName. */
{
    Tcl_Obj *field, *value, *result;
    unsigned short mode;

    if (varName == NULL) {
        result = Tcl_NewObj();
        Tcl_IncrRefCount(result);
#define DOBJPUT(key, objValue)                  \
        Tcl_DictObjPut(NULL, result,            \
            Tcl_NewStringObj((key), -1),        \
            (objValue));
        DOBJPUT("dev",	Tcl_NewWideIntObj((long)statPtr->st_dev));
        DOBJPUT("ino",	Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_ino));







|







2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
    Tcl_StatBuf *statPtr)	/* Pointer to buffer containing stat data to
				 * store in varName. */
{
    Tcl_Obj *field, *value, *result;
    unsigned short mode;

    if (varName == NULL) {
        TclNewObj(result);
        Tcl_IncrRefCount(result);
#define DOBJPUT(key, objValue)                  \
        Tcl_DictObjPut(NULL, result,            \
            Tcl_NewStringObj((key), -1),        \
            (objValue));
        DOBJPUT("dev",	Tcl_NewWideIntObj((long)statPtr->st_dev));
        DOBJPUT("ino",	Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_ino));
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
#undef DOBJPUT
        Tcl_SetObjResult(interp, result);
        Tcl_DecrRefCount(result);
        return TCL_OK;
    }

    /*
     * Assume Tcl_ObjSetVar2() does not keep a copy of the field name!
     *
     * Might be a better idea to call Tcl_SetVar2Ex() instead, except we want
     * to have an object (i.e. possibly cached) array variable name but a
     * string element name, so no API exists. Messy.
     */

#define STORE_ARY(fieldName, object) \
    TclNewLiteralStringObj(field, fieldName);				\







<
<







2351
2352
2353
2354
2355
2356
2357


2358
2359
2360
2361
2362
2363
2364
#undef DOBJPUT
        Tcl_SetObjResult(interp, result);
        Tcl_DecrRefCount(result);
        return TCL_OK;
    }

    /*


     * Might be a better idea to call Tcl_SetVar2Ex() instead, except we want
     * to have an object (i.e. possibly cached) array variable name but a
     * string element name, so no API exists. Messy.
     */

#define STORE_ARY(fieldName, object) \
    TclNewLiteralStringObj(field, fieldName);				\
2309
2310
2311
2312
2313
2314
2315
2316





2317
2318

2319
2320
2321
2322
2323
2324
2325
    STORE_ARY("gid",	Tcl_NewWideIntObj((long)statPtr->st_gid));
    STORE_ARY("size",	Tcl_NewWideIntObj(statPtr->st_size));
#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
    STORE_ARY("blocks",	Tcl_NewWideIntObj(statPtr->st_blocks));
#endif
#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
    STORE_ARY("blksize", Tcl_NewWideIntObj((long)statPtr->st_blksize));
#endif





    STORE_ARY("atime",	Tcl_NewWideIntObj(Tcl_GetAccessTimeFromStat(statPtr)));
    STORE_ARY("mtime",	Tcl_NewWideIntObj(Tcl_GetModificationTimeFromStat(statPtr)));

    STORE_ARY("ctime",	Tcl_NewWideIntObj(Tcl_GetChangeTimeFromStat(statPtr)));
    mode = (unsigned short) statPtr->st_mode;
    STORE_ARY("mode",	Tcl_NewWideIntObj(mode));
    STORE_ARY("type",	Tcl_NewStringObj(GetTypeFromMode(mode), -1));
#undef STORE_ARY

    return TCL_OK;








>
>
>
>
>

|
>







2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
    STORE_ARY("gid",	Tcl_NewWideIntObj((long)statPtr->st_gid));
    STORE_ARY("size",	Tcl_NewWideIntObj(statPtr->st_size));
#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
    STORE_ARY("blocks",	Tcl_NewWideIntObj(statPtr->st_blocks));
#endif
#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
    STORE_ARY("blksize", Tcl_NewWideIntObj((long)statPtr->st_blksize));
#endif
#ifdef HAVE_STRUCT_STAT_ST_RDEV
    if (S_ISCHR(statPtr->st_mode) || S_ISBLK(statPtr->st_mode)) {
	STORE_ARY("rdev", Tcl_NewWideIntObj((long) statPtr->st_rdev));
    }
#endif
    STORE_ARY("atime",	Tcl_NewWideIntObj(Tcl_GetAccessTimeFromStat(statPtr)));
    STORE_ARY("mtime",	Tcl_NewWideIntObj(
	    Tcl_GetModificationTimeFromStat(statPtr)));
    STORE_ARY("ctime",	Tcl_NewWideIntObj(Tcl_GetChangeTimeFromStat(statPtr)));
    mode = (unsigned short) statPtr->st_mode;
    STORE_ARY("mode",	Tcl_NewWideIntObj(mode));
    STORE_ARY("type",	Tcl_NewStringObj(GetTypeFromMode(mode), -1));
#undef STORE_ARY

    return TCL_OK;
2649
2650
2651
2652
2653
2654
2655
2656

2657
2658
2659
2660
2661
2662
2663
    int collect,		/* Select collecting or accumulating mode
				 * (TCL_EACH_*) */
    int objc,			/* The arguments being passed in... */
    Tcl_Obj *const objv[])
{
    int numLists = (objc-2) / 2;
    struct ForeachState *statePtr;
    int i, j, result;


    if (objc < 4 || (objc%2 != 0)) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"varList list ?varList list ...? command");
	return TCL_ERROR;
    }








|
>







2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
    int collect,		/* Select collecting or accumulating mode
				 * (TCL_EACH_*) */
    int objc,			/* The arguments being passed in... */
    Tcl_Obj *const objv[])
{
    int numLists = (objc-2) / 2;
    struct ForeachState *statePtr;
    int i, result;
    Tcl_Size j;

    if (objc < 4 || (objc%2 != 0)) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"varList list ?varList list ...? command");
	return TCL_ERROR;
    }

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
     *
     * The setting up of all of these pointers is moderately messy, but allows
     * the rest of this code to be simple and for us to use a single memory
     * allocation for better performance.
     */

    statePtr = (struct ForeachState *)TclStackAlloc(interp,
	    sizeof(struct ForeachState) + 3 * numLists * sizeof(size_t)
	    + 2 * numLists * (sizeof(Tcl_Obj **) + sizeof(Tcl_Obj *)));
    memset(statePtr, 0,
	    sizeof(struct ForeachState) + 3 * numLists * sizeof(size_t)
	    + 2 * numLists * (sizeof(Tcl_Obj **) + sizeof(Tcl_Obj *)));
    statePtr->varvList = (Tcl_Obj ***) (statePtr + 1);
    statePtr->argvList = statePtr->varvList + numLists;
    statePtr->vCopyList = (Tcl_Obj **) (statePtr->argvList + numLists);
    statePtr->aCopyList = statePtr->vCopyList + numLists;
    statePtr->index = (size_t *) (statePtr->aCopyList + numLists);
    statePtr->varcList = statePtr->index + numLists;
    statePtr->argcList = statePtr->varcList + numLists;

    statePtr->numLists = numLists;
    statePtr->bodyPtr = objv[objc - 1];
    statePtr->bodyIdx = objc - 1;

    if (collect == TCL_EACH_COLLECT) {
	statePtr->resultList = Tcl_NewListObj(0, NULL);
    } else {
	statePtr->resultList = NULL;
    }

    /*
     * Break up the value lists and variable lists into elements.
     */

    for (i=0 ; i<numLists ; i++) {
	/* List */
	/* Variables */
	statePtr->vCopyList[i] = TclListObjCopy(interp, objv[1+i*2]);

	if (statePtr->vCopyList[i] == NULL) {






	    result = TCL_ERROR;
	    goto done;
	}
	TclListObjGetElementsM(NULL, statePtr->vCopyList[i],
	    &statePtr->varcList[i], &statePtr->varvList[i]);
	if (statePtr->varcList[i] < 1) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"%s varlist is empty",
		(statePtr->resultList != NULL ? "lmap" : "foreach")));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION",
		(statePtr->resultList != NULL ? "LMAP" : "FOREACH"),
		"NEEDVARS", NULL);
	    result = TCL_ERROR;
	    goto done;
	}



	/* Values */
	if (TclHasInternalRep(objv[2+i*2],&tclAbstractListType)) {
	    /* Special case for Abstract List */
	    statePtr->aCopyList[i] = Tcl_AbstractListObjCopy(interp, objv[2+i*2]);
	    if (statePtr->aCopyList[i] == NULL) {
		result = TCL_ERROR;
		goto done;
	    }
	    /* Don't compute values here, wait until the last momement */
	    statePtr->argcList[i] = Tcl_AbstractListObjLength(statePtr->aCopyList[i]);
	} else {
	    statePtr->aCopyList[i] = TclListObjCopy(interp, objv[2+i*2]);

	    if (statePtr->aCopyList[i] == NULL) {
		result = TCL_ERROR;
		goto done;
	    }
	    TclListObjGetElementsM(NULL, statePtr->aCopyList[i],
		    &statePtr->argcList[i], &statePtr->argvList[i]);



	}
	/* account for variable <> value mismatch */
	j = statePtr->argcList[i] / statePtr->varcList[i];
	if ((statePtr->argcList[i] % statePtr->varcList[i]) != 0) {
	    j++;
	}
	if (j > statePtr->maxj) {







|


|





|




















|
>
|
>
>
>
>
>
>



<
<










>
>


|
|
|




|
|

|
>
|



|
|
>
>
>







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
     *
     * The setting up of all of these pointers is moderately messy, but allows
     * the rest of this code to be simple and for us to use a single memory
     * allocation for better performance.
     */

    statePtr = (struct ForeachState *)TclStackAlloc(interp,
	    sizeof(struct ForeachState) + 3 * numLists * sizeof(Tcl_Size)
	    + 2 * numLists * (sizeof(Tcl_Obj **) + sizeof(Tcl_Obj *)));
    memset(statePtr, 0,
	    sizeof(struct ForeachState) + 3 * numLists * sizeof(Tcl_Size)
	    + 2 * numLists * (sizeof(Tcl_Obj **) + sizeof(Tcl_Obj *)));
    statePtr->varvList = (Tcl_Obj ***) (statePtr + 1);
    statePtr->argvList = statePtr->varvList + numLists;
    statePtr->vCopyList = (Tcl_Obj **) (statePtr->argvList + numLists);
    statePtr->aCopyList = statePtr->vCopyList + numLists;
    statePtr->index = (Tcl_Size *) (statePtr->aCopyList + numLists);
    statePtr->varcList = statePtr->index + numLists;
    statePtr->argcList = statePtr->varcList + numLists;

    statePtr->numLists = numLists;
    statePtr->bodyPtr = objv[objc - 1];
    statePtr->bodyIdx = objc - 1;

    if (collect == TCL_EACH_COLLECT) {
	statePtr->resultList = Tcl_NewListObj(0, NULL);
    } else {
	statePtr->resultList = NULL;
    }

    /*
     * Break up the value lists and variable lists into elements.
     */

    for (i=0 ; i<numLists ; i++) {
	/* List */
	/* Variables */
	statePtr->vCopyList[i] = TclDuplicatePureObj(
	    interp, objv[1+i*2], &tclListType);
	if (!statePtr->vCopyList[i]) {
	    result = TCL_ERROR;
	    goto done;
	}
	result = TclListObjLengthM(interp, statePtr->vCopyList[i],
	    &statePtr->varcList[i]);
	if (result != TCL_OK) {
	    result = TCL_ERROR;
	    goto done;
	}


	if (statePtr->varcList[i] < 1) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"%s varlist is empty",
		(statePtr->resultList != NULL ? "lmap" : "foreach")));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION",
		(statePtr->resultList != NULL ? "LMAP" : "FOREACH"),
		"NEEDVARS", NULL);
	    result = TCL_ERROR;
	    goto done;
	}
	TclListObjGetElementsM(NULL, statePtr->vCopyList[i],
	    &statePtr->varcList[i], &statePtr->varvList[i]);

	/* Values */
	if (TclObjTypeHasProc(objv[2+i*2],indexProc)) {
	    /* Special case for AbstractList */
	    statePtr->aCopyList[i] = Tcl_DuplicateObj(objv[2+i*2]);
	    if (statePtr->aCopyList[i] == NULL) {
		result = TCL_ERROR;
		goto done;
	    }
	    /* Don't compute values here, wait until the last moment */
	    statePtr->argcList[i] = TclObjTypeHasProc(statePtr->aCopyList[i], lengthProc)(statePtr->aCopyList[i]);
	} else {
	    statePtr->aCopyList[i] = TclDuplicatePureObj(
		interp, objv[2+i*2], &tclListType);
	    if (!statePtr->aCopyList[i]) {
		result = TCL_ERROR;
		goto done;
	    }
	    result = TclListObjGetElementsM(interp, statePtr->aCopyList[i],
		&statePtr->argcList[i], &statePtr->argvList[i]);
	    if (result != TCL_OK) {
		goto done;
	    }
	}
	/* account for variable <> value mismatch */
	j = statePtr->argcList[i] / statePtr->varcList[i];
	if ((statePtr->argcList[i] % statePtr->varcList[i]) != 0) {
	    j++;
	}
	if (j > statePtr->maxj) {
2800
2801
2802
2803
2804
2805
2806
2807
2808




2809
2810
2811
2812
2813
2814
2815

    switch (result) {
    case TCL_CONTINUE:
	result = TCL_OK;
	break;
    case TCL_OK:
	if (statePtr->resultList != NULL) {
	    Tcl_ListObjAppendElement(interp, statePtr->resultList,
		    Tcl_GetObjResult(interp));




	}
	break;
    case TCL_BREAK:
	result = TCL_OK;
	goto finish;
    case TCL_ERROR:
	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(







|
|
>
>
>
>







2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910

    switch (result) {
    case TCL_CONTINUE:
	result = TCL_OK;
	break;
    case TCL_OK:
	if (statePtr->resultList != NULL) {
	    result = Tcl_ListObjAppendElement(
		interp, statePtr->resultList, Tcl_GetObjResult(interp));
	    if (result != TCL_OK) {
		/* e.g. memory alloc failure on big data tests */
		goto done;
	    }
	}
	break;
    case TCL_BREAK:
	result = TCL_OK;
	goto finish;
    case TCL_ERROR:
	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
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
{
    int i;
    Tcl_Size v, k;
    Tcl_Obj *valuePtr, *varValuePtr;

    for (i=0 ; i<statePtr->numLists ; i++) {
	int isAbstractList =
	    TclHasInternalRep(statePtr->aCopyList[i],&tclAbstractListType);

	for (v=0 ; v<statePtr->varcList[i] ; v++) {
	    k = statePtr->index[i]++;
	    if (k < statePtr->argcList[i]) {
		if (isAbstractList) {
		    if (Tcl_AbstractListObjIndex(interp, statePtr->aCopyList[i], k, &valuePtr)
                        != TCL_OK) {
			Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
			    "\n    (setting %s loop variable \"%s\")",
			    (statePtr->resultList != NULL ? "lmap" : "foreach"),
			    TclGetString(statePtr->varvList[i][v])));
			return TCL_ERROR;
		    }
		} else {
		    valuePtr = statePtr->argvList[i][k];
		}
	    } else {
		TclNewObj(valuePtr);	/* Empty string */







|





|
<

|
|
|







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
{
    int i;
    Tcl_Size v, k;
    Tcl_Obj *valuePtr, *varValuePtr;

    for (i=0 ; i<statePtr->numLists ; i++) {
	int isAbstractList =
		TclObjTypeHasProc(statePtr->aCopyList[i],indexProc) != NULL;

	for (v=0 ; v<statePtr->varcList[i] ; v++) {
	    k = statePtr->index[i]++;
	    if (k < statePtr->argcList[i]) {
		if (isAbstractList) {
		    if (Tcl_ObjTypeIndex(interp, statePtr->aCopyList[i], k, &valuePtr) != TCL_OK) {

			Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
				"\n    (setting %s loop variable \"%s\")",
				(statePtr->resultList != NULL ? "lmap" : "foreach"),
				TclGetString(statePtr->varvList[i][v])));
			return TCL_ERROR;
		    }
		} else {
		    valuePtr = statePtr->argvList[i][k];
		}
	    } else {
		TclNewObj(valuePtr);	/* Empty string */

Changes to generic/tclCmdIL.c.

13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
 * 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 <math.h>
#include "tclInt.h"
#include "tclRegexp.h"
#include "tclAbstractList.h"
#include "tclArithSeries.h"
#include <assert.h>

/*
 * During execution of the "lsort" command, structures of the following type
 * are used to arrange the objects being sorted into a collection of linked
 * lists.
 */







<


|
|







13
14
15
16
17
18
19

20
21
22
23
24
25
26
27
28
29
30
 * 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"
#include "tclTomMath.h"
#include <math.h>
#include <assert.h>

/*
 * During execution of the "lsort" command, structures of the following type
 * are used to arrange the objects being sorted into a collection of linked
 * lists.
 */
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

/*
 * These function pointer types are used with the "lsearch" and "lsort"
 * commands to facilitate the "-nocase" option.
 */

typedef int (*SortStrCmpFn_t) (const char *, const char *);
typedef int (*SortMemCmpFn_t) (const void *, const void *, size_t);

/*
 * The "lsort" command needs to pass certain information down to the function
 * that compares two list elements, and the comparison function needs to pass
 * success or failure information back up to the top-level "lsort" command.
 * The following structure is used to pass this information.
 */

typedef struct {
    int isIncreasing;		/* Nonzero means sort in increasing order. */
    int sortMode;		/* The sort mode. One of SORTMODE_* values
				 * defined below. */
    Tcl_Obj *compareCmdPtr;	/* The Tcl comparison command when sortMode is
				 * SORTMODE_COMMAND. Pre-initialized to hold
				 * base of command. */
    int *indexv;		/* If the -index option was specified, this
				 * holds an encoding of the indexes contained
				 * in the list supplied as an argument to
				 * that option.
				 * NULL if no indexes supplied, and points to
				 * singleIndex field when only one
				 * supplied. */
    size_t indexc;			/* Number of indexes in indexv array. */
    int singleIndex;		/* Static space for common index case. */
    int unique;
    int numElements;
    Tcl_Interp *interp;		/* The interpreter in which the sort is being
				 * done. */
    int resultCode;		/* Completion code for the lsort command. If
				 * an error occurs during the sort this is







|













|








|







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

/*
 * These function pointer types are used with the "lsearch" and "lsort"
 * commands to facilitate the "-nocase" option.
 */

typedef int (*SortStrCmpFn_t) (const char *, const char *);
typedef int (*SortMemCmpFn_t) (const void *, const void *, Tcl_Size);

/*
 * The "lsort" command needs to pass certain information down to the function
 * that compares two list elements, and the comparison function needs to pass
 * success or failure information back up to the top-level "lsort" command.
 * The following structure is used to pass this information.
 */

typedef struct {
    int isIncreasing;		/* Nonzero means sort in increasing order. */
    int sortMode;		/* The sort mode. One of SORTMODE_* values
				 * defined below. */
    Tcl_Obj *compareCmdPtr;	/* The Tcl comparison command when sortMode is
				 * SORTMODE_COMMAND. Preinitialized to hold
				 * base of command. */
    int *indexv;		/* If the -index option was specified, this
				 * holds an encoding of the indexes contained
				 * in the list supplied as an argument to
				 * that option.
				 * NULL if no indexes supplied, and points to
				 * singleIndex field when only one
				 * supplied. */
    Tcl_Size indexc;		/* Number of indexes in indexv array. */
    int singleIndex;		/* Static space for common index case. */
    int unique;
    int numElements;
    Tcl_Interp *interp;		/* The interpreter in which the sort is being
				 * done. */
    int resultCode;		/* Completion code for the lsort command. If
				 * an error occurs during the sort this is
93
94
95
96
97
98
99

















100
101
102
103
104
105
106
#define SORTMODE_ASCII		0
#define SORTMODE_INTEGER	1
#define SORTMODE_REAL		2
#define SORTMODE_COMMAND	3
#define SORTMODE_DICTIONARY	4
#define SORTMODE_ASCII_NC	8


















/*
 * Forward declarations for procedures defined in this file:
 */

static int		DictionaryCompare(const char *left, const char *right);
static Tcl_NRPostProc	IfConditionCallback;
static Tcl_ObjCmdProc	InfoArgsCmd;







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







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
#define SORTMODE_ASCII		0
#define SORTMODE_INTEGER	1
#define SORTMODE_REAL		2
#define SORTMODE_COMMAND	3
#define SORTMODE_DICTIONARY	4
#define SORTMODE_ASCII_NC	8

/*
 * Definitions for [lseq] command
 */
static const char *const seq_operations[] = {
    "..", "to", "count", "by", NULL
};
typedef enum Sequence_Operators {
    LSEQ_DOTS, LSEQ_TO, LSEQ_COUNT, LSEQ_BY
} SequenceOperators;
static const char *const seq_step_keywords[] = {"by", NULL};
typedef enum Step_Operators {
    STEP_BY = 4
} SequenceByMode;
typedef enum Sequence_Decoded {
     NoneArg, NumericArg, RangeKeywordArg, ByKeywordArg
} SequenceDecoded;

/*
 * Forward declarations for procedures defined in this file:
 */

static int		DictionaryCompare(const char *left, const char *right);
static Tcl_NRPostProc	IfConditionCallback;
static Tcl_ObjCmdProc	InfoArgsCmd;
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
    {"procs",		   InfoProcsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"script",		   InfoScriptCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"sharedlibextension", InfoSharedlibCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
    {"tclversion",	   InfoTclVersionCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
    {"vars",		   TclInfoVarsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {NULL, NULL, NULL, NULL, NULL, 0}
};

/*
 * Definitions for [lseq] command
 */
static const char *const seq_operations[] = {
    "..", "to", "count", "by", NULL
};
typedef enum Sequence_Operators {
    LSEQ_DOTS, LSEQ_TO, LSEQ_COUNT, LSEQ_BY
} SequenceOperators;
static const char *const seq_step_keywords[] = {"by", NULL};
typedef enum Step_Operators {
    STEP_BY = 4
} SequenceByMode;
typedef enum Sequence_Decoded {
     NoneArg, NumericArg, RangeKeywordArg, ByKeywordArg
} SequenceDecoded;


/*
 *----------------------------------------------------------------------
 *
 * Tcl_IfObjCmd --
 *
 *	This procedure is invoked to process the "if" Tcl command. See the







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







177
178
179
180
181
182
183


















184
185
186
187
188
189
190
    {"procs",		   InfoProcsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"script",		   InfoScriptCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"sharedlibextension", InfoSharedlibCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
    {"tclversion",	   InfoTclVersionCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
    {"vars",		   TclInfoVarsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {NULL, NULL, NULL, NULL, NULL, 0}
};



















/*
 *----------------------------------------------------------------------
 *
 * Tcl_IfObjCmd --
 *
 *	This procedure is invoked to process the "if" Tcl command. See the
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    const char *name, *bytes;
    Proc *procPtr;
    size_t numBytes;

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

    name = TclGetString(objv[1]);







|







536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    const char *name, *bytes;
    Proc *procPtr;
    Tcl_Size numBytes;

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

    name = TclGetString(objv[1]);
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
    Tcl_HashSearch search;
    Namespace *nsPtr;
    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
    Tcl_Obj *listPtr, *elemObjPtr;
    int specificNsInPattern = 0;/* Init. to avoid compiler warning. */
    Tcl_Command cmd;
    size_t i;

    /*
     * Get the pattern and find the "effective namespace" in which to list
     * commands.
     */

    if (objc == 1) {







|







646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
    Tcl_HashSearch search;
    Namespace *nsPtr;
    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
    Tcl_Obj *listPtr, *elemObjPtr;
    int specificNsInPattern = 0;/* Init. to avoid compiler warning. */
    Tcl_Command cmd;
    Tcl_Size i;

    /*
     * Get the pattern and find the "effective namespace" in which to list
     * commands.
     */

    if (objc == 1) {
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
	 * special characters. This lets us avoid scans of any hash tables.
	 */

	entryPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern);
	if (entryPtr != NULL) {
	    if (specificNsInPattern) {
		cmd = (Tcl_Command)Tcl_GetHashValue(entryPtr);
		elemObjPtr = Tcl_NewObj();
		Tcl_GetCommandFullName(interp, cmd, elemObjPtr);
	    } else {
		cmdName = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
		elemObjPtr = Tcl_NewStringObj(cmdName, -1);
	    }
	    Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
	    Tcl_SetObjResult(interp, listPtr);







|







707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
	 * special characters. This lets us avoid scans of any hash tables.
	 */

	entryPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern);
	if (entryPtr != NULL) {
	    if (specificNsInPattern) {
		cmd = (Tcl_Command)Tcl_GetHashValue(entryPtr);
		TclNewObj(elemObjPtr);
		Tcl_GetCommandFullName(interp, cmd, elemObjPtr);
	    } else {
		cmdName = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
		elemObjPtr = Tcl_NewStringObj(cmdName, -1);
	    }
	    Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
	    Tcl_SetObjResult(interp, listPtr);
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
	entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
	while (entryPtr != NULL) {
	    cmdName = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
	    if ((simplePattern == NULL)
		    || Tcl_StringMatch(cmdName, simplePattern)) {
		if (specificNsInPattern) {
		    cmd = (Tcl_Command)Tcl_GetHashValue(entryPtr);
		    elemObjPtr = Tcl_NewObj();
		    Tcl_GetCommandFullName(interp, cmd, elemObjPtr);
		} else {
		    elemObjPtr = Tcl_NewStringObj(cmdName, -1);
		}
		Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
	    }
	    entryPtr = Tcl_NextHashEntry(&search);







|







758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
	entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
	while (entryPtr != NULL) {
	    cmdName = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
	    if ((simplePattern == NULL)
		    || Tcl_StringMatch(cmdName, simplePattern)) {
		if (specificNsInPattern) {
		    cmd = (Tcl_Command)Tcl_GetHashValue(entryPtr);
		    TclNewObj(elemObjPtr);
		    Tcl_GetCommandFullName(interp, cmd, elemObjPtr);
		} else {
		    elemObjPtr = Tcl_NewStringObj(cmdName, -1);
		}
		Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
	    }
	    entryPtr = Tcl_NextHashEntry(&search);
987
988
989
990
991
992
993
994

995
996
997
998
999
1000
1001
		valueObjPtr = Tcl_ObjSetVar2(interp, objv[3], NULL,
			localPtr->defValuePtr, TCL_LEAVE_ERR_MSG);
		if (valueObjPtr == NULL) {
		    return TCL_ERROR;
		}
		Tcl_SetObjResult(interp, Tcl_NewWideIntObj(1));
	    } else {
		Tcl_Obj *nullObjPtr = Tcl_NewObj();


		valueObjPtr = Tcl_ObjSetVar2(interp, objv[3], NULL,
			nullObjPtr, TCL_LEAVE_ERR_MSG);
		if (valueObjPtr == NULL) {
		    return TCL_ERROR;
		}
		Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0));







|
>







985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
		valueObjPtr = Tcl_ObjSetVar2(interp, objv[3], NULL,
			localPtr->defValuePtr, TCL_LEAVE_ERR_MSG);
		if (valueObjPtr == NULL) {
		    return TCL_ERROR;
		}
		Tcl_SetObjResult(interp, Tcl_NewWideIntObj(1));
	    } else {
		Tcl_Obj *nullObjPtr;
		TclNewObj(nullObjPtr);

		valueObjPtr = Tcl_ObjSetVar2(interp, objv[3], NULL,
			nullObjPtr, TCL_LEAVE_ERR_MSG);
		if (valueObjPtr == NULL) {
		    return TCL_ERROR;
		}
		Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0));
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407

	    TclNewObj(procNameObj);
	    Tcl_GetCommandFullName(interp, (Tcl_Command) procPtr->cmdPtr,
		    procNameObj);
	    ADD_PAIR("proc", procNameObj);
	} else if (procPtr->cmdPtr->clientData) {
	    ExtraFrameInfo *efiPtr = (ExtraFrameInfo *)procPtr->cmdPtr->clientData;
	    size_t i;

	    /*
	     * This is a non-standard command. Luckily, it's told us how to
	     * render extra information about its frame.
	     */

	    for (i=0 ; i<efiPtr->length ; i++) {







|







1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406

	    TclNewObj(procNameObj);
	    Tcl_GetCommandFullName(interp, (Tcl_Command) procPtr->cmdPtr,
		    procNameObj);
	    ADD_PAIR("proc", procNameObj);
	} else if (procPtr->cmdPtr->clientData) {
	    ExtraFrameInfo *efiPtr = (ExtraFrameInfo *)procPtr->cmdPtr->clientData;
	    Tcl_Size i;

	    /*
	     * This is a non-standard command. Luckily, it's told us how to
	     * render extra information about its frame.
	     */

	    for (i=0 ; i<efiPtr->length ; i++) {
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
			TclGetOriginalCommand((Tcl_Command) cmdPtr);
		if (realCmdPtr != NULL && TclIsProc(realCmdPtr)) {
		    goto simpleProcOK;
		}
	    } else {
	    simpleProcOK:
		if (specificNsInPattern) {
		    elemObjPtr = Tcl_NewObj();
		    Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr,
			    elemObjPtr);
		} else {
		    elemObjPtr = Tcl_NewStringObj(simplePattern, -1);
		}
		Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
	    }







|







1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
			TclGetOriginalCommand((Tcl_Command) cmdPtr);
		if (realCmdPtr != NULL && TclIsProc(realCmdPtr)) {
		    goto simpleProcOK;
		}
	    } else {
	    simpleProcOK:
		if (specificNsInPattern) {
		    TclNewObj(elemObjPtr);
		    Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr,
			    elemObjPtr);
		} else {
		    elemObjPtr = Tcl_NewStringObj(simplePattern, -1);
		}
		Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
	    }
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
			    TclGetOriginalCommand((Tcl_Command) cmdPtr);
		    if (realCmdPtr != NULL && TclIsProc(realCmdPtr)) {
			goto procOK;
		    }
		} else {
		procOK:
		    if (specificNsInPattern) {
			elemObjPtr = Tcl_NewObj();
			Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr,
				elemObjPtr);
		    } else {
			elemObjPtr = Tcl_NewStringObj(cmdName, -1);
		    }
		    Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
		}







|







1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
			    TclGetOriginalCommand((Tcl_Command) cmdPtr);
		    if (realCmdPtr != NULL && TclIsProc(realCmdPtr)) {
			goto procOK;
		    }
		} else {
		procOK:
		    if (specificNsInPattern) {
			TclNewObj(elemObjPtr);
			Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr,
				elemObjPtr);
		    } else {
			elemObjPtr = Tcl_NewStringObj(cmdName, -1);
		    }
		    Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
		}
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
int
Tcl_JoinObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{

    size_t length, listLen, isAbstractList = 0;
    Tcl_Obj *resObjPtr = NULL, *joinObjPtr, **elemPtrs;

    if ((objc < 2) || (objc > 3)) {
	Tcl_WrongNumArgs(interp, 1, objv, "list ?joinString?");
	return TCL_ERROR;
    }

    /*
     * Make sure the list argument is a list object and get its length and a
     * pointer to its array of element pointers.
     */

    if (TclAbstractListHasProc(objv[1], TCL_ABSL_GETELEMENTS)) {
	listLen = Tcl_AbstractListObjLength(objv[1]);
	isAbstractList = (listLen ? 1 : 0);
	if (listLen > 1 &&
	    Tcl_AbstractListObjGetElements(interp, objv[1], &listLen, &elemPtrs)
	    != TCL_OK) {
	    return TCL_ERROR;
	}
    } else if (TclListObjGetElementsM(interp, objv[1], &listLen,
	    &elemPtrs) != TCL_OK) {
	return TCL_ERROR;
    }

    if (listLen == 0) {
	/* No elements to join; default empty result is correct. */
	return TCL_OK;
    }
    if (listLen == 1) {
	/* One element; return it */
	if (!isAbstractList) {
	    Tcl_SetObjResult(interp, elemPtrs[0]);
	} else {
            Tcl_Obj *elemObj;
            if (Tcl_AbstractListObjIndex(interp, objv[1], 0, &elemObj)
		!= TCL_OK) {
                return TCL_ERROR;
            }
	    Tcl_SetObjResult(interp, elemObj);
	}
	return TCL_OK;
    }

    joinObjPtr = (objc == 2) ? Tcl_NewStringObj(" ", 1) : objv[2];
    Tcl_IncrRefCount(joinObjPtr);

    (void) Tcl_GetStringFromObj(joinObjPtr, &length);
    if (length == 0) {
	resObjPtr = TclStringCat(interp, listLen, elemPtrs, 0);
    } else {
	size_t i;

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

		/*
		 * NOTE: This code is relying on Tcl_AppendObjToObj() **NOT**
		 * to shimmer joinObjPtr.  If it did, then the case where
		 * objv[1] and objv[2] are the same value would not be safe.







>
|












|
|


|


















|















|

|







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
int
Tcl_JoinObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    Tcl_Size length, listLen;
    int isAbstractList = 0;
    Tcl_Obj *resObjPtr = NULL, *joinObjPtr, **elemPtrs;

    if ((objc < 2) || (objc > 3)) {
	Tcl_WrongNumArgs(interp, 1, objv, "list ?joinString?");
	return TCL_ERROR;
    }

    /*
     * Make sure the list argument is a list object and get its length and a
     * pointer to its array of element pointers.
     */

    if (TclObjTypeHasProc(objv[1], getElementsProc)) {
	listLen = TclObjTypeHasProc(objv[1], lengthProc)(objv[1]);
	isAbstractList = (listLen ? 1 : 0);
	if (listLen > 1 &&
	    Tcl_ObjTypeGetElements(interp, objv[1], &listLen, &elemPtrs)
	    != TCL_OK) {
	    return TCL_ERROR;
	}
    } else if (TclListObjGetElementsM(interp, objv[1], &listLen,
	    &elemPtrs) != TCL_OK) {
	return TCL_ERROR;
    }

    if (listLen == 0) {
	/* No elements to join; default empty result is correct. */
	return TCL_OK;
    }
    if (listLen == 1) {
	/* One element; return it */
	if (!isAbstractList) {
	    Tcl_SetObjResult(interp, elemPtrs[0]);
	} else {
            Tcl_Obj *elemObj;
            if (Tcl_ObjTypeIndex(interp, objv[1], 0, &elemObj)
		!= TCL_OK) {
                return TCL_ERROR;
            }
	    Tcl_SetObjResult(interp, elemObj);
	}
	return TCL_OK;
    }

    joinObjPtr = (objc == 2) ? Tcl_NewStringObj(" ", 1) : objv[2];
    Tcl_IncrRefCount(joinObjPtr);

    (void) Tcl_GetStringFromObj(joinObjPtr, &length);
    if (length == 0) {
	resObjPtr = TclStringCat(interp, listLen, elemPtrs, 0);
    } else {
	Tcl_Size i;

	TclNewObj(resObjPtr);
	for (i = 0;  i < listLen;  i++) {
	    if (i > 0) {

		/*
		 * NOTE: This code is relying on Tcl_AppendObjToObj() **NOT**
		 * to shimmer joinObjPtr.  If it did, then the case where
		 * objv[1] and objv[2] are the same value would not be safe.
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
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *listCopyPtr;
    Tcl_Obj **listObjv;		/* The contents of the list. */
    size_t listObjc;		/* The length of the list. */

    int code = TCL_OK;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "list ?varName ...?");
	return TCL_ERROR;
    }

    listCopyPtr = TclListObjCopy(interp, objv[1]);
    if (listCopyPtr == NULL) {
	return TCL_ERROR;
    }



    TclListObjGetElementsM(NULL, listCopyPtr, &listObjc, &listObjv);






    objc -= 2;
    objv += 2;
    while (code == TCL_OK && objc > 0 && listObjc > 0) {
	if (Tcl_ObjSetVar2(interp, *objv++, NULL, *listObjv++,
		TCL_LEAVE_ERR_MSG) == NULL) {
	    code = TCL_ERROR;







|
>
|






|
|


>

>
|
>
>
>
>
>







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
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *listCopyPtr;
    Tcl_Obj **listObjv;		/* The contents of the list. */
    Tcl_Size listObjc;		/* The length of the list. */
    Tcl_Size origListObjc;	/* Original length */
    int code;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "list ?varName ...?");
	return TCL_ERROR;
    }

    listCopyPtr = TclDuplicatePureObj(interp, objv[1], &tclListType);
    if (!listCopyPtr) {
	return TCL_ERROR;
    }
    Tcl_IncrRefCount(listCopyPtr); /* Important! fs */

    code = TclListObjGetElementsM(
	interp, listCopyPtr, &listObjc, &listObjv);
    if (code != TCL_OK) {
	Tcl_DecrRefCount(listCopyPtr);
	return code;
    }
    origListObjc = listObjc;

    objc -= 2;
    objv += 2;
    while (code == TCL_OK && objc > 0 && listObjc > 0) {
	if (Tcl_ObjSetVar2(interp, *objv++, NULL, *listObjv++,
		TCL_LEAVE_ERR_MSG) == NULL) {
	    code = TCL_ERROR;
2343
2344
2345
2346
2347
2348
2349





2350

2351
2352
2353
2354
2355
2356
2357
		code = TCL_ERROR;
	    }
	}
	Tcl_DecrRefCount(emptyObj);
    }

    if (code == TCL_OK && listObjc > 0) {





	Tcl_SetObjResult(interp, Tcl_NewListObj(listObjc, listObjv));

    }

    Tcl_DecrRefCount(listCopyPtr);
    return code;
}

/*







>
>
>
>
>
|
>







2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
		code = TCL_ERROR;
	    }
	}
	Tcl_DecrRefCount(emptyObj);
    }

    if (code == TCL_OK && listObjc > 0) {
	Tcl_Obj *resultObjPtr = TclListObjRange(
	    interp, listCopyPtr, origListObjc - listObjc, origListObjc - 1);
	if (resultObjPtr == NULL) {
	    code = TCL_ERROR;
	} else {
	    Tcl_SetObjResult(interp, resultObjPtr);
	}
    }

    Tcl_DecrRefCount(listCopyPtr);
    return code;
}

/*
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
Tcl_LinsertObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,		/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *listPtr;
    size_t len, index;
    int result;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "list index ?element ...?");
	return TCL_ERROR;
    }

    result = TclListObjLengthM(interp, objv[1], &len);







|
|







2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
Tcl_LinsertObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,		/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *listPtr;
    Tcl_Size len, index;
    int copied = 0, result;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "list index ?element ...?");
	return TCL_ERROR;
    }

    result = TclListObjLengthM(interp, objv[1], &len);
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
     * appended to the list.
     */

    result = TclGetIntForIndexM(interp, objv[2], /*end*/ len, &index);
    if (result != TCL_OK) {
	return result;
    }
    if (index + 1 > len + 1) {
	index = len;
    }

    /*
     * If the list object is unshared we can modify it directly. Otherwise we
     * create a copy to modify: this is "copy on write".
     */

    listPtr = objv[1];
    if (Tcl_IsShared(listPtr)) {

	listPtr = TclListObjCopy(NULL, listPtr);



    }

    if ((objc == 4) && (index == len)) {
	/*
	 * Special case: insert one element at the end of the list.
	 */

	Tcl_ListObjAppendElement(NULL, listPtr, objv[3]);






    } else {
	if (TCL_OK != Tcl_ListObjReplace(interp, listPtr, index, 0,
		(objc-3), &(objv[3]))) {



	    return TCL_ERROR;
	}
    }

    /*
     * Set the interpreter's object result.
     */







|










>
|
>
>
>







|
>
>
>
>
>
>



>
>
>







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
     * appended to the list.
     */

    result = TclGetIntForIndexM(interp, objv[2], /*end*/ len, &index);
    if (result != TCL_OK) {
	return result;
    }
    if (index > len) {
	index = len;
    }

    /*
     * If the list object is unshared we can modify it directly. Otherwise we
     * create a copy to modify: this is "copy on write".
     */

    listPtr = objv[1];
    if (Tcl_IsShared(listPtr)) {
	listPtr = TclDuplicatePureObj(interp, listPtr, &tclListType);
	if (!listPtr) {
	    return TCL_ERROR;
	}
	copied = 1;
    }

    if ((objc == 4) && (index == len)) {
	/*
	 * Special case: insert one element at the end of the list.
	 */

	result = Tcl_ListObjAppendElement(NULL, listPtr, objv[3]);
	if (result != TCL_OK) {
	    if (copied) {
		Tcl_DecrRefCount(listPtr);
	    }
	    return result;
	}
    } else {
	if (TCL_OK != Tcl_ListObjReplace(interp, listPtr, index, 0,
		(objc-3), &(objv[3]))) {
	    if (copied) {
		Tcl_DecrRefCount(listPtr);
	    }
	    return TCL_ERROR;
	}
    }

    /*
     * Set the interpreter's object result.
     */
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
Tcl_LlengthObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])
				/* Argument objects. */
{
    size_t listLen;
    int result;


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

    result = TclListObjLengthM(interp, objv[1], &listLen);
    if (result != TCL_OK) {
	return result;
    }

    /*
     * Set the interpreter's object result to an integer object holding the
     * length.
     */


    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(listLen));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_LpopObjCmd --







|

>
















>
|







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
Tcl_LlengthObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])
				/* Argument objects. */
{
    Tcl_Size listLen;
    int result;
    Tcl_Obj *objPtr;

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

    result = TclListObjLengthM(interp, objv[1], &listLen);
    if (result != TCL_OK) {
	return result;
    }

    /*
     * Set the interpreter's object result to an integer object holding the
     * length.
     */

    TclNewUIntObj(objPtr, listLen);
    Tcl_SetObjResult(interp, objPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_LpopObjCmd --
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
Tcl_LpopObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])
				/* Argument objects. */
{
    size_t listLen;
    int result;
    Tcl_Obj *elemPtr, *stored;
    Tcl_Obj *listPtr, **elemPtrs;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "listvar ?index?");
	return TCL_ERROR;
    }







|
|







2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
Tcl_LpopObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])
				/* Argument objects. */
{
    Tcl_Size listLen;
    int copied = 0, result;
    Tcl_Obj *elemPtr, *stored;
    Tcl_Obj *listPtr, **elemPtrs;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "listvar ?index?");
	return TCL_ERROR;
    }
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
    /*
     * Second, remove the element.
     * TclLsetFlat adds a ref count which is handled.
     */

    if (objc == 2) {
	if (Tcl_IsShared(listPtr)) {

	    listPtr = TclListObjCopy(NULL, listPtr);



	}
	result = Tcl_ListObjReplace(interp, listPtr, listLen - 1, 1, 0, NULL);
	if (result != TCL_OK) {



	    return result;
	}
	Tcl_IncrRefCount(listPtr);
    } else {
	listPtr = TclLsetFlat(interp, listPtr, objc-2, objv+2, NULL);




	if (listPtr == NULL) {
	    return TCL_ERROR;



	}
    }

    stored = Tcl_ObjSetVar2(interp, objv[1], NULL, listPtr, TCL_LEAVE_ERR_MSG);
    Tcl_DecrRefCount(listPtr);
    if (stored == NULL) {
	return TCL_ERROR;
    }

    return TCL_OK;
}








>
|
>
>
>



>
>
>


<

|
>
>
>
|
<

>
>
>




<







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
    /*
     * Second, remove the element.
     * TclLsetFlat adds a ref count which is handled.
     */

    if (objc == 2) {
	if (Tcl_IsShared(listPtr)) {
	    listPtr = TclDuplicatePureObj(interp, listPtr, &tclListType);
	    if (!listPtr) {
		return TCL_ERROR;
	    }
	    copied = 1;
	}
	result = Tcl_ListObjReplace(interp, listPtr, listLen - 1, 1, 0, NULL);
	if (result != TCL_OK) {
	    if (copied) {
		Tcl_DecrRefCount(listPtr);
	    }
	    return result;
	}

    } else {
	Tcl_Obj *newListPtr = TclLsetFlat(interp, listPtr, objc-2, objv+2, NULL);
	if (newListPtr == NULL) {
	    if (copied) {
		Tcl_DecrRefCount(listPtr);
	    }

	    return TCL_ERROR;
	} else {
	    listPtr = newListPtr;
	    TclUndoRefCount(listPtr);
	}
    }

    stored = Tcl_ObjSetVar2(interp, objv[1], NULL, listPtr, TCL_LEAVE_ERR_MSG);

    if (stored == NULL) {
	return TCL_ERROR;
    }

    return TCL_OK;
}

2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736


2737
2738
2739




2740
2741
2742
2743
2744
2745
2746
2747

    result = TclGetIntForIndexM(interp, objv[3], /*endValue*/ listLen - 1,
	    &last);
    if (result != TCL_OK) {
	return result;
    }

    if (TclAbstractListHasProc(objv[1], TCL_ABSL_SLICE)) {
	Tcl_Obj *resultObj;
	int status = Tcl_AbstractListObjRange(interp, objv[1], first, last, &resultObj);
	if (status == TCL_OK) {
	    Tcl_SetObjResult(interp, resultObj);


	}
	return status;
    } else {




	Tcl_SetObjResult(interp, TclListObjRange(objv[1], first, last));
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *







|

|


>
>

<

>
>
>
>
|







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

    result = TclGetIntForIndexM(interp, objv[3], /*endValue*/ listLen - 1,
	    &last);
    if (result != TCL_OK) {
	return result;
    }

    if (TclObjTypeHasProc(objv[1], sliceProc)) {
	Tcl_Obj *resultObj;
	int status = Tcl_ObjTypeSlice(interp, objv[1], first, last, &resultObj);
	if (status == TCL_OK) {
	    Tcl_SetObjResult(interp, resultObj);
	} else {
	    return TCL_ERROR;
	}

    } else {
	Tcl_Obj *resultObj = TclListObjRange(interp, objv[1], first, last);
	if (resultObj == NULL) {
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, resultObj);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
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
 */

static int
LremoveIndexCompare(
    const void *el1Ptr,
    const void *el2Ptr)
{
    size_t idx1 = *((const size_t *) el1Ptr);
    size_t idx2 = *((const size_t *) el2Ptr);

    /*
     * This will put the larger element first.
     */

    return (idx1 < idx2) ? 1 : (idx1 > idx2) ? -1 : 0;
}

int
Tcl_LremoveObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int i, idxc, prevIdx, first, num;
    size_t *idxv, listLen;
    Tcl_Obj *listObj;


    /*
     * Parse the arguments.
     */

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "list ?index ...?");
	return TCL_ERROR;
    }

    listObj = objv[1];
    if (TclListObjLengthM(interp, listObj, &listLen) != TCL_OK) {
	return TCL_ERROR;
    }

    idxc = objc - 2;
    if (idxc == 0) {
	Tcl_SetObjResult(interp, listObj);
	return TCL_OK;
    }
    idxv = (size_t *)Tcl_Alloc((objc - 2) * sizeof(size_t));
    for (i = 2; i < objc; i++) {
	if (TclGetIntForIndexM(interp, objv[i], /*endValue*/ listLen - 1,
		&idxv[i - 2]) != TCL_OK) {
	    Tcl_Free(idxv);
	    return TCL_ERROR;

	}
    }

    /*
     * Sort the indices, large to small so that when we remove an index we
     * don't change the indices still to be processed.
     */

    if (idxc > 1) {
	qsort(idxv, idxc, sizeof(size_t), LremoveIndexCompare);
    }

    /*
     * Make our working copy, then do the actual removes piecemeal.
     */

    if (Tcl_IsShared(listObj)) {

	listObj = TclListObjCopy(NULL, listObj);




    }
    num = 0;
    first = listLen;
    for (i = 0, prevIdx = -1 ; i < idxc ; i++) {
	int idx = idxv[i];

	/*
	 * Repeated index and sanity check.
	 */

	if (idx == prevIdx) {
	    continue;
	}
	prevIdx = idx;
	if (idx < 0 || idx >= (int)listLen) {
	    continue;
	}

	/*
	 * Coalesce adjacent removes to reduce the number of copies.
	 */

	if (num == 0) {
	    num = 1;
	    first = idx;
	} else if (idx + 1 == first) {
	    num++;
	    first = idx;
	} else {
	    /*
	     * Note that this operation can't fail now; we know we have a list
	     * and we're only ever contracting that list.
	     */

	    (void) Tcl_ListObjReplace(interp, listObj, first, num, 0, NULL);



	    listLen -= num;
	    num = 1;
	    first = idx;
	}
    }
    if (num != 0) {
	(void) Tcl_ListObjReplace(interp, listObj, first, num, 0, NULL);



    }
    Tcl_Free(idxv);



    Tcl_SetObjResult(interp, listObj);


    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_LrepeatObjCmd --
 *







|
|















|
|

>




















|

|
|
<
|
>









|







>
|
>
>
>
>




|









|



















|
>
>
>






|
>
>
>
|
<
>
>
>

>
>
|







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

static int
LremoveIndexCompare(
    const void *el1Ptr,
    const void *el2Ptr)
{
    Tcl_Size idx1 = *((const Tcl_Size *) el1Ptr);
    Tcl_Size idx2 = *((const Tcl_Size *) el2Ptr);

    /*
     * This will put the larger element first.
     */

    return (idx1 < idx2) ? 1 : (idx1 > idx2) ? -1 : 0;
}

int
Tcl_LremoveObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Size i, idxc, prevIdx, first, num;
    Tcl_Size *idxv, listLen;
    Tcl_Obj *listObj;
    int copied = 0, status = TCL_OK;

    /*
     * Parse the arguments.
     */

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "list ?index ...?");
	return TCL_ERROR;
    }

    listObj = objv[1];
    if (TclListObjLengthM(interp, listObj, &listLen) != TCL_OK) {
	return TCL_ERROR;
    }

    idxc = objc - 2;
    if (idxc == 0) {
	Tcl_SetObjResult(interp, listObj);
	return TCL_OK;
    }
    idxv = (Tcl_Size *)Tcl_Alloc((objc - 2) * sizeof(*idxv));
    for (i = 2; i < objc; i++) {
	status = (TclGetIntForIndexM(interp, objv[i], /*endValue*/ listLen - 1,
		&idxv[i - 2]) != TCL_OK);

	if (status != TCL_OK) {
	    goto done;
	}
    }

    /*
     * Sort the indices, large to small so that when we remove an index we
     * don't change the indices still to be processed.
     */

    if (idxc > 1) {
	qsort(idxv, idxc, sizeof(*idxv), LremoveIndexCompare);
    }

    /*
     * Make our working copy, then do the actual removes piecemeal.
     */

    if (Tcl_IsShared(listObj)) {
	listObj = TclDuplicatePureObj(interp, listObj, &tclListType);
	if (!listObj) {
	    status = TCL_ERROR;
	    goto done;
	}
	copied = 1;
    }
    num = 0;
    first = listLen;
    for (i = 0, prevIdx = -1 ; i < idxc ; i++) {
	Tcl_Size idx = idxv[i];

	/*
	 * Repeated index and sanity check.
	 */

	if (idx == prevIdx) {
	    continue;
	}
	prevIdx = idx;
	if (idx < 0 || idx >= listLen) {
	    continue;
	}

	/*
	 * Coalesce adjacent removes to reduce the number of copies.
	 */

	if (num == 0) {
	    num = 1;
	    first = idx;
	} else if (idx + 1 == first) {
	    num++;
	    first = idx;
	} else {
	    /*
	     * Note that this operation can't fail now; we know we have a list
	     * and we're only ever contracting that list.
	     */

	    status = Tcl_ListObjReplace(interp, listObj, first, num, 0, NULL);
	    if (status != TCL_OK) {
		goto done;
	    }
	    listLen -= num;
	    num = 1;
	    first = idx;
	}
    }
    if (num != 0) {
	status = Tcl_ListObjReplace(interp, listObj, first, num, 0, NULL);
	if (status != TCL_OK) {
	    if (copied) {
		Tcl_DecrRefCount(listObj);
	    }

	    goto done;
	}
    }
    Tcl_SetObjResult(interp, listObj);
done:
    Tcl_Free(idxv);
    return status;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_LrepeatObjCmd --
 *
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
Tcl_LrepeatObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,		/* Number of arguments. */
    Tcl_Obj *const objv[])
				/* The argument objects. */
{
    int elementCount, i, totalElems;

    Tcl_Obj *listPtr, **dataArray = NULL;

    /*
     * Check arguments for legality:
     *		lrepeat count ?value ...?
     */

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "count ?value ...?");
	return TCL_ERROR;
    }
    if (TCL_OK != TclGetIntFromObj(interp, objv[1], &elementCount)) {
	return TCL_ERROR;
    }
    if (elementCount < 0) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"bad count \"%d\": must be integer >= 0", elementCount));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPEAT", "NEGARG",
		NULL);
	return TCL_ERROR;
    }

    /*
     * Skip forward to the interesting arguments now we've finished parsing.
     */

    objc -= 2;
    objv += 2;

    /* Final sanity check. Do not exceed limits on max list length. */

    if (elementCount && (size_t)objc > LIST_MAX/elementCount) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"max length of a Tcl list (%" TCL_Z_MODIFIER "u elements) exceeded", LIST_MAX));
	Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	return TCL_ERROR;
    }
    totalElems = objc * elementCount;

    /*
     * Get an empty list object that is allocated large enough to hold each







|
>











|




|














|

|







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
Tcl_LrepeatObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,		/* Number of arguments. */
    Tcl_Obj *const objv[])
				/* The argument objects. */
{
    Tcl_WideInt elementCount, i;
    Tcl_Size totalElems;
    Tcl_Obj *listPtr, **dataArray = NULL;

    /*
     * Check arguments for legality:
     *		lrepeat count ?value ...?
     */

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "count ?value ...?");
	return TCL_ERROR;
    }
    if (TCL_OK != TclGetWideIntFromObj(interp, objv[1], &elementCount)) {
	return TCL_ERROR;
    }
    if (elementCount < 0) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"bad count \"%" TCL_LL_MODIFIER "d\": must be integer >= 0", elementCount));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPEAT", "NEGARG",
		NULL);
	return TCL_ERROR;
    }

    /*
     * Skip forward to the interesting arguments now we've finished parsing.
     */

    objc -= 2;
    objv += 2;

    /* Final sanity check. Do not exceed limits on max list length. */

    if (elementCount && objc > LIST_MAX/elementCount) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"max length of a Tcl list (%" TCL_SIZE_MODIFIER "d elements) exceeded", LIST_MAX));
	Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	return TCL_ERROR;
    }
    totalElems = objc * elementCount;

    /*
     * Get an empty list object that is allocated large enough to hold each
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
	Tcl_Obj *tmpPtr = objv[0];

	tmpPtr->refCount += elementCount;
	for (i=0 ; i<elementCount ; i++) {
	    dataArray[i] = tmpPtr;
	}
    } else {
	int j, k = 0;

	for (i=0 ; i<elementCount ; i++) {
	    for (j=0 ; j<objc ; j++) {
		Tcl_IncrRefCount(objv[j]);
		dataArray[k++] = objv[j];
	    }
	}







|







3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
	Tcl_Obj *tmpPtr = objv[0];

	tmpPtr->refCount += elementCount;
	for (i=0 ; i<elementCount ; i++) {
	    dataArray[i] = tmpPtr;
	}
    } else {
	Tcl_Size j, k = 0;

	for (i=0 ; i<elementCount ; i++) {
	    for (j=0 ; j<objc ; j++) {
		Tcl_IncrRefCount(objv[j]);
		dataArray[k++] = objv[j];
	    }
	}
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
Tcl_LreplaceObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *listPtr;
    size_t numToDelete, listLen, first, last;
    int result;

    if (objc < 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"list first last ?element ...?");
	return TCL_ERROR;
    }







|







3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
Tcl_LreplaceObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *listPtr;
    Tcl_Size numToDelete, listLen, first, last;
    int result;

    if (objc < 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"list first last ?element ...?");
	return TCL_ERROR;
    }
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
    }

    result = TclGetIntForIndexM(interp, objv[3], /*end*/ listLen-1, &last);
    if (result != TCL_OK) {
	return result;
    }

    if (first == TCL_INDEX_NONE) {
	first = 0;
    } else if (first > listLen) {
	first = listLen;
    }

    if (last + 1 > listLen) {
	last = listLen - 1;
    }
    if (first + 1 <= last + 1) {
	numToDelete = last - first + 1;
    } else {
	numToDelete = 0;
    }

    /*
     * If the list object is unshared we can modify it directly, otherwise we
     * create a copy to modify: this is "copy on write".
     */

    listPtr = objv[1];
    if (Tcl_IsShared(listPtr)) {

	listPtr = TclListObjCopy(NULL, listPtr);


    }

    /*
     * Note that we call Tcl_ListObjReplace even when numToDelete == 0 and
     * objc == 4. In this case, the list value of listPtr is not changed (no
     * elements are removed or added), but by making the call we are assured
     * we end up with a list in canonical form. Resist any temptation to
     * optimize this case away.
     */

    if (TCL_OK != Tcl_ListObjReplace(interp, listPtr, first, numToDelete,
	    objc-4, objv+4)) {

	return TCL_ERROR;
    }

    /*
     * Set the interpreter's object result.
     */








|





|


|












>
|
>
>












>







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
    }

    result = TclGetIntForIndexM(interp, objv[3], /*end*/ listLen-1, &last);
    if (result != TCL_OK) {
	return result;
    }

    if (first < 0) {
	first = 0;
    } else if (first > listLen) {
	first = listLen;
    }

    if (last >= listLen) {
	last = listLen - 1;
    }
    if (first <= last) {
	numToDelete = last - first + 1;
    } else {
	numToDelete = 0;
    }

    /*
     * If the list object is unshared we can modify it directly, otherwise we
     * create a copy to modify: this is "copy on write".
     */

    listPtr = objv[1];
    if (Tcl_IsShared(listPtr)) {
	listPtr = TclDuplicatePureObj(interp, listPtr, &tclListType);
	if (!listPtr) {
	    return TCL_ERROR;
	}
    }

    /*
     * Note that we call Tcl_ListObjReplace even when numToDelete == 0 and
     * objc == 4. In this case, the list value of listPtr is not changed (no
     * elements are removed or added), but by making the call we are assured
     * we end up with a list in canonical form. Resist any temptation to
     * optimize this case away.
     */

    if (TCL_OK != Tcl_ListObjReplace(interp, listPtr, first, numToDelete,
	    objc-4, objv+4)) {
	Tcl_DecrRefCount(listPtr);
	return TCL_ERROR;
    }

    /*
     * Set the interpreter's object result.
     */

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
Tcl_LreverseObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument values. */
{
    Tcl_Obj **elemv;
    size_t elemc, i, j;

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

    /*
     *  Handle AbstractList special case - do not shimmer into a list, if it
     *  supports a private Reverse function, just to reverse it.
     */
    if (TclAbstractListHasProc(objv[1], TCL_ABSL_REVERSE)) {
	Tcl_Obj *resultObj;

	if (Tcl_AbstractListObjReverse(interp, objv[1], &resultObj) == TCL_OK) {
	    Tcl_SetObjResult(interp, resultObj);
	    return TCL_OK;
	}
    } /* end Abstract List */

    if (TclListObjGetElementsM(interp, objv[1], &elemc, &elemv) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * If the list is empty, just return it. [Bug 1876793]
     */

    if (!elemc) {
	Tcl_SetObjResult(interp, objv[1]);
	return TCL_OK;



    }

    if (Tcl_IsShared(objv[1])
	|| ListObjRepIsShared(objv[1])) { /* Bug 1675044 */
	Tcl_Obj *resultObj, **dataArray;
	ListRep listRep;








|





>




|


|





|










>
>
>







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
Tcl_LreverseObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument values. */
{
    Tcl_Obj **elemv;
    Tcl_Size elemc, i, j;

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

    /*
     *  Handle AbstractList special case - do not shimmer into a list, if it
     *  supports a private Reverse function, just to reverse it.
     */
    if (TclObjTypeHasProc(objv[1], reverseProc)) {
	Tcl_Obj *resultObj;

	if (Tcl_ObjTypeReverse(interp, objv[1], &resultObj) == TCL_OK) {
	    Tcl_SetObjResult(interp, resultObj);
	    return TCL_OK;
	}
    } /* end Abstract List */

    if (TclListObjLengthM(interp, objv[1], &elemc) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * If the list is empty, just return it. [Bug 1876793]
     */

    if (!elemc) {
	Tcl_SetObjResult(interp, objv[1]);
	return TCL_OK;
    }
    if (TclListObjGetElementsM(interp, objv[1], &elemc, &elemv) != TCL_OK) {
	return TCL_ERROR;
    }

    if (Tcl_IsShared(objv[1])
	|| ListObjRepIsShared(objv[1])) { /* Bug 1675044 */
	Tcl_Obj *resultObj, **dataArray;
	ListRep listRep;

3211
3212
3213
3214
3215
3216
3217
3218
3219

3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
Tcl_LsearchObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument values. */
{
    const char *bytes, *patternBytes;
    int match, index, result=TCL_OK, bisect;
    size_t i, length = 0, listc, elemLen, start, groupSize, groupOffset, lower, upper;

    int allocatedIndexVector = 0;
    int isIncreasing;
    Tcl_WideInt patWide, objWide, wide;
    int allMatches, inlineReturn, negatedMatch, returnSubindices, noCase;
    double patDouble, objDouble;
    SortInfo sortInfo;
    Tcl_Obj *patObj, **listv, *listPtr, *startPtr, *itemPtr;
    SortStrCmpFn_t strCmpFn = TclUtfCmp;
    Tcl_RegExp regexp = NULL;
    static const char *const options[] = {
	"-all",	    "-ascii",   "-bisect", "-decreasing", "-dictionary",
	"-exact",   "-glob",    "-increasing", "-index",
	"-inline",  "-integer", "-nocase",     "-not",
	"-real",    "-regexp",  "-sorted",     "-start", "-stride",







|
|
>


|



|







3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
Tcl_LsearchObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument values. */
{
    const char *bytes, *patternBytes;
    int match, result=TCL_OK, bisect;
    Tcl_Size i, length = 0, listc, elemLen, start, index;
    Tcl_Size groupOffset, lower, upper;
    int allocatedIndexVector = 0;
    int isIncreasing;
    Tcl_WideInt patWide, objWide, wide, groupSize;
    int allMatches, inlineReturn, negatedMatch, returnSubindices, noCase;
    double patDouble, objDouble;
    SortInfo sortInfo;
    Tcl_Obj *patObj, **listv, *listPtr, *startPtr, *itemPtr = NULL;
    SortStrCmpFn_t strCmpFn = TclUtfCmp;
    Tcl_RegExp regexp = NULL;
    static const char *const options[] = {
	"-all",	    "-ascii",   "-bisect", "-decreasing", "-dictionary",
	"-exact",   "-glob",    "-increasing", "-index",
	"-inline",  "-integer", "-nocase",     "-not",
	"-real",    "-regexp",  "-sorted",     "-start", "-stride",
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
    sortInfo.indexc = 0;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-option value ...? list pattern");
	return TCL_ERROR;
    }

    for (i = 1; i < (size_t)objc-2; i++) {
	enum lsearchoptions idx;
	if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &idx)
		!= TCL_OK) {
	    result = TCL_ERROR;
	    goto done;
	}
	switch (idx) {







|







3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
    sortInfo.indexc = 0;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-option value ...? list pattern");
	return TCL_ERROR;
    }

    for (i = 1; i < objc-2; i++) {
	enum lsearchoptions idx;
	if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &idx)
		!= TCL_OK) {
	    result = TCL_ERROR;
	    goto done;
	}
	switch (idx) {
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
	     * because it will either be replaced or there will be an error.
	     */

	    if (startPtr != NULL) {
		Tcl_DecrRefCount(startPtr);
		startPtr = NULL;
	    }
	    if (i + 4 > (size_t)objc) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"missing starting index", -1));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		result = TCL_ERROR;
		goto done;
	    }
	    i++;







|







3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
	     * because it will either be replaced or there will be an error.
	     */

	    if (startPtr != NULL) {
		Tcl_DecrRefCount(startPtr);
		startPtr = NULL;
	    }
	    if (i > objc-4) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"missing starting index", -1));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		result = TCL_ERROR;
		goto done;
	    }
	    i++;
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
		startPtr = Tcl_DuplicateObj(objv[i]);
	    } else {
		startPtr = objv[i];
	    }
	    Tcl_IncrRefCount(startPtr);
	    break;
	case LSEARCH_STRIDE:		/* -stride */
	    if (i + 4 > (size_t)objc) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"\"-stride\" option must be "
			"followed by stride length", -1));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		result = TCL_ERROR;
		goto done;
	    }







|







3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
		startPtr = Tcl_DuplicateObj(objv[i]);
	    } else {
		startPtr = objv[i];
	    }
	    Tcl_IncrRefCount(startPtr);
	    break;
	case LSEARCH_STRIDE:		/* -stride */
	    if (i > objc-4) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"\"-stride\" option must be "
			"followed by stride length", -1));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		result = TCL_ERROR;
		goto done;
	    }
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
		goto done;
	    }
	    groupSize = wide;
	    i++;
	    break;
	case LSEARCH_INDEX: {		/* -index */
	    Tcl_Obj **indices;
	    size_t j;

	    if (allocatedIndexVector) {
		TclStackFree(interp, sortInfo.indexv);
		allocatedIndexVector = 0;
	    }
	    if (i + 4 > (size_t)objc) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"\"-index\" option must be followed by list index",
			-1));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		result = TCL_ERROR;
		goto done;
	    }







|





|







3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
		goto done;
	    }
	    groupSize = wide;
	    i++;
	    break;
	case LSEARCH_INDEX: {		/* -index */
	    Tcl_Obj **indices;
	    Tcl_Size j;

	    if (allocatedIndexVector) {
		TclStackFree(interp, sortInfo.indexv);
		allocatedIndexVector = 0;
	    }
	    if (i > objc-4) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"\"-index\" option must be followed by list index",
			-1));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		result = TCL_ERROR;
		goto done;
	    }
3544
3545
3546
3547
3548
3549
3550
3551
3552
3553
3554
3555
3556
3557
3558
	if (sortInfo.indexc > 0) {
	    /*
	     * Use the first value in the list supplied to -index as the
	     * offset of the element within each group by which to sort.
	     */

	    groupOffset = TclIndexDecode(sortInfo.indexv[0], groupSize - 1);
	    if (groupOffset >= groupSize) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"when used with \"-stride\", the leading \"-index\""
			" value must be within the group", -1));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH",
			"BADINDEX", NULL);
		result = TCL_ERROR;
		goto done;







|







3614
3615
3616
3617
3618
3619
3620
3621
3622
3623
3624
3625
3626
3627
3628
	if (sortInfo.indexc > 0) {
	    /*
	     * Use the first value in the list supplied to -index as the
	     * offset of the element within each group by which to sort.
	     */

	    groupOffset = TclIndexDecode(sortInfo.indexv[0], groupSize - 1);
	    if (groupOffset < 0 || groupOffset >= groupSize) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"when used with \"-stride\", the leading \"-index\""
			" value must be within the group", -1));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH",
			"BADINDEX", NULL);
		result = TCL_ERROR;
		goto done;
3584
3585
3586
3587
3588
3589
3590
3591
3592
3593
3594
3595
3596
3597
3598
3599
3600
3601
3602
	}

	/*
	 * If the search started past the end of the list, we just return a
	 * "did not match anything at all" result straight away. [Bug 1374778]
	 */

	if (start >= (size_t)listc) {
	    if (allMatches || inlineReturn) {
		Tcl_ResetResult(interp);
	    } else {
		TclNewIndexObj(itemPtr, TCL_INDEX_NONE);
		Tcl_SetObjResult(interp, itemPtr);
	    }
	    goto done;
	}

	/*
	 * If start points within a group, it points to the start of the group.







|



|







3654
3655
3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
	}

	/*
	 * If the search started past the end of the list, we just return a
	 * "did not match anything at all" result straight away. [Bug 1374778]
	 */

	if (start >= listc) {
	    if (allMatches || inlineReturn) {
		Tcl_ResetResult(interp);
	    } else {
		TclNewIntObj(itemPtr, -1);
		Tcl_SetObjResult(interp, itemPtr);
	    }
	    goto done;
	}

	/*
	 * If start points within a group, it points to the start of the group.
3664
3665
3666
3667
3668
3669
3670

3671
3672
3673




3674
3675
3676
3677
3678
3679
3680

	/*
	 * With -stride, lower, upper and i are kept as multiples of groupSize.
	 */

	lower = start - groupSize;
	upper = listc;

	while (lower + groupSize != upper && sortInfo.resultCode == TCL_OK) {
	    i = (lower + upper)/2;
	    i -= i % groupSize;




	    if (sortInfo.indexc != 0) {
		itemPtr = SelectObjFromSublist(listv[i+groupOffset], &sortInfo);
		if (sortInfo.resultCode != TCL_OK) {
		    result = sortInfo.resultCode;
		    goto done;
		}
	    } else {







>



>
>
>
>







3734
3735
3736
3737
3738
3739
3740
3741
3742
3743
3744
3745
3746
3747
3748
3749
3750
3751
3752
3753
3754
3755

	/*
	 * With -stride, lower, upper and i are kept as multiples of groupSize.
	 */

	lower = start - groupSize;
	upper = listc;
	itemPtr = NULL;
	while (lower + groupSize != upper && sortInfo.resultCode == TCL_OK) {
	    i = (lower + upper)/2;
	    i -= i % groupSize;

	    Tcl_BumpObj(itemPtr);
	    itemPtr = NULL;

	    if (sortInfo.indexc != 0) {
		itemPtr = SelectObjFromSublist(listv[i+groupOffset], &sortInfo);
		if (sortInfo.resultCode != TCL_OK) {
		    result = sortInfo.resultCode;
		    goto done;
		}
	    } else {
3765
3766
3767
3768
3769
3770
3771



3772
3773
3774
3775
3776
3777
3778
	 */

	if (allMatches) {
	    listPtr = Tcl_NewListObj(0, NULL);
	}
	for (i = start; i < listc; i += groupSize) {
	    match = 0;



	    if (sortInfo.indexc != 0) {
		itemPtr = SelectObjFromSublist(listv[i+groupOffset], &sortInfo);
		if (sortInfo.resultCode != TCL_OK) {
		    if (listPtr != NULL) {
			Tcl_DecrRefCount(listPtr);
		    }
		    result = sortInfo.resultCode;







>
>
>







3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
	 */

	if (allMatches) {
	    listPtr = Tcl_NewListObj(0, NULL);
	}
	for (i = start; i < listc; i += groupSize) {
	    match = 0;
	    Tcl_BumpObj(itemPtr);
	    itemPtr = NULL;

	    if (sortInfo.indexc != 0) {
		itemPtr = SelectObjFromSublist(listv[i+groupOffset], &sortInfo);
		if (sortInfo.resultCode != TCL_OK) {
		    if (listPtr != NULL) {
			Tcl_DecrRefCount(listPtr);
		    }
		    result = sortInfo.resultCode;
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
		    Tcl_ListObjReplace(interp, listPtr, LIST_MAX, 0,
			    groupSize, &listv[i]);
		} else {
		    itemPtr = listv[i];
		    Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
		}
	    } else if (returnSubindices) {
		size_t j;

		TclNewIndexObj(itemPtr, i+groupOffset);
		for (j=0 ; j<sortInfo.indexc ; j++) {
		    Tcl_Obj *elObj;
		    size_t elValue = TclIndexDecode(sortInfo.indexv[j], listc);
		    TclNewIndexObj(elObj, elValue);
		    Tcl_ListObjAppendElement(interp, itemPtr, elObj);
		}
		Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
	    } else {
		Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewWideIntObj(i));
	    }
	}
    }




    /*
     * Return everything or a single value.
     */

    if (allMatches) {
	Tcl_SetObjResult(interp, listPtr);
    } else if (!inlineReturn) {
	if (returnSubindices) {
	    size_t j;

	    TclNewIndexObj(itemPtr, index+groupOffset);
	    for (j=0 ; j<sortInfo.indexc ; j++) {
		Tcl_Obj *elObj;
		size_t elValue = TclIndexDecode(sortInfo.indexv[j], listc);
		TclNewIndexObj(elObj, elValue);
		Tcl_ListObjAppendElement(interp, itemPtr, elObj);







|















>
>
>








|







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
		    Tcl_ListObjReplace(interp, listPtr, LIST_MAX, 0,
			    groupSize, &listv[i]);
		} else {
		    itemPtr = listv[i];
		    Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
		}
	    } else if (returnSubindices) {
		Tcl_Size j;

		TclNewIndexObj(itemPtr, i+groupOffset);
		for (j=0 ; j<sortInfo.indexc ; j++) {
		    Tcl_Obj *elObj;
		    size_t elValue = TclIndexDecode(sortInfo.indexv[j], listc);
		    TclNewIndexObj(elObj, elValue);
		    Tcl_ListObjAppendElement(interp, itemPtr, elObj);
		}
		Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
	    } else {
		Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewWideIntObj(i));
	    }
	}
    }

    Tcl_BumpObj(itemPtr);
    itemPtr = NULL;

    /*
     * Return everything or a single value.
     */

    if (allMatches) {
	Tcl_SetObjResult(interp, listPtr);
    } else if (!inlineReturn) {
	if (returnSubindices) {
	    Tcl_Size j;

	    TclNewIndexObj(itemPtr, index+groupOffset);
	    for (j=0 ; j<sortInfo.indexc ; j++) {
		Tcl_Obj *elObj;
		size_t elValue = TclIndexDecode(sortInfo.indexv[j], listc);
		TclNewIndexObj(elObj, elValue);
		Tcl_ListObjAppendElement(interp, itemPtr, elObj);
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
     Tcl_Obj *argPtr,           /* Argument to decode   */
     Tcl_Obj **numValuePtr,     /* Return numeric value */
     int *keywordIndexPtr)      /* Return keyword enum  */
{
    int status;
    SequenceOperators opmode;
    SequenceByMode bymode;
    union {
	Tcl_WideInt i;
	double d;
    } *nvalue;

    status = Tcl_GetNumberFromObj(NULL, argPtr, (void**)&nvalue, keywordIndexPtr);
    if (status == TCL_OK) {
	if (numValuePtr) {
	    *numValuePtr = argPtr;
	}
	return NumericArg;
    } else {
	/* Check for an index expression */







<
<
<
|

|







4056
4057
4058
4059
4060
4061
4062



4063
4064
4065
4066
4067
4068
4069
4070
4071
4072
     Tcl_Obj *argPtr,           /* Argument to decode   */
     Tcl_Obj **numValuePtr,     /* Return numeric value */
     int *keywordIndexPtr)      /* Return keyword enum  */
{
    int status;
    SequenceOperators opmode;
    SequenceByMode bymode;



    void *clientData;

    status = Tcl_GetNumberFromObj(NULL, argPtr, &clientData, keywordIndexPtr);
    if (status == TCL_OK) {
	if (numValuePtr) {
	    *numValuePtr = argPtr;
	}
	return NumericArg;
    } else {
	/* Check for an index expression */
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
	} else {
	    // Determine if expression is double or int
	    if (Tcl_ExprDoubleObj(interp, argPtr, &dvalue) != TCL_OK) {
		keyword = TCL_NUMBER_INT;
		exprValueObj = argPtr;
	    } else {
		if (floor(dvalue) == dvalue) {
		    exprValueObj = Tcl_NewWideIntObj(value);
		    keyword = TCL_NUMBER_INT;
		} else {
		    exprValueObj = Tcl_NewDoubleObj(dvalue);
		    keyword = TCL_NUMBER_DOUBLE;
		}
	    }
	    status = Tcl_RestoreInterpState(interp, savedstate);
	    if (numValuePtr) {
		*numValuePtr = exprValueObj;
	    }







|


|







4082
4083
4084
4085
4086
4087
4088
4089
4090
4091
4092
4093
4094
4095
4096
4097
4098
4099
	} else {
	    // Determine if expression is double or int
	    if (Tcl_ExprDoubleObj(interp, argPtr, &dvalue) != TCL_OK) {
		keyword = TCL_NUMBER_INT;
		exprValueObj = argPtr;
	    } else {
		if (floor(dvalue) == dvalue) {
		    TclNewIntObj(exprValueObj, value);
		    keyword = TCL_NUMBER_INT;
		} else {
		    TclNewDoubleObj(exprValueObj, dvalue);
		    keyword = TCL_NUMBER_DOUBLE;
		}
	    }
	    status = Tcl_RestoreInterpState(interp, savedstate);
	    if (numValuePtr) {
		*numValuePtr = exprValueObj;
	    }
4320
4321
4322
4323
4324
4325
4326
4327


4328
4329
4330
4331
4332
4333
4334
4335
4336
	 goto done;
	 break;
    }

    /*
     * Success!  Now lets create the series object.
     */
    status = TclNewArithSeriesObj(interp, &arithSeriesPtr, useDoubles, start, end, step, elementCount);


    if (status == TCL_OK) {
        Tcl_SetObjResult(interp, arithSeriesPtr);
    }

 done:
    // Free number arguments.
    while (--value_i>=0) {
	if (numValues[value_i]) Tcl_DecrRefCount(numValues[value_i]);
    }







|
>
>

|







4398
4399
4400
4401
4402
4403
4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
	 goto done;
	 break;
    }

    /*
     * Success!  Now lets create the series object.
     */
    status = TclNewArithSeriesObj(interp, &arithSeriesPtr,
		  useDoubles, start, end, step, elementCount);

    if (status == TCL_OK) {
	Tcl_SetObjResult(interp, arithSeriesPtr);
    }

 done:
    // Free number arguments.
    while (--value_i>=0) {
	if (numValues[value_i]) Tcl_DecrRefCount(numValues[value_i]);
    }
4392
4393
4394
4395
4396
4397
4398
4399
4400
4401
4402
4403
4404
4405
4406
4407
     * Substitute the value in the value. Return either the value or else an
     * unshared copy of it.
     */

    if (objc == 4) {
	finalValuePtr = TclLsetList(interp, listPtr, objv[2], objv[3]);
    } else {
	if (TclAbstractListHasProc(listPtr, TCL_ABSL_SETELEMENT)) {
	    finalValuePtr = Tcl_AbstractListSetElement(interp, listPtr,
						       objc-3, objv+2, objv[objc-1]);
	    if (finalValuePtr) {
		Tcl_IncrRefCount(finalValuePtr);
	    }
	} else {
	    finalValuePtr = TclLsetFlat(interp, listPtr, objc-3, objv+2,
					objv[objc-1]);







|
|







4472
4473
4474
4475
4476
4477
4478
4479
4480
4481
4482
4483
4484
4485
4486
4487
     * Substitute the value in the value. Return either the value or else an
     * unshared copy of it.
     */

    if (objc == 4) {
	finalValuePtr = TclLsetList(interp, listPtr, objv[2], objv[3]);
    } else {
	if (TclObjTypeHasProc(listPtr, setElementProc)) {
	    finalValuePtr = Tcl_ObjTypeSetElement(interp, listPtr,
						       objc-3, objv+2, objv[objc-1]);
	    if (finalValuePtr) {
		Tcl_IncrRefCount(finalValuePtr);
	    }
	} else {
	    finalValuePtr = TclLsetFlat(interp, listPtr, objc-3, objv+2,
					objv[objc-1]);
4458
4459
4460
4461
4462
4463
4464
4465
4466
4467
4468
4469
4470
4471
4472
4473
4474
4475
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument values. */
{
    int indices, nocase = 0, indexc;
    int sortMode = SORTMODE_ASCII;
    int group, allocatedIndexVector = 0;
    size_t j, idx, groupSize, groupOffset, length;
    Tcl_WideInt wide;
    Tcl_Obj *resultPtr, *cmdPtr, **listObjPtrs, *listObj, *indexPtr;
    size_t i, elmArrSize;
    SortElement *elementArray = NULL, *elementPtr;
    SortInfo sortInfo;		/* Information about this sort that needs to
				 * be passed to the comparison function. */
#   define MAXCALLOC 1024000
#   define NUM_LISTS 30
    SortElement *subList[NUM_LISTS+1];
				/* This array holds pointers to temporary







|
|

|







4538
4539
4540
4541
4542
4543
4544
4545
4546
4547
4548
4549
4550
4551
4552
4553
4554
4555
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument values. */
{
    int indices, nocase = 0, indexc;
    int sortMode = SORTMODE_ASCII;
    int group, allocatedIndexVector = 0;
    Tcl_Size j, idx, groupOffset, length;
    Tcl_WideInt wide, groupSize;
    Tcl_Obj *resultPtr, *cmdPtr, **listObjPtrs, *listObj, *indexPtr;
    Tcl_Size i, elmArrSize;
    SortElement *elementArray = NULL, *elementPtr;
    SortInfo sortInfo;		/* Information about this sort that needs to
				 * be passed to the comparison function. */
#   define MAXCALLOC 1024000
#   define NUM_LISTS 30
    SortElement *subList[NUM_LISTS+1];
				/* This array holds pointers to temporary
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
    sortInfo.resultCode = TCL_OK;
    cmdPtr = NULL;
    indices = 0;
    group = 0;
    groupSize = 1;
    groupOffset = 0;
    indexPtr = NULL;
    for (i = 1; i < (size_t)objc-1; i++) {
	if (Tcl_GetIndexFromObj(interp, objv[i], switches, "option", 0,
		&index) != TCL_OK) {
	    sortInfo.resultCode = TCL_ERROR;
	    goto done;
	}
	switch (index) {
	case LSORT_ASCII:
	    sortInfo.sortMode = SORTMODE_ASCII;
	    break;
	case LSORT_COMMAND:
	    if (i + 2 == (size_t)objc) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"\"-command\" option must be followed "
			"by comparison command", -1));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		sortInfo.resultCode = TCL_ERROR;
		goto done;
	    }







|










|







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
    sortInfo.resultCode = TCL_OK;
    cmdPtr = NULL;
    indices = 0;
    group = 0;
    groupSize = 1;
    groupOffset = 0;
    indexPtr = NULL;
    for (i = 1; i < objc-1; i++) {
	if (Tcl_GetIndexFromObj(interp, objv[i], switches, "option", 0,
		&index) != TCL_OK) {
	    sortInfo.resultCode = TCL_ERROR;
	    goto done;
	}
	switch (index) {
	case LSORT_ASCII:
	    sortInfo.sortMode = SORTMODE_ASCII;
	    break;
	case LSORT_COMMAND:
	    if (i == objc-2) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"\"-command\" option must be followed "
			"by comparison command", -1));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		sortInfo.resultCode = TCL_ERROR;
		goto done;
	    }
4538
4539
4540
4541
4542
4543
4544
4545
4546
4547
4548
4549
4550
4551
4552
4553
4554
4555
	case LSORT_DICTIONARY:
	    sortInfo.sortMode = SORTMODE_DICTIONARY;
	    break;
	case LSORT_INCREASING:
	    sortInfo.isIncreasing = 1;
	    break;
	case LSORT_INDEX: {
	    size_t sortindex;
	    Tcl_Obj **indexv;

	    if (i + 2 == (size_t)objc) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"\"-index\" option must be followed by list index",
			-1));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		sortInfo.resultCode = TCL_ERROR;
		goto done;
	    }







|


|







4618
4619
4620
4621
4622
4623
4624
4625
4626
4627
4628
4629
4630
4631
4632
4633
4634
4635
	case LSORT_DICTIONARY:
	    sortInfo.sortMode = SORTMODE_DICTIONARY;
	    break;
	case LSORT_INCREASING:
	    sortInfo.isIncreasing = 1;
	    break;
	case LSORT_INDEX: {
	    Tcl_Size sortindex;
	    Tcl_Obj **indexv;

	    if (i == objc-2) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"\"-index\" option must be followed by list index",
			-1));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		sortInfo.resultCode = TCL_ERROR;
		goto done;
	    }
4603
4604
4605
4606
4607
4608
4609
4610
4611
4612
4613
4614
4615
4616
4617
	case LSORT_UNIQUE:
	    sortInfo.unique = 1;
	    break;
	case LSORT_INDICES:
	    indices = 1;
	    break;
	case LSORT_STRIDE:
	    if (i + 2 == (size_t)objc) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"\"-stride\" option must be "
			"followed by stride length", -1));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		sortInfo.resultCode = TCL_ERROR;
		goto done;
	    }







|







4683
4684
4685
4686
4687
4688
4689
4690
4691
4692
4693
4694
4695
4696
4697
	case LSORT_UNIQUE:
	    sortInfo.unique = 1;
	    break;
	case LSORT_INDICES:
	    indices = 1;
	    break;
	case LSORT_STRIDE:
	    if (i == objc-2) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"\"-stride\" option must be "
			"followed by stride length", -1));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		sortInfo.resultCode = TCL_ERROR;
		goto done;
	    }
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
	/*
	 * When sorting using a command, we are reentrant and therefore might
	 * have the representation of the list being sorted shimmered out from
	 * underneath our feet. Take a copy (cheap) to prevent this. [Bug
	 * 1675116]
	 */

	listObj = TclListObjCopy(interp, listObj);
	if (listObj == NULL) {
	    sortInfo.resultCode = TCL_ERROR;
	    goto done;
	}

	/*
	 * The existing command is a list. We want to flatten it, append two
	 * dummy arguments on the end, and replace these arguments later.
	 */

	newCommandPtr = Tcl_DuplicateObj(cmdPtr);
	TclNewObj(newObjPtr);
	Tcl_IncrRefCount(newCommandPtr);
	if (Tcl_ListObjAppendElement(interp, newCommandPtr, newObjPtr)
		!= TCL_OK) {
	    TclDecrRefCount(newCommandPtr);
	    TclDecrRefCount(listObj);
	    Tcl_IncrRefCount(newObjPtr);
	    TclDecrRefCount(newObjPtr);
	    sortInfo.resultCode = TCL_ERROR;
	    goto done;
	}
	Tcl_ListObjAppendElement(interp, newCommandPtr, Tcl_NewObj());
	sortInfo.compareCmdPtr = newCommandPtr;
    }

    if (TclAbstractListHasProc(objv[1], TCL_ABSL_GETELEMENTS)) {
	sortInfo.resultCode =
	    Tcl_AbstractListObjGetElements(interp, listObj, &length, &listObjPtrs);
    } else {
	sortInfo.resultCode = TclListObjGetElementsM(interp, listObj,
	    &length, &listObjPtrs);
    }
    if (sortInfo.resultCode != TCL_OK || length <= 0) {
	goto done;
    }







|
















<
<








|

|







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
	/*
	 * When sorting using a command, we are reentrant and therefore might
	 * have the representation of the list being sorted shimmered out from
	 * underneath our feet. Take a copy (cheap) to prevent this. [Bug
	 * 1675116]
	 */

	listObj = TclDuplicatePureObj(interp ,listObj, &tclListType);
	if (listObj == NULL) {
	    sortInfo.resultCode = TCL_ERROR;
	    goto done;
	}

	/*
	 * The existing command is a list. We want to flatten it, append two
	 * dummy arguments on the end, and replace these arguments later.
	 */

	newCommandPtr = Tcl_DuplicateObj(cmdPtr);
	TclNewObj(newObjPtr);
	Tcl_IncrRefCount(newCommandPtr);
	if (Tcl_ListObjAppendElement(interp, newCommandPtr, newObjPtr)
		!= TCL_OK) {
	    TclDecrRefCount(newCommandPtr);


	    TclDecrRefCount(newObjPtr);
	    sortInfo.resultCode = TCL_ERROR;
	    goto done;
	}
	Tcl_ListObjAppendElement(interp, newCommandPtr, Tcl_NewObj());
	sortInfo.compareCmdPtr = newCommandPtr;
    }

    if (TclObjTypeHasProc(objv[1], getElementsProc)) {
	sortInfo.resultCode =
	    Tcl_ObjTypeGetElements(interp, listObj, &length, &listObjPtrs);
    } else {
	sortInfo.resultCode = TclListObjGetElementsM(interp, listObj,
	    &length, &listObjPtrs);
    }
    if (sortInfo.resultCode != TCL_OK || length <= 0) {
	goto done;
    }
4736
4737
4738
4739
4740
4741
4742
4743
4744
4745
4746
4747
4748
4749
4750
	if (sortInfo.indexc > 0) {
	    /*
	     * Use the first value in the list supplied to -index as the
	     * offset of the element within each group by which to sort.
	     */

	    groupOffset = TclIndexDecode(sortInfo.indexv[0], groupSize - 1);
	    if (groupOffset >= groupSize) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"when used with \"-stride\", the leading \"-index\""
			" value must be within the group", -1));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT",
			"BADINDEX", NULL);
		sortInfo.resultCode = TCL_ERROR;
		goto done;







|







4814
4815
4816
4817
4818
4819
4820
4821
4822
4823
4824
4825
4826
4827
4828
	if (sortInfo.indexc > 0) {
	    /*
	     * Use the first value in the list supplied to -index as the
	     * offset of the element within each group by which to sort.
	     */

	    groupOffset = TclIndexDecode(sortInfo.indexv[0], groupSize - 1);
	    if (groupOffset < 0 || groupOffset >= groupSize) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"when used with \"-stride\", the leading \"-index\""
			" value must be within the group", -1));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT",
			"BADINDEX", NULL);
		sortInfo.resultCode = TCL_ERROR;
		goto done;
4861
4862
4863
4864
4865
4866
4867
4868
4869
4870
4871
4872
4873
4874
4875
	if (indices || group) {
	    elementArray[i].payload.index = idx;
	} else {
	    elementArray[i].payload.objPtr = listObjPtrs[idx];
	}

	/*
	 * Merge this element in the pre-existing sublists (and merge together
	 * sublists when we have two of the same size).
	 */

	elementArray[i].nextPtr = NULL;
	elementPtr = &elementArray[i];
	for (j=0 ; subList[j] ; j++) {
	    elementPtr = MergeLists(subList[j], elementPtr, &sortInfo);







|







4939
4940
4941
4942
4943
4944
4945
4946
4947
4948
4949
4950
4951
4952
4953
	if (indices || group) {
	    elementArray[i].payload.index = idx;
	} else {
	    elementArray[i].payload.objPtr = listObjPtrs[idx];
	}

	/*
	 * Merge this element in the preexisting sublists (and merge together
	 * sublists when we have two of the same size).
	 */

	elementArray[i].nextPtr = NULL;
	elementPtr = &elementArray[i];
	for (j=0 ; subList[j] ; j++) {
	    elementPtr = MergeLists(subList[j], elementPtr, &sortInfo);
4980
4981
4982
4983
4984
4985
4986
4987
4988
4989
4990
4991
4992
4993
4994
4995
4996
4997
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument values. */
{
    Tcl_Obj *listPtr;		/* Pointer to the list being altered. */
    Tcl_Obj *finalValuePtr;	/* Value finally assigned to the variable. */
    int createdNewObj;
    int result;
    size_t first;
    size_t last;
    size_t listLen;
    size_t numToDelete;

    if (objc < 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"listVar first last ?element ...?");
	return TCL_ERROR;
    }








|
|
|
|







5058
5059
5060
5061
5062
5063
5064
5065
5066
5067
5068
5069
5070
5071
5072
5073
5074
5075
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument values. */
{
    Tcl_Obj *listPtr;		/* Pointer to the list being altered. */
    Tcl_Obj *finalValuePtr;	/* Value finally assigned to the variable. */
    int createdNewObj;
    int result;
    Tcl_Size first;
    Tcl_Size last;
    Tcl_Size listLen;
    Tcl_Size numToDelete;

    if (objc < 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"listVar first last ?element ...?");
	return TCL_ERROR;
    }

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
    }

    result = TclGetIntForIndexM(interp, objv[3], /*end*/ listLen-1, &last);
    if (result != TCL_OK) {
	return result;
    }

    if (first == TCL_INDEX_NONE) {
	first = 0;
    } else if (first > listLen) {
	first = listLen;
    }

    /* The +1 in comparisons are necessitated by indices being unsigned */
    if ((last + 1) > listLen) {
	last = listLen - 1;
    }
    if ((first + 1) <= (last + 1)) {
	numToDelete = last - first + 1;
    } else {
	numToDelete = 0;
    }

    if (Tcl_IsShared(listPtr)) {

	listPtr = TclListObjCopy(NULL, listPtr);


	createdNewObj = 1;
    } else {
	createdNewObj = 0;
    }

    result =
	Tcl_ListObjReplace(interp, listPtr, first, numToDelete, objc - 4, objv + 4);
    if (result != TCL_OK) {
	if (createdNewObj) {
	    Tcl_DecrRefCount(listPtr);
	}
	return result;
    }

    /*
     * Tcl_ObjSetVar2 may return a value different from listPtr in the
     * presence of traces etc.. Note that finalValuePtr will always have a
     * reference count of at least 1 corresponding to the reference from the
     * var. If it is same as listPtr, then ref count will be at least 2
     * since we are incr'ing the latter below (safer when calling
     * Tcl_ObjSetVar2 which can release it in some cases). Note that we
     * leave the incrref of listPtr this late because we want to pass it as
     * unshared to Tcl_ListObjReplace above if possible.
     */
    Tcl_IncrRefCount(listPtr);
    finalValuePtr =
	Tcl_ObjSetVar2(interp, objv[1], NULL, listPtr, TCL_LEAVE_ERR_MSG);
    Tcl_DecrRefCount(listPtr); /* safe irrespective of createdNewObj */
    if (finalValuePtr == NULL) {
	return TCL_ERROR;
    }

    Tcl_SetObjResult(interp, finalValuePtr);
    return TCL_OK;
}







|






|


|






>
|
>
>
















|
<
<
<
<
<
<

<


<







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
    }

    result = TclGetIntForIndexM(interp, objv[3], /*end*/ listLen-1, &last);
    if (result != TCL_OK) {
	return result;
    }

    if (first < 0) {
	first = 0;
    } else if (first > listLen) {
	first = listLen;
    }

    /* The +1 in comparisons are necessitated by indices being unsigned */
    if (last >= listLen) {
	last = listLen - 1;
    }
    if (first <= last) {
	numToDelete = last - first + 1;
    } else {
	numToDelete = 0;
    }

    if (Tcl_IsShared(listPtr)) {
	listPtr = TclDuplicatePureObj(interp, listPtr, &tclListType);
	if (!listPtr) {
	    return TCL_ERROR;
	}
	createdNewObj = 1;
    } else {
	createdNewObj = 0;
    }

    result =
	Tcl_ListObjReplace(interp, listPtr, first, numToDelete, objc - 4, objv + 4);
    if (result != TCL_OK) {
	if (createdNewObj) {
	    Tcl_DecrRefCount(listPtr);
	}
	return result;
    }

    /*
     * Tcl_ObjSetVar2 may return a value different from listPtr in the
     * presence of traces etc.






     */

    finalValuePtr =
	Tcl_ObjSetVar2(interp, objv[1], NULL, listPtr, TCL_LEAVE_ERR_MSG);

    if (finalValuePtr == NULL) {
	return TCL_ERROR;
    }

    Tcl_SetObjResult(interp, finalValuePtr);
    return TCL_OK;
}
5179
5180
5181
5182
5183
5184
5185
5186
5187
5188
5189
5190
5191
5192
5193
 *
 * SortCompare --
 *
 *	This procedure is invoked by MergeLists to determine the proper
 *	ordering between two elements.
 *
 * Results:
 *	A negative results means the the first element comes before the
 *	second, and a positive results means that the second element should
 *	come first. A result of zero means the two elements are equal and it
 *	doesn't matter which comes first.
 *
 * Side effects:
 *	None, unless a user-defined comparison command does something weird.
 *







|







5252
5253
5254
5255
5256
5257
5258
5259
5260
5261
5262
5263
5264
5265
5266
 *
 * SortCompare --
 *
 *	This procedure is invoked by MergeLists to determine the proper
 *	ordering between two elements.
 *
 * Results:
 *	A negative results means the first element comes before the
 *	second, and a positive results means that the second element should
 *	come first. A result of zero means the two elements are equal and it
 *	doesn't matter which comes first.
 *
 * Side effects:
 *	None, unless a user-defined comparison command does something weird.
 *
5222
5223
5224
5225
5226
5227
5228
5229
5230
5231
5232
5233
5234
5235
5236
	double a, b;

	a = elemPtr1->collationKey.doubleValue;
	b = elemPtr2->collationKey.doubleValue;
	order = ((a >= b) - (a <= b));
    } else {
	Tcl_Obj **objv, *paramObjv[2];
	size_t objc;
	Tcl_Obj *objPtr1, *objPtr2;

	if (infoPtr->resultCode != TCL_OK) {
	    /*
	     * Once an error has occurred, skip any future comparisons so as
	     * to preserve the error message in sortInterp->result.
	     */







|







5295
5296
5297
5298
5299
5300
5301
5302
5303
5304
5305
5306
5307
5308
5309
	double a, b;

	a = elemPtr1->collationKey.doubleValue;
	b = elemPtr2->collationKey.doubleValue;
	order = ((a >= b) - (a <= b));
    } else {
	Tcl_Obj **objv, *paramObjv[2];
	Tcl_Size objc;
	Tcl_Obj *objPtr1, *objPtr2;

	if (infoPtr->resultCode != TCL_OK) {
	    /*
	     * Once an error has occurred, skip any future comparisons so as
	     * to preserve the error message in sortInterp->result.
	     */
5381
5382
5383
5384
5385
5386
5387
5388
5389
5390
5391
5392
5393
5394
5395

	if ((*left != '\0') && (*right != '\0')) {
	    left += TclUtfToUCS4(left, &uniLeft);
	    right += TclUtfToUCS4(right, &uniRight);

	    /*
	     * Convert both chars to lower for the comparison, because
	     * dictionary sorts are case insensitve. Covert to lower, not
	     * upper, so chars between Z and a will sort before A (where most
	     * other interesting punctuations occur).
	     */

	    uniLeftLower = Tcl_UniCharToLower(uniLeft);
	    uniRightLower = Tcl_UniCharToLower(uniRight);
	} else {







|







5454
5455
5456
5457
5458
5459
5460
5461
5462
5463
5464
5465
5466
5467
5468

	if ((*left != '\0') && (*right != '\0')) {
	    left += TclUtfToUCS4(left, &uniLeft);
	    right += TclUtfToUCS4(right, &uniRight);

	    /*
	     * Convert both chars to lower for the comparison, because
	     * dictionary sorts are case-insensitive. Covert to lower, not
	     * upper, so chars between Z and a will sort before A (where most
	     * other interesting punctuations occur).
	     */

	    uniLeftLower = Tcl_UniCharToLower(uniLeft);
	    uniRightLower = Tcl_UniCharToLower(uniRight);
	} else {
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

static Tcl_Obj *
SelectObjFromSublist(
    Tcl_Obj *objPtr,		/* Obj to select sublist from. */
    SortInfo *infoPtr)		/* Information passed from the top-level
				 * "lsearch" or "lsort" command. */
{
    size_t i;

    /*
     * Quick check for case when no "-index" option is there.
     */

    if (infoPtr->indexc == 0) {
	return objPtr;
    }

    /*
     * Iterate over the indices, traversing through the nested sublists as we
     * go.
     */

    for (i=0 ; i<infoPtr->indexc ; i++) {
	size_t listLen;
	int index;
	Tcl_Obj *currentObj;

	if (TclListObjLengthM(infoPtr->interp, objPtr, &listLen) != TCL_OK) {
	    infoPtr->resultCode = TCL_ERROR;
	    return NULL;
	}

	index = TclIndexDecode(infoPtr->indexv[i], listLen - 1);

	if (Tcl_ListObjIndex(infoPtr->interp, objPtr, index,
		&currentObj) != TCL_OK) {
	    infoPtr->resultCode = TCL_ERROR;
	    return NULL;
	}
	if (currentObj == NULL) {
	    if (index == (int)TCL_INDEX_NONE) {
		index = TCL_INDEX_END - infoPtr->indexv[i];
		Tcl_SetObjResult(infoPtr->interp, Tcl_ObjPrintf(
			"element end-%d missing from sublist \"%s\"",
			index, TclGetString(objPtr)));
	    } else {
		Tcl_SetObjResult(infoPtr->interp, Tcl_ObjPrintf(
			"element %d missing from sublist \"%s\"",
			index, TclGetString(objPtr)));
	    }
	    Tcl_SetErrorCode(infoPtr->interp, "TCL", "OPERATION", "LSORT",
		    "INDEXFAILED", NULL);
	    infoPtr->resultCode = TCL_ERROR;
	    return NULL;
	}
	objPtr = currentObj;


    }
    return objPtr;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * End:
 */







|















|

|














|















>
>












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

static Tcl_Obj *
SelectObjFromSublist(
    Tcl_Obj *objPtr,		/* Obj to select sublist from. */
    SortInfo *infoPtr)		/* Information passed from the top-level
				 * "lsearch" or "lsort" command. */
{
    Tcl_Size i;

    /*
     * Quick check for case when no "-index" option is there.
     */

    if (infoPtr->indexc == 0) {
	return objPtr;
    }

    /*
     * Iterate over the indices, traversing through the nested sublists as we
     * go.
     */

    for (i=0 ; i<infoPtr->indexc ; i++) {
	Tcl_Size listLen;
	int index;
	Tcl_Obj *currentObj, *lastObj=NULL;

	if (TclListObjLengthM(infoPtr->interp, objPtr, &listLen) != TCL_OK) {
	    infoPtr->resultCode = TCL_ERROR;
	    return NULL;
	}

	index = TclIndexDecode(infoPtr->indexv[i], listLen - 1);

	if (Tcl_ListObjIndex(infoPtr->interp, objPtr, index,
		&currentObj) != TCL_OK) {
	    infoPtr->resultCode = TCL_ERROR;
	    return NULL;
	}
	if (currentObj == NULL) {
	    if (index == TCL_INDEX_NONE) {
		index = TCL_INDEX_END - infoPtr->indexv[i];
		Tcl_SetObjResult(infoPtr->interp, Tcl_ObjPrintf(
			"element end-%d missing from sublist \"%s\"",
			index, TclGetString(objPtr)));
	    } else {
		Tcl_SetObjResult(infoPtr->interp, Tcl_ObjPrintf(
			"element %d missing from sublist \"%s\"",
			index, TclGetString(objPtr)));
	    }
	    Tcl_SetErrorCode(infoPtr->interp, "TCL", "OPERATION", "LSORT",
		    "INDEXFAILED", NULL);
	    infoPtr->resultCode = TCL_ERROR;
	    return NULL;
	}
	objPtr = currentObj;
	Tcl_BumpObj(lastObj);
	lastObj = currentObj;
    }
    return objPtr;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * End:
 */

Changes to generic/tclCmdMZ.c.

16
17
18
19
20
21
22

23
24
25
26
27
28
29
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclCompile.h"
#include "tclRegexp.h"
#include "tclStringTrim.h"


static inline Tcl_Obj *	During(Tcl_Interp *interp, int resultCode,
			    Tcl_Obj *oldOptions, Tcl_Obj *errorInfo);
static Tcl_NRPostProc	SwitchPostProc;
static Tcl_NRPostProc	TryPostBody;
static Tcl_NRPostProc	TryPostFinal;
static Tcl_NRPostProc	TryPostHandler;







>







16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclCompile.h"
#include "tclRegexp.h"
#include "tclStringTrim.h"
#include "tclTomMath.h"

static inline Tcl_Obj *	During(Tcl_Interp *interp, int resultCode,
			    Tcl_Obj *oldOptions, Tcl_Obj *errorInfo);
static Tcl_NRPostProc	SwitchPostProc;
static Tcl_NRPostProc	TryPostBody;
static Tcl_NRPostProc	TryPostFinal;
static Tcl_NRPostProc	TryPostHandler;
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
int
Tcl_RegexpObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    size_t offset, stringLength, matchLength, cflags, eflags;
    int i, indices, match, about, all, doinline, numMatchesSaved;
    Tcl_RegExp regExpr;
    Tcl_Obj *objPtr, *startIndex = NULL, *resultPtr = NULL;
    Tcl_RegExpInfo info;
    static const char *const options[] = {
	"-all",		"-about",	"-indices",	"-inline",
	"-expanded",	"-line",	"-linestop",	"-lineanchor",







|







124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
int
Tcl_RegexpObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Size offset, stringLength, matchLength, cflags, eflags;
    int i, indices, match, about, all, doinline, numMatchesSaved;
    Tcl_RegExp regExpr;
    Tcl_Obj *objPtr, *startIndex = NULL, *resultPtr = NULL;
    Tcl_RegExpInfo info;
    static const char *const options[] = {
	"-all",		"-about",	"-indices",	"-inline",
	"-expanded",	"-line",	"-linestop",	"-lineanchor",
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
	case REGEXP_LINESTOP:
	    cflags |= TCL_REG_NLSTOP;
	    break;
	case REGEXP_LINEANCHOR:
	    cflags |= TCL_REG_NLANCH;
	    break;
	case REGEXP_START: {
	    size_t temp;
	    if (++i >= objc) {
		goto endOfForLoop;
	    }
	    if (TclGetIntForIndexM(interp, objv[i], (size_t)WIDE_MAX - 1, &temp) != TCL_OK) {
		goto optionError;
	    }
	    if (startIndex) {
		Tcl_DecrRefCount(startIndex);
	    }
	    startIndex = objv[i];
	    Tcl_IncrRefCount(startIndex);







|



|







187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
	case REGEXP_LINESTOP:
	    cflags |= TCL_REG_NLSTOP;
	    break;
	case REGEXP_LINEANCHOR:
	    cflags |= TCL_REG_NLANCH;
	    break;
	case REGEXP_START: {
	    Tcl_Size temp;
	    if (++i >= objc) {
		goto endOfForLoop;
	    }
	    if (TclGetIntForIndexM(interp, objv[i], TCL_SIZE_MAX - 1, &temp) != TCL_OK) {
		goto optionError;
	    }
	    if (startIndex) {
		Tcl_DecrRefCount(startIndex);
	    }
	    startIndex = objv[i];
	    Tcl_IncrRefCount(startIndex);
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270

    objPtr = objv[1];
    stringLength = Tcl_GetCharLength(objPtr);

    if (startIndex) {
	TclGetIntForIndexM(interp, startIndex, stringLength, &offset);
	Tcl_DecrRefCount(startIndex);
	if (offset == TCL_INDEX_NONE) {
	    offset = TCL_INDEX_START;
	}
    }

    regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags);
    if (regExpr == NULL) {
	return TCL_ERROR;







|







257
258
259
260
261
262
263
264
265
266
267
268
269
270
271

    objPtr = objv[1];
    stringLength = Tcl_GetCharLength(objPtr);

    if (startIndex) {
	TclGetIntForIndexM(interp, startIndex, stringLength, &offset);
	Tcl_DecrRefCount(startIndex);
	if (offset < 0) {
	    offset = TCL_INDEX_START;
	}
    }

    regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags);
    if (regExpr == NULL) {
	return TCL_ERROR;
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
	 * considered the start of the line. If for example the pattern {^} is
	 * passed and -start is positive, then the pattern will not match the
	 * start of the string unless the previous character is a newline.
	 */

	if (offset == TCL_INDEX_START) {
	    eflags = 0;
	} else if (offset + 1 > stringLength + 1) {
	    eflags = TCL_REG_NOTBOL;
	} else if (Tcl_GetUniChar(objPtr, offset-1) == '\n') {
	    eflags = 0;
	} else {
	    eflags = TCL_REG_NOTBOL;
	}








|







304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
	 * considered the start of the line. If for example the pattern {^} is
	 * passed and -start is positive, then the pattern will not match the
	 * start of the string unless the previous character is a newline.
	 */

	if (offset == TCL_INDEX_START) {
	    eflags = 0;
	} else if (offset > stringLength) {
	    eflags = TCL_REG_NOTBOL;
	} else if (Tcl_GetUniChar(objPtr, offset-1) == '\n') {
	    eflags = 0;
	} else {
	    eflags = TCL_REG_NOTBOL;
	}

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
	    /*
	     * It's the number of substitutions, plus one for the matchVar at
	     * index 0
	     */

	    objc = info.nsubs + 1;
	    if (all <= 1) {
		resultPtr = Tcl_NewObj();
	    }
	}
	for (i = 0; i < objc; i++) {
	    Tcl_Obj *newPtr;

	    if (indices) {
		size_t start, end;
		Tcl_Obj *objs[2];

		/*
		 * Only adjust the match area if there was a match for that
		 * area. (Scriptics Bug 4391/SF Bug #219232)
		 */

		if (i <= (int)info.nsubs && info.matches[i].start != TCL_INDEX_NONE) {
		    start = offset + info.matches[i].start;
		    end = offset + info.matches[i].end;

		    /*
		     * Adjust index so it refers to the last character in the
		     * match instead of the first character after the match.
		     */

		    if (end + 1 >= offset + 1) {
			end--;
		    }
		} else {
		    start = TCL_INDEX_NONE;
		    end = TCL_INDEX_NONE;
		}

		TclNewIndexObj(objs[0], start);
		TclNewIndexObj(objs[1], end);

		newPtr = Tcl_NewListObj(2, objs);
	    } else {
		if ((i <= (int)info.nsubs) && (info.matches[i].end + 1 > 1)) {
		    newPtr = Tcl_GetRange(objPtr,
			    offset + info.matches[i].start,
			    offset + info.matches[i].end - 1);
		} else {
		    newPtr = Tcl_NewObj();
		}
	    }
	    if (doinline) {
		if (Tcl_ListObjAppendElement(interp, resultPtr, newPtr)
			!= TCL_OK) {
		    Tcl_DecrRefCount(newPtr);
		    Tcl_DecrRefCount(resultPtr);







|






|







|








|












|




|







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
	    /*
	     * It's the number of substitutions, plus one for the matchVar at
	     * index 0
	     */

	    objc = info.nsubs + 1;
	    if (all <= 1) {
		TclNewObj(resultPtr);
	    }
	}
	for (i = 0; i < objc; i++) {
	    Tcl_Obj *newPtr;

	    if (indices) {
		Tcl_Size start, end;
		Tcl_Obj *objs[2];

		/*
		 * Only adjust the match area if there was a match for that
		 * area. (Scriptics Bug 4391/SF Bug #219232)
		 */

		if (i <= (int)info.nsubs && info.matches[i].start >= 0) {
		    start = offset + info.matches[i].start;
		    end = offset + info.matches[i].end;

		    /*
		     * Adjust index so it refers to the last character in the
		     * match instead of the first character after the match.
		     */

		    if (end >= offset) {
			end--;
		    }
		} else {
		    start = TCL_INDEX_NONE;
		    end = TCL_INDEX_NONE;
		}

		TclNewIndexObj(objs[0], start);
		TclNewIndexObj(objs[1], end);

		newPtr = Tcl_NewListObj(2, objs);
	    } else {
		if ((i <= (int)info.nsubs) && (info.matches[i].end > 0)) {
		    newPtr = Tcl_GetRange(objPtr,
			    offset + info.matches[i].start,
			    offset + info.matches[i].end - 1);
		} else {
		    TclNewObj(newPtr);
		}
	    }
	    if (doinline) {
		if (Tcl_ListObjAppendElement(interp, resultPtr, newPtr)
			!= TCL_OK) {
		    Tcl_DecrRefCount(newPtr);
		    Tcl_DecrRefCount(resultPtr);
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

	/*
	 * Adjust the offset to the character just after the last one in the
	 * matchVar and increment all to count how many times we are making a
	 * match. We always increment the offset by at least one to prevent
	 * endless looping (as in the case: regexp -all {a*} a). Otherwise,
	 * when we match the NULL string at the end of the input string, we
	 * will loop indefinately (because the length of the match is 0, so
	 * offset never changes).
	 */

	matchLength = (info.matches[0].end - info.matches[0].start);

	offset += info.matches[0].end;

	/*
	 * A match of length zero could happen for {^} {$} or {.*} and in
	 * these cases we always want to bump the index up one.
	 */

	if (matchLength == 0) {
	    offset++;
	}
	all++;
	if (offset + 1 >= stringLength + 1) {
	    break;
	}
    }

    /*
     * Set the interpreter's object result to an integer object with value 1
     * if -all wasn't specified, otherwise it's all-1 (the number of times







|
















|







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

	/*
	 * Adjust the offset to the character just after the last one in the
	 * matchVar and increment all to count how many times we are making a
	 * match. We always increment the offset by at least one to prevent
	 * endless looping (as in the case: regexp -all {a*} a). Otherwise,
	 * when we match the NULL string at the end of the input string, we
	 * will loop indefinitely (because the length of the match is 0, so
	 * offset never changes).
	 */

	matchLength = (info.matches[0].end - info.matches[0].start);

	offset += info.matches[0].end;

	/*
	 * A match of length zero could happen for {^} {$} or {.*} and in
	 * these cases we always want to bump the index up one.
	 */

	if (matchLength == 0) {
	    offset++;
	}
	all++;
	if (offset >= stringLength) {
	    break;
	}
    }

    /*
     * Set the interpreter's object result to an integer object with value 1
     * if -all wasn't specified, otherwise it's all-1 (the number of times
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
Tcl_RegsubObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int result, cflags, all, match, command;
    size_t idx, wlen, wsublen = 0, offset, numMatches, numParts;
    size_t start, end, subStart, subEnd;
    Tcl_RegExp regExpr;
    Tcl_RegExpInfo info;
    Tcl_Obj *resultPtr, *subPtr, *objPtr, *startIndex = NULL;
    Tcl_UniChar ch, *wsrc, *wfirstChar, *wstring, *wsubspec = 0, *wend;

    static const char *const options[] = {
	"-all",		"-command",	"-expanded",	"-line",







|
|







484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
Tcl_RegsubObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int result, cflags, all, match, command;
    Tcl_Size idx, wlen, wsublen = 0, offset, numMatches, numParts;
    Tcl_Size start, end, subStart, subEnd;
    Tcl_RegExp regExpr;
    Tcl_RegExpInfo info;
    Tcl_Obj *resultPtr, *subPtr, *objPtr, *startIndex = NULL;
    Tcl_UniChar ch, *wsrc, *wfirstChar, *wstring, *wsubspec = 0, *wend;

    static const char *const options[] = {
	"-all",		"-command",	"-expanded",	"-line",
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521

    cflags = TCL_REG_ADVANCED;
    all = 0;
    offset = TCL_INDEX_START;
    command = 0;
    resultPtr = NULL;

    for (idx = 1; idx < (size_t)objc; idx++) {
	const char *name;

	name = TclGetString(objv[idx]);
	if (name[0] != '-') {
	    break;
	}
	if (Tcl_GetIndexFromObj(interp, objv[idx], options, "option",







|







508
509
510
511
512
513
514
515
516
517
518
519
520
521
522

    cflags = TCL_REG_ADVANCED;
    all = 0;
    offset = TCL_INDEX_START;
    command = 0;
    resultPtr = NULL;

    for (idx = 1; idx < objc; idx++) {
	const char *name;

	name = TclGetString(objv[idx]);
	if (name[0] != '-') {
	    break;
	}
	if (Tcl_GetIndexFromObj(interp, objv[idx], options, "option",
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
	case REGSUB_LINESTOP:
	    cflags |= TCL_REG_NLSTOP;
	    break;
	case REGSUB_LINEANCHOR:
	    cflags |= TCL_REG_NLANCH;
	    break;
	case REGSUB_START: {
	    size_t temp;
	    if (++idx >= (size_t)objc) {
		goto endOfForLoop;
	    }
	    if (TclGetIntForIndexM(interp, objv[idx], (size_t)WIDE_MAX - 1, &temp) != TCL_OK) {
		goto optionError;
	    }
	    if (startIndex) {
		Tcl_DecrRefCount(startIndex);
	    }
	    startIndex = objv[idx];
	    Tcl_IncrRefCount(startIndex);
	    break;
	}
	case REGSUB_LAST:
	    idx++;
	    goto endOfForLoop;
	}
    }

  endOfForLoop:
    if ((size_t)objc < idx + 3 || (size_t)objc > idx + 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-option ...? exp string subSpec ?varName?");
    optionError:
	if (startIndex) {
	    Tcl_DecrRefCount(startIndex);
	}
	return TCL_ERROR;
    }

    objc -= idx;
    objv += idx;

    if (startIndex) {
	size_t stringLength = Tcl_GetCharLength(objv[1]);

	TclGetIntForIndexM(interp, startIndex, stringLength, &offset);
	Tcl_DecrRefCount(startIndex);
	if (offset == TCL_INDEX_NONE) {
	    offset = TCL_INDEX_START;
	}
    }

    if (all && (offset == TCL_INDEX_START) && (command == 0)
	    && (strpbrk(TclGetString(objv[2]), "&\\") == NULL)
	    && (strpbrk(TclGetString(objv[0]), "*+?{}()[].\\|^$") == NULL)) {
	/*
	 * This is a simple one pair string map situation. We make use of a
	 * slightly modified version of the one pair STR_MAP code.
	 */

	size_t slen;
	int nocase, wsrclc;
	int (*strCmpFn)(const Tcl_UniChar*,const Tcl_UniChar*,size_t);
	Tcl_UniChar *p;

	numMatches = 0;
	nocase = (cflags & TCL_REG_NOCASE);
	strCmpFn = nocase ? TclUniCharNcasecmp : TclUniCharNcmp;







|
|


|
















|













|



|
|



|







|







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
	case REGSUB_LINESTOP:
	    cflags |= TCL_REG_NLSTOP;
	    break;
	case REGSUB_LINEANCHOR:
	    cflags |= TCL_REG_NLANCH;
	    break;
	case REGSUB_START: {
	    Tcl_Size temp;
	    if (++idx >= objc) {
		goto endOfForLoop;
	    }
	    if (TclGetIntForIndexM(interp, objv[idx], TCL_SIZE_MAX - 1, &temp) != TCL_OK) {
		goto optionError;
	    }
	    if (startIndex) {
		Tcl_DecrRefCount(startIndex);
	    }
	    startIndex = objv[idx];
	    Tcl_IncrRefCount(startIndex);
	    break;
	}
	case REGSUB_LAST:
	    idx++;
	    goto endOfForLoop;
	}
    }

  endOfForLoop:
    if (objc < idx + 3 || objc > idx + 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-option ...? exp string subSpec ?varName?");
    optionError:
	if (startIndex) {
	    Tcl_DecrRefCount(startIndex);
	}
	return TCL_ERROR;
    }

    objc -= idx;
    objv += idx;

    if (startIndex) {
	Tcl_Size stringLength = Tcl_GetCharLength(objv[1]);

	TclGetIntForIndexM(interp, startIndex, stringLength, &offset);
	Tcl_DecrRefCount(startIndex);
	if (offset < 0) {
	    offset = 0;
	}
    }

    if (all && (offset == 0) && (command == 0)
	    && (strpbrk(TclGetString(objv[2]), "&\\") == NULL)
	    && (strpbrk(TclGetString(objv[0]), "*+?{}()[].\\|^$") == NULL)) {
	/*
	 * This is a simple one pair string map situation. We make use of a
	 * slightly modified version of the one pair STR_MAP code.
	 */

	Tcl_Size slen;
	int nocase, wsrclc;
	int (*strCmpFn)(const Tcl_UniChar*,const Tcl_UniChar*,size_t);
	Tcl_UniChar *p;

	numMatches = 0;
	nocase = (cflags & TCL_REG_NOCASE);
	strCmpFn = nocase ? TclUniCharNcasecmp : TclUniCharNcmp;
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
	 * arguments to the subSpec to form a command, that is then executed
	 * and the result used as the string to substitute in. Actually,
	 * everything is passed through Tcl_EvalObjv, as that's much faster.
	 */

	if (command) {
	    Tcl_Obj **args = NULL, **parts;
	    size_t numArgs;

	    TclListObjGetElementsM(interp, subPtr, &numParts, &parts);
	    numArgs = numParts + info.nsubs + 1;
	    args = (Tcl_Obj **)Tcl_Alloc(sizeof(Tcl_Obj*) * numArgs);
	    memcpy(args, parts, sizeof(Tcl_Obj*) * numParts);

	    for (idx = 0 ; idx <= info.nsubs ; idx++) {
		subStart = info.matches[idx].start;
		subEnd = info.matches[idx].end;
		if ((subStart != TCL_INDEX_NONE) && (subEnd != TCL_INDEX_NONE)) {
		    args[idx + numParts] = Tcl_NewUnicodeObj(
			    wstring + offset + subStart, subEnd - subStart);
		} else {
		    args[idx + numParts] = Tcl_NewObj();
		}
		Tcl_IncrRefCount(args[idx + numParts]);
	    }







|









|







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
	 * arguments to the subSpec to form a command, that is then executed
	 * and the result used as the string to substitute in. Actually,
	 * everything is passed through Tcl_EvalObjv, as that's much faster.
	 */

	if (command) {
	    Tcl_Obj **args = NULL, **parts;
	    Tcl_Size numArgs;

	    TclListObjGetElementsM(interp, subPtr, &numParts, &parts);
	    numArgs = numParts + info.nsubs + 1;
	    args = (Tcl_Obj **)Tcl_Alloc(sizeof(Tcl_Obj*) * numArgs);
	    memcpy(args, parts, sizeof(Tcl_Obj*) * numParts);

	    for (idx = 0 ; idx <= info.nsubs ; idx++) {
		subStart = info.matches[idx].start;
		subEnd = info.matches[idx].end;
		if ((subStart >= 0) && (subEnd >= 0)) {
		    args[idx + numParts] = Tcl_NewUnicodeObj(
			    wstring + offset + subStart, subEnd - subStart);
		} else {
		    args[idx + numParts] = Tcl_NewObj();
		}
		Tcl_IncrRefCount(args[idx + numParts]);
	    }
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
		Tcl_AppendUnicodeToObj(resultPtr, wfirstChar,
			wsrc - wfirstChar);
	    }

	    if (idx <= info.nsubs) {
		subStart = info.matches[idx].start;
		subEnd = info.matches[idx].end;
		if ((subStart != TCL_INDEX_NONE) && (subEnd != TCL_INDEX_NONE)) {
		    Tcl_AppendUnicodeToObj(resultPtr,
			    wstring + offset + subStart, subEnd - subStart);
		}
	    }

	    if (*wsrc == '\\') {
		wsrc++;







|







884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
		Tcl_AppendUnicodeToObj(resultPtr, wfirstChar,
			wsrc - wfirstChar);
	    }

	    if (idx <= info.nsubs) {
		subStart = info.matches[idx].start;
		subEnd = info.matches[idx].end;
		if ((subStart >= 0) && (subEnd >= 0)) {
		    Tcl_AppendUnicodeToObj(resultPtr,
			    wstring + offset + subStart, subEnd - subStart);
		}
	    }

	    if (*wsrc == '\\') {
		wsrc++;
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
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int ch = 0;
    int len;
    const char *splitChars;
    const char *stringPtr;
    const char *end;
    size_t splitCharLen, stringLen;
    Tcl_Obj *listPtr, *objPtr;

    if (objc == 2) {
	splitChars = " \n\t\r";
	splitCharLen = 4;
    } else if (objc == 3) {
	splitChars = Tcl_GetStringFromObj(objv[2], &splitCharLen);
    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "string ?splitChars?");
	return TCL_ERROR;
    }

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

    if (stringLen == 0) {
	/*
	 * Do nothing.
	 */
    } else if (splitCharLen == 0) {
	Tcl_HashTable charReuseTable;







|














|







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
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int ch = 0;
    int len;
    const char *splitChars;
    const char *stringPtr;
    const char *end;
    Tcl_Size splitCharLen, stringLen;
    Tcl_Obj *listPtr, *objPtr;

    if (objc == 2) {
	splitChars = " \n\t\r";
	splitCharLen = 4;
    } else if (objc == 3) {
	splitChars = Tcl_GetStringFromObj(objv[2], &splitCharLen);
    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "string ?splitChars?");
	return TCL_ERROR;
    }

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

    if (stringLen == 0) {
	/*
	 * Do nothing.
	 */
    } else if (splitCharLen == 0) {
	Tcl_HashTable charReuseTable;
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
	Tcl_DeleteHashTable(&charReuseTable);

    } else if (splitCharLen == 1) {
	const char *p;

	/*
	 * Handle the special case of splitting on a single character. This is
	 * only true for the one-char ASCII case, as one unicode char is > 1
	 * byte in length.
	 */

	while (*stringPtr && (p=strchr(stringPtr,*splitChars)) != NULL) {
	    objPtr = Tcl_NewStringObj(stringPtr, p - stringPtr);
	    Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
	    stringPtr = p + 1;
	}
	TclNewStringObj(objPtr, stringPtr, end - stringPtr);
	Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
    } else {
	const char *element, *p, *splitEnd;
	size_t splitLen;
	int splitChar;

	/*
	 * Normal case: split on any of a given set of characters. Discard
	 * instances of the split characters.
	 */








|












|







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
	Tcl_DeleteHashTable(&charReuseTable);

    } else if (splitCharLen == 1) {
	const char *p;

	/*
	 * Handle the special case of splitting on a single character. This is
	 * only true for the one-char ASCII case, as one Unicode char is > 1
	 * byte in length.
	 */

	while (*stringPtr && (p=strchr(stringPtr,*splitChars)) != NULL) {
	    objPtr = Tcl_NewStringObj(stringPtr, p - stringPtr);
	    Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
	    stringPtr = p + 1;
	}
	TclNewStringObj(objPtr, stringPtr, end - stringPtr);
	Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
    } else {
	const char *element, *p, *splitEnd;
	Tcl_Size splitLen;
	int splitChar;

	/*
	 * Normal case: split on any of a given set of characters. Discard
	 * instances of the split characters.
	 */

1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
static int
StringFirstCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    size_t start = TCL_INDEX_START;

    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"needleString haystackString ?startIndex?");
	return TCL_ERROR;
    }

    if (objc == 4) {
	size_t end = Tcl_GetCharLength(objv[2]) - 1;

	if (TCL_OK != TclGetIntForIndexM(interp, objv[3], end, &start)) {
	    return TCL_ERROR;
	}
    }
    Tcl_SetObjResult(interp, TclStringFirst(objv[1], objv[2], start));
    return TCL_OK;







|








|







1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
static int
StringFirstCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Size start = TCL_INDEX_START;

    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"needleString haystackString ?startIndex?");
	return TCL_ERROR;
    }

    if (objc == 4) {
	Tcl_Size end = Tcl_GetCharLength(objv[2]) - 1;

	if (TCL_OK != TclGetIntForIndexM(interp, objv[3], end, &start)) {
	    return TCL_ERROR;
	}
    }
    Tcl_SetObjResult(interp, TclStringFirst(objv[1], objv[2], start));
    return TCL_OK;
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
static int
StringLastCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    size_t last = TCL_INDEX_END;

    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"needleString haystackString ?lastIndex?");
	return TCL_ERROR;
    }

    if (objc == 4) {
	size_t end = Tcl_GetCharLength(objv[2]) - 1;

	if (TCL_OK != TclGetIntForIndexM(interp, objv[3], end, &last)) {
	    return TCL_ERROR;
	}
    }
    Tcl_SetObjResult(interp, TclStringLast(objv[1], objv[2], last));
    return TCL_OK;







|








|







1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
static int
StringLastCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Size last = TCL_SIZE_MAX;

    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"needleString haystackString ?lastIndex?");
	return TCL_ERROR;
    }

    if (objc == 4) {
	Tcl_Size end = Tcl_GetCharLength(objv[2]) - 1;

	if (TCL_OK != TclGetIntForIndexM(interp, objv[3], end, &last)) {
	    return TCL_ERROR;
	}
    }
    Tcl_SetObjResult(interp, TclStringLast(objv[1], objv[2], last));
    return TCL_OK;
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
static int
StringIndexCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    size_t index, end;

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

    /*
     * Get the char length to calculate what 'end' means.
     */

    end = Tcl_GetCharLength(objv[1]) - 1;
    if (TclGetIntForIndexM(interp, objv[2], end, &index) != TCL_OK) {
	return TCL_ERROR;
    }

    if ((index != TCL_INDEX_NONE) && (index + 1 <= end + 1)) {
	int ch = Tcl_GetUniChar(objv[1], index);

	if (ch == -1) {
	    return TCL_OK;
	}

	/*







|















|







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
static int
StringIndexCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Size index, end;

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

    /*
     * Get the char length to calculate what 'end' means.
     */

    end = Tcl_GetCharLength(objv[1]) - 1;
    if (TclGetIntForIndexM(interp, objv[2], end, &index) != TCL_OK) {
	return TCL_ERROR;
    }

    if ((index >= 0) && (index <= end)) {
	int ch = Tcl_GetUniChar(objv[1], index);

	if (ch == -1) {
	    return TCL_OK;
	}

	/*
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
static int
StringInsertCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter */
    int objc,			/* Number of arguments */
    Tcl_Obj *const objv[])	/* Argument objects */
{
    size_t length;		/* String length */
    size_t index;		/* Insert index */
    Tcl_Obj *outObj;		/* Output object */

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

    length = Tcl_GetCharLength(objv[1]);
    if (TclGetIntForIndexM(interp, objv[2], length, &index) != TCL_OK) {
	return TCL_ERROR;
    }

    if (index == TCL_INDEX_NONE) {
	index = TCL_INDEX_START;
    }
    if (index > length) {
	index = length;
    }

    outObj = TclStringReplace(interp, objv[1], index, 0, objv[3],







|
|












|







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
static int
StringInsertCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter */
    int objc,			/* Number of arguments */
    Tcl_Obj *const objv[])	/* Argument objects */
{
    Tcl_Size length;		/* String length */
    Tcl_Size index;		/* Insert index */
    Tcl_Obj *outObj;		/* Output object */

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

    length = Tcl_GetCharLength(objv[1]);
    if (TclGetIntForIndexM(interp, objv[2], length, &index) != TCL_OK) {
	return TCL_ERROR;
    }

    if (index < 0) {
	index = TCL_INDEX_START;
    }
    if (index > length) {
	index = length;
    }

    outObj = TclStringReplace(interp, objv[1], index, 0, objv[3],
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *string1, *end, *stop;
    int (*chcomp)(int) = NULL;	/* The UniChar comparison function. */
    int i, result = 1, strict = 0;
    size_t failat = 0, length1, length2, length3;
    Tcl_Obj *objPtr, *failVarObj = NULL;
    Tcl_WideInt w;

    static const char *const isClasses[] = {
	"alnum",	"alpha",	"ascii",	"control",
	"boolean",	"dict",		"digit",	"double",
	"entier",	"false",	"graph",	"integer",







|







1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *string1, *end, *stop;
    int (*chcomp)(int) = NULL;	/* The UniChar comparison function. */
    int i, result = 1, strict = 0;
    Tcl_Size failat = 0, length1, length2, length3;
    Tcl_Obj *objPtr, *failVarObj = NULL;
    Tcl_WideInt w;

    static const char *const isClasses[] = {
	"alnum",	"alpha",	"ascii",	"control",
	"boolean",	"dict",		"digit",	"double",
	"entier",	"false",	"graph",	"integer",
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
	    }
	}
    }

    /*
     * We get the objPtr so that we can short-cut for some classes by checking
     * the object type (int and double), but we need the string otherwise,
     * because we don't want any conversion of type occuring (as, for example,
     * Tcl_Get*FromObj would do).
     */

    objPtr = objv[objc-1];

    /*
     * When entering here, result == 1 and failat == 0.







|







1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
	    }
	}
    }

    /*
     * We get the objPtr so that we can short-cut for some classes by checking
     * the object type (int and double), but we need the string otherwise,
     * because we don't want any conversion of type occurring (as, for example,
     * Tcl_Get*FromObj would do).
     */

    objPtr = objv[objc-1];

    /*
     * When entering here, result == 1 and failat == 0.
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
	}
	break;
    case STR_IS_CONTROL:
	chcomp = Tcl_UniCharIsControl;
	break;
    case STR_IS_DICT: {
	int dresult;
	size_t dsize;

	dresult = Tcl_DictObjSize(interp, objPtr, &dsize);
	Tcl_ResetResult(interp);
	result = (dresult == TCL_OK) ? 1 : 0;
	if (dresult != TCL_OK && failVarObj != NULL) {
	    /*
	     * Need to figure out where the list parsing failed, which is
	     * fairly expensive. This is adapted from the core of
	     * SetDictFromAny().
	     */

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

	    string1 = Tcl_GetStringFromObj(objPtr, &length1);
	    end = string1 + length1;
	    failat = -1;
	    for (p=string1, lenRemain=length1; lenRemain > 0;
		    p=nextElem, lenRemain=end-nextElem) {







|












|
<







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
	}
	break;
    case STR_IS_CONTROL:
	chcomp = Tcl_UniCharIsControl;
	break;
    case STR_IS_DICT: {
	int dresult;
	Tcl_Size dsize;

	dresult = Tcl_DictObjSize(interp, objPtr, &dsize);
	Tcl_ResetResult(interp);
	result = (dresult == TCL_OK) ? 1 : 0;
	if (dresult != TCL_OK && failVarObj != NULL) {
	    /*
	     * Need to figure out where the list parsing failed, which is
	     * fairly expensive. This is adapted from the core of
	     * SetDictFromAny().
	     */

	    const char *elemStart, *nextElem;
	    Tcl_Size lenRemain, elemSize;

	    const char *p;

	    string1 = Tcl_GetStringFromObj(objPtr, &length1);
	    end = string1 + length1;
	    failat = -1;
	    for (p=string1, lenRemain=length1; lenRemain > 0;
		    p=nextElem, lenRemain=end-nextElem) {
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
	if (length1 == 0) {
	    if (strict) {
		result = 0;
	    }
	    goto str_is_done;
	}
	end = string1 + length1;
	if (TclParseNumber(NULL, objPtr, NULL, NULL, -1,
		(const char **) &stop, 0) != TCL_OK) {
	    result = 0;
	    failat = 0;
	} else {
	    failat = stop - string1;
	    if (stop < end) {
		result = 0;







|







1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
	if (length1 == 0) {
	    if (strict) {
		result = 0;
	    }
	    goto str_is_done;
	}
	end = string1 + length1;
	if (TclParseNumber(NULL, objPtr, NULL, NULL, TCL_INDEX_NONE,
		(const char **) &stop, 0) != TCL_OK) {
	    result = 0;
	    failat = 0;
	} else {
	    failat = stop - string1;
	    if (stop < end) {
		result = 0;
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
	if (length1 == 0) {
	    if (strict) {
		result = 0;
	    }
	    goto str_is_done;
	}
	end = string1 + length1;
	if (TclParseNumber(NULL, objPtr, NULL, NULL, -1,
		(const char **) &stop, TCL_PARSE_INTEGER_ONLY) == TCL_OK) {
	    if (stop == end) {
		/*
		 * Entire string parses as an integer.
		 */

		break;







|







1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
	if (length1 == 0) {
	    if (strict) {
		result = 0;
	    }
	    goto str_is_done;
	}
	end = string1 + length1;
	if (TclParseNumber(NULL, objPtr, NULL, NULL, TCL_INDEX_NONE,
		(const char **) &stop, TCL_PARSE_INTEGER_ONLY) == TCL_OK) {
	    if (stop == end) {
		/*
		 * Entire string parses as an integer.
		 */

		break;
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
	     * Don't bother computing the failure point if we're not going to
	     * return it.
	     */

	    break;
	}
	end = string1 + length1;
	if (TclParseNumber(NULL, objPtr, NULL, NULL, -1,
		(const char **) &stop, TCL_PARSE_INTEGER_ONLY) == TCL_OK) {
	    if (stop == end) {
		/*
		 * Entire string parses as an integer, but rejected by
		 * Tcl_Get(Wide)IntFromObj() so we must have overflowed the
		 * target type, and our convention is to return failure at
		 * index -1 in that situation.







|







1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
	     * Don't bother computing the failure point if we're not going to
	     * return it.
	     */

	    break;
	}
	end = string1 + length1;
	if (TclParseNumber(NULL, objPtr, NULL, NULL, TCL_INDEX_NONE,
		(const char **) &stop, TCL_PARSE_INTEGER_ONLY) == TCL_OK) {
	    if (stop == end) {
		/*
		 * Entire string parses as an integer, but rejected by
		 * Tcl_Get(Wide)IntFromObj() so we must have overflowed the
		 * target type, and our convention is to return failure at
		 * index -1 in that situation.
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
	    /*
	     * Need to figure out where the list parsing failed, which is
	     * fairly expensive. This is adapted from the core of
	     * SetListFromAny().
	     */

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

	    string1 = Tcl_GetStringFromObj(objPtr, &length1);
	    end = string1 + length1;
	    failat = -1;
	    for (p=string1, lenRemain=length1; lenRemain > 0;
		    p=nextElem, lenRemain=end-nextElem) {







|
|







1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
	    /*
	     * Need to figure out where the list parsing failed, which is
	     * fairly expensive. This is adapted from the core of
	     * SetListFromAny().
	     */

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

	    string1 = Tcl_GetStringFromObj(objPtr, &length1);
	    end = string1 + length1;
	    failat = -1;
	    for (p=string1, lenRemain=length1; lenRemain > 0;
		    p=nextElem, lenRemain=end-nextElem) {
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
static int
StringMapCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    size_t length1, length2,  mapElemc, index;
    int nocase = 0, mapWithDict = 0, copySource = 0;
    Tcl_Obj **mapElemv, *sourceObj, *resultPtr;
    Tcl_UniChar *ustring1, *ustring2, *p, *end;
    int (*strCmpFn)(const Tcl_UniChar*, const Tcl_UniChar*, size_t);

    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? charMap string");







|







1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
static int
StringMapCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Size length1, length2,  mapElemc, index;
    int nocase = 0, mapWithDict = 0, copySource = 0;
    Tcl_Obj **mapElemv, *sourceObj, *resultPtr;
    Tcl_UniChar *ustring1, *ustring2, *p, *end;
    int (*strCmpFn)(const Tcl_UniChar*, const Tcl_UniChar*, size_t);

    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? charMap string");
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
    /*
     * This test is tricky, but has to be that way or you get other strange
     * inconsistencies (see test string-10.20.1 for illustration why!)
     */

    if (!TclHasStringRep(objv[objc-2])
	    && TclHasInternalRep(objv[objc-2], &tclDictType)) {
	size_t i;
	int done;
	Tcl_DictSearch search;

	/*
	 * We know the type exactly, so all dict operations will succeed for
	 * sure. This shortens this code quite a bit.
	 */







|







1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
    /*
     * This test is tricky, but has to be that way or you get other strange
     * inconsistencies (see test string-10.20.1 for illustration why!)
     */

    if (!TclHasStringRep(objv[objc-2])
	    && TclHasInternalRep(objv[objc-2], &tclDictType)) {
	Tcl_Size i;
	int done;
	Tcl_DictSearch search;

	/*
	 * We know the type exactly, so all dict operations will succeed for
	 * sure. This shortens this code quite a bit.
	 */
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
	Tcl_DictObjFirst(interp, objv[objc-2], &search, mapElemv+0,
		mapElemv+1, &done);
	for (index=2 ; index<mapElemc ; index+=2) {
	    Tcl_DictObjNext(&search, mapElemv+index, mapElemv+index+1, &done);
	}
	Tcl_DictObjDone(&search);
    } else {
	size_t i;
	if (TclListObjGetElementsM(interp, objv[objc-2], &i,
		&mapElemv) != TCL_OK) {
	    return TCL_ERROR;
	}
	mapElemc = i;
	if (mapElemc == 0) {
	    /*







|







2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
	Tcl_DictObjFirst(interp, objv[objc-2], &search, mapElemv+0,
		mapElemv+1, &done);
	for (index=2 ; index<mapElemc ; index+=2) {
	    Tcl_DictObjNext(&search, mapElemv+index, mapElemv+index+1, &done);
	}
	Tcl_DictObjDone(&search);
    } else {
	Tcl_Size i;
	if (TclListObjGetElementsM(interp, objv[objc-2], &i,
		&mapElemv) != TCL_OK) {
	    return TCL_ERROR;
	}
	mapElemc = i;
	if (mapElemc == 0) {
	    /*
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
	/*
	 * Special case for one map pair which avoids the extra for loop and
	 * extra calls to get Unicode data. The algorithm is otherwise
	 * identical to the multi-pair case. This will be >30% faster on
	 * larger strings.
	 */

	size_t mapLen;
	int u2lc;
	Tcl_UniChar *mapString;

	ustring2 = Tcl_GetUnicodeFromObj(mapElemv[0], &length2);
	p = ustring1;
	if ((length2 > length1) || (length2 == 0)) {
	    /*







|







2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
	/*
	 * Special case for one map pair which avoids the extra for loop and
	 * extra calls to get Unicode data. The algorithm is otherwise
	 * identical to the multi-pair case. This will be >30% faster on
	 * larger strings.
	 */

	Tcl_Size mapLen;
	int u2lc;
	Tcl_UniChar *mapString;

	ustring2 = Tcl_GetUnicodeFromObj(mapElemv[0], &length2);
	p = ustring1;
	if ((length2 > length1) || (length2 == 0)) {
	    /*
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

		    Tcl_AppendUnicodeToObj(resultPtr, mapString, mapLen);
		}
	    }
	}
    } else {
	Tcl_UniChar **mapStrings;
	size_t *mapLens;
	int *u2lc = 0;

	/*
	 * Precompute pointers to the unicode string and length. This saves us
	 * repeated function calls later, significantly speeding up the
	 * algorithm. We only need the lowercase first char in the nocase
	 * case.
	 */

	mapStrings = (Tcl_UniChar **)TclStackAlloc(interp, mapElemc*sizeof(Tcl_UniChar *)*2);
	mapLens = (size_t *)TclStackAlloc(interp, mapElemc * sizeof(size_t) * 2);
	if (nocase) {
	    u2lc = (int *)TclStackAlloc(interp, mapElemc * sizeof(int));
	}
	for (index = 0; index < mapElemc; index++) {
	    mapStrings[index] = Tcl_GetUnicodeFromObj(mapElemv[index],
		    mapLens+index);
	    if (nocase && ((index % 2) == 0)) {







|



|






|







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

		    Tcl_AppendUnicodeToObj(resultPtr, mapString, mapLen);
		}
	    }
	}
    } else {
	Tcl_UniChar **mapStrings;
	Tcl_Size *mapLens;
	int *u2lc = 0;

	/*
	 * Precompute pointers to the Unicode string and length. This saves us
	 * repeated function calls later, significantly speeding up the
	 * algorithm. We only need the lowercase first char in the nocase
	 * case.
	 */

	mapStrings = (Tcl_UniChar **)TclStackAlloc(interp, mapElemc*sizeof(Tcl_UniChar *)*2);
	mapLens = (Tcl_Size *)TclStackAlloc(interp, mapElemc * sizeof(Tcl_Size) * 2);
	if (nocase) {
	    u2lc = (int *)TclStackAlloc(interp, mapElemc * sizeof(int));
	}
	for (index = 0; index < mapElemc; index++) {
	    mapStrings[index] = Tcl_GetUnicodeFromObj(mapElemv[index],
		    mapLens+index);
	    if (nocase && ((index % 2) == 0)) {
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
		 */

		ustring2 = mapStrings[index];
		length2 = mapLens[index];
		if ((length2 > 0) && ((*ustring1 == *ustring2) || (nocase &&
			(Tcl_UniCharToLower(*ustring1) == u2lc[index/2]))) &&
			/* Restrict max compare length. */
			((size_t)(end-ustring1) >= length2) && ((length2 == 1) ||
			!strCmpFn(ustring2, ustring1, length2))) {
		    if (p != ustring1) {
			/*
			 * Put the skipped chars onto the result first.
			 */

			Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p);
			p = ustring1 + length2;
		    } else {
			p += length2;
		    }

		    /*
		     * Adjust len to be full length of matched string.
		     */

		    ustring1 = p - 1;

		    /*
		     * Append the map value to the unicode string.
		     */

		    Tcl_AppendUnicodeToObj(resultPtr,
			    mapStrings[index+1], mapLens[index+1]);
		    break;
		}
	    }







|



















|







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

		ustring2 = mapStrings[index];
		length2 = mapLens[index];
		if ((length2 > 0) && ((*ustring1 == *ustring2) || (nocase &&
			(Tcl_UniCharToLower(*ustring1) == u2lc[index/2]))) &&
			/* Restrict max compare length. */
			((end-ustring1) >= length2) && ((length2 == 1) ||
			!strCmpFn(ustring2, ustring1, length2))) {
		    if (p != ustring1) {
			/*
			 * Put the skipped chars onto the result first.
			 */

			Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p);
			p = ustring1 + length2;
		    } else {
			p += length2;
		    }

		    /*
		     * Adjust len to be full length of matched string.
		     */

		    ustring1 = p - 1;

		    /*
		     * Append the map value to the Unicode string.
		     */

		    Tcl_AppendUnicodeToObj(resultPtr,
			    mapStrings[index+1], mapLens[index+1]);
		    break;
		}
	    }
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253

    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? pattern string");
	return TCL_ERROR;
    }

    if (objc == 4) {
	size_t length;
	const char *string = Tcl_GetStringFromObj(objv[1], &length);

	if ((length > 1) &&
	    strncmp(string, "-nocase", length) == 0) {
	    nocase = TCL_MATCH_NOCASE;
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(







|







2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253

    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? pattern string");
	return TCL_ERROR;
    }

    if (objc == 4) {
	Tcl_Size 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(
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
static int
StringRangeCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    size_t first, last, end;

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

    /*
     * Get the length in actual characters; Then reduce it by one because
     * 'end' refers to the last character, not one past it.
     */

    end = Tcl_GetCharLength(objv[1]) - 1;

    if (TclGetIntForIndexM(interp, objv[2], end, &first) != TCL_OK ||
	    TclGetIntForIndexM(interp, objv[3], end, &last) != TCL_OK) {
	return TCL_ERROR;
    }

    if (last != TCL_INDEX_NONE) {
	Tcl_SetObjResult(interp, Tcl_GetRange(objv[1], first, last));
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------







|


















|







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
static int
StringRangeCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Size first, last, end;

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

    /*
     * Get the length in actual characters; Then reduce it by one because
     * 'end' refers to the last character, not one past it.
     */

    end = Tcl_GetCharLength(objv[1]) - 1;

    if (TclGetIntForIndexM(interp, objv[2], end, &first) != TCL_OK ||
	    TclGetIntForIndexM(interp, objv[3], end, &last) != TCL_OK) {
	return TCL_ERROR;
    }

    if (last >= 0) {
	Tcl_SetObjResult(interp, Tcl_GetRange(objv[1], first, last));
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
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
static int
StringRplcCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
	size_t first, last, end;

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

    end = Tcl_GetCharLength(objv[1]) - 1;

    if (TclGetIntForIndexM(interp, objv[2], end, &first) != TCL_OK ||
	    TclGetIntForIndexM(interp, objv[3], end, &last) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * The following test screens out most empty substrings as candidates for
     * replacement. When they are detected, no replacement is done, and the
     * result is the original string.
     */

    if ((last == TCL_INDEX_NONE) ||	/* Range ends before start of string */
	    (first + 1 > end + 1) ||	/* Range begins after end of string */
	    (last + 1 < first + 1)) {	/* Range begins after it starts */
	/*
	 * BUT!!! when (end < 0) -- an empty original string -- we can
	 * have (first <= end < 0 <= last) and an empty string is permitted
	 * to be replaced.
	 */

	Tcl_SetObjResult(interp, objv[1]);
    } else {
	Tcl_Obj *resultPtr;

	if (first == TCL_INDEX_NONE) {
	    first = TCL_INDEX_START;
	}
	if (last + 1 > end + 1) {
	    last = end;
	}

	resultPtr = TclStringReplace(interp, objv[1], first,
		last + 1 - first, (objc == 5) ? objv[4] : NULL,
		TCL_STRING_IN_PLACE);








|



















|
|
|










|


|







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
static int
StringRplcCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Size first, last, end;

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

    end = Tcl_GetCharLength(objv[1]) - 1;

    if (TclGetIntForIndexM(interp, objv[2], end, &first) != TCL_OK ||
	    TclGetIntForIndexM(interp, objv[3], end, &last) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * The following test screens out most empty substrings as candidates for
     * replacement. When they are detected, no replacement is done, and the
     * result is the original string.
     */

    if ((last < 0) ||	/* Range ends before start of string */
	    (first > end) ||	/* Range begins after end of string */
	    (last < first)) {	/* Range begins after it starts */
	/*
	 * BUT!!! when (end < 0) -- an empty original string -- we can
	 * have (first <= end < 0 <= last) and an empty string is permitted
	 * to be replaced.
	 */

	Tcl_SetObjResult(interp, objv[1]);
    } else {
	Tcl_Obj *resultPtr;

	if (first < 0) {
	    first = TCL_INDEX_START;
	}
	if (last > end) {
	    last = end;
	}

	resultPtr = TclStringReplace(interp, objv[1], first,
		last + 1 - first, (objc == 5) ? objv[4] : NULL,
		TCL_STRING_IN_PLACE);

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

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

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

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








|











|



|







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

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

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

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

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

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

    string = Tcl_GetUnicodeFromObj(objv[1], &length);
    if (TclGetIntForIndexM(interp, objv[2], length-1, &index) != TCL_OK) {
	return TCL_ERROR;
    }
    if (index == TCL_INDEX_NONE) {
	index = TCL_INDEX_START;
    }
    if (index + 1 <= length + 1) {
	p = &string[index];
	end = string+length;
	for (cur = index; p < end; cur++) {
	    p += TclUniCharToUCS4(p, &ch);
	    if (!Tcl_UniCharIsWordChar(ch)) {
		break;
	    }







|











|
|

|







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

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

    string = Tcl_GetUnicodeFromObj(objv[1], &length);
    if (TclGetIntForIndexM(interp, objv[2], length-1, &index) != TCL_OK) {
	return TCL_ERROR;
    }
    if (index < 0) {
	index = 0;
    }
    if (index < length) {
	p = &string[index];
	end = string+length;
	for (cur = index; p < end; cur++) {
	    p += TclUniCharToUCS4(p, &ch);
	    if (!Tcl_UniCharIsWordChar(ch)) {
		break;
	    }
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
    /*
     * Remember to keep code here in some sync with the byte-compiled versions
     * in tclExecute.c (INST_STR_EQ, INST_STR_NEQ and INST_STR_CMP as well as
     * the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...).
     */

    const char *string2;
    int i, match, nocase = 0, reqlength = -1;
    size_t length;

    if (objc < 3 || objc > 6) {
    str_cmp_args:
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-nocase? ?-length int? string1 string2");
	return TCL_ERROR;
    }

    for (i = 1; i < objc-2; i++) {
	string2 = Tcl_GetStringFromObj(objv[i], &length);
	if ((length > 1) && !strncmp(string2, "-nocase", length)) {
	    nocase = 1;
	} else if ((length > 1)
		&& !strncmp(string2, "-length", length)) {
	    if (i+1 >= objc-2) {
		goto str_cmp_args;
	    }
	    i++;
	    if (TclGetIntFromObj(interp, objv[i], &reqlength) != TCL_OK) {
		return TCL_ERROR;
	    }
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad option \"%s\": must be -nocase or -length",
		    string2));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
		    string2, NULL);
	    return TCL_ERROR;
	}
    }

    /*
     * From now on, we only access the two objects at the end of the argument
     * array.
     */

    objv += objc-2;
    match = TclStringCmp(objv[0], objv[1], 0, nocase, reqlength);
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(match ? 0 : 1));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *







|
|


















|


















|







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
    /*
     * Remember to keep code here in some sync with the byte-compiled versions
     * in tclExecute.c (INST_STR_EQ, INST_STR_NEQ and INST_STR_CMP as well as
     * the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...).
     */

    const char *string2;
    int i, match, nocase = 0;
    Tcl_Size length, reqlength = -1;

    if (objc < 3 || objc > 6) {
    str_cmp_args:
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-nocase? ?-length int? string1 string2");
	return TCL_ERROR;
    }

    for (i = 1; i < objc-2; i++) {
	string2 = Tcl_GetStringFromObj(objv[i], &length);
	if ((length > 1) && !strncmp(string2, "-nocase", length)) {
	    nocase = 1;
	} else if ((length > 1)
		&& !strncmp(string2, "-length", length)) {
	    if (i+1 >= objc-2) {
		goto str_cmp_args;
	    }
	    i++;
	    if (TclGetSizeIntFromObj(interp, objv[i], &reqlength) != TCL_OK) {
		return TCL_ERROR;
	    }
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad option \"%s\": must be -nocase or -length",
		    string2));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
		    string2, NULL);
	    return TCL_ERROR;
	}
    }

    /*
     * From now on, we only access the two objects at the end of the argument
     * array.
     */

    objv += objc-2;
    match = TclStringCmp(objv[0], objv[1], 1, nocase, reqlength);
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(match ? 0 : 1));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
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
{
    /*
     * Remember to keep code here in some sync with the byte-compiled versions
     * in tclExecute.c (INST_STR_EQ, INST_STR_NEQ and INST_STR_CMP as well as
     * the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...).
     */

    int match, nocase, reqlength, status;


    status = TclStringCmpOpts(interp, objc, objv, &nocase, &reqlength);
    if (status != TCL_OK) {
	return status;
    }

    objv += objc-2;
    match = TclStringCmp(objv[0], objv[1], 0, nocase, reqlength);
    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(match));
    return TCL_OK;
}

int
TclStringCmpOpts(
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[],	/* Argument objects. */
    int *nocase,
    int *reqlength)
{
    int i;
    size_t length;
    const char *string;

    *reqlength = -1;
    *nocase = 0;
    if (objc < 3 || objc > 6) {
    str_cmp_args:
	Tcl_WrongNumArgs(interp, 1, objv,







|
>


















|


|







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
{
    /*
     * Remember to keep code here in some sync with the byte-compiled versions
     * in tclExecute.c (INST_STR_EQ, INST_STR_NEQ and INST_STR_CMP as well as
     * the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...).
     */

    int match, nocase, status;
    Tcl_Size reqlength;

    status = TclStringCmpOpts(interp, objc, objv, &nocase, &reqlength);
    if (status != TCL_OK) {
	return status;
    }

    objv += objc-2;
    match = TclStringCmp(objv[0], objv[1], 0, nocase, reqlength);
    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(match));
    return TCL_OK;
}

int
TclStringCmpOpts(
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[],	/* Argument objects. */
    int *nocase,
    Tcl_Size *reqlength)
{
    int i;
    Tcl_Size length;
    const char *string;

    *reqlength = -1;
    *nocase = 0;
    if (objc < 3 || objc > 6) {
    str_cmp_args:
	Tcl_WrongNumArgs(interp, 1, objv,
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
	    *nocase = 1;
	} else if ((length > 1)
		&& !strncmp(string, "-length", length)) {
	    if (i+1 >= objc-2) {
		goto str_cmp_args;
	    }
	    i++;
	    if (TclGetIntFromObj(interp, objv[i], reqlength) != TCL_OK) {
		return TCL_ERROR;
	    }
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad option \"%s\": must be -nocase or -length",
		    string));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",







|







2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
	    *nocase = 1;
	} else if ((length > 1)
		&& !strncmp(string, "-length", length)) {
	    if (i+1 >= objc-2) {
		goto str_cmp_args;
	    }
	    i++;
	    if (TclGetSizeIntFromObj(interp, objv[i], reqlength) != TCL_OK) {
		return TCL_ERROR;
	    }
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad option \"%s\": must be -nocase or -length",
		    string));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
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
static int
StringLowerCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    size_t length1, length2;
    const char *string1;
    char *string2;

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

    string1 = Tcl_GetStringFromObj(objv[1], &length1);

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

	length1 = Tcl_UtfToLower(TclGetString(resultPtr));
	Tcl_SetObjLength(resultPtr, length1);
	Tcl_SetObjResult(interp, resultPtr);
    } else {
	size_t first, last;
	const char *start, *end;
	Tcl_Obj *resultPtr;

	length1 = Tcl_NumUtfChars(string1, length1) - 1;
	if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (first == TCL_INDEX_NONE) {
	    first = 0;
	}
	last = first;

	if ((objc == 4) && (TclGetIntForIndexM(interp, objv[3], length1,
		&last) != TCL_OK)) {
	    return TCL_ERROR;
	}

	if (last + 1 >= length1 + 1) {
	    last = length1;
	}
	if (last + 1 < first + 1) {
	    Tcl_SetObjResult(interp, objv[1]);
	    return TCL_OK;
	}

	string1 = Tcl_GetStringFromObj(objv[1], &length1);
	start = Tcl_UtfAtIndex(string1, first);
	end = Tcl_UtfAtIndex(start, last - first + 1);







|

















|







|









|


|







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
static int
StringLowerCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Size length1, length2;
    const char *string1;
    char *string2;

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

    string1 = Tcl_GetStringFromObj(objv[1], &length1);

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

	length1 = Tcl_UtfToLower(TclGetString(resultPtr));
	Tcl_SetObjLength(resultPtr, length1);
	Tcl_SetObjResult(interp, resultPtr);
    } else {
	Tcl_Size first, last;
	const char *start, *end;
	Tcl_Obj *resultPtr;

	length1 = Tcl_NumUtfChars(string1, length1) - 1;
	if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (first < 0) {
	    first = 0;
	}
	last = first;

	if ((objc == 4) && (TclGetIntForIndexM(interp, objv[3], length1,
		&last) != TCL_OK)) {
	    return TCL_ERROR;
	}

	if (last >= length1) {
	    last = length1;
	}
	if (last < first) {
	    Tcl_SetObjResult(interp, objv[1]);
	    return TCL_OK;
	}

	string1 = Tcl_GetStringFromObj(objv[1], &length1);
	start = Tcl_UtfAtIndex(string1, first);
	end = Tcl_UtfAtIndex(start, last - first + 1);
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
static int
StringUpperCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    size_t length1, length2;
    const char *string1;
    char *string2;

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

    string1 = Tcl_GetStringFromObj(objv[1], &length1);

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

	length1 = Tcl_UtfToUpper(TclGetString(resultPtr));
	Tcl_SetObjLength(resultPtr, length1);
	Tcl_SetObjResult(interp, resultPtr);
    } else {
	size_t first, last;
	const char *start, *end;
	Tcl_Obj *resultPtr;

	length1 = Tcl_NumUtfChars(string1, length1) - 1;
	if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (first == TCL_INDEX_NONE) {
	    first = TCL_INDEX_START;
	}
	last = first;

	if ((objc == 4) && (TclGetIntForIndexM(interp, objv[3], length1,
		&last) != TCL_OK)) {
	    return TCL_ERROR;
	}

	if (last + 1 >= length1 + 1) {
	    last = length1;
	}
	if (last + 1 < first + 1) {
	    Tcl_SetObjResult(interp, objv[1]);
	    return TCL_OK;
	}

	string1 = Tcl_GetStringFromObj(objv[1], &length1);
	start = Tcl_UtfAtIndex(string1, first);
	end = Tcl_UtfAtIndex(start, last - first + 1);







|

















|







|
|








|


|







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
static int
StringUpperCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Size length1, length2;
    const char *string1;
    char *string2;

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

    string1 = Tcl_GetStringFromObj(objv[1], &length1);

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

	length1 = Tcl_UtfToUpper(TclGetString(resultPtr));
	Tcl_SetObjLength(resultPtr, length1);
	Tcl_SetObjResult(interp, resultPtr);
    } else {
	Tcl_Size first, last;
	const char *start, *end;
	Tcl_Obj *resultPtr;

	length1 = Tcl_NumUtfChars(string1, length1) - 1;
	if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (first < 0) {
	    first = 0;
	}
	last = first;

	if ((objc == 4) && (TclGetIntForIndexM(interp, objv[3], length1,
		&last) != TCL_OK)) {
	    return TCL_ERROR;
	}

	if (last >= length1) {
	    last = length1;
	}
	if (last < first) {
	    Tcl_SetObjResult(interp, objv[1]);
	    return TCL_OK;
	}

	string1 = Tcl_GetStringFromObj(objv[1], &length1);
	start = Tcl_UtfAtIndex(string1, first);
	end = Tcl_UtfAtIndex(start, last - first + 1);
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
static int
StringTitleCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    size_t length1, length2;
    const char *string1;
    char *string2;

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

    string1 = Tcl_GetStringFromObj(objv[1], &length1);

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

	length1 = Tcl_UtfToTitle(TclGetString(resultPtr));
	Tcl_SetObjLength(resultPtr, length1);
	Tcl_SetObjResult(interp, resultPtr);
    } else {
	size_t first, last;
	const char *start, *end;
	Tcl_Obj *resultPtr;

	length1 = Tcl_NumUtfChars(string1, length1) - 1;
	if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (first == TCL_INDEX_NONE) {
	    first = TCL_INDEX_START;
	}
	last = first;

	if ((objc == 4) && (TclGetIntForIndexM(interp, objv[3], length1,
		&last) != TCL_OK)) {
	    return TCL_ERROR;
	}

	if (last + 1 >= length1 + 1) {
	    last = length1;
	}
	if (last + 1 < first + 1) {
	    Tcl_SetObjResult(interp, objv[1]);
	    return TCL_OK;
	}

	string1 = Tcl_GetStringFromObj(objv[1], &length1);
	start = Tcl_UtfAtIndex(string1, first);
	end = Tcl_UtfAtIndex(start, last - first + 1);







|

















|







|
|








|


|







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
static int
StringTitleCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Size length1, length2;
    const char *string1;
    char *string2;

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

    string1 = Tcl_GetStringFromObj(objv[1], &length1);

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

	length1 = Tcl_UtfToTitle(TclGetString(resultPtr));
	Tcl_SetObjLength(resultPtr, length1);
	Tcl_SetObjResult(interp, resultPtr);
    } else {
	Tcl_Size first, last;
	const char *start, *end;
	Tcl_Obj *resultPtr;

	length1 = Tcl_NumUtfChars(string1, length1) - 1;
	if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (first < 0) {
	    first = 0;
	}
	last = first;

	if ((objc == 4) && (TclGetIntForIndexM(interp, objv[3], length1,
		&last) != TCL_OK)) {
	    return TCL_ERROR;
	}

	if (last >= length1) {
	    last = length1;
	}
	if (last < first) {
	    Tcl_SetObjResult(interp, objv[1]);
	    return TCL_OK;
	}

	string1 = Tcl_GetStringFromObj(objv[1], &length1);
	start = Tcl_UtfAtIndex(string1, first);
	end = Tcl_UtfAtIndex(start, last - first + 1);
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
StringTrimCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *string1, *string2;
    size_t triml, trimr, length1, length2;

    if (objc == 3) {
	string2 = Tcl_GetStringFromObj(objv[2], &length2);
    } else if (objc == 2) {
	string2 = tclDefaultTrimSet;
	length2 = strlen(tclDefaultTrimSet);
    } else {







|







3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
StringTrimCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *string1, *string2;
    Tcl_Size triml, trimr, length1, length2;

    if (objc == 3) {
	string2 = Tcl_GetStringFromObj(objv[2], &length2);
    } else if (objc == 2) {
	string2 = tclDefaultTrimSet;
	length2 = strlen(tclDefaultTrimSet);
    } else {
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *string1, *string2;
    int trim;
    size_t length1, length2;

    if (objc == 3) {
	string2 = Tcl_GetStringFromObj(objv[2], &length2);
    } else if (objc == 2) {
	string2 = tclDefaultTrimSet;
	length2 = strlen(tclDefaultTrimSet);
    } else {







|







3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *string1, *string2;
    int trim;
    Tcl_Size length1, length2;

    if (objc == 3) {
	string2 = Tcl_GetStringFromObj(objv[2], &length2);
    } else if (objc == 2) {
	string2 = tclDefaultTrimSet;
	length2 = strlen(tclDefaultTrimSet);
    } else {
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *string1, *string2;
    int trim;
    size_t length1, length2;

    if (objc == 3) {
	string2 = Tcl_GetStringFromObj(objv[2], &length2);
    } else if (objc == 2) {
	string2 = tclDefaultTrimSet;
	length2 = strlen(tclDefaultTrimSet);
    } else {







|







3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *string1, *string2;
    int trim;
    Tcl_Size length1, length2;

    if (objc == 3) {
	string2 = Tcl_GetStringFromObj(objv[2], &length2);
    } else if (objc == 2) {
	string2 = tclDefaultTrimSet;
	length2 = strlen(tclDefaultTrimSet);
    } else {
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
 *
 *----------------------------------------------------------------------
 */

int
TclSubstOptions(
    Tcl_Interp *interp,
    size_t numOpts1,
    Tcl_Obj *const opts[],
    int *flagPtr)
{
    static const char *const substOptions[] = {
	"-nobackslashes", "-nocommands", "-novariables", NULL
    };
    enum {
	SUBST_NOBACKSLASHES, SUBST_NOCOMMANDS, SUBST_NOVARS
    };
    int i, flags = TCL_SUBST_ALL;
    int numOpts = numOpts1;

    for (i = 0; i < numOpts; i++) {
	int optionIndex;

	if (Tcl_GetIndexFromObj(interp, opts[i], substOptions, "option", 0,
		&optionIndex) != TCL_OK) {
	    return TCL_ERROR;







|










<







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

int
TclSubstOptions(
    Tcl_Interp *interp,
    Tcl_Size numOpts,
    Tcl_Obj *const opts[],
    int *flagPtr)
{
    static const char *const substOptions[] = {
	"-nobackslashes", "-nocommands", "-novariables", NULL
    };
    enum {
	SUBST_NOBACKSLASHES, SUBST_NOCOMMANDS, SUBST_NOVARS
    };
    int i, flags = TCL_SUBST_ALL;


    for (i = 0; i < numOpts; i++) {
	int optionIndex;

	if (Tcl_GetIndexFromObj(interp, opts[i], substOptions, "option", 0,
		&optionIndex) != TCL_OK) {
	    return TCL_ERROR;
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int i, mode, foundmode, splitObjs, numMatchesSaved;
    int noCase;
    size_t patternLength, j;
    const char *pattern;
    Tcl_Obj *stringObj, *indexVarObj, *matchVarObj;
    Tcl_Obj *const *savedObjv = objv;
    Tcl_RegExp regExpr = NULL;
    Interp *iPtr = (Interp *) interp;
    int pc = 0;
    int bidx = 0;		/* Index of body argument. */







|







3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int i, mode, foundmode, splitObjs, numMatchesSaved;
    int noCase;
    Tcl_Size patternLength, j;
    const char *pattern;
    Tcl_Obj *stringObj, *indexVarObj, *matchVarObj;
    Tcl_Obj *const *savedObjv = objv;
    Tcl_RegExp regExpr = NULL;
    Interp *iPtr = (Interp *) interp;
    int pc = 0;
    int bidx = 0;		/* Index of body argument. */
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
     * the same data for the list word itself. The cmdFramePtr line
     * information is manipulated directly.
     */

    splitObjs = 0;
    if (objc == 1) {
	Tcl_Obj **listv;
	size_t listc;

	blist = objv[0];
	if (TclListObjGetElementsM(interp, objv[0], &listc, &listv) != TCL_OK) {
	    return TCL_ERROR;
	}

	/*
	 * Ensure that the list is non-empty.
	 */

	if (listc < 1 || listc > INT_MAX) {
	    Tcl_WrongNumArgs(interp, 1, savedObjv,
		    "?-option ...? string {?pattern body ...? ?default body?}");
	    return TCL_ERROR;



	}
	objc = listc;
	objv = listv;
	splitObjs = 1;
    }

    /*







|


|











>
>
>







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
     * the same data for the list word itself. The cmdFramePtr line
     * information is manipulated directly.
     */

    splitObjs = 0;
    if (objc == 1) {
	Tcl_Obj **listv;
	Tcl_Size listc;

	blist = objv[0];
	if (TclListObjLengthM(interp, objv[0], &listc) != TCL_OK) {
	    return TCL_ERROR;
	}

	/*
	 * Ensure that the list is non-empty.
	 */

	if (listc < 1 || listc > INT_MAX) {
	    Tcl_WrongNumArgs(interp, 1, savedObjv,
		    "?-option ...? string {?pattern body ...? ?default body?}");
	    return TCL_ERROR;
	}
	if (TclListObjGetElementsM(interp, objv[0], &listc, &listv) != TCL_OK) {
	    return TCL_ERROR;
	}
	objc = listc;
	objv = listv;
	splitObjs = 1;
    }

    /*
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
	    TclNewObj(indicesObj);
	}

	for (j=0 ; j<=info.nsubs ; j++) {
	    if (indexVarObj != NULL) {
		Tcl_Obj *rangeObjAry[2];

		if (info.matches[j].end + 1 > 1) {
		    TclNewIndexObj(rangeObjAry[0], info.matches[j].start);
		    TclNewIndexObj(rangeObjAry[1], info.matches[j].end-1);
		} else {
		    TclNewIndexObj(rangeObjAry[1], TCL_INDEX_NONE);
		    rangeObjAry[0] = rangeObjAry[1];
		}

		/*
		 * Never fails; the object is always clean at this point.
		 */

		Tcl_ListObjAppendElement(NULL, indicesObj,
			Tcl_NewListObj(2, rangeObjAry));
	    }

	    if (matchVarObj != NULL) {
		Tcl_Obj *substringObj;

		if (info.matches[j].end + 1 > 1) {
		    substringObj = Tcl_GetRange(stringObj,
			    info.matches[j].start, info.matches[j].end-1);
		} else {
		    TclNewObj(substringObj);
		}

		/*







|



|














|







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

	for (j=0 ; j<=info.nsubs ; j++) {
	    if (indexVarObj != NULL) {
		Tcl_Obj *rangeObjAry[2];

		if (info.matches[j].end > 0) {
		    TclNewIndexObj(rangeObjAry[0], info.matches[j].start);
		    TclNewIndexObj(rangeObjAry[1], info.matches[j].end-1);
		} else {
		    TclNewIntObj(rangeObjAry[1], -1);
		    rangeObjAry[0] = rangeObjAry[1];
		}

		/*
		 * Never fails; the object is always clean at this point.
		 */

		Tcl_ListObjAppendElement(NULL, indicesObj,
			Tcl_NewListObj(2, rangeObjAry));
	    }

	    if (matchVarObj != NULL) {
		Tcl_Obj *substringObj;

		if (info.matches[j].end > 0) {
		    substringObj = Tcl_GetRange(stringObj,
			    info.matches[j].start, info.matches[j].end-1);
		} else {
		    TclNewObj(substringObj);
		}

		/*
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
	    for (k=0; k < objc; k++) {
		ctxPtr->line[k] = -1;
	    }
	}
    }

    for (j = i + 1; ; j += 2) {
	if (j >= (size_t)objc) {
	    /*
	     * This shouldn't happen since we've checked that the last body is
	     * not a continuation...
	     */

	    Tcl_Panic("fall-out when searching for body to match pattern");
	}







|







3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
	    for (k=0; k < objc; k++) {
		ctxPtr->line[k] = -1;
	    }
	}
    }

    for (j = i + 1; ; j += 2) {
	if (j >= objc) {
	    /*
	     * This shouldn't happen since we've checked that the last body is
	     * not a continuation...
	     */

	    Tcl_Panic("fall-out when searching for body to match pattern");
	}
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
{
    /* Unpack the preserved data */

    int splitObjs = PTR2INT(data[0]);
    CmdFrame *ctxPtr = (CmdFrame *)data[1];
    int pc = PTR2INT(data[2]);
    const char *pattern = (const char *)data[3];
    size_t patternLength = strlen(pattern);

    /*
     * Clean up TIP 280 context information
     */

    if (splitObjs) {
	Tcl_Free(ctxPtr->line);







|







3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
{
    /* Unpack the preserved data */

    int splitObjs = PTR2INT(data[0]);
    CmdFrame *ctxPtr = (CmdFrame *)data[1];
    int pc = PTR2INT(data[2]);
    const char *pattern = (const char *)data[3];
    Tcl_Size patternLength = strlen(pattern);

    /*
     * Clean up TIP 280 context information
     */

    if (splitObjs) {
	Tcl_Free(ctxPtr->line);
3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
    }

    /*
     * Generate an error message if necessary.
     */

    if (result == TCL_ERROR) {
	unsigned limit = 50;
	int overflow = (patternLength > limit);

	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (\"%.*s%s\" arm line %d)",
		(overflow ? limit : (unsigned)patternLength), pattern,
		(overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
    }
    TclStackFree(interp, ctxPtr);
    return result;
}

/*







|




|







3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
    }

    /*
     * Generate an error message if necessary.
     */

    if (result == TCL_ERROR) {
	int limit = 50;
	int overflow = (patternLength > limit);

	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (\"%.*s%s\" arm line %d)",
		(int) (overflow ? limit : patternLength), pattern,
		(overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
    }
    TclStackFree(interp, ctxPtr);
    return result;
}

/*
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
Tcl_ThrowObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *options;
    size_t len;

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

    /*







|







3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
Tcl_ThrowObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *options;
    Tcl_Size len;

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

    /*
4068
4069
4070
4071
4072
4073
4074
4075
4076
4077
4078
4079
4080
4081
4082
4083
4084
#endif

    if (count <= 1) {
	/*
	 * Use int obj since we know time is not fractional. [Bug 1202178]
	 */

	objs[0] = Tcl_NewWideIntObj((count <= 0) ? 0 : (Tcl_WideInt)totalMicroSec);
    } else {
	objs[0] = Tcl_NewDoubleObj(totalMicroSec/count);
    }

    /*
     * Construct the result as a list because many programs have always parsed
     * as such (extracting the first element, typically).
     */








|

|







4071
4072
4073
4074
4075
4076
4077
4078
4079
4080
4081
4082
4083
4084
4085
4086
4087
#endif

    if (count <= 1) {
	/*
	 * Use int obj since we know time is not fractional. [Bug 1202178]
	 */

	TclNewIntObj(objs[0], (count <= 0) ? 0 : (Tcl_WideInt)totalMicroSec);
    } else {
	TclNewDoubleObj(objs[0], totalMicroSec/count);
    }

    /*
     * Construct the result as a list because many programs have always parsed
     * as such (extracting the first element, typically).
     */

4555
4556
4557
4558
4559
4560
4561
4562
4563
4564
4565
4566
4567
4568
4569
	    /*
	     * Calibration: obtaining new measurement overhead.
	     */

	    if (measureOverhead > ((double) usec) / count) {
		measureOverhead = ((double) usec) / count;
	    }
	    objs[0] = Tcl_NewDoubleObj(measureOverhead);
	    TclNewLiteralStringObj(objs[1], "\xC2\xB5s/#-overhead"); /* mics */
	    objs += 2;
	}

	val = usec / count;		/* microsecs per iteration */
	if (val >= 1000000) {
	    TclNewIntObj(objs[0], val);







|







4558
4559
4560
4561
4562
4563
4564
4565
4566
4567
4568
4569
4570
4571
4572
	    /*
	     * Calibration: obtaining new measurement overhead.
	     */

	    if (measureOverhead > ((double) usec) / count) {
		measureOverhead = ((double) usec) / count;
	    }
	    TclNewDoubleObj(objs[0], measureOverhead);
	    TclNewLiteralStringObj(objs[1], "\xC2\xB5s/#-overhead"); /* mics */
	    objs += 2;
	}

	val = usec / count;		/* microsecs per iteration */
	if (val >= 1000000) {
	    TclNewIntObj(objs[0], val);
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
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *bodyObj, *handlersObj, *finallyObj = NULL;
    int i, bodyShared, haveHandlers, code;
    size_t dummy;
    static const char *const handlerNames[] = {
	"finally", "on", "trap", NULL
    };
    enum Handlers {
	TryFinally, TryOn, TryTrap
    };

    /*
     * Parse the arguments. The handlers are passed to subsequent callbacks as
     * a Tcl_Obj list of the 5-tuples like (type, returnCode, errorCodePrefix,
     * bindVariables, script), and the finally script is just passed as it is.
     */

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"body ?handler ...? ?finally script?");
	return TCL_ERROR;
    }
    bodyObj = objv[1];
    handlersObj = Tcl_NewObj();
    bodyShared = 0;
    haveHandlers = 0;
    for (i=2 ; i<objc ; i++) {
	enum Handlers type;
	Tcl_Obj *info[5];

	if (Tcl_GetIndexFromObj(interp, objv[i], handlerNames, "handler type",







|



















|







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
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *bodyObj, *handlersObj, *finallyObj = NULL;
    int i, bodyShared, haveHandlers, code;
    Tcl_Size dummy;
    static const char *const handlerNames[] = {
	"finally", "on", "trap", NULL
    };
    enum Handlers {
	TryFinally, TryOn, TryTrap
    };

    /*
     * Parse the arguments. The handlers are passed to subsequent callbacks as
     * a Tcl_Obj list of the 5-tuples like (type, returnCode, errorCodePrefix,
     * bindVariables, script), and the finally script is just passed as it is.
     */

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"body ?handler ...? ?finally script?");
	return TCL_ERROR;
    }
    bodyObj = objv[1];
    TclNewObj(handlersObj);
    bodyShared = 0;
    haveHandlers = 0;
    for (i=2 ; i<objc ; i++) {
	enum Handlers type;
	Tcl_Obj *info[5];

	if (Tcl_GetIndexFromObj(interp, objv[i], handlerNames, "handler type",
4872
4873
4874
4875
4876
4877
4878
4879
4880
4881
4882
4883
4884
4885
4886
TryPostBody(
    void *data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj *resultObj, *options, *handlersObj, *finallyObj, *cmdObj, **objv;
    int code, objc;
    size_t i, numHandlers = 0;

    handlersObj = (Tcl_Obj *)data[0];
    finallyObj = (Tcl_Obj *)data[1];
    objv = (Tcl_Obj **)data[2];
    objc = PTR2INT(data[3]);

    cmdObj = objv[0];







|







4875
4876
4877
4878
4879
4880
4881
4882
4883
4884
4885
4886
4887
4888
4889
TryPostBody(
    void *data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj *resultObj, *options, *handlersObj, *finallyObj, *cmdObj, **objv;
    int code, objc;
    Tcl_Size i, numHandlers = 0;

    handlersObj = (Tcl_Obj *)data[0];
    finallyObj = (Tcl_Obj *)data[1];
    objv = (Tcl_Obj **)data[2];
    objc = PTR2INT(data[3]);

    cmdObj = objv[0];
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
    if (handlersObj != NULL) {
	int found = 0;
	Tcl_Obj **handlers, **info;

	TclListObjGetElementsM(NULL, handlersObj, &numHandlers, &handlers);
	for (i=0 ; i<numHandlers ; i++) {
	    Tcl_Obj *handlerBodyObj;
	    size_t numElems = 0;

	    TclListObjGetElementsM(NULL, handlers[i], &numElems, &info);
	    if (!found) {
		Tcl_GetIntFromObj(NULL, info[1], &code);
		if (code != result) {
		    continue;
		}

		/*
		 * When processing an error, we must also perform list-prefix
		 * matching of the errorcode list. However, if this was an
		 * 'on' handler, the list that we are matching against will be
		 * empty.
		 */

		if (code == TCL_ERROR) {
		    Tcl_Obj *errorCodeName, *errcode, **bits1, **bits2;
		    size_t len1, len2, j;

		    TclNewLiteralStringObj(errorCodeName, "-errorcode");
		    Tcl_DictObjGet(NULL, options, errorCodeName, &errcode);
		    Tcl_DecrRefCount(errorCodeName);
		    TclListObjGetElementsM(NULL, info[2], &len1, &bits1);
		    if (TclListObjGetElementsM(NULL, errcode, &len2,
			    &bits2) != TCL_OK) {







|

















|







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
    if (handlersObj != NULL) {
	int found = 0;
	Tcl_Obj **handlers, **info;

	TclListObjGetElementsM(NULL, handlersObj, &numHandlers, &handlers);
	for (i=0 ; i<numHandlers ; i++) {
	    Tcl_Obj *handlerBodyObj;
	    Tcl_Size numElems = 0;

	    TclListObjGetElementsM(NULL, handlers[i], &numElems, &info);
	    if (!found) {
		Tcl_GetIntFromObj(NULL, info[1], &code);
		if (code != result) {
		    continue;
		}

		/*
		 * When processing an error, we must also perform list-prefix
		 * matching of the errorcode list. However, if this was an
		 * 'on' handler, the list that we are matching against will be
		 * empty.
		 */

		if (code == TCL_ERROR) {
		    Tcl_Obj *errorCodeName, *errcode, **bits1, **bits2;
		    Tcl_Size len1, len2, j;

		    TclNewLiteralStringObj(errorCodeName, "-errorcode");
		    Tcl_DictObjGet(NULL, options, errorCodeName, &errcode);
		    Tcl_DecrRefCount(errorCodeName);
		    TclListObjGetElementsM(NULL, info[2], &len1, &bits1);
		    if (TclListObjGetElementsM(NULL, errcode, &len2,
			    &bits2) != TCL_OK) {
5294
5295
5296
5297
5298
5299
5300
5301
5302
5303
5304
5305
5306
5307
5308
 */

void
TclListLines(
    Tcl_Obj *listObj,		/* Pointer to obj holding a string with list
				 * structure. Assumed to be valid. Assumed to
				 * contain n elements. */
    size_t line,			/* Line the list as a whole starts on. */
    int n,			/* #elements in lines */
    int *lines,			/* Array of line numbers, to fill. */
    Tcl_Obj *const *elems)      /* The list elems as Tcl_Obj*, in need of
				 * derived continuation data */
{
    const char *listStr = TclGetString(listObj);
    const char *listHead = listStr;







|







5297
5298
5299
5300
5301
5302
5303
5304
5305
5306
5307
5308
5309
5310
5311
 */

void
TclListLines(
    Tcl_Obj *listObj,		/* Pointer to obj holding a string with list
				 * structure. Assumed to be valid. Assumed to
				 * contain n elements. */
    Tcl_Size line,		/* Line the list as a whole starts on. */
    int n,			/* #elements in lines */
    int *lines,			/* Array of line numbers, to fill. */
    Tcl_Obj *const *elems)      /* The list elems as Tcl_Obj*, in need of
				 * derived continuation data */
{
    const char *listStr = TclGetString(listObj);
    const char *listHead = listStr;

Changes to generic/tclCompCmds.c.

226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileArray*Cmd --
 *
 *	Functions called to compile "array" sucommands.
 *
 * Results:
 *	All return TCL_OK for a successful compile, and TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "array" subcommand at







|







226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileArray*Cmd --
 *
 *	Functions called to compile "array" subcommands.
 *
 * Results:
 *	All return TCL_OK for a successful compile, and TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "array" subcommand at
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *varTokenPtr, *dataTokenPtr;
    int isScalar, localIndex, code = TCL_OK;
    int isDataLiteral, isDataValid, isDataEven;
    size_t len;
    int keyVar, valVar, infoIndex;
    int fwd, offsetBack, offsetFwd;
    Tcl_Obj *literalObj;
    ForeachInfo *infoPtr;

    if (parsePtr->numWords != 3) {
	return TCL_ERROR;







|







283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *varTokenPtr, *dataTokenPtr;
    int isScalar, localIndex, code = TCL_OK;
    int isDataLiteral, isDataValid, isDataEven;
    Tcl_Size len;
    int keyVar, valVar, infoIndex;
    int fwd, offsetBack, offsetFwd;
    Tcl_Obj *literalObj;
    ForeachInfo *infoPtr;

    if (parsePtr->numWords != 3) {
	return TCL_ERROR;
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
     */

    keyVar = AnonymousLocal(envPtr);
    valVar = AnonymousLocal(envPtr);

    infoPtr = (ForeachInfo *)Tcl_Alloc(offsetof(ForeachInfo, varLists) + sizeof(ForeachVarList *));
    infoPtr->numLists = 1;
    infoPtr->varLists[0] = (ForeachVarList *)Tcl_Alloc(offsetof(ForeachVarList, varIndexes) + 2 * sizeof(size_t));
    infoPtr->varLists[0]->numVars = 2;
    infoPtr->varLists[0]->varIndexes[0] = keyVar;
    infoPtr->varLists[0]->varIndexes[1] = valVar;
    infoIndex = TclCreateAuxData(infoPtr, &newForeachInfoType, envPtr);

    /*
     * Start issuing instructions to write to the array.







|







389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
     */

    keyVar = AnonymousLocal(envPtr);
    valVar = AnonymousLocal(envPtr);

    infoPtr = (ForeachInfo *)Tcl_Alloc(offsetof(ForeachInfo, varLists) + sizeof(ForeachVarList *));
    infoPtr->numLists = 1;
    infoPtr->varLists[0] = (ForeachVarList *)Tcl_Alloc(offsetof(ForeachVarList, varIndexes) + 2 * sizeof(Tcl_Size));
    infoPtr->varLists[0]->numVars = 2;
    infoPtr->varLists[0]->varIndexes[0] = keyVar;
    infoPtr->varLists[0]->varIndexes[1] = valVar;
    infoIndex = TclCreateAuxData(infoPtr, &newForeachInfoType, envPtr);

    /*
     * Start issuing instructions to write to the array.
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
     * Otherwise, compile instructions to substitute the body text before
     * starting the catch, then BEGIN_CATCH, and then EVAL_STK to evaluate the
     * substituted body.
     * Care has to be taken to make sure that substitution happens outside the
     * catch range so that errors in the substitution are not caught.
     * [Bug 219184]
     * The reason for duplicating the script is that EVAL_STK would otherwise
     * begin by undeflowing the stack below the mark set by BEGIN_CATCH4.
     */

    range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
    if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	TclEmitInstInt4(	INST_BEGIN_CATCH4, range,	envPtr);
	ExceptionRangeStarts(envPtr, range);
	BODY(cmdTokenPtr, 1);







|







631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
     * Otherwise, compile instructions to substitute the body text before
     * starting the catch, then BEGIN_CATCH, and then EVAL_STK to evaluate the
     * substituted body.
     * Care has to be taken to make sure that substitution happens outside the
     * catch range so that errors in the substitution are not caught.
     * [Bug 219184]
     * The reason for duplicating the script is that EVAL_STK would otherwise
     * begin by underflowing the stack below the mark set by BEGIN_CATCH4.
     */

    range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
    if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	TclEmitInstInt4(	INST_BEGIN_CATCH4, range,	envPtr);
	ExceptionRangeStarts(envPtr, range);
	BODY(cmdTokenPtr, 1);
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
	    break;
	}
	(void) Tcl_ListObjAppendElement(NULL, listObj, objPtr);
    }
    if (listObj != NULL) {
	Tcl_Obj **objs;
	const char *bytes;
	size_t len, slen;

	TclListObjGetElementsM(NULL, listObj, &len, &objs);
	objPtr = Tcl_ConcatObj(len, objs);
	Tcl_DecrRefCount(listObj);
	bytes = Tcl_GetStringFromObj(objPtr, &slen);
	PushLiteral(envPtr, bytes, slen);
	Tcl_DecrRefCount(objPtr);







|







887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
	    break;
	}
	(void) Tcl_ListObjAppendElement(NULL, listObj, objPtr);
    }
    if (listObj != NULL) {
	Tcl_Obj **objs;
	const char *bytes;
	Tcl_Size len, slen;

	TclListObjGetElementsM(NULL, listObj, &len, &objs);
	objPtr = Tcl_ConcatObj(len, objs);
	Tcl_DecrRefCount(listObj);
	bytes = Tcl_GetStringFromObj(objPtr, &slen);
	PushLiteral(envPtr, bytes, slen);
	Tcl_DecrRefCount(objPtr);
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileDict*Cmd --
 *
 *	Functions called to compile "dict" sucommands.
 *
 * Results:
 *	All return TCL_OK for a successful compile, and TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "dict" subcommand at







|







979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileDict*Cmd --
 *
 *	Functions called to compile "dict" subcommands.
 *
 * Results:
 *	All return TCL_OK for a successful compile, and TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "dict" subcommand at
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088

    /*
     * Parse the increment amount, if present.
     */

    if (parsePtr->numWords == 4) {
	const char *word;
	size_t numBytes;
	int code;
	Tcl_Token *incrTokenPtr;
	Tcl_Obj *intObj;

	incrTokenPtr = TokenAfter(keyTokenPtr);
	if (incrTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	    return TclCompileBasic2Or3ArgCmd(interp, parsePtr,cmdPtr, envPtr);







|







1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088

    /*
     * Parse the increment amount, if present.
     */

    if (parsePtr->numWords == 4) {
	const char *word;
	Tcl_Size numBytes;
	int code;
	Tcl_Token *incrTokenPtr;
	Tcl_Obj *intObj;

	incrTokenPtr = TokenAfter(keyTokenPtr);
	if (incrTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	    return TclCompileBasic2Or3ArgCmd(interp, parsePtr,cmdPtr, envPtr);
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
{
    DefineLineInformation;	/* TIP #280 */
    int worker;			/* Temp var for building the value in. */
    Tcl_Token *tokenPtr;
    Tcl_Obj *keyObj, *valueObj, *dictObj;
    const char *bytes;
    int i;
    size_t len;

    if ((parsePtr->numWords & 1) == 0) {
	return TCL_ERROR;
    }

    /*
     * See if we can build the value at compile time...







|







1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
{
    DefineLineInformation;	/* TIP #280 */
    int worker;			/* Temp var for building the value in. */
    Tcl_Token *tokenPtr;
    Tcl_Obj *keyObj, *valueObj, *dictObj;
    const char *bytes;
    int i;
    Tcl_Size len;

    if ((parsePtr->numWords & 1) == 0) {
	return TCL_ERROR;
    }

    /*
     * See if we can build the value at compile time...
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
				 * construct a new dictionary with the loop
				 * body result. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *varsTokenPtr, *dictTokenPtr, *bodyTokenPtr;
    int keyVarIndex, valueVarIndex, nameChars, loopRange, catchRange;
    int infoIndex, jumpDisplacement, bodyTargetOffset, emptyTargetOffset;
    size_t numVars;
    int endTargetOffset;
    int collectVar = -1;	/* Index of temp var holding the result
				 * dict. */
    const char **argv;
    Tcl_DString buffer;

    /*







|







1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
				 * construct a new dictionary with the loop
				 * body result. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *varsTokenPtr, *dictTokenPtr, *bodyTokenPtr;
    int keyVarIndex, valueVarIndex, nameChars, loopRange, catchRange;
    int infoIndex, jumpDisplacement, bodyTargetOffset, emptyTargetOffset;
    Tcl_Size numVars;
    int endTargetOffset;
    int collectVar = -1;	/* Index of temp var holding the result
				 * dict. */
    const char **argv;
    Tcl_DString buffer;

    /*
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
    jumpDisplacement = bodyTargetOffset - CurrentOffset(envPtr);
    TclEmitInstInt4(	INST_JUMP_FALSE4, jumpDisplacement,	envPtr);
    endTargetOffset = CurrentOffset(envPtr);
    TclEmitInstInt1(	INST_JUMP1, 0,				envPtr);

    /*
     * Error handler "finally" clause, which force-terminates the iteration
     * and rethrows the error.
     */

    TclAdjustStackDepth(-1, envPtr);
    ExceptionRangeTarget(envPtr, catchRange, catchOffset);
    TclEmitOpcode(	INST_PUSH_RETURN_OPTIONS,		envPtr);
    TclEmitOpcode(	INST_PUSH_RESULT,			envPtr);
    TclEmitOpcode(	INST_END_CATCH,				envPtr);







|







1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
    jumpDisplacement = bodyTargetOffset - CurrentOffset(envPtr);
    TclEmitInstInt4(	INST_JUMP_FALSE4, jumpDisplacement,	envPtr);
    endTargetOffset = CurrentOffset(envPtr);
    TclEmitInstInt1(	INST_JUMP1, 0,				envPtr);

    /*
     * Error handler "finally" clause, which force-terminates the iteration
     * and re-throws the error.
     */

    TclAdjustStackDepth(-1, envPtr);
    ExceptionRangeTarget(envPtr, catchRange, catchOffset);
    TclEmitOpcode(	INST_PUSH_RETURN_OPTIONS,		envPtr);
    TclEmitOpcode(	INST_PUSH_RESULT,			envPtr);
    TclEmitOpcode(	INST_END_CATCH,				envPtr);
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
     */

    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);

    /*
     * Termination code for non-ok returns: stash the result and return
     * options in the stack, bring up the key list, finish the update code,
     * and finally return with the catched return data
     */

    ExceptionRangeTarget(envPtr, range, catchOffset);
    TclEmitOpcode(	INST_PUSH_RESULT,			envPtr);
    TclEmitOpcode(	INST_PUSH_RETURN_OPTIONS,		envPtr);
    TclEmitOpcode(	INST_END_CATCH,				envPtr);
    TclEmitInstInt4(	INST_REVERSE, 3,			envPtr);







|







1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
     */

    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);

    /*
     * Termination code for non-ok returns: stash the result and return
     * options in the stack, bring up the key list, finish the update code,
     * and finally return with the caught return data
     */

    ExceptionRangeTarget(envPtr, range, catchOffset);
    TclEmitOpcode(	INST_PUSH_RESULT,			envPtr);
    TclEmitOpcode(	INST_PUSH_RETURN_OPTIONS,		envPtr);
    TclEmitOpcode(	INST_END_CATCH,				envPtr);
    TclEmitInstInt4(	INST_REVERSE, 3,			envPtr);
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;
    int i, dictVarIndex;

    /*
     * There must be at least two argument after the command. And we impose an
     * (arbirary) safe limit; anyone exceeding it should stop worrying about
     * speed quite so much. ;-)
     */

    /* TODO: Consider support for compiling expanded args. */
    if ((int)parsePtr->numWords<4 || (int)parsePtr->numWords>100) {
	return TCL_ERROR;
    }







|







1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;
    int i, dictVarIndex;

    /*
     * There must be at least two argument after the command. And we impose an
     * (arbitrary) safe limit; anyone exceeding it should stop worrying about
     * speed quite so much. ;-)
     */

    /* TODO: Consider support for compiling expanded args. */
    if ((int)parsePtr->numWords<4 || (int)parsePtr->numWords>100) {
	return TCL_ERROR;
    }
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
PrintDictUpdateInfo(
    void *clientData,
    Tcl_Obj *appendObj,
    TCL_UNUSED(ByteCode *),
    TCL_UNUSED(size_t))
{
    DictUpdateInfo *duiPtr = (DictUpdateInfo *)clientData;
    size_t i;

    for (i=0 ; i<duiPtr->length ; i++) {
	if (i) {
	    Tcl_AppendToObj(appendObj, ", ", -1);
	}
	Tcl_AppendPrintfToObj(appendObj, "%%v%" TCL_Z_MODIFIER "u", duiPtr->varIndices[i]);
    }
}

static void
DisassembleDictUpdateInfo(
    void *clientData,
    Tcl_Obj *dictObj,
    TCL_UNUSED(ByteCode *),
    TCL_UNUSED(size_t))
{
    DictUpdateInfo *duiPtr = (DictUpdateInfo *)clientData;
    size_t i;
    Tcl_Obj *variables;

    TclNewObj(variables);
    for (i=0 ; i<duiPtr->length ; i++) {
	Tcl_ListObjAppendElement(NULL, variables,
		Tcl_NewWideIntObj(duiPtr->varIndices[i]));
    }







|

















|







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
PrintDictUpdateInfo(
    void *clientData,
    Tcl_Obj *appendObj,
    TCL_UNUSED(ByteCode *),
    TCL_UNUSED(size_t))
{
    DictUpdateInfo *duiPtr = (DictUpdateInfo *)clientData;
    Tcl_Size i;

    for (i=0 ; i<duiPtr->length ; i++) {
	if (i) {
	    Tcl_AppendToObj(appendObj, ", ", -1);
	}
	Tcl_AppendPrintfToObj(appendObj, "%%v%" TCL_Z_MODIFIER "u", duiPtr->varIndices[i]);
    }
}

static void
DisassembleDictUpdateInfo(
    void *clientData,
    Tcl_Obj *dictObj,
    TCL_UNUSED(ByteCode *),
    TCL_UNUSED(size_t))
{
    DictUpdateInfo *duiPtr = (DictUpdateInfo *)clientData;
    Tcl_Size i;
    Tcl_Obj *variables;

    TclNewObj(variables);
    for (i=0 ; i<duiPtr->length ; i++) {
	Tcl_ListObjAppendElement(NULL, variables,
		Tcl_NewWideIntObj(duiPtr->varIndices[i]));
    }
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
    ForeachInfo *infoPtr=NULL;	/* Points to the structure describing this
				 * foreach command. Stored in a AuxData
				 * record in the ByteCode. */

    Tcl_Token *tokenPtr, *bodyTokenPtr;
    int jumpBackOffset, infoIndex, range;
    int numWords, numLists, i, code = TCL_OK;
    size_t j;
    Tcl_Obj *varListObj = NULL;

    /*
     * If the foreach command isn't in a procedure, don't compile it inline:
     * the payoff is too small.
     */








|







2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
    ForeachInfo *infoPtr=NULL;	/* Points to the structure describing this
				 * foreach command. Stored in a AuxData
				 * record in the ByteCode. */

    Tcl_Token *tokenPtr, *bodyTokenPtr;
    int jumpBackOffset, infoIndex, range;
    int numWords, numLists, i, code = TCL_OK;
    Tcl_Size j;
    Tcl_Obj *varListObj = NULL;

    /*
     * If the foreach command isn't in a procedure, don't compile it inline:
     * the payoff is too small.
     */

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

    TclNewObj(varListObj);
    for (i = 0, tokenPtr = parsePtr->tokenPtr;
	    i < numWords-1;
	    i++, tokenPtr = TokenAfter(tokenPtr)) {
	ForeachVarList *varListPtr;
	size_t numVars;

	if (i%2 != 1) {
	    continue;
	}

	/*
	 * If the variable list is empty, we can enter an infinite loop when
	 * the interpreted version would not.  Take care to ensure this does
	 * not happen.  [Bug 1671138]
	 */

	if (!TclWordKnownAtCompileTime(tokenPtr, varListObj) ||
		TCL_OK != TclListObjLengthM(NULL, varListObj, &numVars) ||
		numVars == 0) {
	    code = TCL_ERROR;
	    goto done;
	}

	varListPtr = (ForeachVarList *)Tcl_Alloc(offsetof(ForeachVarList, varIndexes)
		+ numVars * sizeof(size_t));
	varListPtr->numVars = numVars;
	infoPtr->varLists[i/2] = varListPtr;
	infoPtr->numLists++;

	for (j = 0;  j < numVars;  j++) {
	    Tcl_Obj *varNameObj;
	    const char *bytes;
	    int varIndex;
	    size_t length;


	    Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj);
	    bytes = Tcl_GetStringFromObj(varNameObj, &length);
	    varIndex = LocalScalar(bytes, length, envPtr);
	    if (varIndex < 0) {
		code = TCL_ERROR;







|



















|








|







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

    TclNewObj(varListObj);
    for (i = 0, tokenPtr = parsePtr->tokenPtr;
	    i < numWords-1;
	    i++, tokenPtr = TokenAfter(tokenPtr)) {
	ForeachVarList *varListPtr;
	Tcl_Size numVars;

	if (i%2 != 1) {
	    continue;
	}

	/*
	 * If the variable list is empty, we can enter an infinite loop when
	 * the interpreted version would not.  Take care to ensure this does
	 * not happen.  [Bug 1671138]
	 */

	if (!TclWordKnownAtCompileTime(tokenPtr, varListObj) ||
		TCL_OK != TclListObjLengthM(NULL, varListObj, &numVars) ||
		numVars == 0) {
	    code = TCL_ERROR;
	    goto done;
	}

	varListPtr = (ForeachVarList *)Tcl_Alloc(offsetof(ForeachVarList, varIndexes)
		+ numVars * sizeof(varListPtr->varIndexes[0]));
	varListPtr->numVars = numVars;
	infoPtr->varLists[i/2] = varListPtr;
	infoPtr->numLists++;

	for (j = 0;  j < numVars;  j++) {
	    Tcl_Obj *varNameObj;
	    const char *bytes;
	    int varIndex;
	    Tcl_Size length;


	    Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj);
	    bytes = Tcl_GetStringFromObj(varNameObj, &length);
	    varIndex = LocalScalar(bytes, length, envPtr);
	    if (varIndex < 0) {
		code = TCL_ERROR;
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
    void *clientData,
    Tcl_Obj *appendObj,
    TCL_UNUSED(ByteCode *),
    TCL_UNUSED(size_t))
{
    ForeachInfo *infoPtr = (ForeachInfo *)clientData;
    ForeachVarList *varsPtr;
    size_t i, j;

    Tcl_AppendToObj(appendObj, "data=[", -1);

    for (i=0 ; i<infoPtr->numLists ; i++) {
	if (i) {
	    Tcl_AppendToObj(appendObj, ", ", -1);
	}







|







2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
    void *clientData,
    Tcl_Obj *appendObj,
    TCL_UNUSED(ByteCode *),
    TCL_UNUSED(size_t))
{
    ForeachInfo *infoPtr = (ForeachInfo *)clientData;
    ForeachVarList *varsPtr;
    Tcl_Size i, j;

    Tcl_AppendToObj(appendObj, "data=[", -1);

    for (i=0 ; i<infoPtr->numLists ; i++) {
	if (i) {
	    Tcl_AppendToObj(appendObj, ", ", -1);
	}
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
    void *clientData,
    Tcl_Obj *appendObj,
    TCL_UNUSED(ByteCode *),
    TCL_UNUSED(size_t))
{
    ForeachInfo *infoPtr = (ForeachInfo *)clientData;
    ForeachVarList *varsPtr;
    size_t i, j;

    Tcl_AppendPrintfToObj(appendObj, "jumpOffset=%+" TCL_Z_MODIFIER "d, vars=",
	    infoPtr->loopCtTemp);
    for (i=0 ; i<infoPtr->numLists ; i++) {
	if (i) {
	    Tcl_AppendToObj(appendObj, ",", -1);
	}







|







3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
    void *clientData,
    Tcl_Obj *appendObj,
    TCL_UNUSED(ByteCode *),
    TCL_UNUSED(size_t))
{
    ForeachInfo *infoPtr = (ForeachInfo *)clientData;
    ForeachVarList *varsPtr;
    Tcl_Size i, j;

    Tcl_AppendPrintfToObj(appendObj, "jumpOffset=%+" TCL_Z_MODIFIER "d, vars=",
	    infoPtr->loopCtTemp);
    for (i=0 ; i<infoPtr->numLists ; i++) {
	if (i) {
	    Tcl_AppendToObj(appendObj, ",", -1);
	}
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
    void *clientData,
    Tcl_Obj *dictObj,
    TCL_UNUSED(ByteCode *),
    TCL_UNUSED(size_t))
{
    ForeachInfo *infoPtr = (ForeachInfo *)clientData;
    ForeachVarList *varsPtr;
    size_t i, j;
    Tcl_Obj *objPtr, *innerPtr;

    /*
     * Data stores.
     */

    TclNewObj(objPtr);







|







3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
    void *clientData,
    Tcl_Obj *dictObj,
    TCL_UNUSED(ByteCode *),
    TCL_UNUSED(size_t))
{
    ForeachInfo *infoPtr = (ForeachInfo *)clientData;
    ForeachVarList *varsPtr;
    Tcl_Size i, j;
    Tcl_Obj *objPtr, *innerPtr;

    /*
     * Data stores.
     */

    TclNewObj(objPtr);
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
    void *clientData,
    Tcl_Obj *dictObj,
    TCL_UNUSED(ByteCode *),
    TCL_UNUSED(size_t))
{
    ForeachInfo *infoPtr = (ForeachInfo *)clientData;
    ForeachVarList *varsPtr;
    size_t i, j;
    Tcl_Obj *objPtr, *innerPtr;

    /*
     * Jump offset.
     */

    Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("jumpOffset", -1),







|







3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
    void *clientData,
    Tcl_Obj *dictObj,
    TCL_UNUSED(ByteCode *),
    TCL_UNUSED(size_t))
{
    ForeachInfo *infoPtr = (ForeachInfo *)clientData;
    ForeachVarList *varsPtr;
    Tcl_Size i, j;
    Tcl_Obj *objPtr, *innerPtr;

    /*
     * Jump offset.
     */

    Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("jumpOffset", -1),
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
    Tcl_Obj **objv, *formatObj, *tmpObj;
    const char *bytes, *start;
    int i, j;
    size_t len;

    /*
     * Don't handle any guaranteed-error cases.
     */

    if ((int)parsePtr->numWords < 2) {
	return TCL_ERROR;







|







3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
    Tcl_Obj **objv, *formatObj, *tmpObj;
    const char *bytes, *start;
    int i, j;
    Tcl_Size len;

    /*
     * Don't handle any guaranteed-error cases.
     */

    if ((int)parsePtr->numWords < 2) {
	return TCL_ERROR;

Changes to generic/tclCompCmdsGR.c.

45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
 *
 *----------------------------------------------------------------------
 */

int
TclGetIndexFromToken(
    Tcl_Token *tokenPtr,
    size_t before,
    size_t after,
    int *indexPtr)
{
    Tcl_Obj *tmpObj;
    int result = TCL_ERROR;

    TclNewObj(tmpObj);
    if (TclWordKnownAtCompileTime(tokenPtr, tmpObj)) {







|
|







45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
 *
 *----------------------------------------------------------------------
 */

int
TclGetIndexFromToken(
    Tcl_Token *tokenPtr,
    int before,
    int after,
    int *indexPtr)
{
    Tcl_Obj *tmpObj;
    int result = TCL_ERROR;

    TclNewObj(tmpObj);
    if (TclWordKnownAtCompileTime(tokenPtr, tmpObj)) {
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *varTokenPtr;
    int localIndex, numWords, i;

    /* TODO: Consider support for compiling expanded args. */
    numWords = (int)parsePtr->numWords;
    if (numWords < 2) {
	return TCL_ERROR;
    }

    /*
     * 'global' has no effect outside of proc bodies; handle that at runtime
     */







|







91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *varTokenPtr;
    int localIndex, numWords, i;

    /* TODO: Consider support for compiling expanded args. */
    numWords = parsePtr->numWords;
    if (numWords < 2) {
	return TCL_ERROR;
    }

    /*
     * 'global' has no effect outside of proc bodies; handle that at runtime
     */
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
    /*
     * Only compile the "if" command if all arguments are simple words, in
     * order to insure correct substitution [Bug 219166]
     */

    tokenPtr = parsePtr->tokenPtr;
    wordIdx = 0;
    numWords = (int)parsePtr->numWords;

    for (wordIdx = 0; wordIdx < numWords; wordIdx++) {
	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	    return TCL_ERROR;
	}
	tokenPtr = TokenAfter(tokenPtr);
    }







|







192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
    /*
     * Only compile the "if" command if all arguments are simple words, in
     * order to insure correct substitution [Bug 219166]
     */

    tokenPtr = parsePtr->tokenPtr;
    wordIdx = 0;
    numWords = parsePtr->numWords;

    for (wordIdx = 0; wordIdx < numWords; wordIdx++) {
	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	    return TCL_ERROR;
	}
	tokenPtr = TokenAfter(tokenPtr);
    }
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
     */

    for (j = jumpEndFixupArray.next;  j > 0;  j--) {
	jumpIndex = (j - 1);	/* i.e. process the closest jump first. */
	if (TclFixupForwardJumpToHere(envPtr,
		jumpEndFixupArray.fixup + jumpIndex, 127)) {
	    /*
	     * Adjust the immediately preceeding "ifFalse" jump. We moved it's
	     * target (just after this jump) down three bytes.
	     */

	    unsigned char *ifFalsePc = envPtr->codeStart
		    + jumpFalseFixupArray.fixup[jumpIndex].codeOffset;
	    unsigned char opCode = *ifFalsePc;








|







412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
     */

    for (j = jumpEndFixupArray.next;  j > 0;  j--) {
	jumpIndex = (j - 1);	/* i.e. process the closest jump first. */
	if (TclFixupForwardJumpToHere(envPtr,
		jumpEndFixupArray.fixup + jumpIndex, 127)) {
	    /*
	     * Adjust the immediately preceding "ifFalse" jump. We moved it's
	     * target (just after this jump) down three bytes.
	     */

	    unsigned char *ifFalsePc = envPtr->codeStart
		    + jumpFalseFixupArray.fixup[jumpIndex].codeOffset;
	    unsigned char opCode = *ifFalsePc;

615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630

    if (bytes[0] != ':' || bytes[1] != ':' || !TclMatchIsTrivial(bytes)) {
	goto notCompilable;
    }
    Tcl_DecrRefCount(objPtr);

    /*
     * Confirmed as a literal that will not frighten the horses. Compile. Note
     * that the result needs to be list-ified.
     */

    /* TODO: Just push the known value */
    CompileWord(envPtr, tokenPtr,		interp, 1);
    TclEmitOpcode(	INST_RESOLVE_COMMAND,	envPtr);
    TclEmitOpcode(	INST_DUP,		envPtr);
    TclEmitOpcode(	INST_STR_LEN,		envPtr);







|
|







615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630

    if (bytes[0] != ':' || bytes[1] != ':' || !TclMatchIsTrivial(bytes)) {
	goto notCompilable;
    }
    Tcl_DecrRefCount(objPtr);

    /*
     * Confirmed as a literal that will not frighten the horses. Compile.
     * The result must be made into a list.
     */

    /* TODO: Just push the known value */
    CompileWord(envPtr, tokenPtr,		interp, 1);
    TclEmitOpcode(	INST_RESOLVE_COMMAND,	envPtr);
    TclEmitOpcode(	INST_DUP,		envPtr);
    TclEmitOpcode(	INST_STR_LEN,		envPtr);
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *varTokenPtr, *valueTokenPtr;
    int isScalar, localIndex, numWords, i;

    /* TODO: Consider support for compiling expanded args. */
    numWords = (int)parsePtr->numWords;
    if (numWords < 3) {
	return TCL_ERROR;
    }

    if (numWords != 3 || envPtr->procPtr == NULL) {
	goto lappendMultiple;
    }







|







843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *varTokenPtr, *valueTokenPtr;
    int isScalar, localIndex, numWords, i;

    /* TODO: Consider support for compiling expanded args. */
    numWords = parsePtr->numWords;
    if (numWords < 3) {
	return TCL_ERROR;
    }

    if (numWords != 3 || envPtr->procPtr == NULL) {
	goto lappendMultiple;
    }
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;
    int isScalar, localIndex, numWords, idx;

    numWords = (int)parsePtr->numWords;

    /*
     * Check for command syntax error, but we'll punt that to runtime.
     */

    if (numWords < 3) {
	return TCL_ERROR;







|







957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;
    int isScalar, localIndex, numWords, idx;

    numWords = parsePtr->numWords;

    /*
     * Check for command syntax error, but we'll punt that to runtime.
     */

    if (numWords < 3) {
	return TCL_ERROR;
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *idxTokenPtr, *valTokenPtr;
    int i, idx, numWords = (int)parsePtr->numWords;

    /*
     * Quit if not enough args.
     */

    /* TODO: Consider support for compiling expanded args. */
    if (numWords <= 1) {







|







1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *idxTokenPtr, *valTokenPtr;
    int i, idx, numWords = parsePtr->numWords;

    /*
     * Quit if not enough args.
     */

    /* TODO: Consider support for compiling expanded args. */
    if (numWords <= 1) {
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
    }

    /*
     * Test if all arguments are compile-time known. If they are, we can
     * implement with a simple push.
     */

    numWords = (int)parsePtr->numWords;
    valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
    TclNewObj(listObj);
    for (i = 1; i < numWords && listObj != NULL; i++) {
	TclNewObj(objPtr);
	if (TclWordKnownAtCompileTime(valueTokenPtr, objPtr)) {
	    (void) Tcl_ListObjAppendElement(NULL, listObj, objPtr);
	} else {







|







1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
    }

    /*
     * Test if all arguments are compile-time known. If they are, we can
     * implement with a simple push.
     */

    numWords = parsePtr->numWords;
    valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
    TclNewObj(listObj);
    for (i = 1; i < numWords && listObj != NULL; i++) {
	TclNewObj(objPtr);
	if (TclWordKnownAtCompileTime(valueTokenPtr, objPtr)) {
	    (void) Tcl_ListObjAppendElement(NULL, listObj, objPtr);
	} else {
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
	return TCL_OK;
    }

    /*
     * Push the all values onto the stack.
     */

    numWords = (int)parsePtr->numWords;
    valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
    concat = build = 0;
    for (i = 1; i < numWords; i++) {
	if (valueTokenPtr->type == TCL_TOKEN_EXPAND_WORD && build > 0) {
	    TclEmitInstInt4(	INST_LIST, build,	envPtr);
	    if (concat) {
		TclEmitOpcode(	INST_LIST_CONCAT,	envPtr);







|







1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
	return TCL_OK;
    }

    /*
     * Push the all values onto the stack.
     */

    numWords = parsePtr->numWords;
    valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
    concat = build = 0;
    for (i = 1; i < numWords; i++) {
	if (valueTokenPtr->type == TCL_TOKEN_EXPAND_WORD && build > 0) {
	    TclEmitInstInt4(	INST_LIST, build,	envPtr);
	    if (concat) {
		TclEmitOpcode(	INST_LIST_CONCAT,	envPtr);
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
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;
    int i;

    if ((int)parsePtr->numWords < 3) {
	return TCL_ERROR;
    }
    
    /* Push list, insertion index onto the stack */
    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 1);
    tokenPtr = TokenAfter(tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 2);

    /* Push new elements to be inserted */
    for (i=3 ; i<(int)parsePtr->numWords ; i++) {
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, i);
    }

    /* First operand is count of arguments */
    TclEmitInstInt4(INST_LREPLACE4, parsePtr->numWords - 1, envPtr);
    /* 
     * Second operand is bitmask
     *  TCL_LREPLACE4_END_IS_LAST - end refers to last element
     *  TCL_LREPLACE4_SINGLE_INDEX - second index is not present
     *     indicating this is a pure insert
     */
    TclEmitInt1(TCL_LREPLACE4_SINGLE_INDEX, envPtr);








|














|







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
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;
    int i;

    if ((int)parsePtr->numWords < 3) {
	return TCL_ERROR;
    }

    /* Push list, insertion index onto the stack */
    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 1);
    tokenPtr = TokenAfter(tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 2);

    /* Push new elements to be inserted */
    for (i=3 ; i<(int)parsePtr->numWords ; i++) {
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, i);
    }

    /* First operand is count of arguments */
    TclEmitInstInt4(INST_LREPLACE4, parsePtr->numWords - 1, envPtr);
    /*
     * Second operand is bitmask
     *  TCL_LREPLACE4_END_IS_LAST - end refers to last element
     *  TCL_LREPLACE4_SINGLE_INDEX - second index is not present
     *     indicating this is a pure insert
     */
    TclEmitInt1(TCL_LREPLACE4_SINGLE_INDEX, envPtr);

1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
    CompileWord(envPtr, tokenPtr, interp, 1);
    tokenPtr = TokenAfter(tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 2);
    tokenPtr = TokenAfter(tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 3);

    /* Push new elements to be inserted */
    for (i=4 ; i< (int) parsePtr->numWords ; i++) {
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, i);
    }

    /* First operand is count of arguments */
    TclEmitInstInt4(INST_LREPLACE4, parsePtr->numWords - 1, envPtr);
    /* 
     * Second operand is bitmask
     *  TCL_LREPLACE4_END_IS_LAST - end refers to last element
     */
    TclEmitInt1(TCL_LREPLACE4_END_IS_LAST, envPtr);

    return TCL_OK;
}







|






|







1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
    CompileWord(envPtr, tokenPtr, interp, 1);
    tokenPtr = TokenAfter(tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 2);
    tokenPtr = TokenAfter(tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 3);

    /* Push new elements to be inserted */
    for (i=4 ; i< (int)parsePtr->numWords ; i++) {
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, i);
    }

    /* First operand is count of arguments */
    TclEmitInstInt4(INST_LREPLACE4, parsePtr->numWords - 1, envPtr);
    /*
     * Second operand is bitmask
     *  TCL_LREPLACE4_END_IS_LAST - end refers to last element
     */
    TclEmitInt1(TCL_LREPLACE4_END_IS_LAST, envPtr);

    return TCL_OK;
}
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
	}
	str = varTokenPtr[1].start;
	len = varTokenPtr[1].size;
	if ((len == 2) && (str[0] == '-') && (str[1] == '-')) {
	    sawLast++;
	    i++;
	    break;
	} else if ((len > 1) && (strncmp(str,"-nocase", len) == 0)) {
	    nocase = 1;
	} else {
	    /*
	     * Not an option we recognize.
	     */

	    return TCL_ERROR;







|







1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
	}
	str = varTokenPtr[1].start;
	len = varTokenPtr[1].size;
	if ((len == 2) && (str[0] == '-') && (str[1] == '-')) {
	    sawLast++;
	    i++;
	    break;
	} else if ((len > 1) && (strncmp(str, "-nocase", len) == 0)) {
	    nocase = 1;
	} else {
	    /*
	     * Not an option we recognize.
	     */

	    return TCL_ERROR;
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123

    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr, *stringTokenPtr;
    Tcl_Obj *patternObj = NULL, *replacementObj = NULL;
    Tcl_DString pattern;
    const char *bytes;
    int exact, quantified, result = TCL_ERROR;
    size_t len;

    if ((int)parsePtr->numWords < 5 || (int)parsePtr->numWords > 6) {
	return TCL_ERROR;
    }

    /*
     * Parse the "-all", which must be the first argument (other options not







|







2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123

    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr, *stringTokenPtr;
    Tcl_Obj *patternObj = NULL, *replacementObj = NULL;
    Tcl_DString pattern;
    const char *bytes;
    int exact, quantified, result = TCL_ERROR;
    Tcl_Size len;

    if ((int)parsePtr->numWords < 5 || (int)parsePtr->numWords > 6) {
	return TCL_ERROR;
    }

    /*
     * Parse the "-all", which must be the first argument (other options not
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
{
    DefineLineInformation;	/* TIP #280 */
    /*
     * General syntax: [return ?-option value ...? ?result?]
     * An even number of words means an explicit result argument is present.
     */
    int level, code, objc, status = TCL_OK;
    size_t size;
    int numWords = (int)parsePtr->numWords;
    int explicitResult = (0 == (numWords % 2));
    int numOptionWords = numWords - 1 - explicitResult;
    Tcl_Obj *returnOpts, **objv;
    Tcl_Token *wordTokenPtr = TokenAfter(parsePtr->tokenPtr);

    /*
     * Check for special case which can always be compiled:







|
|







2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
{
    DefineLineInformation;	/* TIP #280 */
    /*
     * General syntax: [return ?-option value ...? ?result?]
     * An even number of words means an explicit result argument is present.
     */
    int level, code, objc, status = TCL_OK;
    Tcl_Size size;
    int numWords = parsePtr->numWords;
    int explicitResult = (0 == (numWords % 2));
    int numOptionWords = numWords - 1 - explicitResult;
    Tcl_Obj *returnOpts, **objv;
    Tcl_Token *wordTokenPtr = TokenAfter(parsePtr->tokenPtr);

    /*
     * Check for special case which can always be compiled:
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488

void
TclCompileSyntaxError(
    Tcl_Interp *interp,
    CompileEnv *envPtr)
{
    Tcl_Obj *msg = Tcl_GetObjResult(interp);
    size_t numBytes;
    const char *bytes = Tcl_GetStringFromObj(msg, &numBytes);

    TclErrorStackResetIf(interp, bytes, numBytes);
    TclEmitPush(TclRegisterLiteral(envPtr, bytes, numBytes, 0), envPtr);
    CompileReturnInternal(envPtr, INST_SYNTAX, TCL_ERROR, 0,
	    TclNoErrorStack(interp, Tcl_GetReturnOptions(interp, TCL_ERROR)));
    Tcl_ResetResult(interp);







|







2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488

void
TclCompileSyntaxError(
    Tcl_Interp *interp,
    CompileEnv *envPtr)
{
    Tcl_Obj *msg = Tcl_GetObjResult(interp);
    Tcl_Size 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);
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
    int localIndex, numWords, i;
    Tcl_Obj *objPtr;

    if (envPtr->procPtr == NULL) {
	return TCL_ERROR;
    }

    numWords = (int)parsePtr->numWords;
    if (numWords < 3) {
	return TCL_ERROR;
    }

    /*
     * Push the frame index if it is known at compile time
     */







|







2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
    int localIndex, numWords, i;
    Tcl_Obj *objPtr;

    if (envPtr->procPtr == NULL) {
	return TCL_ERROR;
    }

    numWords = parsePtr->numWords;
    if (numWords < 3) {
	return TCL_ERROR;
    }

    /*
     * Push the frame index if it is known at compile time
     */
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *varTokenPtr, *valueTokenPtr;
    int localIndex, numWords, i;

    numWords = (int)parsePtr->numWords;
    if (numWords < 2) {
	return TCL_ERROR;
    }

    /*
     * Bail out if not compiling a proc body
     */







|







2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *varTokenPtr, *valueTokenPtr;
    int localIndex, numWords, i;

    numWords = parsePtr->numWords;
    if (numWords < 2) {
	return TCL_ERROR;
    }

    /*
     * Bail out if not compiling a proc body
     */
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
    TCL_UNUSED(Tcl_Interp *),
    Tcl_Token *varTokenPtr,	/* Token representing the variable name */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Obj *tailPtr;
    const char *tailName, *p;
    int n = varTokenPtr->numComponents;
    size_t len;
    Tcl_Token *lastTokenPtr;
    int full, localIndex;

    /*
     * Determine if the tail is (a) known at compile time, and (b) not an
     * array element. Should any of these fail, return an error so that the
     * non-compiled command will be called at runtime.







|







2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
    TCL_UNUSED(Tcl_Interp *),
    Tcl_Token *varTokenPtr,	/* Token representing the variable name */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Obj *tailPtr;
    const char *tailName, *p;
    int n = varTokenPtr->numComponents;
    Tcl_Size len;
    Tcl_Token *lastTokenPtr;
    int full, localIndex;

    /*
     * Determine if the tail is (a) known at compile time, and (b) not an
     * array element. Should any of these fail, return an error so that the
     * non-compiled command will be called at runtime.

Changes to generic/tclCompCmdsSZ.c.

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
		Tcl_DecrRefCount(obj);
	    } else {
		folded = obj;
	    }
	} else {
	    Tcl_DecrRefCount(obj);
	    if (folded) {
		size_t len;
		const char *bytes = Tcl_GetStringFromObj(folded, &len);

		PushLiteral(envPtr, bytes, len);
		Tcl_DecrRefCount(folded);
		folded = NULL;
		numArgs ++;
	    }
	    CompileWord(envPtr, wordTokenPtr, interp, i);
	    numArgs ++;
	    if (numArgs >= 254) { /* 254 to take care of the possible +1 of "folded" above */
		TclEmitInstInt1(INST_STR_CONCAT1, numArgs, envPtr);
		numArgs = 1;	/* concat pushes 1 obj, the result */
	    }
	}
	wordTokenPtr = TokenAfter(wordTokenPtr);
    }
    if (folded) {
	size_t len;
	const char *bytes = Tcl_GetStringFromObj(folded, &len);

	PushLiteral(envPtr, bytes, len);
	Tcl_DecrRefCount(folded);
	folded = NULL;
	numArgs ++;
    }







|

















|







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
		Tcl_DecrRefCount(obj);
	    } else {
		folded = obj;
	    }
	} else {
	    Tcl_DecrRefCount(obj);
	    if (folded) {
		Tcl_Size 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) {
	Tcl_Size len;
	const char *bytes = Tcl_GetStringFromObj(folded, &len);

	PushLiteral(envPtr, bytes, len);
	Tcl_DecrRefCount(folded);
	folded = NULL;
	numArgs ++;
    }
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
	 * something with backslashes). Just push the actual character (not
	 * byte) length.
	 */

	char buf[TCL_INTEGER_SPACE];
	size_t len = Tcl_GetCharLength(objPtr);

	len = sprintf(buf, "%" TCL_Z_MODIFIER "u", len);
	PushLiteral(envPtr, buf, len);
    } else {
	SetLineInformation(1);
	CompileTokens(envPtr, tokenPtr, interp);
	TclEmitOpcode(INST_STR_LEN, envPtr);
    }
    TclDecrRefCount(objPtr);







|







893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
	 * something with backslashes). Just push the actual character (not
	 * byte) length.
	 */

	char buf[TCL_INTEGER_SPACE];
	size_t len = Tcl_GetCharLength(objPtr);

	len = snprintf(buf, sizeof(buf), "%" TCL_Z_MODIFIER "u", len);
	PushLiteral(envPtr, buf, len);
    } else {
	SetLineInformation(1);
	CompileTokens(envPtr, tokenPtr, interp);
	TclEmitOpcode(INST_STR_LEN, envPtr);
    }
    TclDecrRefCount(objPtr);
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *mapTokenPtr, *stringTokenPtr;
    Tcl_Obj *mapObj, **objv;
    const char *bytes;
    size_t len, slen;

    /*
     * We only handle the case:
     *
     *    string map {foo bar} $thing
     *
     * That is, a literal two-element list (doesn't need to be brace-quoted,







|







917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *mapTokenPtr, *stringTokenPtr;
    Tcl_Obj *mapObj, **objv;
    const char *bytes;
    Tcl_Size len, slen;

    /*
     * We only handle the case:
     *
     *    string map {foo bar} $thing
     *
     * That is, a literal two-element list (doesn't need to be brace-quoted,
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
    return TCL_OK;
}

void
TclSubstCompile(
    Tcl_Interp *interp,
    const char *bytes,
    size_t numBytes,
    int flags,
    size_t line,
    CompileEnv *envPtr)
{
    Tcl_Token *endTokenPtr, *tokenPtr;
    int breakOffset = 0, count = 0;
    size_t bline = line;
    Tcl_Parse parse;
    Tcl_InterpState state = NULL;

    TclSubstParse(interp, bytes, numBytes, flags, &parse, &state);
    if (state != NULL) {
	Tcl_ResetResult(interp);
    }







|

|




|







1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
    return TCL_OK;
}

void
TclSubstCompile(
    Tcl_Interp *interp,
    const char *bytes,
    Tcl_Size numBytes,
    int flags,
    Tcl_Size line,
    CompileEnv *envPtr)
{
    Tcl_Token *endTokenPtr, *tokenPtr;
    int breakOffset = 0, count = 0;
    Tcl_Size bline = line;
    Tcl_Parse parse;
    Tcl_InterpState state = NULL;

    TclSubstParse(interp, bytes, numBytes, flags, &parse, &state);
    if (state != NULL) {
	Tcl_ResetResult(interp);
    }
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
    if (tokenPtr->type != TCL_TOKEN_TEXT && tokenPtr->type != TCL_TOKEN_BS) {
	PUSH("");
	count++;
    }

    for (endTokenPtr = tokenPtr + parse.numTokens;
	    tokenPtr < endTokenPtr; tokenPtr = TokenAfter(tokenPtr)) {
	size_t length;
	int literal, catchRange, breakJump;
	char buf[4] = "";
	JumpFixup startFixup, okFixup, returnFixup, breakFixup;
	JumpFixup continueFixup, otherFixup, endFixup;

	switch (tokenPtr->type) {
	case TCL_TOKEN_TEXT:







|







1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
    if (tokenPtr->type != TCL_TOKEN_TEXT && tokenPtr->type != TCL_TOKEN_BS) {
	PUSH("");
	count++;
    }

    for (endTokenPtr = tokenPtr + parse.numTokens;
	    tokenPtr < endTokenPtr; tokenPtr = TokenAfter(tokenPtr)) {
	Tcl_Size length;
	int literal, catchRange, breakJump;
	char buf[4] = "";
	JumpFixup startFixup, okFixup, returnFixup, breakFixup;
	JumpFixup continueFixup, otherFixup, endFixup;

	switch (tokenPtr->type) {
	case TCL_TOKEN_TEXT:
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
	     * TCL_OK or TCL_ERROR from the substituted variable read; if so,
	     * there is no need to generate elaborate exception-management
	     * code. Note that the first component of TCL_TOKEN_VARIABLE is
	     * always TCL_TOKEN_TEXT...
	     */

	    if (tokenPtr->numComponents > 1) {
		size_t i;
		int foundCommand = 0;

		for (i=2 ; i<=tokenPtr->numComponents ; i++) {
		    if (tokenPtr[i].type == TCL_TOKEN_COMMAND) {
			foundCommand = 1;
			break;
		    }







|







1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
	     * TCL_OK or TCL_ERROR from the substituted variable read; if so,
	     * there is no need to generate elaborate exception-management
	     * code. Note that the first component of TCL_TOKEN_VARIABLE is
	     * always TCL_TOKEN_TEXT...
	     */

	    if (tokenPtr->numComponents > 1) {
		Tcl_Size i;
		int foundCommand = 0;

		for (i=2 ; i<=tokenPtr->numComponents ; i++) {
		    if (tokenPtr[i].type == TCL_TOKEN_COMMAND) {
			foundCommand = 1;
			break;
		    }
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
     * copies of the string from the input token for the generated tokens (it
     * causes a crash during exception handling). When multiple tokens are
     * available at this point, this is pretty easy.
     */

    if (numWords == 1) {
	const char *bytes;
	size_t maxLen, numBytes;
	size_t bline;		/* TIP #280: line of the pattern/action list,
				 * and start of list for when tracking the
				 * location. This list comes immediately after
				 * the value we switch on. */

	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	    return TCL_ERROR;
	}







|
|







1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
     * copies of the string from the input token for the generated tokens (it
     * causes a crash during exception handling). When multiple tokens are
     * available at this point, this is pretty easy.
     */

    if (numWords == 1) {
	const char *bytes;
	Tcl_Size maxLen, numBytes;
	Tcl_Size bline;		/* TIP #280: line of the pattern/action list,
				 * and start of list for when tracking the
				 * location. This list comes immediately after
				 * the value we switch on. */

	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	    return TCL_ERROR;
	}
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
    Tcl_DString buffer;
    Tcl_HashEntry *hPtr;

    /*
     * Compile the switch by using a jump table, which is basically a
     * hashtable that maps from literal values to match against to the offset
     * (relative to the INST_JUMP_TABLE instruction) to jump to. The jump
     * table itself is independent of any invokation of the bytecode, and as
     * such is stored in an auxData block.
     *
     * Start by allocating the jump table itself, plus some workspace.
     */

    jtPtr = (JumptableInfo *)Tcl_Alloc(sizeof(JumptableInfo));
    Tcl_InitHashTable(&jtPtr->hashTable, TCL_STRING_KEYS);







|







2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
    Tcl_DString buffer;
    Tcl_HashEntry *hPtr;

    /*
     * Compile the switch by using a jump table, which is basically a
     * hashtable that maps from literal values to match against to the offset
     * (relative to the INST_JUMP_TABLE instruction) to jump to. The jump
     * table itself is independent of any invocation of the bytecode, and as
     * such is stored in an auxData block.
     *
     * Start by allocating the jump table itself, plus some workspace.
     */

    jtPtr = (JumptableInfo *)Tcl_Alloc(sizeof(JumptableInfo));
    Tcl_InitHashTable(&jtPtr->hashTable, TCL_STRING_KEYS);
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
    int i;

    if (parsePtr->numWords < 2 || parsePtr->numWords > 256
	    || envPtr->procPtr == NULL) {
	return TCL_ERROR;
    }

    /* make room for the nsObjPtr */
    /* TODO: Doesn't this have to be a known value? */
    CompileWord(envPtr, tokenPtr, interp, 0);







|







2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
    int i;

    if (parsePtr->numWords < 2 || parsePtr->numWords >= 256
	    || envPtr->procPtr == NULL) {
	return TCL_ERROR;
    }

    /* make room for the nsObjPtr */
    /* TODO: Doesn't this have to be a known value? */
    CompileWord(envPtr, tokenPtr, interp, 0);
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    int numWords = parsePtr->numWords;
    Tcl_Token *codeToken, *msgToken;
    Tcl_Obj *objPtr;
    int codeKnown, codeIsList, codeIsValid;
    size_t len;

    if (numWords != 3) {
	return TCL_ERROR;
    }
    codeToken = TokenAfter(parsePtr->tokenPtr);
    msgToken = TokenAfter(codeToken);








|







2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    int numWords = parsePtr->numWords;
    Tcl_Token *codeToken, *msgToken;
    Tcl_Obj *objPtr;
    int codeKnown, codeIsList, codeIsValid;
    Tcl_Size len;

    if (numWords != 3) {
	return TCL_ERROR;
    }
    codeToken = TokenAfter(parsePtr->tokenPtr);
    msgToken = TokenAfter(codeToken);

2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
	memset(matchClauses, 0, sizeof(Tcl_Obj *) * numHandlers);
	matchCodes = (int *)TclStackAlloc(interp, sizeof(int) * numHandlers);
	resultVarIndices = (int *)TclStackAlloc(interp, sizeof(int) * numHandlers);
	optionVarIndices = (int *)TclStackAlloc(interp, sizeof(int) * numHandlers);

	for (i=0 ; i<numHandlers ; i++) {
	    Tcl_Obj *tmpObj, **objv;
	    size_t objc;

	    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
		goto failedToCompile;
	    }
	    if (tokenPtr[1].size == 4
		    && !strncmp(tokenPtr[1].start, "trap", 4)) {
		/*







|







2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
	memset(matchClauses, 0, sizeof(Tcl_Obj *) * numHandlers);
	matchCodes = (int *)TclStackAlloc(interp, sizeof(int) * numHandlers);
	resultVarIndices = (int *)TclStackAlloc(interp, sizeof(int) * numHandlers);
	optionVarIndices = (int *)TclStackAlloc(interp, sizeof(int) * numHandlers);

	for (i=0 ; i<numHandlers ; i++) {
	    Tcl_Obj *tmpObj, **objv;
	    Tcl_Size objc;

	    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
		goto failedToCompile;
	    }
	    if (tokenPtr[1].size == 4
		    && !strncmp(tokenPtr[1].start, "trap", 4)) {
		/*
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
	    }
	    if (TclListObjGetElementsM(NULL, tmpObj, &objc, &objv) != TCL_OK
		    || (objc > 2)) {
		TclDecrRefCount(tmpObj);
		goto failedToCompile;
	    }
	    if (objc > 0) {
		size_t len;
		const char *varname = Tcl_GetStringFromObj(objv[0], &len);

		resultVarIndices[i] = LocalScalar(varname, len, envPtr);
		if (resultVarIndices[i] < 0) {
		    TclDecrRefCount(tmpObj);
		    goto failedToCompile;
		}
	    } else {
		resultVarIndices[i] = -1;
	    }
	    if (objc == 2) {
		size_t len;
		const char *varname = Tcl_GetStringFromObj(objv[1], &len);

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







|











|







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
	    }
	    if (TclListObjGetElementsM(NULL, tmpObj, &objc, &objv) != TCL_OK
		    || (objc > 2)) {
		TclDecrRefCount(tmpObj);
		goto failedToCompile;
	    }
	    if (objc > 0) {
		Tcl_Size 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) {
		Tcl_Size len;
		const char *varname = Tcl_GetStringFromObj(objv[1], &len);

		optionVarIndices[i] = LocalScalar(varname, len, envPtr);
		if (optionVarIndices[i] < 0) {
		    TclDecrRefCount(tmpObj);
		    goto failedToCompile;
		}
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
    int *resultVars,
    int *optionVars,
    Tcl_Token **handlerTokens)
{
    DefineLineInformation;	/* TIP #280 */
    int range, resultVar, optionsVar;
    int i, j, forwardsNeedFixing = 0, trapZero = 0, afterBody = 0;
    size_t slen, len;
    int *addrsToFix, *forwardsToFix, notCodeJumpSource, notECJumpSource;
    int *noError;
    char buf[TCL_INTEGER_SPACE];

    resultVar = AnonymousLocal(envPtr);
    optionsVar = AnonymousLocal(envPtr);
    if (resultVar < 0 || optionsVar < 0) {







|







3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
    int *resultVars,
    int *optionVars,
    Tcl_Token **handlerTokens)
{
    DefineLineInformation;	/* TIP #280 */
    int range, resultVar, optionsVar;
    int i, j, forwardsNeedFixing = 0, trapZero = 0, afterBody = 0;
    Tcl_Size slen, len;
    int *addrsToFix, *forwardsToFix, notCodeJumpSource, notECJumpSource;
    int *noError;
    char buf[TCL_INTEGER_SPACE];

    resultVar = AnonymousLocal(envPtr);
    optionsVar = AnonymousLocal(envPtr);
    if (resultVar < 0 || optionsVar < 0) {
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134

    addrsToFix = (int *)TclStackAlloc(interp, sizeof(int)*numHandlers);
    forwardsToFix = (int *)TclStackAlloc(interp, sizeof(int)*numHandlers);
    noError = (int *)TclStackAlloc(interp, sizeof(int)*numHandlers);

    for (i=0 ; i<numHandlers ; i++) {
	noError[i] = -1;
	sprintf(buf, "%d", matchCodes[i]);
	OP(				DUP);
	PushLiteral(envPtr, buf, strlen(buf));
	OP(				EQ);
	JUMP4(				JUMP_FALSE, notCodeJumpSource);
	if (matchClauses[i]) {
	    const char *p;
	    TclListObjLengthM(NULL, matchClauses[i], &len);







|







3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134

    addrsToFix = (int *)TclStackAlloc(interp, sizeof(int)*numHandlers);
    forwardsToFix = (int *)TclStackAlloc(interp, sizeof(int)*numHandlers);
    noError = (int *)TclStackAlloc(interp, sizeof(int)*numHandlers);

    for (i=0 ; i<numHandlers ; i++) {
	noError[i] = -1;
	snprintf(buf, sizeof(buf), "%d", matchCodes[i]);
	OP(				DUP);
	PushLiteral(envPtr, buf, strlen(buf));
	OP(				EQ);
	JUMP4(				JUMP_FALSE, notCodeJumpSource);
	if (matchClauses[i]) {
	    const char *p;
	    TclListObjLengthM(NULL, matchClauses[i], &len);
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
    Tcl_Token *finallyToken)	/* Not NULL */
{
    DefineLineInformation;	/* TIP #280 */
    int range, resultVar, optionsVar, i, j, forwardsNeedFixing = 0;
    int trapZero = 0, afterBody = 0, finalOK, finalError, noFinalError;
    int *addrsToFix, *forwardsToFix, notCodeJumpSource, notECJumpSource;
    char buf[TCL_INTEGER_SPACE];
    size_t slen, len;

    resultVar = AnonymousLocal(envPtr);
    optionsVar = AnonymousLocal(envPtr);
    if (resultVar < 0 || optionsVar < 0) {
	return TCL_ERROR;
    }








|







3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
    Tcl_Token *finallyToken)	/* Not NULL */
{
    DefineLineInformation;	/* TIP #280 */
    int range, resultVar, optionsVar, i, j, forwardsNeedFixing = 0;
    int trapZero = 0, afterBody = 0, finalOK, finalError, noFinalError;
    int *addrsToFix, *forwardsToFix, notCodeJumpSource, notECJumpSource;
    char buf[TCL_INTEGER_SPACE];
    Tcl_Size slen, len;

    resultVar = AnonymousLocal(envPtr);
    optionsVar = AnonymousLocal(envPtr);
    if (resultVar < 0 || optionsVar < 0) {
	return TCL_ERROR;
    }

3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
    addrsToFix = (int *)TclStackAlloc(interp, sizeof(int)*numHandlers);
    forwardsToFix = (int *)TclStackAlloc(interp, sizeof(int)*numHandlers);

    for (i=0 ; i<numHandlers ; i++) {
	int noTrapError, trapError;
	const char *p;

	sprintf(buf, "%d", matchCodes[i]);
	OP(				DUP);
	PushLiteral(envPtr, buf, strlen(buf));
	OP(				EQ);
	JUMP4(				JUMP_FALSE, notCodeJumpSource);
	if (matchClauses[i]) {
	    TclListObjLengthM(NULL, matchClauses[i], &len);








|







3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
    addrsToFix = (int *)TclStackAlloc(interp, sizeof(int)*numHandlers);
    forwardsToFix = (int *)TclStackAlloc(interp, sizeof(int)*numHandlers);

    for (i=0 ; i<numHandlers ; i++) {
	int noTrapError, trapError;
	const char *p;

	snprintf(buf, sizeof(buf), "%d", matchCodes[i]);
	OP(				DUP);
	PushLiteral(envPtr, buf, strlen(buf));
	OP(				EQ);
	JUMP4(				JUMP_FALSE, notCodeJumpSource);
	if (matchClauses[i]) {
	    TclListObjLengthM(NULL, matchClauses[i], &len);

3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688
3689
3690
		    continue;
		}
	    }
	    return TCL_ERROR;
	}
	if (varCount == 0) {
	    const char *bytes;
	    size_t len;

	    bytes = Tcl_GetStringFromObj(leadingWord, &len);
	    if (i == 1 && len == 11 && !strncmp("-nocomplain", bytes, 11)) {
		flags = 0;
		haveFlags++;
	    } else if (i == (2 - flags) && len == 2 && !strncmp("--", bytes, 2)) {
		haveFlags++;







|







3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688
3689
3690
		    continue;
		}
	    }
	    return TCL_ERROR;
	}
	if (varCount == 0) {
	    const char *bytes;
	    Tcl_Size 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++;
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
    Tcl_Parse *parsePtr,
    const char *identity,
    int instruction,
    CompileEnv *envPtr)
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
    size_t words;

    /* TODO: Consider support for compiling expanded args. */
    for (words=1 ; words<parsePtr->numWords ; words++) {
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, words);
    }
    if (parsePtr->numWords <= 2) {
	PushLiteral(envPtr, identity, -1);
	words++;
    }
    if (words > 3) {
	/*
	 * Reverse order of arguments to get precise agreement with [expr] in
	 * calcuations, including roundoff errors.
	 */

	OP4(	REVERSE, words-1);
    }
    while (--words > 1) {
	TclEmitOpcode(instruction, envPtr);
    }







|













|







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
    Tcl_Parse *parsePtr,
    const char *identity,
    int instruction,
    CompileEnv *envPtr)
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
    Tcl_Size words;

    /* TODO: Consider support for compiling expanded args. */
    for (words=1 ; words<parsePtr->numWords ; words++) {
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, words);
    }
    if (parsePtr->numWords <= 2) {
	PushLiteral(envPtr, identity, -1);
	words++;
    }
    if (words > 3) {
	/*
	 * Reverse order of arguments to get precise agreement with [expr] in
	 * calculations, including roundoff errors.
	 */

	OP4(	REVERSE, words-1);
    }
    while (--words > 1) {
	TclEmitOpcode(instruction, envPtr);
    }
4172
4173
4174
4175
4176
4177
4178
4179
4180
4181
4182
4183
4184
4185
4186
	/*
	 * No local variable space!
	 */

	return TCL_ERROR;
    } else {
	int tmpIndex = AnonymousLocal(envPtr);
	size_t words;

	tokenPtr = TokenAfter(parsePtr->tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, 1);
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, 2);
	STORE(tmpIndex);
	TclEmitOpcode(instruction, envPtr);







|







4172
4173
4174
4175
4176
4177
4178
4179
4180
4181
4182
4183
4184
4185
4186
	/*
	 * No local variable space!
	 */

	return TCL_ERROR;
    } else {
	int tmpIndex = AnonymousLocal(envPtr);
	Tcl_Size words;

	tokenPtr = TokenAfter(parsePtr->tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, 1);
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, 2);
	STORE(tmpIndex);
	TclEmitOpcode(instruction, envPtr);
4308
4309
4310
4311
4312
4313
4314
4315
4316
4317
4318
4319
4320
4321
4322
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
    size_t words;

    /*
     * This one has its own implementation because the ** operator is the only
     * one with right associativity.
     */

    for (words=1 ; words<parsePtr->numWords ; words++) {







|







4308
4309
4310
4311
4312
4313
4314
4315
4316
4317
4318
4319
4320
4321
4322
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
    Tcl_Size words;

    /*
     * This one has its own implementation because the ** operator is the only
     * one with right associativity.
     */

    for (words=1 ; words<parsePtr->numWords ; words++) {
4509
4510
4511
4512
4513
4514
4515
4516
4517
4518
4519
4520
4521
4522
4523
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
    size_t words;

    /* TODO: Consider support for compiling expanded args. */
    if (parsePtr->numWords == 1) {
	/*
	 * Fallback to direct eval to report syntax error.
	 */








|







4509
4510
4511
4512
4513
4514
4515
4516
4517
4518
4519
4520
4521
4522
4523
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
    Tcl_Size words;

    /* TODO: Consider support for compiling expanded args. */
    if (parsePtr->numWords == 1) {
	/*
	 * Fallback to direct eval to report syntax error.
	 */

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
    if (words == 3) {
	TclEmitOpcode(INST_SUB, envPtr);
	return TCL_OK;
    }

    /*
     * Reverse order of arguments to get precise agreement with [expr] in
     * calcuations, including roundoff errors.
     */

    TclEmitInstInt4(INST_REVERSE, words-1, envPtr);
    while (--words > 1) {
	TclEmitInstInt4(INST_REVERSE, 2, envPtr);
	TclEmitOpcode(INST_SUB, envPtr);
    }
    return TCL_OK;
}

int
TclCompileDivOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
    size_t words;

    /* TODO: Consider support for compiling expanded args. */
    if (parsePtr->numWords == 1) {
	/*
	 * Fallback to direct eval to report syntax error.
	 */








|



















|







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
    if (words == 3) {
	TclEmitOpcode(INST_SUB, envPtr);
	return TCL_OK;
    }

    /*
     * Reverse order of arguments to get precise agreement with [expr] in
     * calculations, including roundoff errors.
     */

    TclEmitInstInt4(INST_REVERSE, words-1, envPtr);
    while (--words > 1) {
	TclEmitInstInt4(INST_REVERSE, 2, envPtr);
	TclEmitOpcode(INST_SUB, envPtr);
    }
    return TCL_OK;
}

int
TclCompileDivOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
    Tcl_Size words;

    /* TODO: Consider support for compiling expanded args. */
    if (parsePtr->numWords == 1) {
	/*
	 * Fallback to direct eval to report syntax error.
	 */

4578
4579
4580
4581
4582
4583
4584
4585
4586
4587
4588
4589
4590
4591
4592
    if (words <= 3) {
	TclEmitOpcode(INST_DIV, envPtr);
	return TCL_OK;
    }

    /*
     * Reverse order of arguments to get precise agreement with [expr] in
     * calcuations, including roundoff errors.
     */

    TclEmitInstInt4(INST_REVERSE, words-1, envPtr);
    while (--words > 1) {
	TclEmitInstInt4(INST_REVERSE, 2, envPtr);
	TclEmitOpcode(INST_DIV, envPtr);
    }







|







4578
4579
4580
4581
4582
4583
4584
4585
4586
4587
4588
4589
4590
4591
4592
    if (words <= 3) {
	TclEmitOpcode(INST_DIV, envPtr);
	return TCL_OK;
    }

    /*
     * Reverse order of arguments to get precise agreement with [expr] in
     * calculations, including roundoff errors.
     */

    TclEmitInstInt4(INST_REVERSE, words-1, envPtr);
    while (--words > 1) {
	TclEmitInstInt4(INST_REVERSE, 2, envPtr);
	TclEmitOpcode(INST_DIV, envPtr);
    }

Changes to generic/tclCompExpr.c.

92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
 *
 * While the parse tree is being constructed, the same memory space is used to
 * hold the p.prev field which chains together a stack of incomplete trees
 * awaiting their right operands.
 *
 * The lexeme field is filled in with the lexeme of the operator that is
 * returned by the ParseLexeme() routine. Only lexemes for unary and binary
 * operators get stored in an OpNode. Other lexmes get different treatement.
 *
 * The precedence field provides a place to store the precedence of the
 * operator, so it need not be looked up again and again.
 *
 * The mark field is use to control the traversal of the tree, so that it can
 * be done non-recursively. The mark values are:
 */







|







92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
 *
 * While the parse tree is being constructed, the same memory space is used to
 * hold the p.prev field which chains together a stack of incomplete trees
 * awaiting their right operands.
 *
 * The lexeme field is filled in with the lexeme of the operator that is
 * returned by the ParseLexeme() routine. Only lexemes for unary and binary
 * operators get stored in an OpNode. Other lexmes get different treatment.
 *
 * The precedence field provides a place to store the precedence of the
 * operator, so it need not be looked up again and again.
 *
 * The mark field is use to control the traversal of the tree, so that it can
 * be done non-recursively. The mark values are:
 */
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167

/* Uncategorized lexemes */

#define PLUS		1	/* Ambiguous. Resolves to UNARY_PLUS or
				 * BINARY_PLUS according to context. */
#define MINUS		2	/* Ambiguous. Resolves to UNARY_MINUS or
				 * BINARY_MINUS according to context. */
#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







|







153
154
155
156
157
158
159
160
161
162
163
164
165
166
167

/* Uncategorized lexemes */

#define PLUS		1	/* Ambiguous. Resolves to UNARY_PLUS or
				 * BINARY_PLUS according to context. */
#define MINUS		2	/* Ambiguous. Resolves to UNARY_MINUS or
				 * BINARY_MINUS according to context. */
#define BAREWORD	3	/* Ambiguous. 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
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
 * Declarations for local functions to this file:
 */

static void		CompileExprTree(Tcl_Interp *interp, OpNode *nodes,
			    int index, Tcl_Obj *const **litObjvPtr,
			    Tcl_Obj *const *funcObjv, Tcl_Token *tokenPtr,
			    CompileEnv *envPtr, int optimize);
static void		ConvertTreeToTokens(const char *start, size_t numBytes,
			    OpNode *nodes, Tcl_Token *tokenPtr,
			    Tcl_Parse *parsePtr);
static int		ExecConstantExprTree(Tcl_Interp *interp, OpNode *nodes,
			    int index, Tcl_Obj * const **litObjvPtr);
static int		ParseExpr(Tcl_Interp *interp, const char *start,
			    size_t numBytes, OpNode **opTreePtr,
			    Tcl_Obj *litList, Tcl_Obj *funcList,
			    Tcl_Parse *parsePtr, int parseOnly);
static size_t		ParseLexeme(const char *start, size_t numBytes,
			    unsigned char *lexemePtr, Tcl_Obj **literalPtr);

/*
 *----------------------------------------------------------------------
 *
 * ParseExpr --
 *







|





|


|







507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
 * Declarations for local functions to this file:
 */

static void		CompileExprTree(Tcl_Interp *interp, OpNode *nodes,
			    int index, Tcl_Obj *const **litObjvPtr,
			    Tcl_Obj *const *funcObjv, Tcl_Token *tokenPtr,
			    CompileEnv *envPtr, int optimize);
static void		ConvertTreeToTokens(const char *start, Tcl_Size numBytes,
			    OpNode *nodes, Tcl_Token *tokenPtr,
			    Tcl_Parse *parsePtr);
static int		ExecConstantExprTree(Tcl_Interp *interp, OpNode *nodes,
			    int index, Tcl_Obj * const **litObjvPtr);
static int		ParseExpr(Tcl_Interp *interp, const char *start,
			    Tcl_Size numBytes, OpNode **opTreePtr,
			    Tcl_Obj *litList, Tcl_Obj *funcList,
			    Tcl_Parse *parsePtr, int parseOnly);
static Tcl_Size		ParseLexeme(const char *start, Tcl_Size numBytes,
			    unsigned char *lexemePtr, Tcl_Obj **literalPtr);

/*
 *----------------------------------------------------------------------
 *
 * ParseExpr --
 *
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
 *----------------------------------------------------------------------
 */

static int
ParseExpr(
    Tcl_Interp *interp,		/* Used for error reporting. */
    const char *start,		/* Start of source string to parse. */
    size_t numBytes,		/* Number of bytes in string. */
    OpNode **opTreePtr,		/* Points to space where a pointer to the
				 * allocated OpNode tree should go. */
    Tcl_Obj *litList,		/* List to append literals to. */
    Tcl_Obj *funcList,		/* List to append function names to. */
    Tcl_Parse *parsePtr,	/* Structure to fill with tokens representing
				 * those operands that require run time
				 * substitutions. */
    int parseOnly)		/* A boolean indicating whether the caller's
				 * aim is just a parse, or whether it will go
				 * on to compile the expression. Different
				 * optimizations are appropriate for the two
				 * scenarios. */
{
    OpNode *nodes = NULL;	/* Pointer to the OpNode storage array where
				 * we build the parse tree. */
    unsigned int nodesAvailable = 64; /* Initial size of the storage array. This
				 * value establishes a minimum tree memory
				 * cost of only about 1 kibyte, and is large
				 * enough for most expressions to parse with
				 * no need for array growth and
				 * reallocation. */
    unsigned int nodesUsed = 0;	/* Number of OpNodes filled. */
    size_t scanned = 0;		/* Capture number of byte scanned by parsing
				 * routines. */
    int lastParsed;		/* Stores info about what the lexeme parsed
				 * the previous pass through the parsing loop
				 * was. If it was an operator, lastParsed is
				 * the index of the OpNode for that operator.
				 * If it was not an operator, lastParsed holds
				 * an OperandTypes value encoding what we need







|

















|




|







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

static int
ParseExpr(
    Tcl_Interp *interp,		/* Used for error reporting. */
    const char *start,		/* Start of source string to parse. */
    Tcl_Size numBytes,		/* Number of bytes in string. */
    OpNode **opTreePtr,		/* Points to space where a pointer to the
				 * allocated OpNode tree should go. */
    Tcl_Obj *litList,		/* List to append literals to. */
    Tcl_Obj *funcList,		/* List to append function names to. */
    Tcl_Parse *parsePtr,	/* Structure to fill with tokens representing
				 * those operands that require run time
				 * substitutions. */
    int parseOnly)		/* A boolean indicating whether the caller's
				 * aim is just a parse, or whether it will go
				 * on to compile the expression. Different
				 * optimizations are appropriate for the two
				 * scenarios. */
{
    OpNode *nodes = NULL;	/* Pointer to the OpNode storage array where
				 * we build the parse tree. */
    unsigned int nodesAvailable = 64; /* Initial size of the storage array. This
				 * value establishes a minimum tree memory
				 * cost of only about 1 kilobyte, and is large
				 * enough for most expressions to parse with
				 * no need for array growth and
				 * reallocation. */
    unsigned int nodesUsed = 0;	/* Number of OpNodes filled. */
    Tcl_Size scanned = 0;	/* Capture number of byte scanned by parsing
				 * routines. */
    int lastParsed;		/* Stores info about what the lexeme parsed
				 * the previous pass through the parsing loop
				 * was. If it was an operator, lastParsed is
				 * the index of the OpNode for that operator.
				 * If it was not an operator, lastParsed holds
				 * an OperandTypes value encoding what we need
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
				 * message where the error location is
				 * reported, this "mark" substring is inserted
				 * into the string being parsed to aid in
				 * pinpointing the location of the syntax
				 * error in the expression. */
    int insertMark = 0;		/* A boolean controlling whether the "mark"
				 * should be inserted. */
    const unsigned limit = 25;	/* Portions of the error message are
				 * constructed out of substrings of the
				 * original expression. In order to keep the
				 * error message readable, we impose this
				 * limit on the substring size we extract. */

    TclParseInit(interp, start, numBytes, parsePtr);








|







621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
				 * message where the error location is
				 * reported, this "mark" substring is inserted
				 * into the string being parsed to aid in
				 * pinpointing the location of the syntax
				 * error in the expression. */
    int insertMark = 0;		/* A boolean controlling whether the "mark"
				 * should be inserted. */
    const int limit = 25;	/* Portions of the error message are
				 * constructed out of substrings of the
				 * original expression. In order to keep the
				 * error message readable, we impose this
				 * limit on the substring size we extract. */

    TclParseInit(interp, start, numBytes, parsePtr);

773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
			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,
			    start, (scanned < limit) ? "" : "...",
			    (scanned < limit) ? (int)scanned : (int)limit - 3,
			    start, (scanned < limit) ? "" : "...");
		    Tcl_AppendPrintfToObj(post, " or \"%.*s%s(...)\" or ...",
			    (scanned < limit) ? (int)scanned : (int)limit - 3,
			    start, (scanned < limit) ? "" : "...");
		    errCode = "BAREWORD";
		    if (start[0] == '0') {
			const char *stop;
			TclParseNumber(NULL, NULL, NULL, start, scanned,
				&stop, TCL_PARSE_NO_WHITESPACE);








|



|

|


|







773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
			Tcl_ListObjAppendElement(NULL, funcList, literal);
			scanned = scanned2 - 1;
			break;
		    }

		    Tcl_DecrRefCount(literal);
		    msg = Tcl_ObjPrintf("invalid bareword \"%.*s%s\"",
			    (int)((scanned < limit) ? scanned : limit - 3), start,
			    (scanned < limit) ? "" : "...");
		    post = Tcl_ObjPrintf(
			    "should be \"$%.*s%s\" or \"{%.*s%s}\"",
			    (int) ((scanned < limit) ? scanned : limit - 3),
			    start, (scanned < limit) ? "" : "...",
			    (int) ((scanned < limit) ? scanned : limit - 3),
			    start, (scanned < limit) ? "" : "...");
		    Tcl_AppendPrintfToObj(post, " or \"%.*s%s(...)\" or ...",
			    (int) ((scanned < limit) ? scanned : limit - 3),
			    start, (scanned < limit) ? "" : "...");
		    errCode = "BAREWORD";
		    if (start[0] == '0') {
			const char *stop;
			TclParseNumber(NULL, NULL, NULL, start, scanned,
				&stop, TCL_PARSE_NO_WHITESPACE);

1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
 *
 *----------------------------------------------------------------------
 */

static void
ConvertTreeToTokens(
    const char *start,
    size_t numBytes,
    OpNode *nodes,
    Tcl_Token *tokenPtr,
    Tcl_Parse *parsePtr)
{
    int subExprTokenIdx = 0;
    OpNode *nodePtr = nodes;
    int next = nodePtr->right;







|







1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
 *
 *----------------------------------------------------------------------
 */

static void
ConvertTreeToTokens(
    const char *start,
    Tcl_Size numBytes,
    OpNode *nodes,
    Tcl_Token *tokenPtr,
    Tcl_Parse *parsePtr)
{
    int subExprTokenIdx = 0;
    OpNode *nodePtr = nodes;
    int next = nodePtr->right;
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
 *----------------------------------------------------------------------
 */

int
Tcl_ParseExpr(
    Tcl_Interp *interp,		/* Used for error reporting. */
    const char *start,		/* Start of source string to parse. */
    size_t numBytes,		/* Number of bytes in string. If -1, the
				 * string consists of all bytes up to the
				 * first null character. */
    Tcl_Parse *parsePtr)	/* Structure to fill with information about
				 * the parsed expression; any previous
				 * information in the structure is ignored. */
{
    int code;
    OpNode *opTree = NULL;	/* Will point to the tree of operators. */
    Tcl_Obj *litList;	/* List to hold the literals. */
    Tcl_Obj *funcList;	/* List to hold the functon names. */
    Tcl_Parse *exprParsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse));
				/* Holds the Tcl_Tokens of substitutions. */

    TclNewObj(litList);
    TclNewObj(funcList);
    if (numBytes == TCL_INDEX_NONE) {
	numBytes = (start ? strlen(start) : 0);
    }

    code = ParseExpr(interp, start, numBytes, &opTree, litList, funcList,
	    exprParsePtr, 1 /* parseOnly */);
    Tcl_DecrRefCount(funcList);
    Tcl_DecrRefCount(litList);







|















|







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

int
Tcl_ParseExpr(
    Tcl_Interp *interp,		/* Used for error reporting. */
    const char *start,		/* Start of source string to parse. */
    Tcl_Size numBytes,		/* Number of bytes in string. If -1, the
				 * string consists of all bytes up to the
				 * first null character. */
    Tcl_Parse *parsePtr)	/* Structure to fill with information about
				 * the parsed expression; any previous
				 * information in the structure is ignored. */
{
    int code;
    OpNode *opTree = NULL;	/* Will point to the tree of operators. */
    Tcl_Obj *litList;	/* List to hold the literals. */
    Tcl_Obj *funcList;	/* List to hold the functon names. */
    Tcl_Parse *exprParsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse));
				/* Holds the Tcl_Tokens of substitutions. */

    TclNewObj(litList);
    TclNewObj(funcList);
    if (numBytes < 0) {
	numBytes = (start ? strlen(start) : 0);
    }

    code = ParseExpr(interp, start, numBytes, &opTree, litList, funcList,
	    exprParsePtr, 1 /* parseOnly */);
    Tcl_DecrRefCount(funcList);
    Tcl_DecrRefCount(litList);
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
 *	Parse a single lexeme from the start of a string, scanning no more
 *	than numBytes bytes.
 *
 * Results:
 *	Returns the number of bytes scanned to produce the lexeme.
 *
 * Side effects:
 *	Code identifying lexeme parsed is writen to *lexemePtr.
 *
 *----------------------------------------------------------------------
 */

static size_t
ParseLexeme(
    const char *start,		/* Start of lexeme to parse. */
    size_t numBytes,		/* Number of bytes in string. */
    unsigned char *lexemePtr,	/* Write code of parsed lexeme to this
				 * storage. */
    Tcl_Obj **literalPtr)	/* Write corresponding literal value to this
				   storage, if non-NULL. */
{
    const char *end;
    int ch;







|




|


|







1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
 *	Parse a single lexeme from the start of a string, scanning no more
 *	than numBytes bytes.
 *
 * Results:
 *	Returns the number of bytes scanned to produce the lexeme.
 *
 * Side effects:
 *	Code identifying lexeme parsed is written to *lexemePtr.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Size
ParseLexeme(
    const char *start,		/* Start of lexeme to parse. */
    Tcl_Size numBytes,		/* Number of bytes in string. */
    unsigned char *lexemePtr,	/* Write code of parsed lexeme to this
				 * storage. */
    Tcl_Obj **literalPtr)	/* Write corresponding literal value to this
				   storage, if non-NULL. */
{
    const char *end;
    int ch;
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
	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');
    }







|







1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
	return 1;
    }
    switch (byte) {
    case '#': {
	/*
	 * Scan forward over the comment contents.
	 */
	Tcl_Size size;

	for (size = 0; byte != '\n' && byte != 0 && size < numBytes; size++) {
	    byte = UCHAR(start[size]);
	}
	*lexemePtr = COMMENT;
	return size - (byte == '\n');
    }
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098

2099
2100
2101
2102
2103
2104
2105

    TclNewObj(literal);
    if (TclParseNumber(NULL, literal, NULL, start, numBytes, &end,
	    TCL_PARSE_NO_WHITESPACE) == TCL_OK) {
	if (end < start + numBytes && !TclIsBareword(*end)) {

	number:
	    TclInitStringRep(literal, start, end-start);
	    *lexemePtr = NUMBER;
	    if (literalPtr) {

		*literalPtr = literal;
	    } else {
		Tcl_DecrRefCount(literal);
	    }
	    return (end-start);
	} else {
	    unsigned char lexeme;







<


>







2089
2090
2091
2092
2093
2094
2095

2096
2097
2098
2099
2100
2101
2102
2103
2104
2105

    TclNewObj(literal);
    if (TclParseNumber(NULL, literal, NULL, start, numBytes, &end,
	    TCL_PARSE_NO_WHITESPACE) == TCL_OK) {
	if (end < start + numBytes && !TclIsBareword(*end)) {

	number:

	    *lexemePtr = NUMBER;
	    if (literalPtr) {
		TclInitStringRep(literal, start, end-start);
		*literalPtr = literal;
	    } else {
		Tcl_DecrRefCount(literal);
	    }
	    return (end-start);
	} else {
	    unsigned char lexeme;
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
    /*
     * We reject leading underscores in bareword.  No sensible reason why.
     * Might be inspired by reserved identifier rules in C, which of course
     * have no direct relevance here.
     */

    if (!TclIsBareword(*start) || *start == '_') {
	size_t scanned;
	if (Tcl_UtfCharComplete(start, numBytes)) {
	    scanned = TclUtfToUCS4(start, &ch);
	} else {
	    char utfBytes[8];

	    memcpy(utfBytes, start, numBytes);
	    utfBytes[numBytes] = '\0';
	    scanned = TclUtfToUCS4(utfBytes, &ch);
	}
	*lexemePtr = INVALID;
	Tcl_DecrRefCount(literal);
	return scanned;
    }
    end = start;
    while (numBytes && TclIsBareword(*end)) {
	end += 1;
	numBytes -= 1;
    }
    *lexemePtr = BAREWORD;
    if (literalPtr) {
	Tcl_SetStringObj(literal, start, (int) (end-start));
	*literalPtr = literal;
    } else {
	Tcl_DecrRefCount(literal);
    }
    return (end-start);
}








|




















|







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
    /*
     * We reject leading underscores in bareword.  No sensible reason why.
     * Might be inspired by reserved identifier rules in C, which of course
     * have no direct relevance here.
     */

    if (!TclIsBareword(*start) || *start == '_') {
	Tcl_Size scanned;
	if (Tcl_UtfCharComplete(start, numBytes)) {
	    scanned = TclUtfToUCS4(start, &ch);
	} else {
	    char utfBytes[8];

	    memcpy(utfBytes, start, numBytes);
	    utfBytes[numBytes] = '\0';
	    scanned = TclUtfToUCS4(utfBytes, &ch);
	}
	*lexemePtr = INVALID;
	Tcl_DecrRefCount(literal);
	return scanned;
    }
    end = start;
    while (numBytes && TclIsBareword(*end)) {
	end += 1;
	numBytes -= 1;
    }
    *lexemePtr = BAREWORD;
    if (literalPtr) {
	Tcl_SetStringObj(literal, start, end-start);
	*literalPtr = literal;
    } else {
	Tcl_DecrRefCount(literal);
    }
    return (end-start);
}

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
 *----------------------------------------------------------------------
 */

void
TclCompileExpr(
    Tcl_Interp *interp,		/* Used for error reporting. */
    const char *script,		/* The source script to compile. */
    size_t numBytes,		/* Number of bytes in script. */
    CompileEnv *envPtr,		/* Holds resulting instructions. */
    int optimize)		/* 0 for one-off expressions. */
{
    OpNode *opTree = NULL;	/* Will point to the tree of operators */
    Tcl_Obj *litList;		/* List to hold the literals */
    Tcl_Obj *funcList;		/* List to hold the functon names*/
    Tcl_Parse *parsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse));
				/* Holds the Tcl_Tokens of substitutions */
    int code;

    TclNewObj(litList);
    TclNewObj(funcList);
    code = ParseExpr(interp, script, numBytes, &opTree, litList,
	    funcList, parsePtr, 0 /* parseOnly */);

    if (code == TCL_OK) {
	/*
	 * Valid parse; compile the tree.
	 */

	size_t objc;
	Tcl_Obj *const *litObjv;
	Tcl_Obj **funcObjv;

	/* TIP #280 : Track Lines within the expression */
	TclAdvanceLines(&envPtr->line, script,
		script + TclParseAllWhiteSpace(script, numBytes));








|




















|







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

void
TclCompileExpr(
    Tcl_Interp *interp,		/* Used for error reporting. */
    const char *script,		/* The source script to compile. */
    Tcl_Size numBytes,		/* Number of bytes in script. */
    CompileEnv *envPtr,		/* Holds resulting instructions. */
    int optimize)		/* 0 for one-off expressions. */
{
    OpNode *opTree = NULL;	/* Will point to the tree of operators */
    Tcl_Obj *litList;		/* List to hold the literals */
    Tcl_Obj *funcList;		/* List to hold the functon names*/
    Tcl_Parse *parsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse));
				/* Holds the Tcl_Tokens of substitutions */
    int code;

    TclNewObj(litList);
    TclNewObj(funcList);
    code = ParseExpr(interp, script, numBytes, &opTree, litList,
	    funcList, parsePtr, 0 /* parseOnly */);

    if (code == TCL_OK) {
	/*
	 * Valid parse; compile the tree.
	 */

	Tcl_Size objc;
	Tcl_Obj *const *litObjv;
	Tcl_Obj **funcObjv;

	/* TIP #280 : Track Lines within the expression */
	TclAdvanceLines(&envPtr->line, script,
		script + TclParseAllWhiteSpace(script, numBytes));

2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
	} else if (nodePtr->mark == MARK_RIGHT) {
	    next = nodePtr->right;

	    switch (nodePtr->lexeme) {
	    case FUNCTION: {
		Tcl_DString cmdName;
		const char *p;
		size_t length;

		Tcl_DStringInit(&cmdName);
		TclDStringAppendLiteral(&cmdName, "tcl::mathfunc::");
		p = Tcl_GetStringFromObj(*funcObjv, &length);
		funcObjv++;
		Tcl_DStringAppend(&cmdName, p, length);
		TclEmitPush(TclRegisterLiteral(envPtr,







|







2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
	} else if (nodePtr->mark == MARK_RIGHT) {
	    next = nodePtr->right;

	    switch (nodePtr->lexeme) {
	    case FUNCTION: {
		Tcl_DString cmdName;
		const char *p;
		Tcl_Size length;

		Tcl_DStringInit(&cmdName);
		TclDStringAppendLiteral(&cmdName, "tcl::mathfunc::");
		p = Tcl_GetStringFromObj(*funcObjv, &length);
		funcObjv++;
		Tcl_DStringAppend(&cmdName, p, length);
		TclEmitPush(TclRegisterLiteral(envPtr,
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
	    numWords = 1;	/* No arguments, so just the command */
	    break;
	case OT_LITERAL: {
	    Tcl_Obj *const *litObjv = *litObjvPtr;
	    Tcl_Obj *literal = *litObjv;

	    if (optimize) {
		size_t length;
		const char *bytes = Tcl_GetStringFromObj(literal, &length);
		int idx = TclRegisterLiteral(envPtr, bytes, length, 0);
		Tcl_Obj *objPtr = TclFetchLiteral(envPtr, idx);

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







|







2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
	    numWords = 1;	/* No arguments, so just the command */
	    break;
	case OT_LITERAL: {
	    Tcl_Obj *const *litObjv = *litObjvPtr;
	    Tcl_Obj *literal = *litObjv;

	    if (optimize) {
		Tcl_Size 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:
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
		    /*
		     * Don't generate a string rep, but if we have one
		     * already, then use it to share via the literal table.
		     */

		    if (TclHasStringRep(objPtr)) {
			Tcl_Obj *tableValue;
			size_t numBytes;
			const char *bytes
				= Tcl_GetStringFromObj(objPtr, &numBytes);

			idx = TclRegisterLiteral(envPtr, bytes, numBytes, 0);
			tableValue = TclFetchLiteral(envPtr, idx);
			if ((tableValue->typePtr == NULL) &&
				(objPtr->typePtr != NULL)) {







|







2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
		    /*
		     * Don't generate a string rep, but if we have one
		     * already, then use it to share via the literal table.
		     */

		    if (TclHasStringRep(objPtr)) {
			Tcl_Obj *tableValue;
			Tcl_Size numBytes;
			const char *bytes
				= Tcl_GetStringFromObj(objPtr, &numBytes);

			idx = TclRegisterLiteral(envPtr, bytes, numBytes, 0);
			tableValue = TclFetchLiteral(envPtr, idx);
			if ((tableValue->typePtr == NULL) &&
				(objPtr->typePtr != NULL)) {
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
	    nodes[1].lexeme = lexeme;
	    nodes[1].mark = MARK_LEFT;
	    nodes[1].left = OT_LITERAL;
	    nodes[1].right = OT_LITERAL;
	    nodes[1].p.parent = 0;
	} else {
	    if (lexeme == DIVIDE) {
		litObjv[0] = Tcl_NewDoubleObj(1.0);
	    } else {
		TclNewIntObj(litObjv[0], occdPtr->i.identity);
	    }
	    Tcl_IncrRefCount(litObjv[0]);
	    litObjv[1] = objv[1];
	    nodes[0].lexeme = START;
	    nodes[0].mark = MARK_RIGHT;







|







2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
	    nodes[1].lexeme = lexeme;
	    nodes[1].mark = MARK_LEFT;
	    nodes[1].left = OT_LITERAL;
	    nodes[1].right = OT_LITERAL;
	    nodes[1].p.parent = 0;
	} else {
	    if (lexeme == DIVIDE) {
		TclNewDoubleObj(litObjv[0], 1.0);
	    } else {
		TclNewIntObj(litObjv[0], occdPtr->i.identity);
	    }
	    Tcl_IncrRefCount(litObjv[0]);
	    litObjv[1] = objv[1];
	    nodes[0].lexeme = START;
	    nodes[0].mark = MARK_RIGHT;

Changes to generic/tclCompile.c.

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
    {"strle",		  1,   -1,         0,	{OPERAND_NONE}},
	/* String Less or equal:	push (stknext <= stktop) */
    {"strge",		  1,   -1,         0,	{OPERAND_NONE}},
	/* String Greater or equal:	push (stknext >= stktop) */
    {"lreplace4",	  6,   INT_MIN,    2,	{OPERAND_UINT4, OPERAND_UINT1}},
	/* Operands: number of arguments, flags
	 * flags: Combination of TCL_LREPLACE4_* flags
	 * Stack: ... listobj index1 ?index2? new1 ... newN => ... newlistobj 
	 * where index2 is present only if TCL_LREPLACE_SINGLE_INDEX is not
	 * set in flags.
	 */

    {NULL, 0, 0, 0, {OPERAND_NONE}}
};

/*
 * Prototypes for procedures defined later in this file:
 */

static void		CleanupByteCode(ByteCode *codePtr);
static ByteCode *	CompileSubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    int flags);
static void		DupByteCodeInternalRep(Tcl_Obj *srcPtr,
			    Tcl_Obj *copyPtr);
static unsigned char *	EncodeCmdLocMap(CompileEnv *envPtr,
			    ByteCode *codePtr, unsigned char *startPtr);
static void		EnterCmdExtentData(CompileEnv *envPtr,
			    size_t cmdNumber, size_t numSrcBytes, size_t numCodeBytes);
static void		EnterCmdStartData(CompileEnv *envPtr,
			    size_t cmdNumber, size_t srcOffset, size_t codeOffset);
static void		FreeByteCodeInternalRep(Tcl_Obj *objPtr);
static void		FreeSubstCodeInternalRep(Tcl_Obj *objPtr);
static int		GetCmdLocEncodingSize(CompileEnv *envPtr);
static int		IsCompactibleCompileEnv(CompileEnv *envPtr);
static void		PreventCycle(Tcl_Obj *objPtr, CompileEnv *envPtr);
#ifdef TCL_COMPILE_STATS
static void		RecordByteCodeStats(ByteCode *codePtr);
#endif /* TCL_COMPILE_STATS */
static int		SetByteCodeFromAny(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
static void		StartExpanding(CompileEnv *envPtr);

/*
 * TIP #280: Helper for building the per-word line information of all compiled
 * commands.
 */
static void		EnterCmdWordData(ExtCmdLoc *eclPtr, size_t srcOffset,
			    Tcl_Token *tokenPtr, const char *cmd,
			    size_t numWords, size_t line, int *clNext, int **lines,
			    CompileEnv *envPtr);
static void		ReleaseCmdWordData(ExtCmdLoc *eclPtr);

/*
 * tclByteCodeType provides the standard type management procedures for the
 * bytecode type.
 */

const Tcl_ObjType tclByteCodeType = {
    "bytecode",			/* name */
    FreeByteCodeInternalRep,	/* freeIntRepProc */
    DupByteCodeInternalRep,	/* dupIntRepProc */
    NULL,			/* updateStringProc */
    SetByteCodeFromAny		/* setFromAnyProc */

};

/*
 * subtCodeType provides the standard type managemnt procedures for the
 * substcode type, which represents substiution within a Tcl value.
 */

static const Tcl_ObjType substCodeType = {
    "substcode",		/* name */
    FreeSubstCodeInternalRep,	/* freeIntRepProc */
    DupByteCodeInternalRep,	/* dupIntRepProc - shared with bytecode */
    NULL,			/* updateStringProc */
    NULL,			/* setFromAnyProc */

};
#define SubstFlags(objPtr) (objPtr)->internalRep.twoPtrValue.ptr2

/*
 * Helper macros.
 */








|



















|

|
















|

|













|
>



|
|








>







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
    {"strle",		  1,   -1,         0,	{OPERAND_NONE}},
	/* String Less or equal:	push (stknext <= stktop) */
    {"strge",		  1,   -1,         0,	{OPERAND_NONE}},
	/* String Greater or equal:	push (stknext >= stktop) */
    {"lreplace4",	  6,   INT_MIN,    2,	{OPERAND_UINT4, OPERAND_UINT1}},
	/* Operands: number of arguments, flags
	 * flags: Combination of TCL_LREPLACE4_* flags
	 * Stack: ... listobj index1 ?index2? new1 ... newN => ... newlistobj
	 * where index2 is present only if TCL_LREPLACE_SINGLE_INDEX is not
	 * set in flags.
	 */

    {NULL, 0, 0, 0, {OPERAND_NONE}}
};

/*
 * Prototypes for procedures defined later in this file:
 */

static void		CleanupByteCode(ByteCode *codePtr);
static ByteCode *	CompileSubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    int flags);
static void		DupByteCodeInternalRep(Tcl_Obj *srcPtr,
			    Tcl_Obj *copyPtr);
static unsigned char *	EncodeCmdLocMap(CompileEnv *envPtr,
			    ByteCode *codePtr, unsigned char *startPtr);
static void		EnterCmdExtentData(CompileEnv *envPtr,
			    Tcl_Size cmdNumber, Tcl_Size numSrcBytes, Tcl_Size numCodeBytes);
static void		EnterCmdStartData(CompileEnv *envPtr,
			    Tcl_Size cmdNumber, Tcl_Size srcOffset, Tcl_Size codeOffset);
static void		FreeByteCodeInternalRep(Tcl_Obj *objPtr);
static void		FreeSubstCodeInternalRep(Tcl_Obj *objPtr);
static int		GetCmdLocEncodingSize(CompileEnv *envPtr);
static int		IsCompactibleCompileEnv(CompileEnv *envPtr);
static void		PreventCycle(Tcl_Obj *objPtr, CompileEnv *envPtr);
#ifdef TCL_COMPILE_STATS
static void		RecordByteCodeStats(ByteCode *codePtr);
#endif /* TCL_COMPILE_STATS */
static int		SetByteCodeFromAny(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
static void		StartExpanding(CompileEnv *envPtr);

/*
 * TIP #280: Helper for building the per-word line information of all compiled
 * commands.
 */
static void		EnterCmdWordData(ExtCmdLoc *eclPtr, Tcl_Size srcOffset,
			    Tcl_Token *tokenPtr, const char *cmd,
			    Tcl_Size numWords, Tcl_Size line, int *clNext, int **lines,
			    CompileEnv *envPtr);
static void		ReleaseCmdWordData(ExtCmdLoc *eclPtr);

/*
 * tclByteCodeType provides the standard type management procedures for the
 * bytecode type.
 */

const Tcl_ObjType tclByteCodeType = {
    "bytecode",			/* name */
    FreeByteCodeInternalRep,	/* freeIntRepProc */
    DupByteCodeInternalRep,	/* dupIntRepProc */
    NULL,			/* updateStringProc */
    SetByteCodeFromAny,		/* setFromAnyProc */
    TCL_OBJTYPE_V0
};

/*
 * substCodeType provides the standard type management procedures for the
 * substcode type, which represents substitution within a Tcl value.
 */

static const Tcl_ObjType substCodeType = {
    "substcode",		/* name */
    FreeSubstCodeInternalRep,	/* freeIntRepProc */
    DupByteCodeInternalRep,	/* dupIntRepProc - shared with bytecode */
    NULL,			/* updateStringProc */
    NULL,			/* setFromAnyProc */
    TCL_OBJTYPE_V0
};
#define SubstFlags(objPtr) (objPtr)->internalRep.twoPtrValue.ptr2

/*
 * Helper macros.
 */

770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
    Tcl_Obj *objPtr,		/* The object to make a ByteCode object. */
    CompileHookProc *hookProc,	/* Procedure to invoke after compilation. */
    void *clientData)	/* Hook procedure private data. */
{
    Interp *iPtr = (Interp *) interp;
    CompileEnv compEnv;		/* Compilation environment structure allocated
				 * in frame. */
    size_t length;
    int result = TCL_OK;
    const char *stringPtr;
    Proc *procPtr = iPtr->compiledProcPtr;
    ContLineLoc *clLocPtr;

#ifdef TCL_COMPILE_DEBUG
    if (!traceInitialized) {







|







772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
    Tcl_Obj *objPtr,		/* The object to make a ByteCode object. */
    CompileHookProc *hookProc,	/* Procedure to invoke after compilation. */
    void *clientData)	/* Hook procedure private data. */
{
    Interp *iPtr = (Interp *) interp;
    CompileEnv compEnv;		/* Compilation environment structure allocated
				 * in frame. */
    Tcl_Size length;
    int result = TCL_OK;
    const char *stringPtr;
    Proc *procPtr = iPtr->compiledProcPtr;
    ContLineLoc *clLocPtr;

#ifdef TCL_COMPILE_DEBUG
    if (!traceInitialized) {
862
863
864
865
866
867
868












869
870
871
872
873
874
875
    /*
     * Invoke the compilation hook procedure if there is one.
     */

    if (hookProc) {
	result = hookProc(interp, &compEnv, clientData);
    }













    /*
     * Change the object into a ByteCode object. Ownership of the literal
     * objects and aux data items passes to the ByteCode object.
     */

#ifdef TCL_COMPILE_DEBUG







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







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
    /*
     * Invoke the compilation hook procedure if there is one.
     */

    if (hookProc) {
	result = hookProc(interp, &compEnv, clientData);
    }

    /*
     * After optimization is all done, check that byte code length limits
     * are not exceeded. Bug [27b3ce2997].
     */
    if ((compEnv.codeNext - compEnv.codeStart) > INT_MAX) {
	/*
	 * Cannot just return TCL_ERROR as callers ignore return value.
	 * TODO - May be use TclCompileSyntaxError here?
	 */
	Tcl_Panic("Maximum byte code length %d exceeded.", INT_MAX);
    }

    /*
     * Change the object into a ByteCode object. Ownership of the literal
     * objects and aux data items passes to the ByteCode object.
     */

#ifdef TCL_COMPILE_DEBUG
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
		iPtr->varFramePtr->localCachePtr)) {
	    Tcl_StoreInternalRep(objPtr, &substCodeType, NULL);
	    codePtr = NULL;
	}
    }
    if (codePtr == NULL) {
	CompileEnv compEnv;
	size_t numBytes;
	const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes);

	/* TODO: Check for more TIP 280 */
	TclInitCompileEnv(interp, &compEnv, bytes, numBytes, NULL, 0);

	TclSubstCompile(interp, bytes, numBytes, flags, 1, &compEnv);








|







1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
		iPtr->varFramePtr->localCachePtr)) {
	    Tcl_StoreInternalRep(objPtr, &substCodeType, NULL);
	    codePtr = NULL;
	}
    }
    if (codePtr == NULL) {
	CompileEnv compEnv;
	Tcl_Size 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);

1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
    TclReleaseByteCode(codePtr);
}

static void
ReleaseCmdWordData(
    ExtCmdLoc *eclPtr)
{
    size_t i;

    if (eclPtr->type == TCL_LOCATION_SOURCE) {
	Tcl_DecrRefCount(eclPtr->path);
    }
    for (i=0 ; i<eclPtr->nuloc ; i++) {
	Tcl_Free(eclPtr->loc[i].line);
    }







|







1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
    TclReleaseByteCode(codePtr);
}

static void
ReleaseCmdWordData(
    ExtCmdLoc *eclPtr)
{
    Tcl_Size i;

    if (eclPtr->type == TCL_LOCATION_SOURCE) {
	Tcl_DecrRefCount(eclPtr->path);
    }
    for (i=0 ; i<eclPtr->nuloc ; i++) {
	Tcl_Free(eclPtr->loc[i].line);
    }
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
	     *			ctx.data.tebc.codePtr is used instead.
	     */

	    TclGetSrcInfoForPc(ctxPtr);
	    pc = 1;
	}

	if ((ctxPtr->nline <= (size_t)word) || (ctxPtr->line[word] < 0)) {
	    /*
	     * Word is not a literal, relative counting.
	     */

	    envPtr->line = 1;
	    envPtr->extCmdMapPtr->type =
		    (envPtr->procPtr ? TCL_LOCATION_PROC : TCL_LOCATION_BC);







|







1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
	     *			ctx.data.tebc.codePtr is used instead.
	     */

	    TclGetSrcInfoForPc(ctxPtr);
	    pc = 1;
	}

	if ((ctxPtr->nline <= word) || (ctxPtr->line[word] < 0)) {
	    /*
	     * Word is not a literal, relative counting.
	     */

	    envPtr->line = 1;
	    envPtr->extCmdMapPtr->type =
		    (envPtr->procPtr ? TCL_LOCATION_PROC : TCL_LOCATION_BC);
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
    }
    if (envPtr->iPtr) {
	/*
	 * We never converted to Bytecode, so free the things we would
	 * have transferred to it.
	 */

	size_t i;
	LiteralEntry *entryPtr = envPtr->literalArrayPtr;
	AuxData *auxDataPtr = envPtr->auxDataArrayPtr;

	for (i = 0;  i < envPtr->literalArrayNext;  i++) {
	    TclReleaseLiteral((Tcl_Interp *)envPtr->iPtr, entryPtr->objPtr);
	    entryPtr++;
	}







|







1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
    }
    if (envPtr->iPtr) {
	/*
	 * We never converted to Bytecode, so free the things we would
	 * have transferred to it.
	 */

	Tcl_Size i;
	LiteralEntry *entryPtr = envPtr->literalArrayPtr;
	AuxData *auxDataPtr = envPtr->auxDataArrayPtr;

	for (i = 0;  i < envPtr->literalArrayNext;  i++) {
	    TclReleaseLiteral((Tcl_Interp *)envPtr->iPtr, entryPtr->objPtr);
	    entryPtr++;
	}
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
    Tcl_Interp *interp,
    Tcl_Obj *cmdObj,
    CompileEnv *envPtr)
{
    const char *bytes;
    Command *cmdPtr;
    int cmdLitIdx, extraLiteralFlags = LITERAL_CMD_NAME;
    size_t length;

    cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj);
    if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_VIA_RESOLVER)) {
	extraLiteralFlags |= LITERAL_UNSHARED;
    }

    bytes = Tcl_GetStringFromObj(cmdObj, &length);







|







1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
    Tcl_Interp *interp,
    Tcl_Obj *cmdObj,
    CompileEnv *envPtr)
{
    const char *bytes;
    Command *cmdPtr;
    int cmdLitIdx, extraLiteralFlags = LITERAL_CMD_NAME;
    Tcl_Size length;

    cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj);
    if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_VIA_RESOLVER)) {
	extraLiteralFlags |= LITERAL_UNSHARED;
    }

    bytes = Tcl_GetStringFromObj(cmdObj, &length);
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
    int *clNext = envPtr->clNext;
    int cmdIdx = envPtr->numCommands;
    int startCodeOffset = envPtr->codeNext - envPtr->codeStart;
    int depth = TclGetStackDepth(envPtr);

    assert ((int)parsePtr->numWords > 0);

    /* Pre-Compile */

    TclNewObj(cmdObj);
    envPtr->numCommands++;
    EnterCmdStartData(envPtr, cmdIdx,
	    parsePtr->commandStart - envPtr->source, startCodeOffset);

    /*







|







2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
    int *clNext = envPtr->clNext;
    int cmdIdx = envPtr->numCommands;
    int startCodeOffset = envPtr->codeNext - envPtr->codeStart;
    int depth = TclGetStackDepth(envPtr);

    assert ((int)parsePtr->numWords > 0);

    /* Precompile */

    TclNewObj(cmdObj);
    envPtr->numCommands++;
    EnterCmdStartData(envPtr, cmdIdx,
	    parsePtr->commandStart - envPtr->source, startCodeOffset);

    /*
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144

void
TclCompileScript(
    Tcl_Interp *interp,		/* Used for error and status reporting. Also
				 * serves as context for finding and compiling
				 * commands. May not be NULL. */
    const char *script,		/* The source script to compile. */
    size_t numBytes,		/* Number of bytes in script. If -1, the
				 * script consists of all bytes up to the
				 * first null character. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    int lastCmdIdx = -1;	/* Index into envPtr->cmdMapPtr of the last
				 * command this routine compiles into bytecode.
				 * Initial value of -1 indicates this routine







|







2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158

void
TclCompileScript(
    Tcl_Interp *interp,		/* Used for error and status reporting. Also
				 * serves as context for finding and compiling
				 * commands. May not be NULL. */
    const char *script,		/* The source script to compile. */
    Tcl_Size numBytes,		/* Number of bytes in script. If < 0, the
				 * script consists of all bytes up to the
				 * first null character. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    int lastCmdIdx = -1;	/* Index into envPtr->cmdMapPtr of the last
				 * command this routine compiles into bytecode.
				 * Initial value of -1 indicates this routine
2160
2161
2162
2163
2164
2165
2166




2167
2168
2169
2170













2171
2172
2173
2174
2175
2176
2177
    if (iPtr->numLevels / 5 > iPtr->maxNestingDepth / 4) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
	    "too many nested compilations (infinite loop?)", -1));
	Tcl_SetErrorCode(interp, "TCL", "LIMIT", "STACK", NULL);
	TclCompileSyntaxError(interp, envPtr);
	return;
    }





    /* Each iteration compiles one command from the script. */

    if (numBytes + 1 > 1) {













      /*
       * Don't use system stack (size of Tcl_Parse is ca. 400 bytes), so
       * many nested compilations (body enclosed in body) can cause abnormal
       * program termination with a stack overflow exception, bug [fec0c17d39].
       */
      Tcl_Parse *parsePtr = (Tcl_Parse *)Tcl_Alloc(sizeof(Tcl_Parse));








>
>
>
>



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







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
    if (iPtr->numLevels / 5 > iPtr->maxNestingDepth / 4) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
	    "too many nested compilations (infinite loop?)", -1));
	Tcl_SetErrorCode(interp, "TCL", "LIMIT", "STACK", NULL);
	TclCompileSyntaxError(interp, envPtr);
	return;
    }

    if (numBytes < 0) {
	numBytes = strlen(script);
    }

    /* Each iteration compiles one command from the script. */

    if (numBytes > 0) {
      if (numBytes >= INT_MAX) {
	/*
	 * Note this gets -errorline as 1. Not worth figuring out which line
	 * crosses the limit to get -errorline for this error case.
	 */
	Tcl_SetObjResult(interp,
	  Tcl_ObjPrintf("Script length %" TCL_SIZE_MODIFIER
			   "d exceeds max permitted length %d.",
			   numBytes, (int)INT_MAX-1));
	    Tcl_SetErrorCode(interp, "TCL", "LIMIT", "SCRIPTLENGTH", NULL);
	    TclCompileSyntaxError(interp, envPtr);
	    return;
      }
      /*
       * Don't use system stack (size of Tcl_Parse is ca. 400 bytes), so
       * many nested compilations (body enclosed in body) can cause abnormal
       * program termination with a stack overflow exception, bug [fec0c17d39].
       */
      Tcl_Parse *parsePtr = (Tcl_Parse *)Tcl_Alloc(sizeof(Tcl_Parse));

2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
void
TclCompileVarSubst(
    Tcl_Interp *interp,
    Tcl_Token *tokenPtr,
    CompileEnv *envPtr)
{
    const char *p, *name = tokenPtr[1].start;
    size_t i, nameBytes = tokenPtr[1].size;
    size_t localVar;
    int localVarName = 1;

    /*
     * Determine how the variable name should be handled: if it contains any
     * namespace qualifiers it is not a local variable (localVarName=-1); if
     * it looks like an array element and the token has a single component, it
     * should not be created here [Bug 569438] (localVarName=0); otherwise,







|
|







2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
void
TclCompileVarSubst(
    Tcl_Interp *interp,
    Tcl_Token *tokenPtr,
    CompileEnv *envPtr)
{
    const char *p, *name = tokenPtr[1].start;
    Tcl_Size i, nameBytes = tokenPtr[1].size;
    Tcl_Size localVar;
    int localVarName = 1;

    /*
     * Determine how the variable name should be handled: if it contains any
     * namespace qualifiers it is not a local variable (localVarName=-1); if
     * it looks like an array element and the token has a single component, it
     * should not be created here [Bug 569438] (localVarName=0); otherwise,
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
    }

    /*
     * Either push the variable's name, or find its index in the array
     * of local variables in a procedure frame.
     */

    localVar = TCL_INDEX_NONE;
    if (localVarName != -1) {
	localVar = TclFindCompiledLocal(name, nameBytes, localVarName, envPtr);
    }
    if (localVar == TCL_INDEX_NONE) {
	PushLiteral(envPtr, name, nameBytes);
    }

    /*
     * Emit instructions to load the variable.
     */

    TclAdvanceLines(&envPtr->line, tokenPtr[1].start,
	    tokenPtr[1].start + tokenPtr[1].size);

    if (tokenPtr->numComponents == 1) {
	if (localVar == TCL_INDEX_NONE) {
	    TclEmitOpcode(INST_LOAD_STK, envPtr);
	} else if (localVar <= 255) {
	    TclEmitInstInt1(INST_LOAD_SCALAR1, localVar, envPtr);
	} else {
	    TclEmitInstInt4(INST_LOAD_SCALAR4, localVar, envPtr);
	}
    } else {
	TclCompileTokens(interp, tokenPtr+2, tokenPtr->numComponents-1, envPtr);
	if (localVar == TCL_INDEX_NONE) {
	    TclEmitOpcode(INST_LOAD_ARRAY_STK, envPtr);
	} else if (localVar <= 255) {
	    TclEmitInstInt1(INST_LOAD_ARRAY1, localVar, envPtr);
	} else {
	    TclEmitInstInt4(INST_LOAD_ARRAY4, localVar, envPtr);
	}
    }







|



|











|








|







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
    }

    /*
     * Either push the variable's name, or find its index in the array
     * of local variables in a procedure frame.
     */

    localVar = -1;
    if (localVarName != -1) {
	localVar = TclFindCompiledLocal(name, nameBytes, localVarName, envPtr);
    }
    if (localVar < 0) {
	PushLiteral(envPtr, name, nameBytes);
    }

    /*
     * Emit instructions to load the variable.
     */

    TclAdvanceLines(&envPtr->line, tokenPtr[1].start,
	    tokenPtr[1].start + tokenPtr[1].size);

    if (tokenPtr->numComponents == 1) {
	if (localVar < 0) {
	    TclEmitOpcode(INST_LOAD_STK, envPtr);
	} else if (localVar <= 255) {
	    TclEmitInstInt1(INST_LOAD_SCALAR1, localVar, envPtr);
	} else {
	    TclEmitInstInt4(INST_LOAD_SCALAR4, localVar, envPtr);
	}
    } else {
	TclCompileTokens(interp, tokenPtr+2, tokenPtr->numComponents-1, envPtr);
	if (localVar < 0) {
	    TclEmitOpcode(INST_LOAD_ARRAY_STK, envPtr);
	} else if (localVar <= 255) {
	    TclEmitInstInt1(INST_LOAD_ARRAY1, localVar, envPtr);
	} else {
	    TclEmitInstInt4(INST_LOAD_ARRAY4, localVar, envPtr);
	}
    }
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
#define NUM_STATIC_POS 20
    int isLiteral, maxNumCL, numCL;
    int *clPosition = NULL;
    int depth = TclGetStackDepth(envPtr);
    int count = count1;

    /*
     * if this is actually a literal, handle continuation lines by
     * preallocating a small table to store the locations of any continuation
     * lines we find in this literal.  The table is extended if needed.
     *
     * Note: In contrast with the analagous code in 'TclSubstTokens()' the
     * 'adjust' variable seems unneeded here.  The code which merges
     * continuation line information of multiple words which concat'd at
     * runtime also seems unneeded. Either that or I have not managed to find a
     * test case for these two possibilities yet.  It might be a difference
     * between compile- versus run-time processing.







|

|







2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
#define NUM_STATIC_POS 20
    int isLiteral, maxNumCL, numCL;
    int *clPosition = NULL;
    int depth = TclGetStackDepth(envPtr);
    int count = count1;

    /*
     * If this is actually a literal, handle continuation lines by
     * preallocating a small table to store the locations of any continuation
     * lines found in this literal.  The table is extended if needed.
     *
     * Note: In contrast with the analagous code in 'TclSubstTokens()' the
     * 'adjust' variable seems unneeded here.  The code which merges
     * continuation line information of multiple words which concat'd at
     * runtime also seems unneeded. Either that or I have not managed to find a
     * test case for these two possibilities yet.  It might be a difference
     * between compile- versus run-time processing.
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
 */

static void
PreventCycle(
    Tcl_Obj *objPtr,
    CompileEnv *envPtr)
{
    size_t i;

    for (i = 0;  i < envPtr->literalArrayNext; i++) {
	if (objPtr == TclFetchLiteral(envPtr, i)) {
	    /*
	     * Prevent circular reference where the bytecode internalrep of
	     * a value contains a literal which is that same value.
	     * If this is allowed to happen, refcount decrements may not
	     * reach zero, and memory may leak.  Bugs 467523, 3357771
	     *
	     * NOTE:  [Bugs 3392070, 3389764] We make a copy based completely
	     * on the string value, and do not call Tcl_DuplicateObj() so we
             * can be sure we do not have any lingering cycles hiding in
	     * the internalrep.
	     */
	    size_t numBytes;
	    const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes);
	    Tcl_Obj *copyPtr = Tcl_NewStringObj(bytes, numBytes);

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

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







|














|







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

static void
PreventCycle(
    Tcl_Obj *objPtr,
    CompileEnv *envPtr)
{
    Tcl_Size i;

    for (i = 0;  i < envPtr->literalArrayNext; i++) {
	if (objPtr == TclFetchLiteral(envPtr, i)) {
	    /*
	     * Prevent circular reference where the bytecode internalrep of
	     * a value contains a literal which is that same value.
	     * If this is allowed to happen, refcount decrements may not
	     * reach zero, and memory may leak.  Bugs 467523, 3357771
	     *
	     * NOTE:  [Bugs 3392070, 3389764] We make a copy based completely
	     * on the string value, and do not call Tcl_DuplicateObj() so we
             * can be sure we do not have any lingering cycles hiding in
	     * the internalrep.
	     */
	    Tcl_Size 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;
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
 * Side effects:
 *	Creates and registers a new local variable if create is 1 and the
 *	variable is unknown, or if the name is NULL.
 *
 *----------------------------------------------------------------------
 */

size_t
TclFindCompiledLocal(
    const char *name,	/* Points to first character of the name of a
				 * scalar or array variable. If NULL, a
				 * temporary var should be created. */
    size_t nameBytes,		/* Number of bytes in the name. */
    int create,			/* If 1, allocate a local frame entry for the
				 * variable if it is new. */
    CompileEnv *envPtr)		/* Points to the current compile environment*/
{
    CompiledLocal *localPtr;
    size_t localVar = TCL_INDEX_NONE;
    size_t i;
    Proc *procPtr;

    /*
     * If not creating a temporary, does a local variable of the specified
     * name already exist?
     */

    procPtr = envPtr->procPtr;

    if (procPtr == NULL) {
	/*
	 * Compiling a non-body script: give it read access to the LVT in the
	 * current localCache
	 */

	LocalCache *cachePtr = envPtr->iPtr->varFramePtr->localCachePtr;
	const char *localName;
	Tcl_Obj **varNamePtr;
	size_t len;

	if (!cachePtr || !name) {
	    return TCL_INDEX_NONE;
	}

	varNamePtr = &cachePtr->varName0;
	for (i=0; i < cachePtr->numVars; varNamePtr++, i++) {
	    if (*varNamePtr) {
		localName = Tcl_GetStringFromObj(*varNamePtr, &len);
		if ((len == nameBytes) && !strncmp(name, localName, len)) {
		    return i;
		}
	    }
	}
	return TCL_INDEX_NONE;
    }

    if (name != NULL) {
	size_t localCt = procPtr->numCompiledLocals;

	localPtr = procPtr->firstLocalPtr;
	for (i = 0;  i < localCt;  i++) {
	    if (!TclIsVarTemporary(localPtr)) {
		char *localName = localPtr->name;

		if ((nameBytes == localPtr->nameLength) &&







|




|





|
|


















|


















|







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
 * Side effects:
 *	Creates and registers a new local variable if create is 1 and the
 *	variable is unknown, or if the name is NULL.
 *
 *----------------------------------------------------------------------
 */

Tcl_Size
TclFindCompiledLocal(
    const char *name,	/* Points to first character of the name of a
				 * scalar or array variable. If NULL, a
				 * temporary var should be created. */
    Tcl_Size nameBytes,		/* Number of bytes in the name. */
    int create,			/* If 1, allocate a local frame entry for the
				 * variable if it is new. */
    CompileEnv *envPtr)		/* Points to the current compile environment*/
{
    CompiledLocal *localPtr;
    Tcl_Size localVar = TCL_INDEX_NONE;
    Tcl_Size i;
    Proc *procPtr;

    /*
     * If not creating a temporary, does a local variable of the specified
     * name already exist?
     */

    procPtr = envPtr->procPtr;

    if (procPtr == NULL) {
	/*
	 * Compiling a non-body script: give it read access to the LVT in the
	 * current localCache
	 */

	LocalCache *cachePtr = envPtr->iPtr->varFramePtr->localCachePtr;
	const char *localName;
	Tcl_Obj **varNamePtr;
	Tcl_Size len;

	if (!cachePtr || !name) {
	    return TCL_INDEX_NONE;
	}

	varNamePtr = &cachePtr->varName0;
	for (i=0; i < cachePtr->numVars; varNamePtr++, i++) {
	    if (*varNamePtr) {
		localName = Tcl_GetStringFromObj(*varNamePtr, &len);
		if ((len == nameBytes) && !strncmp(name, localName, len)) {
		    return i;
		}
	    }
	}
	return TCL_INDEX_NONE;
    }

    if (name != NULL) {
	Tcl_Size localCt = procPtr->numCompiledLocals;

	localPtr = procPtr->firstLocalPtr;
	for (i = 0;  i < localCt;  i++) {
	    if (!TclIsVarTemporary(localPtr)) {
		char *localName = localPtr->name;

		if ((nameBytes == localPtr->nameLength) &&
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
 */

static void
EnterCmdStartData(
    CompileEnv *envPtr,		/* Points to the compilation environment
				 * structure in which to enter command
				 * location information. */
    size_t cmdIndex,		/* Index of the command whose start data is
				 * being set. */
    size_t srcOffset,		/* Offset of first char of the command. */
    size_t codeOffset)		/* Offset of first byte of command code. */
{
    CmdLocation *cmdLocPtr;

    if (cmdIndex >= envPtr->numCommands) {
	Tcl_Panic("EnterCmdStartData: bad command index %" TCL_Z_MODIFIER "u", cmdIndex);
    }

    if (cmdIndex >= envPtr->cmdMapEnd) {
	/*
	 * Expand the command location array by allocating more storage from
	 * the heap. The currently allocated CmdLocation entries are stored







|

|
|



|







3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
 */

static void
EnterCmdStartData(
    CompileEnv *envPtr,		/* Points to the compilation environment
				 * structure in which to enter command
				 * location information. */
    Tcl_Size cmdIndex,		/* Index of the command whose start data is
				 * being set. */
    Tcl_Size srcOffset,		/* Offset of first char of the command. */
    Tcl_Size codeOffset)		/* Offset of first byte of command code. */
{
    CmdLocation *cmdLocPtr;

    if (cmdIndex < 0 || cmdIndex >= envPtr->numCommands) {
	Tcl_Panic("EnterCmdStartData: bad command index %" TCL_Z_MODIFIER "u", cmdIndex);
    }

    if (cmdIndex >= envPtr->cmdMapEnd) {
	/*
	 * Expand the command location array by allocating more storage from
	 * the heap. The currently allocated CmdLocation entries are stored
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
 */

static void
EnterCmdExtentData(
    CompileEnv *envPtr,		/* Points to the compilation environment
				 * structure in which to enter command
				 * location information. */
    size_t cmdIndex,		/* Index of the command whose source and code
				 * length data is being set. */
    size_t numSrcBytes,		/* Number of command source chars. */
    size_t numCodeBytes)		/* Offset of last byte of command code. */
{
    CmdLocation *cmdLocPtr;

    if (cmdIndex >= envPtr->numCommands) {
	Tcl_Panic("EnterCmdExtentData: bad command index %" TCL_Z_MODIFIER "u", cmdIndex);
    }

    if (cmdIndex > envPtr->cmdMapEnd) {
	Tcl_Panic("EnterCmdExtentData: missing start data for command %" TCL_Z_MODIFIER "u",
		cmdIndex);
    }







|

|
|



|







3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
 */

static void
EnterCmdExtentData(
    CompileEnv *envPtr,		/* Points to the compilation environment
				 * structure in which to enter command
				 * location information. */
    Tcl_Size cmdIndex,		/* Index of the command whose source and code
				 * length data is being set. */
    Tcl_Size numSrcBytes,		/* Number of command source chars. */
    Tcl_Size numCodeBytes)		/* Offset of last byte of command code. */
{
    CmdLocation *cmdLocPtr;

    if (cmdIndex < 0 || cmdIndex >= envPtr->numCommands) {
	Tcl_Panic("EnterCmdExtentData: bad command index %" TCL_Z_MODIFIER "u", cmdIndex);
    }

    if (cmdIndex > envPtr->cmdMapEnd) {
	Tcl_Panic("EnterCmdExtentData: missing start data for command %" TCL_Z_MODIFIER "u",
		cmdIndex);
    }
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
 */

static void
EnterCmdWordData(
    ExtCmdLoc *eclPtr,		/* Points to the map environment structure in
				 * which to enter command location
				 * information. */
    size_t srcOffset,		/* Offset of first char of the command. */
    Tcl_Token *tokenPtr,
    const char *cmd,
    size_t numWords,
    size_t line,
    int *clNext,
    int **wlines,
    CompileEnv *envPtr)
{
    ECL *ePtr;
    const char *last;
    size_t wordIdx, wordLine;
    int *wwlines, *wordNext;

    if (eclPtr->nuloc >= eclPtr->nloc) {
	/*
	 * Expand the ECL array by allocating more storage from the heap. The
	 * currently allocated ECL entries are stored from eclPtr->loc[0] up
	 * to eclPtr->loc[eclPtr->nuloc-1] (inclusive).







|


|
|






|







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

static void
EnterCmdWordData(
    ExtCmdLoc *eclPtr,		/* Points to the map environment structure in
				 * which to enter command location
				 * information. */
    Tcl_Size srcOffset,		/* Offset of first char of the command. */
    Tcl_Token *tokenPtr,
    const char *cmd,
    Tcl_Size numWords,
    Tcl_Size line,
    int *clNext,
    int **wlines,
    CompileEnv *envPtr)
{
    ECL *ePtr;
    const char *last;
    Tcl_Size wordIdx, wordLine;
    int *wwlines, *wordNext;

    if (eclPtr->nuloc >= eclPtr->nloc) {
	/*
	 * Expand the ECL array by allocating more storage from the heap. The
	 * currently allocated ECL entries are stored from eclPtr->loc[0] up
	 * to eclPtr->loc[eclPtr->nuloc-1] (inclusive).
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
 *	the array in expanded: a new array of double the size is allocated, if
 *	envPtr->mallocedExceptArray is non-zero the old array is freed, and
 *	ExceptionRange entries are copied from the old array to the new one.
 *
 *----------------------------------------------------------------------
 */

size_t
TclCreateExceptRange(
    ExceptionRangeType type,	/* The kind of ExceptionRange desired. */
    CompileEnv *envPtr)/* Points to CompileEnv for which to create a
				 * new ExceptionRange structure. */
{
    ExceptionRange *rangePtr;
    ExceptionAux *auxPtr;
    size_t index = envPtr->exceptArrayNext;

    if (index >= envPtr->exceptArrayEnd) {
	/*
	 * Expand the ExceptionRange array. The currently allocated entries
	 * are stored between elements 0 and (envPtr->exceptArrayNext - 1)
	 * [inclusive].
	 */







|







|







3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
 *	the array in expanded: a new array of double the size is allocated, if
 *	envPtr->mallocedExceptArray is non-zero the old array is freed, and
 *	ExceptionRange entries are copied from the old array to the new one.
 *
 *----------------------------------------------------------------------
 */

Tcl_Size
TclCreateExceptRange(
    ExceptionRangeType type,	/* The kind of ExceptionRange desired. */
    CompileEnv *envPtr)/* Points to CompileEnv for which to create a
				 * new ExceptionRange structure. */
{
    ExceptionRange *rangePtr;
    ExceptionAux *auxPtr;
    Tcl_Size index = envPtr->exceptArrayNext;

    if (index >= envPtr->exceptArrayEnd) {
	/*
	 * Expand the ExceptionRange array. The currently allocated entries
	 * are stored between elements 0 and (envPtr->exceptArrayNext - 1)
	 * [inclusive].
	 */
3728
3729
3730
3731
3732
3733
3734
3735
3736
3737
3738
3739
3740
3741
3742
3743
3744
3745
3746
3747
3748
3749
3750
3751
 *
 * Side effects:
 *	If there is not enough room in the CompileEnv's AuxData array, its size
 *	is doubled.
 *----------------------------------------------------------------------
 */

size_t
TclCreateAuxData(
    void *clientData,	/* The compilation auxiliary data to store in
				 * the new aux data record. */
    const AuxDataType *typePtr,	/* Pointer to the type to attach to this
				 * AuxData */
    CompileEnv *envPtr)/* Points to the CompileEnv for which a new
				 * aux data structure is to be allocated. */
{
    size_t index;			/* Index for the new AuxData structure. */
    AuxData *auxDataPtr;
				/* Points to the new AuxData structure */

    index = envPtr->auxDataArrayNext;
    if (index >= envPtr->auxDataArrayEnd) {
	/*
	 * Expand the AuxData array. The currently allocated entries are







|








|







3759
3760
3761
3762
3763
3764
3765
3766
3767
3768
3769
3770
3771
3772
3773
3774
3775
3776
3777
3778
3779
3780
3781
3782
 *
 * Side effects:
 *	If there is not enough room in the CompileEnv's AuxData array, its size
 *	is doubled.
 *----------------------------------------------------------------------
 */

Tcl_Size
TclCreateAuxData(
    void *clientData,	/* The compilation auxiliary data to store in
				 * the new aux data record. */
    const AuxDataType *typePtr,	/* Pointer to the type to attach to this
				 * AuxData */
    CompileEnv *envPtr)/* Points to the CompileEnv for which a new
				 * aux data structure is to be allocated. */
{
    Tcl_Size index;		/* Index for the new AuxData structure. */
    AuxData *auxDataPtr;
				/* Points to the new AuxData structure */

    index = envPtr->auxDataArrayNext;
    if (index >= envPtr->auxDataArrayEnd) {
	/*
	 * Expand the AuxData array. The currently allocated entries are
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
    ByteCode *codePtr,		/* ByteCode in which to encode envPtr's
				 * command location information. */
    unsigned char *startPtr)	/* Points to the first byte in codePtr's
				 * memory block where the location information
				 * is to be stored. */
{
    CmdLocation *mapPtr = envPtr->cmdMapPtr;
    size_t i, codeDelta, codeLen, srcLen, prevOffset;
    size_t numCmds = envPtr->numCommands;
    unsigned char *p = startPtr;
    int srcDelta;

    /*
     * Encode the code offset for each command as a sequence of deltas.
     */

    codePtr->codeDeltaStart = p;
    prevOffset = 0;
    for (i = 0;  i < numCmds;  i++) {
	codeDelta = mapPtr[i].codeOffset - prevOffset;
	if (codeDelta == TCL_INDEX_NONE) {
	    Tcl_Panic("EncodeCmdLocMap: bad code offset");
	} else if (codeDelta <= 127) {
	    TclStoreInt1AtPtr(codeDelta, p);
	    p++;
	} else {
	    TclStoreInt1AtPtr(0xFF, p);
	    p++;
	    TclStoreInt4AtPtr(codeDelta, p);
	    p += 4;
	}
	prevOffset = mapPtr[i].codeOffset;
    }

    /*
     * Encode the code length for each command.
     */

    codePtr->codeLengthStart = p;
    for (i = 0;  i < numCmds;  i++) {
	codeLen = mapPtr[i].numCodeBytes;
	if (codeLen == TCL_INDEX_NONE) {
	    Tcl_Panic("EncodeCmdLocMap: bad code length");
	} else if (codeLen <= 127) {
	    TclStoreInt1AtPtr(codeLen, p);
	    p++;
	} else {
	    TclStoreInt1AtPtr(0xFF, p);
	    p++;







|
|











|




















|







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
    ByteCode *codePtr,		/* ByteCode in which to encode envPtr's
				 * command location information. */
    unsigned char *startPtr)	/* Points to the first byte in codePtr's
				 * memory block where the location information
				 * is to be stored. */
{
    CmdLocation *mapPtr = envPtr->cmdMapPtr;
    Tcl_Size i, codeDelta, codeLen, srcLen, prevOffset;
    Tcl_Size numCmds = envPtr->numCommands;
    unsigned char *p = startPtr;
    int srcDelta;

    /*
     * Encode the code offset for each command as a sequence of deltas.
     */

    codePtr->codeDeltaStart = p;
    prevOffset = 0;
    for (i = 0;  i < numCmds;  i++) {
	codeDelta = mapPtr[i].codeOffset - prevOffset;
	if (codeDelta < 0) {
	    Tcl_Panic("EncodeCmdLocMap: bad code offset");
	} else if (codeDelta <= 127) {
	    TclStoreInt1AtPtr(codeDelta, p);
	    p++;
	} else {
	    TclStoreInt1AtPtr(0xFF, p);
	    p++;
	    TclStoreInt4AtPtr(codeDelta, p);
	    p += 4;
	}
	prevOffset = mapPtr[i].codeOffset;
    }

    /*
     * Encode the code length for each command.
     */

    codePtr->codeLengthStart = p;
    for (i = 0;  i < numCmds;  i++) {
	codeLen = mapPtr[i].numCodeBytes;
	if (codeLen < 0) {
	    Tcl_Panic("EncodeCmdLocMap: bad code length");
	} else if (codeLen <= 127) {
	    TclStoreInt1AtPtr(codeLen, p);
	    p++;
	} else {
	    TclStoreInt1AtPtr(0xFF, p);
	    p++;
4484
4485
4486
4487
4488
4489
4490
4491
4492
4493
4494
4495
4496
4497
4498
    /*
     * Encode the source length for each command.
     */

    codePtr->srcLengthStart = p;
    for (i = 0;  i < numCmds;  i++) {
	srcLen = mapPtr[i].numSrcBytes;
	if (srcLen == TCL_INDEX_NONE) {
	    Tcl_Panic("EncodeCmdLocMap: bad source length");
	} else if (srcLen <= 127) {
	    TclStoreInt1AtPtr(srcLen, p);
	    p++;
	} else {
	    TclStoreInt1AtPtr(0xFF, p);
	    p++;







|







4515
4516
4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
    /*
     * Encode the source length for each command.
     */

    codePtr->srcLengthStart = p;
    for (i = 0;  i < numCmds;  i++) {
	srcLen = mapPtr[i].numSrcBytes;
	if (srcLen < 0) {
	    Tcl_Panic("EncodeCmdLocMap: bad source length");
	} else if (srcLen <= 127) {
	    TclStoreInt1AtPtr(srcLen, p);
	    p++;
	} else {
	    TclStoreInt1AtPtr(0xFF, p);
	    p++;

Changes to generic/tclCompile.h.

440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
				 * code when new namespace resolution rules
				 * are put into effect. */
    Tcl_Size refCount;		/* Reference count: set 1 when created plus 1
				 * for each execution of the code currently
				 * active. This structure can be freed when
				 * refCount becomes zero. */
    unsigned int flags;		/* flags describing state for the codebyte.
				 * this variable holds ORed values from the
				 * TCL_BYTECODE_ masks defined above */
    const char *source;		/* The source string from which this ByteCode
				 * was compiled. Note that this pointer is not
				 * owned by the ByteCode and must not be freed
				 * or modified by it. */
    Proc *procPtr;		/* If the ByteCode was compiled from a
				 * procedure body, this is a pointer to its







|







440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
				 * code when new namespace resolution rules
				 * are put into effect. */
    Tcl_Size refCount;		/* Reference count: set 1 when created plus 1
				 * for each execution of the code currently
				 * active. This structure can be freed when
				 * refCount becomes zero. */
    unsigned int flags;		/* flags describing state for the codebyte.
				 * this variable holds OR'ed values from the
				 * TCL_BYTECODE_ masks defined above */
    const char *source;		/* The source string from which this ByteCode
				 * was compiled. Note that this pointer is not
				 * owned by the ByteCode and must not be freed
				 * or modified by it. */
    Proc *procPtr;		/* If the ByteCode was compiled from a
				 * procedure body, this is a pointer to its
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
 *----------------------------------------------------------------
 * Procedures shared among Tcl bytecode compilation and execution modules but
 * not used outside:
 *----------------------------------------------------------------
 */

MODULE_SCOPE int	TclAttemptCompileProc(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, size_t depth, Command *cmdPtr,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCleanupStackForBreakContinue(CompileEnv *envPtr,
			    ExceptionAux *auxPtr);
MODULE_SCOPE void	TclCompileCmdWord(Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, size_t count,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCompileExpr(Tcl_Interp *interp, const char *script,
			    size_t numBytes, CompileEnv *envPtr, int optimize);
MODULE_SCOPE void	TclCompileExprWords(Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, size_t numWords,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCompileInvocation(Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, Tcl_Obj *cmdObj, size_t numWords,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCompileScript(Tcl_Interp *interp,
			    const char *script, size_t numBytes,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCompileSyntaxError(Tcl_Interp *interp,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCompileTokens(Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, size_t count,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCompileVarSubst(Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, CompileEnv *envPtr);
MODULE_SCOPE size_t	TclCreateAuxData(void *clientData,
			    const AuxDataType *typePtr, CompileEnv *envPtr);
MODULE_SCOPE size_t	TclCreateExceptRange(ExceptionRangeType type,
			    CompileEnv *envPtr);
MODULE_SCOPE ExecEnv *	TclCreateExecEnv(Tcl_Interp *interp, size_t size);
MODULE_SCOPE Tcl_Obj *	TclCreateLiteral(Interp *iPtr, const char *bytes,
			    size_t length, TCL_HASH_TYPE hash, int *newPtr,
			    Namespace *nsPtr, int flags,
			    LiteralEntry **globalPtrPtr);
MODULE_SCOPE void	TclDeleteExecEnv(ExecEnv *eePtr);
MODULE_SCOPE void	TclDeleteLiteralTable(Tcl_Interp *interp,
			    LiteralTable *tablePtr);
MODULE_SCOPE void	TclEmitForwardJump(CompileEnv *envPtr,
			    TclJumpType jumpType, JumpFixup *jumpFixupPtr);
MODULE_SCOPE void	TclEmitInvoke(CompileEnv *envPtr, int opcode, ...);
MODULE_SCOPE ExceptionRange * TclGetExceptionRangeForPc(unsigned char *pc,
			    int catchOnly, ByteCode *codePtr);
MODULE_SCOPE void	TclExpandJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE int	TclNRExecuteByteCode(Tcl_Interp *interp,
			    ByteCode *codePtr);
MODULE_SCOPE Tcl_Obj *	TclFetchLiteral(CompileEnv *envPtr, TCL_HASH_TYPE index);
MODULE_SCOPE size_t	TclFindCompiledLocal(const char *name, size_t nameChars,
			    int create, CompileEnv *envPtr);
MODULE_SCOPE int	TclFixupForwardJump(CompileEnv *envPtr,
			    JumpFixup *jumpFixupPtr, int jumpDist,
			    int distThreshold);
MODULE_SCOPE void	TclFreeCompileEnv(CompileEnv *envPtr);
MODULE_SCOPE void	TclFreeJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE int	TclGetIndexFromToken(Tcl_Token *tokenPtr,
			    size_t before, size_t after, int *indexPtr);
MODULE_SCOPE ByteCode *	TclInitByteCode(CompileEnv *envPtr);
MODULE_SCOPE ByteCode *	TclInitByteCodeObj(Tcl_Obj *objPtr,
			    const Tcl_ObjType *typePtr, CompileEnv *envPtr);
MODULE_SCOPE void	TclInitCompileEnv(Tcl_Interp *interp,
			    CompileEnv *envPtr, const char *string,
			    size_t numBytes, const CmdFrame *invoker, int word);
MODULE_SCOPE void	TclInitJumpFixupArray(JumpFixupArray *fixupArrayPtr);







|







|







|








|

|



|













|
|







|







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
 *----------------------------------------------------------------
 * Procedures shared among Tcl bytecode compilation and execution modules but
 * not used outside:
 *----------------------------------------------------------------
 */

MODULE_SCOPE int	TclAttemptCompileProc(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Tcl_Size depth, Command *cmdPtr,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCleanupStackForBreakContinue(CompileEnv *envPtr,
			    ExceptionAux *auxPtr);
MODULE_SCOPE void	TclCompileCmdWord(Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, size_t count,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCompileExpr(Tcl_Interp *interp, const char *script,
			    Tcl_Size numBytes, CompileEnv *envPtr, int optimize);
MODULE_SCOPE void	TclCompileExprWords(Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, size_t numWords,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCompileInvocation(Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, Tcl_Obj *cmdObj, size_t numWords,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCompileScript(Tcl_Interp *interp,
			    const char *script, Tcl_Size numBytes,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCompileSyntaxError(Tcl_Interp *interp,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCompileTokens(Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, size_t count,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCompileVarSubst(Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, CompileEnv *envPtr);
MODULE_SCOPE Tcl_Size	TclCreateAuxData(void *clientData,
			    const AuxDataType *typePtr, CompileEnv *envPtr);
MODULE_SCOPE Tcl_Size	TclCreateExceptRange(ExceptionRangeType type,
			    CompileEnv *envPtr);
MODULE_SCOPE ExecEnv *	TclCreateExecEnv(Tcl_Interp *interp, size_t size);
MODULE_SCOPE Tcl_Obj *	TclCreateLiteral(Interp *iPtr, const char *bytes,
			    Tcl_Size length, size_t hash, int *newPtr,
			    Namespace *nsPtr, int flags,
			    LiteralEntry **globalPtrPtr);
MODULE_SCOPE void	TclDeleteExecEnv(ExecEnv *eePtr);
MODULE_SCOPE void	TclDeleteLiteralTable(Tcl_Interp *interp,
			    LiteralTable *tablePtr);
MODULE_SCOPE void	TclEmitForwardJump(CompileEnv *envPtr,
			    TclJumpType jumpType, JumpFixup *jumpFixupPtr);
MODULE_SCOPE void	TclEmitInvoke(CompileEnv *envPtr, int opcode, ...);
MODULE_SCOPE ExceptionRange * TclGetExceptionRangeForPc(unsigned char *pc,
			    int catchOnly, ByteCode *codePtr);
MODULE_SCOPE void	TclExpandJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE int	TclNRExecuteByteCode(Tcl_Interp *interp,
			    ByteCode *codePtr);
MODULE_SCOPE Tcl_Obj *	TclFetchLiteral(CompileEnv *envPtr, Tcl_Size index);
MODULE_SCOPE Tcl_Size	TclFindCompiledLocal(const char *name, Tcl_Size nameChars,
			    int create, CompileEnv *envPtr);
MODULE_SCOPE int	TclFixupForwardJump(CompileEnv *envPtr,
			    JumpFixup *jumpFixupPtr, int jumpDist,
			    int distThreshold);
MODULE_SCOPE void	TclFreeCompileEnv(CompileEnv *envPtr);
MODULE_SCOPE void	TclFreeJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE int	TclGetIndexFromToken(Tcl_Token *tokenPtr,
			    int before, int after, int *indexPtr);
MODULE_SCOPE ByteCode *	TclInitByteCode(CompileEnv *envPtr);
MODULE_SCOPE ByteCode *	TclInitByteCodeObj(Tcl_Obj *objPtr,
			    const Tcl_ObjType *typePtr, CompileEnv *envPtr);
MODULE_SCOPE void	TclInitCompileEnv(Tcl_Interp *interp,
			    CompileEnv *envPtr, const char *string,
			    size_t numBytes, const CmdFrame *invoker, int word);
MODULE_SCOPE void	TclInitJumpFixupArray(JumpFixupArray *fixupArrayPtr);
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
#ifdef TCL_COMPILE_DEBUG
MODULE_SCOPE void	TclPrintByteCodeObj(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
#endif
MODULE_SCOPE int	TclPrintInstruction(ByteCode *codePtr,
			    const unsigned char *pc);
MODULE_SCOPE void	TclPrintObject(FILE *outFile,
			    Tcl_Obj *objPtr, size_t maxChars);
MODULE_SCOPE void	TclPrintSource(FILE *outFile,
			    const char *string, size_t maxChars);
MODULE_SCOPE void	TclPushVarName(Tcl_Interp *interp,
			    Tcl_Token *varTokenPtr, CompileEnv *envPtr,
			    int flags, int *localIndexPtr,
			    int *isScalarPtr);
MODULE_SCOPE void	TclPreserveByteCode(ByteCode *codePtr);
MODULE_SCOPE void	TclReleaseByteCode(ByteCode *codePtr);
MODULE_SCOPE void	TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr);







|

|







1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
#ifdef TCL_COMPILE_DEBUG
MODULE_SCOPE void	TclPrintByteCodeObj(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
#endif
MODULE_SCOPE int	TclPrintInstruction(ByteCode *codePtr,
			    const unsigned char *pc);
MODULE_SCOPE void	TclPrintObject(FILE *outFile,
			    Tcl_Obj *objPtr, Tcl_Size maxChars);
MODULE_SCOPE void	TclPrintSource(FILE *outFile,
			    const char *string, Tcl_Size maxChars);
MODULE_SCOPE void	TclPushVarName(Tcl_Interp *interp,
			    Tcl_Token *varTokenPtr, CompileEnv *envPtr,
			    int flags, int *localIndexPtr,
			    int *isScalarPtr);
MODULE_SCOPE void	TclPreserveByteCode(ByteCode *codePtr);
MODULE_SCOPE void	TclReleaseByteCode(ByteCode *codePtr);
MODULE_SCOPE void	TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr);
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
MODULE_SCOPE void	TclVerifyGlobalLiteralTable(Interp *iPtr);
MODULE_SCOPE void	TclVerifyLocalLiteralTable(CompileEnv *envPtr);
#endif
MODULE_SCOPE int	TclWordKnownAtCompileTime(Tcl_Token *tokenPtr,
			    Tcl_Obj *valuePtr);
MODULE_SCOPE void	TclLogCommandInfo(Tcl_Interp *interp,
			    const char *script, const char *command,
			    size_t length, const unsigned char *pc,
			    Tcl_Obj **tosPtr);
MODULE_SCOPE Tcl_Obj	*TclGetInnerContext(Tcl_Interp *interp,
			    const unsigned char *pc, Tcl_Obj **tosPtr);
MODULE_SCOPE Tcl_Obj	*TclNewInstNameObj(unsigned char inst);
MODULE_SCOPE int	TclPushProcCallFrame(void *clientData,
			    Tcl_Interp *interp, size_t objc,
			    Tcl_Obj *const objv[], int isLambda);
#endif /* TCL_MAJOR_VERSION > 8 */


/*
 *----------------------------------------------------------------
 * Macros and flag values used by Tcl bytecode compilation and execution







|





|







1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
MODULE_SCOPE void	TclVerifyGlobalLiteralTable(Interp *iPtr);
MODULE_SCOPE void	TclVerifyLocalLiteralTable(CompileEnv *envPtr);
#endif
MODULE_SCOPE int	TclWordKnownAtCompileTime(Tcl_Token *tokenPtr,
			    Tcl_Obj *valuePtr);
MODULE_SCOPE void	TclLogCommandInfo(Tcl_Interp *interp,
			    const char *script, const char *command,
			    Tcl_Size length, const unsigned char *pc,
			    Tcl_Obj **tosPtr);
MODULE_SCOPE Tcl_Obj	*TclGetInnerContext(Tcl_Interp *interp,
			    const unsigned char *pc, Tcl_Obj **tosPtr);
MODULE_SCOPE Tcl_Obj	*TclNewInstNameObj(unsigned char inst);
MODULE_SCOPE int	TclPushProcCallFrame(void *clientData,
			    Tcl_Interp *interp, Tcl_Size objc,
			    Tcl_Obj *const objv[], int isLambda);
#endif /* TCL_MAJOR_VERSION > 8 */


/*
 *----------------------------------------------------------------
 * Macros and flag values used by Tcl bytecode compilation and execution
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827

#define TCL_DTRACE_DEBUG_LOG() \
    int tclDTraceDebugEnabled = TCL_DTRACE_DEBUG_LOG_ENABLED;	\
    int tclDTraceDebugIndent = 0;				\
    FILE *tclDTraceDebugLog = NULL;				\
    void TclDTraceOpenDebugLog(void) {				\
	char n[35];						\
	sprintf(n, "/tmp/tclDTraceDebug-%" TCL_Z_MODIFIER "u.log", \
		(size_t) getpid());			\
	tclDTraceDebugLog = fopen(n, "a");			\
    }

#define TclDTraceDbgMsg(p, m, ...) \
    do {								\
	if (tclDTraceDebugEnabled) {					\







|







1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827

#define TCL_DTRACE_DEBUG_LOG() \
    int tclDTraceDebugEnabled = TCL_DTRACE_DEBUG_LOG_ENABLED;	\
    int tclDTraceDebugIndent = 0;				\
    FILE *tclDTraceDebugLog = NULL;				\
    void TclDTraceOpenDebugLog(void) {				\
	char n[35];						\
	snprintf(n, sizeof(n), "/tmp/tclDTraceDebug-%" TCL_Z_MODIFIER "u.log", \
		(size_t) getpid());			\
	tclDTraceDebugLog = fopen(n, "a");			\
    }

#define TclDTraceDbgMsg(p, m, ...) \
    do {								\
	if (tclDTraceDebugEnabled) {					\

Changes to generic/tclConfig.c.

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

static int
QueryConfigObjCmd(
    void *clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    QCCD *cdPtr = (QCCD *)clientData;
    Tcl_Obj *pkgName = cdPtr->pkg;
    Tcl_Obj *pDB, *pkgDict, *val, *listPtr;
    size_t m, n = 0;
    static const char *const subcmdStrings[] = {
	"get", "list", NULL
    };
    enum subcmds {
	CFG_GET, CFG_LIST
    } index;
    Tcl_DString conv;







|

















|







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
 *
 * QueryConfigObjCmd --
 *
 *	Implementation of "::<package>::pkgconfig", the command to query
 *	configuration information embedded into a library.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the manual for what this command does.
 *
 *----------------------------------------------------------------------
 */

static int
QueryConfigObjCmd(
    void *clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    QCCD *cdPtr = (QCCD *)clientData;
    Tcl_Obj *pkgName = cdPtr->pkg;
    Tcl_Obj *pDB, *pkgDict, *val, *listPtr;
    Tcl_Size m, n = 0;
    static const char *const subcmdStrings[] = {
	"get", "list", NULL
    };
    enum subcmds {
	CFG_GET, CFG_LIST
    } index;
    Tcl_DString conv;
254
255
256
257
258
259
260
261



262
263
264
265
266
267
268
		return TCL_ERROR;
	    }
	}
	/*
	 * Value is stored as-is in a byte array, see Bug [9b2e636361],
	 * so we have to decode it first.
	 */
	value = (const char *) Tcl_GetByteArrayFromObj(val, &n);



	value = Tcl_ExternalToUtfDString(venc, value, n, &conv);
	Tcl_SetObjResult(interp, Tcl_NewStringObj(value,
		Tcl_DStringLength(&conv)));
	Tcl_DStringFree(&conv);
	return TCL_OK;

    case CFG_LIST:







|
>
>
>







254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
		return TCL_ERROR;
	    }
	}
	/*
	 * Value is stored as-is in a byte array, see Bug [9b2e636361],
	 * so we have to decode it first.
	 */
	value = (const char *) Tcl_GetBytesFromObj(interp, val, &n);
	if (value == NULL) {
	    return TCL_ERROR;
	}
	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.

2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
    { "bt",	tZONE,	  -HOUR( 3) },	    /* Baghdad, USSR Zone 2 */
    { "it",	tZONE,	  -HOUR( 7/2) },    /* Iran */
    { "zp4",	tZONE,	  -HOUR( 4) },	    /* USSR Zone 3 */
    { "zp5",	tZONE,	  -HOUR( 5) },	    /* USSR Zone 4 */
    { "ist",	tZONE,	  -HOUR(11/2) },    /* Indian Standard */
    { "zp6",	tZONE,	  -HOUR( 6) },	    /* USSR Zone 5 */
#if	0
    /* For completeness.  NST is also Newfoundland Stanard, nad SST is
     * also Swedish Summer. */
    { "nst",	tZONE,	  -HOUR(13/2) },    /* North Sumatra */
    { "sst",	tZONE,	  -HOUR( 7) },	    /* South Sumatra, USSR Zone 6 */
#endif	/* 0 */
    { "wast",	tZONE,	  -HOUR( 7) },	    /* West Australian Standard */
    { "wadt",	tDAYZONE, -HOUR( 7) },	    /* West Australian Daylight */
    { "jt",	tZONE,	  -HOUR(15/2) },    /* Java (3pm in Cronusland!) */







|







2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
    { "bt",	tZONE,	  -HOUR( 3) },	    /* Baghdad, USSR Zone 2 */
    { "it",	tZONE,	  -HOUR( 7/2) },    /* Iran */
    { "zp4",	tZONE,	  -HOUR( 4) },	    /* USSR Zone 3 */
    { "zp5",	tZONE,	  -HOUR( 5) },	    /* USSR Zone 4 */
    { "ist",	tZONE,	  -HOUR(11/2) },    /* Indian Standard */
    { "zp6",	tZONE,	  -HOUR( 6) },	    /* USSR Zone 5 */
#if	0
    /* For completeness.  NST is also Newfoundland Standard, and SST is
     * also Swedish Summer. */
    { "nst",	tZONE,	  -HOUR(13/2) },    /* North Sumatra */
    { "sst",	tZONE,	  -HOUR( 7) },	    /* South Sumatra, USSR Zone 6 */
#endif	/* 0 */
    { "wast",	tZONE,	  -HOUR( 7) },	    /* West Australian Standard */
    { "wadt",	tDAYZONE, -HOUR( 7) },	    /* West Australian Daylight */
    { "jt",	tZONE,	  -HOUR(15/2) },    /* Java (3pm in Cronusland!) */

Changes to generic/tclDecls.h.

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
EXTERN int		Tcl_GetBoolean(Tcl_Interp *interp, const char *src,
				int *intPtr);
/* 32 */
EXTERN int		Tcl_GetBooleanFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, int *intPtr);
/* 33 */
EXTERN unsigned char *	TclGetByteArrayFromObj(Tcl_Obj *objPtr,
				int *numBytesPtr);
/* 34 */
EXTERN int		Tcl_GetDouble(Tcl_Interp *interp, const char *src,
				double *doublePtr);
/* 35 */
EXTERN int		Tcl_GetDoubleFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, double *doublePtr);
/* Slot 36 is reserved */
/* 37 */
EXTERN int		Tcl_GetInt(Tcl_Interp *interp, const char *src,
				int *intPtr);
/* 38 */
EXTERN int		Tcl_GetIntFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, int *intPtr);
/* 39 */
EXTERN int		Tcl_GetLongFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, long *longPtr);
/* 40 */
EXTERN const Tcl_ObjType * Tcl_GetObjType(const char *typeName);
/* 41 */
EXTERN char *		TclGetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr);
/* 42 */
EXTERN void		Tcl_InvalidateStringRep(Tcl_Obj *objPtr);
/* 43 */
EXTERN int		Tcl_ListObjAppendList(Tcl_Interp *interp,
				Tcl_Obj *listPtr, Tcl_Obj *elemListPtr);
/* 44 */
EXTERN int		Tcl_ListObjAppendElement(Tcl_Interp *interp,
				Tcl_Obj *listPtr, Tcl_Obj *objPtr);
/* 45 */
EXTERN int		TclListObjGetElements(Tcl_Interp *interp,
				Tcl_Obj *listPtr, int *objcPtr,
				Tcl_Obj ***objvPtr);
/* 46 */
EXTERN int		Tcl_ListObjIndex(Tcl_Interp *interp,
				Tcl_Obj *listPtr, Tcl_Size index,
				Tcl_Obj **objPtrPtr);
/* 47 */
EXTERN int		TclListObjLength(Tcl_Interp *interp,
				Tcl_Obj *listPtr, int *lengthPtr);
/* 48 */
EXTERN int		Tcl_ListObjReplace(Tcl_Interp *interp,
				Tcl_Obj *listPtr, Tcl_Size first,
				Tcl_Size count, Tcl_Size objc,
				Tcl_Obj *const objv[]);
/* Slot 49 is reserved */
/* 50 */







|



















|










|







|







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
EXTERN int		Tcl_GetBoolean(Tcl_Interp *interp, const char *src,
				int *intPtr);
/* 32 */
EXTERN int		Tcl_GetBooleanFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, int *intPtr);
/* 33 */
EXTERN unsigned char *	TclGetByteArrayFromObj(Tcl_Obj *objPtr,
				void *numBytesPtr);
/* 34 */
EXTERN int		Tcl_GetDouble(Tcl_Interp *interp, const char *src,
				double *doublePtr);
/* 35 */
EXTERN int		Tcl_GetDoubleFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, double *doublePtr);
/* Slot 36 is reserved */
/* 37 */
EXTERN int		Tcl_GetInt(Tcl_Interp *interp, const char *src,
				int *intPtr);
/* 38 */
EXTERN int		Tcl_GetIntFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, int *intPtr);
/* 39 */
EXTERN int		Tcl_GetLongFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, long *longPtr);
/* 40 */
EXTERN const Tcl_ObjType * Tcl_GetObjType(const char *typeName);
/* 41 */
EXTERN char *		TclGetStringFromObj(Tcl_Obj *objPtr, void *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,
				Tcl_Obj *listPtr, Tcl_Obj *objPtr);
/* 45 */
EXTERN int		TclListObjGetElements(Tcl_Interp *interp,
				Tcl_Obj *listPtr, void *objcPtr,
				Tcl_Obj ***objvPtr);
/* 46 */
EXTERN int		Tcl_ListObjIndex(Tcl_Interp *interp,
				Tcl_Obj *listPtr, Tcl_Size index,
				Tcl_Obj **objPtrPtr);
/* 47 */
EXTERN int		TclListObjLength(Tcl_Interp *interp,
				Tcl_Obj *listPtr, void *lengthPtr);
/* 48 */
EXTERN int		Tcl_ListObjReplace(Tcl_Interp *interp,
				Tcl_Obj *listPtr, Tcl_Size first,
				Tcl_Size count, Tcl_Size objc,
				Tcl_Obj *const objv[]);
/* Slot 49 is reserved */
/* 50 */
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
/* 97 */
EXTERN Tcl_Interp *	Tcl_CreateChild(Tcl_Interp *interp, const char *name,
				int isSafe);
/* 98 */
EXTERN Tcl_TimerToken	Tcl_CreateTimerHandler(int milliseconds,
				Tcl_TimerProc *proc, void *clientData);
/* 99 */
EXTERN Tcl_Trace	Tcl_CreateTrace(Tcl_Interp *interp, int level,
				Tcl_CmdTraceProc *proc, void *clientData);
/* 100 */
EXTERN void		Tcl_DeleteAssocData(Tcl_Interp *interp,
				const char *name);
/* 101 */
EXTERN void		Tcl_DeleteChannelHandler(Tcl_Channel chan,
				Tcl_ChannelProc *proc, void *clientData);







|







302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
/* 97 */
EXTERN Tcl_Interp *	Tcl_CreateChild(Tcl_Interp *interp, const char *name,
				int isSafe);
/* 98 */
EXTERN Tcl_TimerToken	Tcl_CreateTimerHandler(int milliseconds,
				Tcl_TimerProc *proc, void *clientData);
/* 99 */
EXTERN Tcl_Trace	Tcl_CreateTrace(Tcl_Interp *interp, Tcl_Size level,
				Tcl_CmdTraceProc *proc, void *clientData);
/* 100 */
EXTERN void		Tcl_DeleteAssocData(Tcl_Interp *interp,
				const char *name);
/* 101 */
EXTERN void		Tcl_DeleteChannelHandler(Tcl_Channel chan,
				Tcl_ChannelProc *proc, void *clientData);
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
EXTERN const char *	Tcl_SignalId(int sig);
/* 240 */
EXTERN const char *	Tcl_SignalMsg(int sig);
/* 241 */
EXTERN void		Tcl_SourceRCFile(Tcl_Interp *interp);
/* 242 */
EXTERN int		TclSplitList(Tcl_Interp *interp, const char *listStr,
				int *argcPtr, const char ***argvPtr);
/* 243 */
EXTERN void		TclSplitPath(const char *path, int *argcPtr,
				const char ***argvPtr);
/* Slot 244 is reserved */
/* Slot 245 is reserved */
/* Slot 246 is reserved */
/* Slot 247 is reserved */
/* 248 */
EXTERN int		Tcl_TraceVar2(Tcl_Interp *interp, const char *part1,







|

|







661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
EXTERN const char *	Tcl_SignalId(int sig);
/* 240 */
EXTERN const char *	Tcl_SignalMsg(int sig);
/* 241 */
EXTERN void		Tcl_SourceRCFile(Tcl_Interp *interp);
/* 242 */
EXTERN int		TclSplitList(Tcl_Interp *interp, const char *listStr,
				void *argcPtr, const char ***argvPtr);
/* 243 */
EXTERN void		TclSplitPath(const char *path, void *argcPtr,
				const char ***argvPtr);
/* Slot 244 is reserved */
/* Slot 245 is reserved */
/* Slot 246 is reserved */
/* Slot 247 is reserved */
/* 248 */
EXTERN int		Tcl_TraceVar2(Tcl_Interp *interp, const char *part1,
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
/* 321 */
EXTERN int		Tcl_UniCharToLower(int ch);
/* 322 */
EXTERN int		Tcl_UniCharToTitle(int ch);
/* 323 */
EXTERN int		Tcl_UniCharToUpper(int ch);
/* 324 */
EXTERN int		Tcl_UniCharToUtf(int ch, char *buf);
/* 325 */
EXTERN const char *	TclUtfAtIndex(const char *src, Tcl_Size index);
/* 326 */
EXTERN int		TclUtfCharComplete(const char *src, Tcl_Size length);
/* 327 */
EXTERN Tcl_Size		Tcl_UtfBackslash(const char *src, int *readPtr,
				char *dst);







|







856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
/* 321 */
EXTERN int		Tcl_UniCharToLower(int ch);
/* 322 */
EXTERN int		Tcl_UniCharToTitle(int ch);
/* 323 */
EXTERN int		Tcl_UniCharToUpper(int ch);
/* 324 */
EXTERN Tcl_Size		Tcl_UniCharToUtf(int ch, char *buf);
/* 325 */
EXTERN const char *	TclUtfAtIndex(const char *src, Tcl_Size index);
/* 326 */
EXTERN int		TclUtfCharComplete(const char *src, Tcl_Size length);
/* 327 */
EXTERN Tcl_Size		Tcl_UtfBackslash(const char *src, int *readPtr,
				char *dst);
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
				Tcl_Size dstLen, int *srcReadPtr,
				int *dstWrotePtr, int *dstCharsPtr);
/* 333 */
EXTERN char *		Tcl_UtfToExternalDString(Tcl_Encoding encoding,
				const char *src, Tcl_Size srcLen,
				Tcl_DString *dsPtr);
/* 334 */
EXTERN int		Tcl_UtfToLower(char *src);
/* 335 */
EXTERN int		Tcl_UtfToTitle(char *src);
/* 336 */
EXTERN int		Tcl_UtfToChar16(const char *src,
				unsigned short *chPtr);
/* 337 */
EXTERN int		Tcl_UtfToUpper(char *src);
/* 338 */
EXTERN Tcl_Size		Tcl_WriteChars(Tcl_Channel chan, const char *src,
				Tcl_Size srcLen);
/* 339 */
EXTERN Tcl_Size		Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr);
/* 340 */
EXTERN char *		Tcl_GetString(Tcl_Obj *objPtr);







|

|

|


|







884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
				Tcl_Size dstLen, int *srcReadPtr,
				int *dstWrotePtr, int *dstCharsPtr);
/* 333 */
EXTERN char *		Tcl_UtfToExternalDString(Tcl_Encoding encoding,
				const char *src, Tcl_Size srcLen,
				Tcl_DString *dsPtr);
/* 334 */
EXTERN Tcl_Size		Tcl_UtfToLower(char *src);
/* 335 */
EXTERN Tcl_Size		Tcl_UtfToTitle(char *src);
/* 336 */
EXTERN Tcl_Size		Tcl_UtfToChar16(const char *src,
				unsigned short *chPtr);
/* 337 */
EXTERN Tcl_Size		Tcl_UtfToUpper(char *src);
/* 338 */
EXTERN Tcl_Size		Tcl_WriteChars(Tcl_Channel chan, const char *src,
				Tcl_Size srcLen);
/* 339 */
EXTERN Tcl_Size		Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr);
/* 340 */
EXTERN char *		Tcl_GetString(Tcl_Obj *objPtr);
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
/* 391 */
EXTERN void		Tcl_ConditionFinalize(Tcl_Condition *condPtr);
/* 392 */
EXTERN void		Tcl_MutexFinalize(Tcl_Mutex *mutex);
/* 393 */
EXTERN int		Tcl_CreateThread(Tcl_ThreadId *idPtr,
				Tcl_ThreadCreateProc *proc, void *clientData,
				Tcl_Size stackSize, int flags);
/* 394 */
EXTERN Tcl_Size		Tcl_ReadRaw(Tcl_Channel chan, char *dst,
				Tcl_Size bytesToRead);
/* 395 */
EXTERN Tcl_Size		Tcl_WriteRaw(Tcl_Channel chan, const char *src,
				Tcl_Size srcLen);
/* 396 */







|







1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
/* 391 */
EXTERN void		Tcl_ConditionFinalize(Tcl_Condition *condPtr);
/* 392 */
EXTERN void		Tcl_MutexFinalize(Tcl_Mutex *mutex);
/* 393 */
EXTERN int		Tcl_CreateThread(Tcl_ThreadId *idPtr,
				Tcl_ThreadCreateProc *proc, void *clientData,
				TCL_HASH_TYPE stackSize, int flags);
/* 394 */
EXTERN Tcl_Size		Tcl_ReadRaw(Tcl_Channel chan, char *dst,
				Tcl_Size bytesToRead);
/* 395 */
EXTERN Tcl_Size		Tcl_WriteRaw(Tcl_Channel chan, const char *src,
				Tcl_Size srcLen);
/* 396 */
1133
1134
1135
1136
1137
1138
1139
1140

1141
1142
1143
1144
1145
1146
1147
				const char *file, int line);
/* 432 */
EXTERN int		Tcl_AttemptSetObjLength(Tcl_Obj *objPtr,
				Tcl_Size length);
/* 433 */
EXTERN Tcl_ThreadId	Tcl_GetChannelThread(Tcl_Channel channel);
/* 434 */
EXTERN Tcl_UniChar *	TclGetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr);

/* Slot 435 is reserved */
/* Slot 436 is reserved */
/* 437 */
EXTERN Tcl_Obj *	Tcl_SubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
				int flags);
/* 438 */
EXTERN int		Tcl_DetachChannel(Tcl_Interp *interp,







|
>







1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
				const char *file, int line);
/* 432 */
EXTERN int		Tcl_AttemptSetObjLength(Tcl_Obj *objPtr,
				Tcl_Size length);
/* 433 */
EXTERN Tcl_ThreadId	Tcl_GetChannelThread(Tcl_Channel channel);
/* 434 */
EXTERN Tcl_UniChar *	TclGetUnicodeFromObj(Tcl_Obj *objPtr,
				void *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,
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
EXTERN int		Tcl_FSChdir(Tcl_Obj *pathPtr);
/* 459 */
EXTERN int		Tcl_FSConvertToPathType(Tcl_Interp *interp,
				Tcl_Obj *pathPtr);
/* 460 */
EXTERN Tcl_Obj *	Tcl_FSJoinPath(Tcl_Obj *listObj, Tcl_Size elements);
/* 461 */
EXTERN Tcl_Obj *	TclFSSplitPath(Tcl_Obj *pathPtr, int *lenPtr);
/* 462 */
EXTERN int		Tcl_FSEqualPaths(Tcl_Obj *firstPtr,
				Tcl_Obj *secondPtr);
/* 463 */
EXTERN Tcl_Obj *	Tcl_FSGetNormalizedPath(Tcl_Interp *interp,
				Tcl_Obj *pathPtr);
/* 464 */







|







1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
EXTERN int		Tcl_FSChdir(Tcl_Obj *pathPtr);
/* 459 */
EXTERN int		Tcl_FSConvertToPathType(Tcl_Interp *interp,
				Tcl_Obj *pathPtr);
/* 460 */
EXTERN Tcl_Obj *	Tcl_FSJoinPath(Tcl_Obj *listObj, Tcl_Size elements);
/* 461 */
EXTERN Tcl_Obj *	TclFSSplitPath(Tcl_Obj *pathPtr, void *lenPtr);
/* 462 */
EXTERN int		Tcl_FSEqualPaths(Tcl_Obj *firstPtr,
				Tcl_Obj *secondPtr);
/* 463 */
EXTERN Tcl_Obj *	Tcl_FSGetNormalizedPath(Tcl_Interp *interp,
				Tcl_Obj *pathPtr);
/* 464 */
1259
1260
1261
1262
1263
1264
1265
1266

1267
1268
1269
1270
1271
1272
1273
1274
EXTERN void		Tcl_FSMountsChanged(const Tcl_Filesystem *fsPtr);
/* 481 */
EXTERN int		Tcl_EvalTokensStandard(Tcl_Interp *interp,
				Tcl_Token *tokenPtr, Tcl_Size count);
/* 482 */
EXTERN void		Tcl_GetTime(Tcl_Time *timeBuf);
/* 483 */
EXTERN Tcl_Trace	Tcl_CreateObjTrace(Tcl_Interp *interp, int level,

				int flags, Tcl_CmdObjTraceProc *objProc,
				void *clientData,
				Tcl_CmdObjTraceDeleteProc *delProc);
/* 484 */
EXTERN int		Tcl_GetCommandInfoFromToken(Tcl_Command token,
				Tcl_CmdInfo *infoPtr);
/* 485 */
EXTERN int		Tcl_SetCommandInfoFromToken(Tcl_Command token,







|
>
|







1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
EXTERN void		Tcl_FSMountsChanged(const Tcl_Filesystem *fsPtr);
/* 481 */
EXTERN int		Tcl_EvalTokensStandard(Tcl_Interp *interp,
				Tcl_Token *tokenPtr, Tcl_Size count);
/* 482 */
EXTERN void		Tcl_GetTime(Tcl_Time *timeBuf);
/* 483 */
EXTERN Tcl_Trace	Tcl_CreateObjTrace(Tcl_Interp *interp,
				Tcl_Size level, int flags,
				Tcl_CmdObjTraceProc *objProc,
				void *clientData,
				Tcl_CmdObjTraceDeleteProc *delProc);
/* 484 */
EXTERN int		Tcl_GetCommandInfoFromToken(Tcl_Command token,
				Tcl_CmdInfo *infoPtr);
/* 485 */
EXTERN int		Tcl_SetCommandInfoFromToken(Tcl_Command token,
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
EXTERN int		Tcl_DictObjGet(Tcl_Interp *interp, Tcl_Obj *dictPtr,
				Tcl_Obj *keyPtr, Tcl_Obj **valuePtrPtr);
/* 496 */
EXTERN int		Tcl_DictObjRemove(Tcl_Interp *interp,
				Tcl_Obj *dictPtr, Tcl_Obj *keyPtr);
/* 497 */
EXTERN int		TclDictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr,
				int *sizePtr);
/* 498 */
EXTERN int		Tcl_DictObjFirst(Tcl_Interp *interp,
				Tcl_Obj *dictPtr, Tcl_DictSearch *searchPtr,
				Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr,
				int *donePtr);
/* 499 */
EXTERN void		Tcl_DictObjNext(Tcl_DictSearch *searchPtr,







|







1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
EXTERN int		Tcl_DictObjGet(Tcl_Interp *interp, Tcl_Obj *dictPtr,
				Tcl_Obj *keyPtr, Tcl_Obj **valuePtrPtr);
/* 496 */
EXTERN int		Tcl_DictObjRemove(Tcl_Interp *interp,
				Tcl_Obj *dictPtr, Tcl_Obj *keyPtr);
/* 497 */
EXTERN int		TclDictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr,
				void *sizePtr);
/* 498 */
EXTERN int		Tcl_DictObjFirst(Tcl_Interp *interp,
				Tcl_Obj *dictPtr, Tcl_DictSearch *searchPtr,
				Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr,
				int *donePtr);
/* 499 */
EXTERN void		Tcl_DictObjNext(Tcl_DictSearch *searchPtr,
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
EXTERN int		Tcl_SetEnsembleParameterList(Tcl_Interp *interp,
				Tcl_Command token, Tcl_Obj *paramList);
/* 603 */
EXTERN int		Tcl_GetEnsembleParameterList(Tcl_Interp *interp,
				Tcl_Command token, Tcl_Obj **paramListPtr);
/* 604 */
EXTERN int		TclParseArgsObjv(Tcl_Interp *interp,
				const Tcl_ArgvInfo *argTable, int *objcPtr,
				Tcl_Obj *const *objv, Tcl_Obj ***remObjv);
/* 605 */
EXTERN int		Tcl_GetErrorLine(Tcl_Interp *interp);
/* 606 */
EXTERN void		Tcl_SetErrorLine(Tcl_Interp *interp, int lineNum);
/* 607 */
EXTERN void		Tcl_TransferResult(Tcl_Interp *sourceInterp,







|







1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
EXTERN int		Tcl_SetEnsembleParameterList(Tcl_Interp *interp,
				Tcl_Command token, Tcl_Obj *paramList);
/* 603 */
EXTERN int		Tcl_GetEnsembleParameterList(Tcl_Interp *interp,
				Tcl_Command token, Tcl_Obj **paramListPtr);
/* 604 */
EXTERN int		TclParseArgsObjv(Tcl_Interp *interp,
				const Tcl_ArgvInfo *argTable, void *objcPtr,
				Tcl_Obj *const *objv, Tcl_Obj ***remObjv);
/* 605 */
EXTERN int		Tcl_GetErrorLine(Tcl_Interp *interp);
/* 606 */
EXTERN void		Tcl_SetErrorLine(Tcl_Interp *interp, int lineNum);
/* 607 */
EXTERN void		Tcl_TransferResult(Tcl_Interp *sourceInterp,
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
				const char *varName, void *addr, int type,
				Tcl_Size size);
/* 645 */
EXTERN int		Tcl_GetIntForIndex(Tcl_Interp *interp,
				Tcl_Obj *objPtr, Tcl_Size endValue,
				Tcl_Size *indexPtr);
/* 646 */
EXTERN int		Tcl_UtfToUniChar(const char *src, int *chPtr);
/* 647 */
EXTERN char *		Tcl_UniCharToUtfDString(const int *uniStr,
				Tcl_Size uniLength, Tcl_DString *dsPtr);
/* 648 */
EXTERN int *		Tcl_UtfToUniCharDString(const char *src,
				Tcl_Size length, Tcl_DString *dsPtr);
/* 649 */
EXTERN unsigned char *	TclGetBytesFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, int *numBytesPtr);
/* 650 */
EXTERN unsigned char *	Tcl_GetBytesFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, size_t *numBytesPtr);
/* 651 */
EXTERN char *		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 *numBytesPtr);
/* 654 */
EXTERN int		Tcl_UtfCharComplete(const char *src, Tcl_Size length);
/* 655 */
EXTERN const char *	Tcl_UtfNext(const char *src);
/* 656 */
EXTERN const char *	Tcl_UtfPrev(const char *src, const char *start);
/* 657 */
EXTERN int		Tcl_UniCharIsUnicode(int ch);
/* 658 */
EXTERN Tcl_Size		Tcl_ExternalToUtfDStringEx(Tcl_Encoding encoding,

				const char *src, Tcl_Size srcLen, int flags,
				Tcl_DString *dsPtr);

/* 659 */
EXTERN Tcl_Size		Tcl_UtfToExternalDStringEx(Tcl_Encoding encoding,

				const char *src, Tcl_Size srcLen, int flags,
				Tcl_DString *dsPtr);

/* 660 */
EXTERN int		Tcl_AsyncMarkFromSignal(Tcl_AsyncHandler async,
				int sigNumber);
/* 661 */
EXTERN int		Tcl_ListObjGetElements(Tcl_Interp *interp,
				Tcl_Obj *listPtr, size_t *objcPtr,
				Tcl_Obj ***objvPtr);
/* 662 */
EXTERN int		Tcl_ListObjLength(Tcl_Interp *interp,
				Tcl_Obj *listPtr, size_t *lengthPtr);
/* 663 */
EXTERN int		Tcl_DictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr,
				size_t *sizePtr);
/* 664 */
EXTERN int		Tcl_SplitList(Tcl_Interp *interp,
				const char *listStr, size_t *argcPtr,
				const char ***argvPtr);
/* 665 */
EXTERN void		Tcl_SplitPath(const char *path, size_t *argcPtr,
				const char ***argvPtr);
/* 666 */
EXTERN Tcl_Obj *	Tcl_FSSplitPath(Tcl_Obj *pathPtr, size_t *lenPtr);
/* 667 */
EXTERN int		Tcl_ParseArgsObjv(Tcl_Interp *interp,
				const Tcl_ArgvInfo *argTable,
				size_t *objcPtr, Tcl_Obj *const *objv,
				Tcl_Obj ***remObjv);
/* 668 */
EXTERN Tcl_Size		Tcl_UniCharLen(const int *uniStr);
/* 669 */
EXTERN Tcl_Size		Tcl_NumUtfChars(const char *src, Tcl_Size length);
/* 670 */
EXTERN Tcl_Size		Tcl_GetCharLength(Tcl_Obj *objPtr);







|








|


|


|


|


|









|
>
|
|
>

|
>
|
|
>





|



|


|


|


|


|



|







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
				const char *varName, void *addr, int type,
				Tcl_Size size);
/* 645 */
EXTERN int		Tcl_GetIntForIndex(Tcl_Interp *interp,
				Tcl_Obj *objPtr, Tcl_Size endValue,
				Tcl_Size *indexPtr);
/* 646 */
EXTERN Tcl_Size		Tcl_UtfToUniChar(const char *src, int *chPtr);
/* 647 */
EXTERN char *		Tcl_UniCharToUtfDString(const int *uniStr,
				Tcl_Size uniLength, Tcl_DString *dsPtr);
/* 648 */
EXTERN int *		Tcl_UtfToUniCharDString(const char *src,
				Tcl_Size length, Tcl_DString *dsPtr);
/* 649 */
EXTERN unsigned char *	TclGetBytesFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, void *numBytesPtr);
/* 650 */
EXTERN unsigned char *	Tcl_GetBytesFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, Tcl_Size *numBytesPtr);
/* 651 */
EXTERN char *		Tcl_GetStringFromObj(Tcl_Obj *objPtr,
				Tcl_Size *lengthPtr);
/* 652 */
EXTERN Tcl_UniChar *	Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr,
				Tcl_Size *lengthPtr);
/* 653 */
EXTERN unsigned char *	Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr,
				Tcl_Size *numBytesPtr);
/* 654 */
EXTERN int		Tcl_UtfCharComplete(const char *src, Tcl_Size length);
/* 655 */
EXTERN const char *	Tcl_UtfNext(const char *src);
/* 656 */
EXTERN const char *	Tcl_UtfPrev(const char *src, const char *start);
/* 657 */
EXTERN int		Tcl_UniCharIsUnicode(int ch);
/* 658 */
EXTERN int		Tcl_ExternalToUtfDStringEx(Tcl_Interp *interp,
				Tcl_Encoding encoding, const char *src,
				Tcl_Size srcLen, int flags,
				Tcl_DString *dsPtr,
				Tcl_Size *errorLocationPtr);
/* 659 */
EXTERN int		Tcl_UtfToExternalDStringEx(Tcl_Interp *interp,
				Tcl_Encoding encoding, const char *src,
				Tcl_Size srcLen, int flags,
				Tcl_DString *dsPtr,
				Tcl_Size *errorLocationPtr);
/* 660 */
EXTERN int		Tcl_AsyncMarkFromSignal(Tcl_AsyncHandler async,
				int sigNumber);
/* 661 */
EXTERN int		Tcl_ListObjGetElements(Tcl_Interp *interp,
				Tcl_Obj *listPtr, Tcl_Size *objcPtr,
				Tcl_Obj ***objvPtr);
/* 662 */
EXTERN int		Tcl_ListObjLength(Tcl_Interp *interp,
				Tcl_Obj *listPtr, Tcl_Size *lengthPtr);
/* 663 */
EXTERN int		Tcl_DictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr,
				Tcl_Size *sizePtr);
/* 664 */
EXTERN int		Tcl_SplitList(Tcl_Interp *interp,
				const char *listStr, Tcl_Size *argcPtr,
				const char ***argvPtr);
/* 665 */
EXTERN void		Tcl_SplitPath(const char *path, Tcl_Size *argcPtr,
				const char ***argvPtr);
/* 666 */
EXTERN Tcl_Obj *	Tcl_FSSplitPath(Tcl_Obj *pathPtr, Tcl_Size *lenPtr);
/* 667 */
EXTERN int		Tcl_ParseArgsObjv(Tcl_Interp *interp,
				const Tcl_ArgvInfo *argTable,
				Tcl_Size *objcPtr, Tcl_Obj *const *objv,
				Tcl_Obj ***remObjv);
/* 668 */
EXTERN Tcl_Size		Tcl_UniCharLen(const int *uniStr);
/* 669 */
EXTERN Tcl_Size		Tcl_NumUtfChars(const char *src, Tcl_Size length);
/* 670 */
EXTERN Tcl_Size		Tcl_GetCharLength(Tcl_Obj *objPtr);
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
				Tcl_Obj *objPtr, int flags, char *charPtr);
/* 676 */
EXTERN Tcl_Command	Tcl_CreateObjCommand2(Tcl_Interp *interp,
				const char *cmdName, Tcl_ObjCmdProc2 *proc2,
				void *clientData,
				Tcl_CmdDeleteProc *deleteProc);
/* 677 */
EXTERN Tcl_Trace	Tcl_CreateObjTrace2(Tcl_Interp *interp, int level,

				int flags, Tcl_CmdObjTraceProc2 *objProc2,
				void *clientData,
				Tcl_CmdObjTraceDeleteProc *delProc);
/* 678 */
EXTERN Tcl_Command	Tcl_NRCreateCommand2(Tcl_Interp *interp,
				const char *cmdName, Tcl_ObjCmdProc2 *proc,
				Tcl_ObjCmdProc2 *nreProc2, void *clientData,
				Tcl_CmdDeleteProc *deleteProc);
/* 679 */
EXTERN int		Tcl_NRCallObjProc2(Tcl_Interp *interp,
				Tcl_ObjCmdProc2 *objProc2, void *clientData,
				size_t objc, Tcl_Obj *const objv[]);
/* 680 */
EXTERN int		Tcl_GetNumberFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, void **clientDataPtr,
				int *typePtr);
/* 681 */
EXTERN int		Tcl_GetNumber(Tcl_Interp *interp, const char *bytes,
				size_t numBytes, void **clientDataPtr,
				int *typePtr);
/* 682 */
EXTERN int		Tcl_RemoveChannelMode(Tcl_Interp *interp,
				Tcl_Channel chan, int mode);
/* 683 */
EXTERN int		Tcl_GetEncodingNulLength(Tcl_Encoding encoding);
/* 684 */

EXTERN Tcl_AbstractListType * Tcl_AbstractListGetType(Tcl_Obj *objPtr);
/* 685 */
EXTERN Tcl_Obj *	Tcl_AbstractListObjNew(Tcl_Interp *interp,
				const Tcl_AbstractListType*vTablePtr);
/* 686 */
EXTERN Tcl_WideInt	Tcl_AbstractListObjLength(Tcl_Obj *abstractListPtr);
/* 687 */
EXTERN int		Tcl_AbstractListObjIndex(Tcl_Interp *interp,
				Tcl_Obj *abstractListPtr, Tcl_Size index,
				Tcl_Obj **elemObjPtr);
/* 688 */
EXTERN int		Tcl_AbstractListObjRange(Tcl_Interp *interp,
				Tcl_Obj *abstractListPtr, Tcl_Size fromIdx,
				Tcl_Size toIdx, Tcl_Obj **newObjPtr);
/* 689 */
EXTERN int		Tcl_AbstractListObjReverse(Tcl_Interp *interp,
				Tcl_Obj *abstractListPtr,
				Tcl_Obj **newObjPtr);
/* 690 */
EXTERN int		Tcl_AbstractListObjGetElements(Tcl_Interp *interp,
				Tcl_Obj *objPtr, Tcl_Size *objcPtr,
				Tcl_Obj ***objvPtr);
/* 691 */
EXTERN Tcl_Obj *	Tcl_AbstractListObjCopy(Tcl_Interp *interp,
				Tcl_Obj *listPtr);
/* 692 */
EXTERN void *		Tcl_AbstractListGetConcreteRep(Tcl_Obj *objPtr);
/* 693 */
EXTERN Tcl_Obj *	Tcl_AbstractListSetElement(Tcl_Interp *interp,
				Tcl_Obj *listPtr, Tcl_Size indexCount,
				Tcl_Obj *const indexArray[],
				Tcl_Obj *valueObj);

typedef struct {
    const struct TclPlatStubs *tclPlatStubs;
    const struct TclIntStubs *tclIntStubs;
    const struct TclIntPlatStubs *tclIntPlatStubs;
} TclStubHooks;








|
>
|










|






|





|

>
|

|
<

<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
|
<
|
<
<
|
|
<
<
<
<
<







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
				Tcl_Obj *objPtr, int flags, char *charPtr);
/* 676 */
EXTERN Tcl_Command	Tcl_CreateObjCommand2(Tcl_Interp *interp,
				const char *cmdName, Tcl_ObjCmdProc2 *proc2,
				void *clientData,
				Tcl_CmdDeleteProc *deleteProc);
/* 677 */
EXTERN Tcl_Trace	Tcl_CreateObjTrace2(Tcl_Interp *interp,
				Tcl_Size level, int flags,
				Tcl_CmdObjTraceProc2 *objProc2,
				void *clientData,
				Tcl_CmdObjTraceDeleteProc *delProc);
/* 678 */
EXTERN Tcl_Command	Tcl_NRCreateCommand2(Tcl_Interp *interp,
				const char *cmdName, Tcl_ObjCmdProc2 *proc,
				Tcl_ObjCmdProc2 *nreProc2, void *clientData,
				Tcl_CmdDeleteProc *deleteProc);
/* 679 */
EXTERN int		Tcl_NRCallObjProc2(Tcl_Interp *interp,
				Tcl_ObjCmdProc2 *objProc2, void *clientData,
				ptrdiff_t objc, Tcl_Obj *const objv[]);
/* 680 */
EXTERN int		Tcl_GetNumberFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, void **clientDataPtr,
				int *typePtr);
/* 681 */
EXTERN int		Tcl_GetNumber(Tcl_Interp *interp, const char *bytes,
				Tcl_Size numBytes, void **clientDataPtr,
				int *typePtr);
/* 682 */
EXTERN int		Tcl_RemoveChannelMode(Tcl_Interp *interp,
				Tcl_Channel chan, int mode);
/* 683 */
EXTERN Tcl_Size		Tcl_GetEncodingNulLength(Tcl_Encoding encoding);
/* 684 */
EXTERN int		Tcl_GetWideUIntFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, Tcl_WideUInt *uwidePtr);
/* 685 */
EXTERN Tcl_Obj *	Tcl_DStringToObj(Tcl_DString *dsPtr);

/* 686 */


EXTERN int		Tcl_GetSizeIntFromObj(Tcl_Interp *interp,












				Tcl_Obj *objPtr, Tcl_Size *sizePtr);

/* Slot 687 is reserved */


/* 688 */
EXTERN void		TclUnusedStubEntry(void);






typedef struct {
    const struct TclPlatStubs *tclPlatStubs;
    const struct TclIntStubs *tclIntStubs;
    const struct TclIntPlatStubs *tclIntPlatStubs;
} TclStubHooks;

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
    void (*reserved26)(void);
    Tcl_Obj * (*tcl_DbNewObj) (const char *file, int line); /* 27 */
    Tcl_Obj * (*tcl_DbNewStringObj) (const char *bytes, Tcl_Size 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 *intPtr); /* 31 */
    int (*tcl_GetBooleanFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 32 */
    unsigned char * (*tclGetByteArrayFromObj) (Tcl_Obj *objPtr, int *numBytesPtr); /* 33 */
    int (*tcl_GetDouble) (Tcl_Interp *interp, const char *src, double *doublePtr); /* 34 */
    int (*tcl_GetDoubleFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); /* 35 */
    void (*reserved36)(void);
    int (*tcl_GetInt) (Tcl_Interp *interp, const char *src, int *intPtr); /* 37 */
    int (*tcl_GetIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 38 */
    int (*tcl_GetLongFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr); /* 39 */
    const Tcl_ObjType * (*tcl_GetObjType) (const char *typeName); /* 40 */
    char * (*tclGetStringFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 41 */
    void (*tcl_InvalidateStringRep) (Tcl_Obj *objPtr); /* 42 */
    int (*tcl_ListObjAppendList) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *elemListPtr); /* 43 */
    int (*tcl_ListObjAppendElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *objPtr); /* 44 */
    int (*tclListObjGetElements) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *objcPtr, Tcl_Obj ***objvPtr); /* 45 */
    int (*tcl_ListObjIndex) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size index, Tcl_Obj **objPtrPtr); /* 46 */
    int (*tclListObjLength) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *lengthPtr); /* 47 */
    int (*tcl_ListObjReplace) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size first, Tcl_Size count, Tcl_Size objc, Tcl_Obj *const objv[]); /* 48 */
    void (*reserved49)(void);
    Tcl_Obj * (*tcl_NewByteArrayObj) (const unsigned char *bytes, Tcl_Size numBytes); /* 50 */
    Tcl_Obj * (*tcl_NewDoubleObj) (double doubleValue); /* 51 */
    void (*reserved52)(void);
    Tcl_Obj * (*tcl_NewListObj) (Tcl_Size objc, Tcl_Obj *const objv[]); /* 53 */
    void (*reserved54)(void);







|







|



|

|







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
    void (*reserved26)(void);
    Tcl_Obj * (*tcl_DbNewObj) (const char *file, int line); /* 27 */
    Tcl_Obj * (*tcl_DbNewStringObj) (const char *bytes, Tcl_Size 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 *intPtr); /* 31 */
    int (*tcl_GetBooleanFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 32 */
    unsigned char * (*tclGetByteArrayFromObj) (Tcl_Obj *objPtr, void *numBytesPtr); /* 33 */
    int (*tcl_GetDouble) (Tcl_Interp *interp, const char *src, double *doublePtr); /* 34 */
    int (*tcl_GetDoubleFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); /* 35 */
    void (*reserved36)(void);
    int (*tcl_GetInt) (Tcl_Interp *interp, const char *src, int *intPtr); /* 37 */
    int (*tcl_GetIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 38 */
    int (*tcl_GetLongFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr); /* 39 */
    const Tcl_ObjType * (*tcl_GetObjType) (const char *typeName); /* 40 */
    char * (*tclGetStringFromObj) (Tcl_Obj *objPtr, void *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 (*tclListObjGetElements) (Tcl_Interp *interp, Tcl_Obj *listPtr, void *objcPtr, Tcl_Obj ***objvPtr); /* 45 */
    int (*tcl_ListObjIndex) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size index, Tcl_Obj **objPtrPtr); /* 46 */
    int (*tclListObjLength) (Tcl_Interp *interp, Tcl_Obj *listPtr, void *lengthPtr); /* 47 */
    int (*tcl_ListObjReplace) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size first, Tcl_Size count, Tcl_Size objc, Tcl_Obj *const objv[]); /* 48 */
    void (*reserved49)(void);
    Tcl_Obj * (*tcl_NewByteArrayObj) (const unsigned char *bytes, Tcl_Size numBytes); /* 50 */
    Tcl_Obj * (*tcl_NewDoubleObj) (double doubleValue); /* 51 */
    void (*reserved52)(void);
    Tcl_Obj * (*tcl_NewListObj) (Tcl_Size objc, Tcl_Obj *const objv[]); /* 53 */
    void (*reserved54)(void);
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
    void (*tcl_CreateEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, void *clientData); /* 92 */
    void (*tcl_CreateExitHandler) (Tcl_ExitProc *proc, void *clientData); /* 93 */
    Tcl_Interp * (*tcl_CreateInterp) (void); /* 94 */
    void (*reserved95)(void);
    Tcl_Command (*tcl_CreateObjCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 96 */
    Tcl_Interp * (*tcl_CreateChild) (Tcl_Interp *interp, const char *name, int isSafe); /* 97 */
    Tcl_TimerToken (*tcl_CreateTimerHandler) (int milliseconds, Tcl_TimerProc *proc, void *clientData); /* 98 */
    Tcl_Trace (*tcl_CreateTrace) (Tcl_Interp *interp, int level, Tcl_CmdTraceProc *proc, void *clientData); /* 99 */
    void (*tcl_DeleteAssocData) (Tcl_Interp *interp, const char *name); /* 100 */
    void (*tcl_DeleteChannelHandler) (Tcl_Channel chan, Tcl_ChannelProc *proc, void *clientData); /* 101 */
    void (*tcl_DeleteCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, void *clientData); /* 102 */
    int (*tcl_DeleteCommand) (Tcl_Interp *interp, const char *cmdName); /* 103 */
    int (*tcl_DeleteCommandFromToken) (Tcl_Interp *interp, Tcl_Command command); /* 104 */
    void (*tcl_DeleteEvents) (Tcl_EventDeleteProc *proc, void *clientData); /* 105 */
    void (*tcl_DeleteEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, void *clientData); /* 106 */







|







1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
    void (*tcl_CreateEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, void *clientData); /* 92 */
    void (*tcl_CreateExitHandler) (Tcl_ExitProc *proc, void *clientData); /* 93 */
    Tcl_Interp * (*tcl_CreateInterp) (void); /* 94 */
    void (*reserved95)(void);
    Tcl_Command (*tcl_CreateObjCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 96 */
    Tcl_Interp * (*tcl_CreateChild) (Tcl_Interp *interp, const char *name, int isSafe); /* 97 */
    Tcl_TimerToken (*tcl_CreateTimerHandler) (int milliseconds, Tcl_TimerProc *proc, void *clientData); /* 98 */
    Tcl_Trace (*tcl_CreateTrace) (Tcl_Interp *interp, Tcl_Size level, Tcl_CmdTraceProc *proc, void *clientData); /* 99 */
    void (*tcl_DeleteAssocData) (Tcl_Interp *interp, const char *name); /* 100 */
    void (*tcl_DeleteChannelHandler) (Tcl_Channel chan, Tcl_ChannelProc *proc, void *clientData); /* 101 */
    void (*tcl_DeleteCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, void *clientData); /* 102 */
    int (*tcl_DeleteCommand) (Tcl_Interp *interp, const char *cmdName); /* 103 */
    int (*tcl_DeleteCommandFromToken) (Tcl_Interp *interp, Tcl_Command command); /* 104 */
    void (*tcl_DeleteEvents) (Tcl_EventDeleteProc *proc, void *clientData); /* 105 */
    void (*tcl_DeleteEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, void *clientData); /* 106 */
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
    void (*tcl_SetObjResult) (Tcl_Interp *interp, Tcl_Obj *resultObjPtr); /* 235 */
    void (*tcl_SetStdChannel) (Tcl_Channel channel, int type); /* 236 */
    void (*reserved237)(void);
    const char * (*tcl_SetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags); /* 238 */
    const char * (*tcl_SignalId) (int sig); /* 239 */
    const char * (*tcl_SignalMsg) (int sig); /* 240 */
    void (*tcl_SourceRCFile) (Tcl_Interp *interp); /* 241 */
    int (*tclSplitList) (Tcl_Interp *interp, const char *listStr, int *argcPtr, const char ***argvPtr); /* 242 */
    void (*tclSplitPath) (const char *path, int *argcPtr, const char ***argvPtr); /* 243 */
    void (*reserved244)(void);
    void (*reserved245)(void);
    void (*reserved246)(void);
    void (*reserved247)(void);
    int (*tcl_TraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, void *clientData); /* 248 */
    char * (*tcl_TranslateFileName) (Tcl_Interp *interp, const char *name, Tcl_DString *bufferPtr); /* 249 */
    Tcl_Size (*tcl_Ungets) (Tcl_Channel chan, const char *str, Tcl_Size len, int atHead); /* 250 */







|
|







2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
    void (*tcl_SetObjResult) (Tcl_Interp *interp, Tcl_Obj *resultObjPtr); /* 235 */
    void (*tcl_SetStdChannel) (Tcl_Channel channel, int type); /* 236 */
    void (*reserved237)(void);
    const char * (*tcl_SetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags); /* 238 */
    const char * (*tcl_SignalId) (int sig); /* 239 */
    const char * (*tcl_SignalMsg) (int sig); /* 240 */
    void (*tcl_SourceRCFile) (Tcl_Interp *interp); /* 241 */
    int (*tclSplitList) (Tcl_Interp *interp, const char *listStr, void *argcPtr, const char ***argvPtr); /* 242 */
    void (*tclSplitPath) (const char *path, void *argcPtr, const char ***argvPtr); /* 243 */
    void (*reserved244)(void);
    void (*reserved245)(void);
    void (*reserved246)(void);
    void (*reserved247)(void);
    int (*tcl_TraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, void *clientData); /* 248 */
    char * (*tcl_TranslateFileName) (Tcl_Interp *interp, const char *name, Tcl_DString *bufferPtr); /* 249 */
    Tcl_Size (*tcl_Ungets) (Tcl_Channel chan, const char *str, Tcl_Size len, int atHead); /* 250 */
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
    Tcl_Obj * (*tcl_SetVar2Ex) (Tcl_Interp *interp, const char *part1, const char *part2, Tcl_Obj *newValuePtr, int flags); /* 317 */
    void (*tcl_ThreadAlert) (Tcl_ThreadId threadId); /* 318 */
    void (*tcl_ThreadQueueEvent) (Tcl_ThreadId threadId, Tcl_Event *evPtr, int position); /* 319 */
    int (*tcl_UniCharAtIndex) (const char *src, Tcl_Size 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 * (*tclUtfAtIndex) (const char *src, Tcl_Size index); /* 325 */
    int (*tclUtfCharComplete) (const char *src, Tcl_Size length); /* 326 */
    Tcl_Size (*tcl_UtfBackslash) (const char *src, int *readPtr, char *dst); /* 327 */
    const char * (*tcl_UtfFindFirst) (const char *src, int ch); /* 328 */
    const char * (*tcl_UtfFindLast) (const char *src, int ch); /* 329 */
    const char * (*tclUtfNext) (const char *src); /* 330 */
    const char * (*tclUtfPrev) (const char *src, const char *start); /* 331 */
    int (*tcl_UtfToExternal) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, Tcl_Size srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, Tcl_Size dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 332 */
    char * (*tcl_UtfToExternalDString) (Tcl_Encoding encoding, const char *src, Tcl_Size 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 */
    Tcl_Size (*tcl_WriteChars) (Tcl_Channel chan, const char *src, Tcl_Size srcLen); /* 338 */
    Tcl_Size (*tcl_WriteObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 339 */
    char * (*tcl_GetString) (Tcl_Obj *objPtr); /* 340 */
    void (*reserved341)(void);
    void (*reserved342)(void);
    void (*tcl_AlertNotifier) (void *clientData); /* 343 */
    void (*tcl_ServiceModeHook) (int mode); /* 344 */







|









|
|
|
|







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
    Tcl_Obj * (*tcl_SetVar2Ex) (Tcl_Interp *interp, const char *part1, const char *part2, Tcl_Obj *newValuePtr, int flags); /* 317 */
    void (*tcl_ThreadAlert) (Tcl_ThreadId threadId); /* 318 */
    void (*tcl_ThreadQueueEvent) (Tcl_ThreadId threadId, Tcl_Event *evPtr, int position); /* 319 */
    int (*tcl_UniCharAtIndex) (const char *src, Tcl_Size index); /* 320 */
    int (*tcl_UniCharToLower) (int ch); /* 321 */
    int (*tcl_UniCharToTitle) (int ch); /* 322 */
    int (*tcl_UniCharToUpper) (int ch); /* 323 */
    Tcl_Size (*tcl_UniCharToUtf) (int ch, char *buf); /* 324 */
    const char * (*tclUtfAtIndex) (const char *src, Tcl_Size index); /* 325 */
    int (*tclUtfCharComplete) (const char *src, Tcl_Size length); /* 326 */
    Tcl_Size (*tcl_UtfBackslash) (const char *src, int *readPtr, char *dst); /* 327 */
    const char * (*tcl_UtfFindFirst) (const char *src, int ch); /* 328 */
    const char * (*tcl_UtfFindLast) (const char *src, int ch); /* 329 */
    const char * (*tclUtfNext) (const char *src); /* 330 */
    const char * (*tclUtfPrev) (const char *src, const char *start); /* 331 */
    int (*tcl_UtfToExternal) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, Tcl_Size srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, Tcl_Size dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 332 */
    char * (*tcl_UtfToExternalDString) (Tcl_Encoding encoding, const char *src, Tcl_Size srcLen, Tcl_DString *dsPtr); /* 333 */
    Tcl_Size (*tcl_UtfToLower) (char *src); /* 334 */
    Tcl_Size (*tcl_UtfToTitle) (char *src); /* 335 */
    Tcl_Size (*tcl_UtfToChar16) (const char *src, unsigned short *chPtr); /* 336 */
    Tcl_Size (*tcl_UtfToUpper) (char *src); /* 337 */
    Tcl_Size (*tcl_WriteChars) (Tcl_Channel chan, const char *src, Tcl_Size srcLen); /* 338 */
    Tcl_Size (*tcl_WriteObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 339 */
    char * (*tcl_GetString) (Tcl_Obj *objPtr); /* 340 */
    void (*reserved341)(void);
    void (*reserved342)(void);
    void (*tcl_AlertNotifier) (void *clientData); /* 343 */
    void (*tcl_ServiceModeHook) (int mode); /* 344 */
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
    void (*tcl_SetNotifier) (const Tcl_NotifierProcs *notifierProcPtr); /* 386 */
    Tcl_Mutex * (*tcl_GetAllocMutex) (void); /* 387 */
    int (*tcl_GetChannelNames) (Tcl_Interp *interp); /* 388 */
    int (*tcl_GetChannelNamesEx) (Tcl_Interp *interp, const char *pattern); /* 389 */
    int (*tcl_ProcObjCmd) (void *clientData, Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[]); /* 390 */
    void (*tcl_ConditionFinalize) (Tcl_Condition *condPtr); /* 391 */
    void (*tcl_MutexFinalize) (Tcl_Mutex *mutex); /* 392 */
    int (*tcl_CreateThread) (Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc, void *clientData, Tcl_Size stackSize, int flags); /* 393 */
    Tcl_Size (*tcl_ReadRaw) (Tcl_Channel chan, char *dst, Tcl_Size bytesToRead); /* 394 */
    Tcl_Size (*tcl_WriteRaw) (Tcl_Channel chan, const char *src, Tcl_Size srcLen); /* 395 */
    Tcl_Channel (*tcl_GetTopChannel) (Tcl_Channel chan); /* 396 */
    int (*tcl_ChannelBuffered) (Tcl_Channel chan); /* 397 */
    const char * (*tcl_ChannelName) (const Tcl_ChannelType *chanTypePtr); /* 398 */
    Tcl_ChannelTypeVersion (*tcl_ChannelVersion) (const Tcl_ChannelType *chanTypePtr); /* 399 */
    Tcl_DriverBlockModeProc * (*tcl_ChannelBlockModeProc) (const Tcl_ChannelType *chanTypePtr); /* 400 */







|







2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
    void (*tcl_SetNotifier) (const Tcl_NotifierProcs *notifierProcPtr); /* 386 */
    Tcl_Mutex * (*tcl_GetAllocMutex) (void); /* 387 */
    int (*tcl_GetChannelNames) (Tcl_Interp *interp); /* 388 */
    int (*tcl_GetChannelNamesEx) (Tcl_Interp *interp, const char *pattern); /* 389 */
    int (*tcl_ProcObjCmd) (void *clientData, Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[]); /* 390 */
    void (*tcl_ConditionFinalize) (Tcl_Condition *condPtr); /* 391 */
    void (*tcl_MutexFinalize) (Tcl_Mutex *mutex); /* 392 */
    int (*tcl_CreateThread) (Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc, void *clientData, TCL_HASH_TYPE stackSize, int flags); /* 393 */
    Tcl_Size (*tcl_ReadRaw) (Tcl_Channel chan, char *dst, Tcl_Size bytesToRead); /* 394 */
    Tcl_Size (*tcl_WriteRaw) (Tcl_Channel chan, const char *src, Tcl_Size srcLen); /* 395 */
    Tcl_Channel (*tcl_GetTopChannel) (Tcl_Channel chan); /* 396 */
    int (*tcl_ChannelBuffered) (Tcl_Channel chan); /* 397 */
    const char * (*tcl_ChannelName) (const Tcl_ChannelType *chanTypePtr); /* 398 */
    Tcl_ChannelTypeVersion (*tcl_ChannelVersion) (const Tcl_ChannelType *chanTypePtr); /* 399 */
    Tcl_DriverBlockModeProc * (*tcl_ChannelBlockModeProc) (const Tcl_ChannelType *chanTypePtr); /* 400 */
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
    void (*tcl_UntraceCommand) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, void *clientData); /* 427 */
    void * (*tcl_AttemptAlloc) (TCL_HASH_TYPE size); /* 428 */
    void * (*tcl_AttemptDbCkalloc) (TCL_HASH_TYPE size, const char *file, int line); /* 429 */
    void * (*tcl_AttemptRealloc) (void *ptr, TCL_HASH_TYPE size); /* 430 */
    void * (*tcl_AttemptDbCkrealloc) (void *ptr, TCL_HASH_TYPE size, const char *file, int line); /* 431 */
    int (*tcl_AttemptSetObjLength) (Tcl_Obj *objPtr, Tcl_Size length); /* 432 */
    Tcl_ThreadId (*tcl_GetChannelThread) (Tcl_Channel channel); /* 433 */
    Tcl_UniChar * (*tclGetUnicodeFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 434 */
    void (*reserved435)(void);
    void (*reserved436)(void);
    Tcl_Obj * (*tcl_SubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 437 */
    int (*tcl_DetachChannel) (Tcl_Interp *interp, Tcl_Channel channel); /* 438 */
    int (*tcl_IsStandardChannel) (Tcl_Channel channel); /* 439 */
    int (*tcl_FSCopyFile) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr); /* 440 */
    int (*tcl_FSCopyDirectory) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr); /* 441 */







|







2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
    void (*tcl_UntraceCommand) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, void *clientData); /* 427 */
    void * (*tcl_AttemptAlloc) (TCL_HASH_TYPE size); /* 428 */
    void * (*tcl_AttemptDbCkalloc) (TCL_HASH_TYPE size, const char *file, int line); /* 429 */
    void * (*tcl_AttemptRealloc) (void *ptr, TCL_HASH_TYPE size); /* 430 */
    void * (*tcl_AttemptDbCkrealloc) (void *ptr, TCL_HASH_TYPE size, const char *file, int line); /* 431 */
    int (*tcl_AttemptSetObjLength) (Tcl_Obj *objPtr, Tcl_Size length); /* 432 */
    Tcl_ThreadId (*tcl_GetChannelThread) (Tcl_Channel channel); /* 433 */
    Tcl_UniChar * (*tclGetUnicodeFromObj) (Tcl_Obj *objPtr, void *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 */
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
    int (*tcl_FSStat) (Tcl_Obj *pathPtr, Tcl_StatBuf *buf); /* 454 */
    int (*tcl_FSAccess) (Tcl_Obj *pathPtr, int mode); /* 455 */
    Tcl_Channel (*tcl_FSOpenFileChannel) (Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *modeString, int permissions); /* 456 */
    Tcl_Obj * (*tcl_FSGetCwd) (Tcl_Interp *interp); /* 457 */
    int (*tcl_FSChdir) (Tcl_Obj *pathPtr); /* 458 */
    int (*tcl_FSConvertToPathType) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 459 */
    Tcl_Obj * (*tcl_FSJoinPath) (Tcl_Obj *listObj, Tcl_Size elements); /* 460 */
    Tcl_Obj * (*tclFSSplitPath) (Tcl_Obj *pathPtr, int *lenPtr); /* 461 */
    int (*tcl_FSEqualPaths) (Tcl_Obj *firstPtr, Tcl_Obj *secondPtr); /* 462 */
    Tcl_Obj * (*tcl_FSGetNormalizedPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 463 */
    Tcl_Obj * (*tcl_FSJoinToPath) (Tcl_Obj *pathPtr, Tcl_Size objc, Tcl_Obj *const objv[]); /* 464 */
    void * (*tcl_FSGetInternalRep) (Tcl_Obj *pathPtr, const Tcl_Filesystem *fsPtr); /* 465 */
    Tcl_Obj * (*tcl_FSGetTranslatedPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 466 */
    int (*tcl_FSEvalFile) (Tcl_Interp *interp, Tcl_Obj *fileName); /* 467 */
    Tcl_Obj * (*tcl_FSNewNativePath) (const Tcl_Filesystem *fromFilesystem, void *clientData); /* 468 */







|







2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
    int (*tcl_FSStat) (Tcl_Obj *pathPtr, Tcl_StatBuf *buf); /* 454 */
    int (*tcl_FSAccess) (Tcl_Obj *pathPtr, int mode); /* 455 */
    Tcl_Channel (*tcl_FSOpenFileChannel) (Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *modeString, int permissions); /* 456 */
    Tcl_Obj * (*tcl_FSGetCwd) (Tcl_Interp *interp); /* 457 */
    int (*tcl_FSChdir) (Tcl_Obj *pathPtr); /* 458 */
    int (*tcl_FSConvertToPathType) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 459 */
    Tcl_Obj * (*tcl_FSJoinPath) (Tcl_Obj *listObj, Tcl_Size elements); /* 460 */
    Tcl_Obj * (*tclFSSplitPath) (Tcl_Obj *pathPtr, void *lenPtr); /* 461 */
    int (*tcl_FSEqualPaths) (Tcl_Obj *firstPtr, Tcl_Obj *secondPtr); /* 462 */
    Tcl_Obj * (*tcl_FSGetNormalizedPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 463 */
    Tcl_Obj * (*tcl_FSJoinToPath) (Tcl_Obj *pathPtr, Tcl_Size objc, Tcl_Obj *const objv[]); /* 464 */
    void * (*tcl_FSGetInternalRep) (Tcl_Obj *pathPtr, const Tcl_Filesystem *fsPtr); /* 465 */
    Tcl_Obj * (*tcl_FSGetTranslatedPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 466 */
    int (*tcl_FSEvalFile) (Tcl_Interp *interp, Tcl_Obj *fileName); /* 467 */
    Tcl_Obj * (*tcl_FSNewNativePath) (const Tcl_Filesystem *fromFilesystem, void *clientData); /* 468 */
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
    const char * (*tcl_FSGetTranslatedStringPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 476 */
    const Tcl_Filesystem * (*tcl_FSGetFileSystemForPath) (Tcl_Obj *pathPtr); /* 477 */
    Tcl_PathType (*tcl_FSGetPathType) (Tcl_Obj *pathPtr); /* 478 */
    int (*tcl_OutputBuffered) (Tcl_Channel chan); /* 479 */
    void (*tcl_FSMountsChanged) (const Tcl_Filesystem *fsPtr); /* 480 */
    int (*tcl_EvalTokensStandard) (Tcl_Interp *interp, Tcl_Token *tokenPtr, Tcl_Size count); /* 481 */
    void (*tcl_GetTime) (Tcl_Time *timeBuf); /* 482 */
    Tcl_Trace (*tcl_CreateObjTrace) (Tcl_Interp *interp, int level, int flags, Tcl_CmdObjTraceProc *objProc, void *clientData, Tcl_CmdObjTraceDeleteProc *delProc); /* 483 */
    int (*tcl_GetCommandInfoFromToken) (Tcl_Command token, Tcl_CmdInfo *infoPtr); /* 484 */
    int (*tcl_SetCommandInfoFromToken) (Tcl_Command token, const Tcl_CmdInfo *infoPtr); /* 485 */
    Tcl_Obj * (*tcl_DbNewWideIntObj) (Tcl_WideInt wideValue, const char *file, int line); /* 486 */
    int (*tcl_GetWideIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideInt *widePtr); /* 487 */
    Tcl_Obj * (*tcl_NewWideIntObj) (Tcl_WideInt wideValue); /* 488 */
    void (*tcl_SetWideIntObj) (Tcl_Obj *objPtr, Tcl_WideInt wideValue); /* 489 */
    Tcl_StatBuf * (*tcl_AllocStatBuf) (void); /* 490 */
    long long (*tcl_Seek) (Tcl_Channel chan, long long offset, int mode); /* 491 */
    long long (*tcl_Tell) (Tcl_Channel chan); /* 492 */
    Tcl_DriverWideSeekProc * (*tcl_ChannelWideSeekProc) (const Tcl_ChannelType *chanTypePtr); /* 493 */
    int (*tcl_DictObjPut) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr, Tcl_Obj *valuePtr); /* 494 */
    int (*tcl_DictObjGet) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr, Tcl_Obj **valuePtrPtr); /* 495 */
    int (*tcl_DictObjRemove) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr); /* 496 */
    int (*tclDictObjSize) (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 */
    void (*tcl_DictObjDone) (Tcl_DictSearch *searchPtr); /* 500 */
    int (*tcl_DictObjPutKeyList) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Size keyc, Tcl_Obj *const *keyv, Tcl_Obj *valuePtr); /* 501 */
    int (*tcl_DictObjRemoveKeyList) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Size keyc, Tcl_Obj *const *keyv); /* 502 */
    Tcl_Obj * (*tcl_NewDictObj) (void); /* 503 */
    Tcl_Obj * (*tcl_DbNewDictObj) (const char *file, int line); /* 504 */







|













|







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
    const char * (*tcl_FSGetTranslatedStringPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 476 */
    const Tcl_Filesystem * (*tcl_FSGetFileSystemForPath) (Tcl_Obj *pathPtr); /* 477 */
    Tcl_PathType (*tcl_FSGetPathType) (Tcl_Obj *pathPtr); /* 478 */
    int (*tcl_OutputBuffered) (Tcl_Channel chan); /* 479 */
    void (*tcl_FSMountsChanged) (const Tcl_Filesystem *fsPtr); /* 480 */
    int (*tcl_EvalTokensStandard) (Tcl_Interp *interp, Tcl_Token *tokenPtr, Tcl_Size count); /* 481 */
    void (*tcl_GetTime) (Tcl_Time *timeBuf); /* 482 */
    Tcl_Trace (*tcl_CreateObjTrace) (Tcl_Interp *interp, Tcl_Size level, int flags, Tcl_CmdObjTraceProc *objProc, void *clientData, Tcl_CmdObjTraceDeleteProc *delProc); /* 483 */
    int (*tcl_GetCommandInfoFromToken) (Tcl_Command token, Tcl_CmdInfo *infoPtr); /* 484 */
    int (*tcl_SetCommandInfoFromToken) (Tcl_Command token, const Tcl_CmdInfo *infoPtr); /* 485 */
    Tcl_Obj * (*tcl_DbNewWideIntObj) (Tcl_WideInt wideValue, const char *file, int line); /* 486 */
    int (*tcl_GetWideIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideInt *widePtr); /* 487 */
    Tcl_Obj * (*tcl_NewWideIntObj) (Tcl_WideInt wideValue); /* 488 */
    void (*tcl_SetWideIntObj) (Tcl_Obj *objPtr, Tcl_WideInt wideValue); /* 489 */
    Tcl_StatBuf * (*tcl_AllocStatBuf) (void); /* 490 */
    long long (*tcl_Seek) (Tcl_Channel chan, long long offset, int mode); /* 491 */
    long long (*tcl_Tell) (Tcl_Channel chan); /* 492 */
    Tcl_DriverWideSeekProc * (*tcl_ChannelWideSeekProc) (const Tcl_ChannelType *chanTypePtr); /* 493 */
    int (*tcl_DictObjPut) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr, Tcl_Obj *valuePtr); /* 494 */
    int (*tcl_DictObjGet) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr, Tcl_Obj **valuePtrPtr); /* 495 */
    int (*tcl_DictObjRemove) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr); /* 496 */
    int (*tclDictObjSize) (Tcl_Interp *interp, Tcl_Obj *dictPtr, void *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 */
    void (*tcl_DictObjDone) (Tcl_DictSearch *searchPtr); /* 500 */
    int (*tcl_DictObjPutKeyList) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Size keyc, Tcl_Obj *const *keyv, Tcl_Obj *valuePtr); /* 501 */
    int (*tcl_DictObjRemoveKeyList) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Size keyc, Tcl_Obj *const *keyv); /* 502 */
    Tcl_Obj * (*tcl_NewDictObj) (void); /* 503 */
    Tcl_Obj * (*tcl_DbNewDictObj) (const char *file, int line); /* 504 */
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
    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 (*tclParseArgsObjv) (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 */
    int (*tcl_InterpActive) (Tcl_Interp *interp); /* 608 */
    void (*tcl_BackgroundException) (Tcl_Interp *interp, int code); /* 609 */
    int (*tcl_ZlibDeflate) (Tcl_Interp *interp, int format, Tcl_Obj *data, int level, Tcl_Obj *gzipHeaderDictObj); /* 610 */
    int (*tcl_ZlibInflate) (Tcl_Interp *interp, int format, Tcl_Obj *data, Tcl_Size buffersize, Tcl_Obj *gzipHeaderDictObj); /* 611 */







|







2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
    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 (*tclParseArgsObjv) (Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, void *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 */
    int (*tcl_InterpActive) (Tcl_Interp *interp); /* 608 */
    void (*tcl_BackgroundException) (Tcl_Interp *interp, int code); /* 609 */
    int (*tcl_ZlibDeflate) (Tcl_Interp *interp, int format, Tcl_Obj *data, int level, Tcl_Obj *gzipHeaderDictObj); /* 610 */
    int (*tcl_ZlibInflate) (Tcl_Interp *interp, int format, Tcl_Obj *data, Tcl_Size buffersize, Tcl_Obj *gzipHeaderDictObj); /* 611 */
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
    void (*tcl_StoreInternalRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr, const Tcl_ObjInternalRep *irPtr); /* 639 */
    int (*tcl_HasStringRep) (Tcl_Obj *objPtr); /* 640 */
    void (*tcl_IncrRefCount) (Tcl_Obj *objPtr); /* 641 */
    void (*tcl_DecrRefCount) (Tcl_Obj *objPtr); /* 642 */
    int (*tcl_IsShared) (Tcl_Obj *objPtr); /* 643 */
    int (*tcl_LinkArray) (Tcl_Interp *interp, const char *varName, void *addr, int type, Tcl_Size size); /* 644 */
    int (*tcl_GetIntForIndex) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size endValue, Tcl_Size *indexPtr); /* 645 */
    int (*tcl_UtfToUniChar) (const char *src, int *chPtr); /* 646 */
    char * (*tcl_UniCharToUtfDString) (const int *uniStr, Tcl_Size uniLength, Tcl_DString *dsPtr); /* 647 */
    int * (*tcl_UtfToUniCharDString) (const char *src, Tcl_Size length, Tcl_DString *dsPtr); /* 648 */
    unsigned char * (*tclGetBytesFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *numBytesPtr); /* 649 */
    unsigned char * (*tcl_GetBytesFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, size_t *numBytesPtr); /* 650 */
    char * (*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 *numBytesPtr); /* 653 */
    int (*tcl_UtfCharComplete) (const char *src, Tcl_Size length); /* 654 */
    const char * (*tcl_UtfNext) (const char *src); /* 655 */
    const char * (*tcl_UtfPrev) (const char *src, const char *start); /* 656 */
    int (*tcl_UniCharIsUnicode) (int ch); /* 657 */
    Tcl_Size (*tcl_ExternalToUtfDStringEx) (Tcl_Encoding encoding, const char *src, Tcl_Size srcLen, int flags, Tcl_DString *dsPtr); /* 658 */
    Tcl_Size (*tcl_UtfToExternalDStringEx) (Tcl_Encoding encoding, const char *src, Tcl_Size srcLen, int flags, Tcl_DString *dsPtr); /* 659 */
    int (*tcl_AsyncMarkFromSignal) (Tcl_AsyncHandler async, int sigNumber); /* 660 */
    int (*tcl_ListObjGetElements) (Tcl_Interp *interp, Tcl_Obj *listPtr, size_t *objcPtr, Tcl_Obj ***objvPtr); /* 661 */
    int (*tcl_ListObjLength) (Tcl_Interp *interp, Tcl_Obj *listPtr, size_t *lengthPtr); /* 662 */
    int (*tcl_DictObjSize) (Tcl_Interp *interp, Tcl_Obj *dictPtr, size_t *sizePtr); /* 663 */
    int (*tcl_SplitList) (Tcl_Interp *interp, const char *listStr, size_t *argcPtr, const char ***argvPtr); /* 664 */
    void (*tcl_SplitPath) (const char *path, size_t *argcPtr, const char ***argvPtr); /* 665 */
    Tcl_Obj * (*tcl_FSSplitPath) (Tcl_Obj *pathPtr, size_t *lenPtr); /* 666 */
    int (*tcl_ParseArgsObjv) (Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, size_t *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv); /* 667 */
    Tcl_Size (*tcl_UniCharLen) (const int *uniStr); /* 668 */
    Tcl_Size (*tcl_NumUtfChars) (const char *src, Tcl_Size length); /* 669 */
    Tcl_Size (*tcl_GetCharLength) (Tcl_Obj *objPtr); /* 670 */
    const char * (*tcl_UtfAtIndex) (const char *src, Tcl_Size index); /* 671 */
    Tcl_Obj * (*tcl_GetRange) (Tcl_Obj *objPtr, Tcl_Size first, Tcl_Size last); /* 672 */
    int (*tcl_GetUniChar) (Tcl_Obj *objPtr, Tcl_Size index); /* 673 */
    int (*tcl_GetBool) (Tcl_Interp *interp, const char *src, int flags, char *charPtr); /* 674 */
    int (*tcl_GetBoolFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, char *charPtr); /* 675 */
    Tcl_Command (*tcl_CreateObjCommand2) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc2 *proc2, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 676 */
    Tcl_Trace (*tcl_CreateObjTrace2) (Tcl_Interp *interp, int level, int flags, Tcl_CmdObjTraceProc2 *objProc2, void *clientData, Tcl_CmdObjTraceDeleteProc *delProc); /* 677 */
    Tcl_Command (*tcl_NRCreateCommand2) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc2 *proc, Tcl_ObjCmdProc2 *nreProc2, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 678 */
    int (*tcl_NRCallObjProc2) (Tcl_Interp *interp, Tcl_ObjCmdProc2 *objProc2, void *clientData, size_t objc, Tcl_Obj *const objv[]); /* 679 */
    int (*tcl_GetNumberFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, void **clientDataPtr, int *typePtr); /* 680 */
    int (*tcl_GetNumber) (Tcl_Interp *interp, const char *bytes, size_t numBytes, void **clientDataPtr, int *typePtr); /* 681 */
    int (*tcl_RemoveChannelMode) (Tcl_Interp *interp, Tcl_Channel chan, int mode); /* 682 */
    int (*tcl_GetEncodingNulLength) (Tcl_Encoding encoding); /* 683 */
    Tcl_AbstractListType * (*tcl_AbstractListGetType) (Tcl_Obj *objPtr); /* 684 */
    Tcl_Obj * (*tcl_AbstractListObjNew) (Tcl_Interp *interp, const Tcl_AbstractListType*vTablePtr); /* 685 */
    Tcl_WideInt (*tcl_AbstractListObjLength) (Tcl_Obj *abstractListPtr); /* 686 */
    int (*tcl_AbstractListObjIndex) (Tcl_Interp *interp, Tcl_Obj *abstractListPtr, Tcl_Size index, Tcl_Obj **elemObjPtr); /* 687 */
    int (*tcl_AbstractListObjRange) (Tcl_Interp *interp, Tcl_Obj *abstractListPtr, Tcl_Size fromIdx, Tcl_Size toIdx, Tcl_Obj **newObjPtr); /* 688 */
    int (*tcl_AbstractListObjReverse) (Tcl_Interp *interp, Tcl_Obj *abstractListPtr, Tcl_Obj **newObjPtr); /* 689 */
    int (*tcl_AbstractListObjGetElements) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size *objcPtr, Tcl_Obj ***objvPtr); /* 690 */
    Tcl_Obj * (*tcl_AbstractListObjCopy) (Tcl_Interp *interp, Tcl_Obj *listPtr); /* 691 */
    void * (*tcl_AbstractListGetConcreteRep) (Tcl_Obj *objPtr); /* 692 */
    Tcl_Obj * (*tcl_AbstractListSetElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size indexCount, Tcl_Obj *const indexArray[], Tcl_Obj *valueObj); /* 693 */

} TclStubs;

extern const TclStubs *tclStubsPtr;

#ifdef __cplusplus
}
#endif







|


|
|
|
|
|




|
|

|
|
|
|
|
|
|









|

|

|

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







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
    void (*tcl_StoreInternalRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr, const Tcl_ObjInternalRep *irPtr); /* 639 */
    int (*tcl_HasStringRep) (Tcl_Obj *objPtr); /* 640 */
    void (*tcl_IncrRefCount) (Tcl_Obj *objPtr); /* 641 */
    void (*tcl_DecrRefCount) (Tcl_Obj *objPtr); /* 642 */
    int (*tcl_IsShared) (Tcl_Obj *objPtr); /* 643 */
    int (*tcl_LinkArray) (Tcl_Interp *interp, const char *varName, void *addr, int type, Tcl_Size size); /* 644 */
    int (*tcl_GetIntForIndex) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size endValue, Tcl_Size *indexPtr); /* 645 */
    Tcl_Size (*tcl_UtfToUniChar) (const char *src, int *chPtr); /* 646 */
    char * (*tcl_UniCharToUtfDString) (const int *uniStr, Tcl_Size uniLength, Tcl_DString *dsPtr); /* 647 */
    int * (*tcl_UtfToUniCharDString) (const char *src, Tcl_Size length, Tcl_DString *dsPtr); /* 648 */
    unsigned char * (*tclGetBytesFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, void *numBytesPtr); /* 649 */
    unsigned char * (*tcl_GetBytesFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size *numBytesPtr); /* 650 */
    char * (*tcl_GetStringFromObj) (Tcl_Obj *objPtr, Tcl_Size *lengthPtr); /* 651 */
    Tcl_UniChar * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, Tcl_Size *lengthPtr); /* 652 */
    unsigned char * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, Tcl_Size *numBytesPtr); /* 653 */
    int (*tcl_UtfCharComplete) (const char *src, Tcl_Size length); /* 654 */
    const char * (*tcl_UtfNext) (const char *src); /* 655 */
    const char * (*tcl_UtfPrev) (const char *src, const char *start); /* 656 */
    int (*tcl_UniCharIsUnicode) (int ch); /* 657 */
    int (*tcl_ExternalToUtfDStringEx) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, Tcl_Size srcLen, int flags, Tcl_DString *dsPtr, Tcl_Size *errorLocationPtr); /* 658 */
    int (*tcl_UtfToExternalDStringEx) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, Tcl_Size srcLen, int flags, Tcl_DString *dsPtr, Tcl_Size *errorLocationPtr); /* 659 */
    int (*tcl_AsyncMarkFromSignal) (Tcl_AsyncHandler async, int sigNumber); /* 660 */
    int (*tcl_ListObjGetElements) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size *objcPtr, Tcl_Obj ***objvPtr); /* 661 */
    int (*tcl_ListObjLength) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size *lengthPtr); /* 662 */
    int (*tcl_DictObjSize) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Size *sizePtr); /* 663 */
    int (*tcl_SplitList) (Tcl_Interp *interp, const char *listStr, Tcl_Size *argcPtr, const char ***argvPtr); /* 664 */
    void (*tcl_SplitPath) (const char *path, Tcl_Size *argcPtr, const char ***argvPtr); /* 665 */
    Tcl_Obj * (*tcl_FSSplitPath) (Tcl_Obj *pathPtr, Tcl_Size *lenPtr); /* 666 */
    int (*tcl_ParseArgsObjv) (Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, Tcl_Size *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv); /* 667 */
    Tcl_Size (*tcl_UniCharLen) (const int *uniStr); /* 668 */
    Tcl_Size (*tcl_NumUtfChars) (const char *src, Tcl_Size length); /* 669 */
    Tcl_Size (*tcl_GetCharLength) (Tcl_Obj *objPtr); /* 670 */
    const char * (*tcl_UtfAtIndex) (const char *src, Tcl_Size index); /* 671 */
    Tcl_Obj * (*tcl_GetRange) (Tcl_Obj *objPtr, Tcl_Size first, Tcl_Size last); /* 672 */
    int (*tcl_GetUniChar) (Tcl_Obj *objPtr, Tcl_Size index); /* 673 */
    int (*tcl_GetBool) (Tcl_Interp *interp, const char *src, int flags, char *charPtr); /* 674 */
    int (*tcl_GetBoolFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, char *charPtr); /* 675 */
    Tcl_Command (*tcl_CreateObjCommand2) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc2 *proc2, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 676 */
    Tcl_Trace (*tcl_CreateObjTrace2) (Tcl_Interp *interp, Tcl_Size level, int flags, Tcl_CmdObjTraceProc2 *objProc2, void *clientData, Tcl_CmdObjTraceDeleteProc *delProc); /* 677 */
    Tcl_Command (*tcl_NRCreateCommand2) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc2 *proc, Tcl_ObjCmdProc2 *nreProc2, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 678 */
    int (*tcl_NRCallObjProc2) (Tcl_Interp *interp, Tcl_ObjCmdProc2 *objProc2, void *clientData, ptrdiff_t objc, Tcl_Obj *const objv[]); /* 679 */
    int (*tcl_GetNumberFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, void **clientDataPtr, int *typePtr); /* 680 */
    int (*tcl_GetNumber) (Tcl_Interp *interp, const char *bytes, Tcl_Size numBytes, void **clientDataPtr, int *typePtr); /* 681 */
    int (*tcl_RemoveChannelMode) (Tcl_Interp *interp, Tcl_Channel chan, int mode); /* 682 */
    Tcl_Size (*tcl_GetEncodingNulLength) (Tcl_Encoding encoding); /* 683 */



    int (*tcl_GetWideUIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideUInt *uwidePtr); /* 684 */

    Tcl_Obj * (*tcl_DStringToObj) (Tcl_DString *dsPtr); /* 685 */
    int (*tcl_GetSizeIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size *sizePtr); /* 686 */

    void (*reserved687)(void);

    void (*tclUnusedStubEntry) (void); /* 688 */
} TclStubs;

extern const TclStubs *tclStubsPtr;

#ifdef __cplusplus
}
#endif
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
	(tclStubsPtr->tcl_GetNumberFromObj) /* 680 */
#define Tcl_GetNumber \
	(tclStubsPtr->tcl_GetNumber) /* 681 */
#define Tcl_RemoveChannelMode \
	(tclStubsPtr->tcl_RemoveChannelMode) /* 682 */
#define Tcl_GetEncodingNulLength \
	(tclStubsPtr->tcl_GetEncodingNulLength) /* 683 */
#define Tcl_AbstractListGetType \
	(tclStubsPtr->tcl_AbstractListGetType) /* 684 */
#define Tcl_AbstractListObjNew \
	(tclStubsPtr->tcl_AbstractListObjNew) /* 685 */
#define Tcl_AbstractListObjLength \
	(tclStubsPtr->tcl_AbstractListObjLength) /* 686 */
#define Tcl_AbstractListObjIndex \
	(tclStubsPtr->tcl_AbstractListObjIndex) /* 687 */
#define Tcl_AbstractListObjRange \
	(tclStubsPtr->tcl_AbstractListObjRange) /* 688 */
#define Tcl_AbstractListObjReverse \
	(tclStubsPtr->tcl_AbstractListObjReverse) /* 689 */
#define Tcl_AbstractListObjGetElements \
	(tclStubsPtr->tcl_AbstractListObjGetElements) /* 690 */
#define Tcl_AbstractListObjCopy \
	(tclStubsPtr->tcl_AbstractListObjCopy) /* 691 */
#define Tcl_AbstractListGetConcreteRep \
	(tclStubsPtr->tcl_AbstractListGetConcreteRep) /* 692 */
#define Tcl_AbstractListSetElement \
	(tclStubsPtr->tcl_AbstractListSetElement) /* 693 */

#endif /* defined(USE_TCL_STUBS) */

/* !END!: Do not edit above this line. */



#ifdef _WIN32
#   undef Tcl_CreateFileHandler
#   undef Tcl_DeleteFileHandler
#   undef Tcl_GetOpenFile
#endif








|
|
|
|
|
|
<
|
<
<
<
<
<
<
|
|
<
<
<
<




>
>







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
	(tclStubsPtr->tcl_GetNumberFromObj) /* 680 */
#define Tcl_GetNumber \
	(tclStubsPtr->tcl_GetNumber) /* 681 */
#define Tcl_RemoveChannelMode \
	(tclStubsPtr->tcl_RemoveChannelMode) /* 682 */
#define Tcl_GetEncodingNulLength \
	(tclStubsPtr->tcl_GetEncodingNulLength) /* 683 */
#define Tcl_GetWideUIntFromObj \
	(tclStubsPtr->tcl_GetWideUIntFromObj) /* 684 */
#define Tcl_DStringToObj \
	(tclStubsPtr->tcl_DStringToObj) /* 685 */
#define Tcl_GetSizeIntFromObj \
	(tclStubsPtr->tcl_GetSizeIntFromObj) /* 686 */

/* Slot 687 is reserved */






#define TclUnusedStubEntry \
	(tclStubsPtr->tclUnusedStubEntry) /* 688 */





#endif /* defined(USE_TCL_STUBS) */

/* !END!: Do not edit above this line. */

#undef TclUnusedStubEntry

#ifdef _WIN32
#   undef Tcl_CreateFileHandler
#   undef Tcl_DeleteFileHandler
#   undef Tcl_GetOpenFile
#endif

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
#define Tcl_UntraceVar(interp, varName, flags, proc, clientData) \
	Tcl_UntraceVar2(interp, varName, NULL, flags, proc, clientData)
#define Tcl_VarTraceInfo(interp, varName, flags, proc, prevClientData) \
	Tcl_VarTraceInfo2(interp, varName, NULL, flags, proc, prevClientData)
#define Tcl_UpVar(interp, frameName, varName, localName, flags) \
	Tcl_UpVar2(interp, frameName, varName, NULL, localName, flags)
#define Tcl_AddErrorInfo(interp, message) \
	Tcl_AppendObjToErrorInfo(interp, Tcl_NewStringObj(message, TCL_INDEX_NONE))
#define Tcl_AddObjErrorInfo(interp, message, length) \
	Tcl_AppendObjToErrorInfo(interp, Tcl_NewStringObj(message, length))
#define Tcl_Eval(interp, objPtr) \
	Tcl_EvalEx(interp, objPtr, TCL_INDEX_NONE, 0)
#define Tcl_GlobalEval(interp, objPtr) \
	Tcl_EvalEx(interp, objPtr, TCL_INDEX_NONE, TCL_EVAL_GLOBAL)
#define Tcl_GetStringResult(interp) Tcl_GetString(Tcl_GetObjResult(interp))
#define Tcl_SetResult(interp, result, freeProc) \
	do { \
	    const char *__result = result; \
	    Tcl_FreeProc *__freeProc = freeProc; \
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(__result, TCL_INDEX_NONE)); \
	    if (__result != NULL && __freeProc != NULL && __freeProc != TCL_VOLATILE) { \
		if (__freeProc == TCL_DYNAMIC) { \
		    Tcl_Free((char *)__result); \
		} else { \
		    (*__freeProc)((char *)__result); \
		} \
	    } \
	} while(0)

#undef Tcl_UtfToExternalDString
#define Tcl_UtfToExternalDString(encoding, src, len, ds) \
	(Tcl_UtfToExternalDStringEx((encoding), (src), (len), \
	TCL_ENCODING_NOCOMPLAIN, (ds)), Tcl_DStringValue(ds))
#undef Tcl_ExternalToUtfDString
#define Tcl_ExternalToUtfDString(encoding, src, len, ds) \
	(Tcl_ExternalToUtfDStringEx((encoding), (src), (len), \
	TCL_ENCODING_NOCOMPLAIN, (ds)), Tcl_DStringValue(ds))

#if defined(USE_TCL_STUBS)
#   if defined(_WIN32) && defined(_WIN64)
#	undef Tcl_GetTime
/* Handle Win64 tk.dll being loaded in Cygwin64. */
#	define Tcl_GetTime(t) \
		do { \
		    union { \
			Tcl_Time now; \
			long long reserved; \
		    } _t; \
		    _t.reserved = -1; \
		    tclStubsPtr->tcl_GetTime((&_t.now)); \
		    if (_t.reserved != -1) { \
			_t.now.usec = _t.reserved; \
		    } \
		    *(t) = _t.now; \
		} while (0)
#   endif
#   if defined(__CYGWIN__) && defined(TCL_WIDE_INT_IS_LONG)
/* On Cygwin64, long is 64-bit while on Win64 long is 32-bit. Therefore
 * we have to make sure that all stub entries on Cygwin64 follow the







|











|











|
|


|
|







|






|







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
#define Tcl_UntraceVar(interp, varName, flags, proc, clientData) \
	Tcl_UntraceVar2(interp, varName, NULL, flags, proc, clientData)
#define Tcl_VarTraceInfo(interp, varName, flags, proc, prevClientData) \
	Tcl_VarTraceInfo2(interp, varName, NULL, flags, proc, prevClientData)
#define Tcl_UpVar(interp, frameName, varName, localName, flags) \
	Tcl_UpVar2(interp, frameName, varName, NULL, localName, flags)
#define Tcl_AddErrorInfo(interp, message) \
	Tcl_AppendObjToErrorInfo(interp, Tcl_NewStringObj(message, -1))
#define Tcl_AddObjErrorInfo(interp, message, length) \
	Tcl_AppendObjToErrorInfo(interp, Tcl_NewStringObj(message, length))
#define Tcl_Eval(interp, objPtr) \
	Tcl_EvalEx(interp, objPtr, TCL_INDEX_NONE, 0)
#define Tcl_GlobalEval(interp, objPtr) \
	Tcl_EvalEx(interp, objPtr, TCL_INDEX_NONE, TCL_EVAL_GLOBAL)
#define Tcl_GetStringResult(interp) Tcl_GetString(Tcl_GetObjResult(interp))
#define Tcl_SetResult(interp, result, freeProc) \
	do { \
	    const char *__result = result; \
	    Tcl_FreeProc *__freeProc = freeProc; \
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(__result, -1)); \
	    if (__result != NULL && __freeProc != NULL && __freeProc != TCL_VOLATILE) { \
		if (__freeProc == TCL_DYNAMIC) { \
		    Tcl_Free((char *)__result); \
		} else { \
		    (*__freeProc)((char *)__result); \
		} \
	    } \
	} while(0)

#undef Tcl_UtfToExternalDString
#define Tcl_UtfToExternalDString(encoding, src, len, ds) \
	(Tcl_UtfToExternalDStringEx(NULL, (encoding), (src), (len), \
	TCL_ENCODING_PROFILE_TCL8, (ds), NULL), Tcl_DStringValue(ds))
#undef Tcl_ExternalToUtfDString
#define Tcl_ExternalToUtfDString(encoding, src, len, ds) \
	(Tcl_ExternalToUtfDStringEx(NULL, (encoding), (src), (len), \
	TCL_ENCODING_PROFILE_TCL8, (ds), NULL), Tcl_DStringValue(ds))

#if defined(USE_TCL_STUBS)
#   if defined(_WIN32) && defined(_WIN64)
#	undef Tcl_GetTime
/* Handle Win64 tk.dll being loaded in Cygwin64. */
#	define Tcl_GetTime(t) \
		do { \
		    struct { \
			Tcl_Time now; \
			long long reserved; \
		    } _t; \
		    _t.reserved = -1; \
		    tclStubsPtr->tcl_GetTime((&_t.now)); \
		    if (_t.reserved != -1) { \
			_t.now.usec = (long) _t.reserved; \
		    } \
		    *(t) = _t.now; \
		} while (0)
#   endif
#   if defined(__CYGWIN__) && defined(TCL_WIDE_INT_IS_LONG)
/* On Cygwin64, long is 64-bit while on Win64 long is 32-bit. Therefore
 * we have to make sure that all stub entries on Cygwin64 follow the
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

#undef Tcl_GetString
#undef Tcl_GetUnicode
#define Tcl_GetString(objPtr) \
	Tcl_GetStringFromObj(objPtr, (Tcl_Size *)NULL)
#define Tcl_GetUnicode(objPtr) \
	Tcl_GetUnicodeFromObj(objPtr, (Tcl_Size *)NULL)

#undef Tcl_GetBytesFromObj



#undef Tcl_GetIndexFromObjStruct
#undef Tcl_GetBooleanFromObj
#undef Tcl_GetBoolean
#undef Tcl_GetStringFromObj
#undef Tcl_GetUnicodeFromObj
#undef TclGetByteArrayFromObj
#undef Tcl_GetByteArrayFromObj
#if defined(USE_TCL_STUBS)

#define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \
	(sizeof(*(sizePtr)) <= sizeof(int) ? \
		tclStubsPtr->tclGetBytesFromObj(interp, objPtr, (int *)(void *)(sizePtr)) : \
		tclStubsPtr->tcl_GetBytesFromObj(interp, objPtr, (size_t *)(void *)(sizePtr)))









#define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \
	(tclStubsPtr->tcl_GetIndexFromObjStruct((interp), (objPtr), (tablePtr), (offset), (msg), \
		(flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr)))
#define Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) \
	((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? tclStubsPtr->tcl_GetBooleanFromObj(interp, objPtr, (int *)(boolPtr)) : \
	Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)))
#define Tcl_GetBoolean(interp, src, boolPtr) \
	((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? tclStubsPtr->tcl_GetBoolean(interp, src, (int *)(boolPtr)) : \
	Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)))
#define Tcl_GetStringFromObj(objPtr, sizePtr) \
	(sizeof(*(sizePtr)) <= sizeof(int) ? \
		tclStubsPtr->tclGetStringFromObj(objPtr, (int *)(void *)(sizePtr)) : \
		tclStubsPtr->tcl_GetStringFromObj(objPtr, (size_t *)(void *)(sizePtr)))
#if TCL_MAJOR_VERSION > 8
#define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
	(sizeof(*(sizePtr)) <= sizeof(int) ? \
		tclStubsPtr->tclGetBytesFromObj(NULL, objPtr, (int *)(void *)(sizePtr)) : \
		tclStubsPtr->tcl_GetBytesFromObj(NULL, objPtr, (size_t *)(void *)(sizePtr)))
#else
#define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
	(sizeof(*(sizePtr)) <= sizeof(int) ? \
		tclStubsPtr->tclGetByteArrayFromObj(objPtr, (int *)(void *)(sizePtr)) : \
		tclStubsPtr->tcl_GetByteArrayFromObj(objPtr, (size_t *)(void *)(sizePtr)))
#endif
#define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \
	(sizeof(*(sizePtr)) <= sizeof(int) ? \
		tclStubsPtr->tclGetUnicodeFromObj(objPtr, (int *)(void *)(sizePtr)) : \
		tclStubsPtr->tcl_GetUnicodeFromObj(objPtr, (size_t *)(void *)(sizePtr)))
#else
#define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \
	(sizeof(*(sizePtr)) <= sizeof(int) ? \
		TclGetBytesFromObj(interp, objPtr, (int *)(void *)(sizePtr)) : \
		(Tcl_GetBytesFromObj)(interp, objPtr, (size_t *)(void *)(sizePtr)))
#define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \
	((Tcl_GetIndexFromObjStruct)((interp), (objPtr), (tablePtr), (offset), (msg), \
		(flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr)))
#define Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) \
	((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? Tcl_GetBooleanFromObj(interp, objPtr, (int *)(boolPtr)) : \
	Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)))
#define Tcl_GetBoolean(interp, src, boolPtr) \
	((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? Tcl_GetBoolean(interp, src, (int *)(boolPtr)) : \
	Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)))
#define Tcl_GetStringFromObj(objPtr, sizePtr) \
	(sizeof(*(sizePtr)) <= sizeof(int) ? \
		TclGetStringFromObj(objPtr, (int *)(void *)(sizePtr)) : \
		(Tcl_GetStringFromObj)(objPtr, (size_t *)(void *)(sizePtr)))
#define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
	(sizeof(*(sizePtr)) <= sizeof(int) ? \
		TclGetBytesFromObj(NULL, objPtr, (int *)(void *)(sizePtr)) : \
		(Tcl_GetBytesFromObj)(NULL, objPtr, (size_t *)(void *)(sizePtr)))
#define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \
	(sizeof(*(sizePtr)) <= sizeof(int) ? \
		TclGetUnicodeFromObj(objPtr, (int *)(void *)(sizePtr)) : \
		(Tcl_GetUnicodeFromObj)(objPtr, (size_t *)(void *)(sizePtr)))
#endif

#ifdef TCL_MEM_DEBUG
#   undef Tcl_Alloc
#   define Tcl_Alloc(x) \
    (Tcl_DbCkalloc((x), __FILE__, __LINE__))
#   undef Tcl_Free







>
|
>
>
>



<
<



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









<
<
<
<



|
|



|
|

<
<
<
<



|
|











|
|


|
|


|
|







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

#undef Tcl_GetString
#undef Tcl_GetUnicode
#define Tcl_GetString(objPtr) \
	Tcl_GetStringFromObj(objPtr, (Tcl_Size *)NULL)
#define Tcl_GetUnicode(objPtr) \
	Tcl_GetUnicodeFromObj(objPtr, (Tcl_Size *)NULL)
#if TCL_MAJOR_VERSION < 9 || !defined(TCL_NO_DEPRECATED)
#   undef Tcl_GetBytesFromObj
#   undef Tcl_GetStringFromObj
#   undef Tcl_GetUnicodeFromObj
#endif
#undef Tcl_GetIndexFromObjStruct
#undef Tcl_GetBooleanFromObj
#undef Tcl_GetBoolean


#undef TclGetByteArrayFromObj
#undef Tcl_GetByteArrayFromObj
#if defined(USE_TCL_STUBS)
#   if TCL_MAJOR_VERSION < 9 || !defined(TCL_NO_DEPRECATED)
#	define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \
		(sizeof(*(sizePtr)) <= sizeof(int) ? \
			tclStubsPtr->tclGetBytesFromObj(interp, objPtr, (sizePtr)) : \
			tclStubsPtr->tcl_GetBytesFromObj(interp, objPtr, (Tcl_Size *)(void *)(sizePtr)))
#	define Tcl_GetStringFromObj(objPtr, sizePtr) \
		(sizeof(*(sizePtr)) <= sizeof(int) ? \
			tclStubsPtr->tclGetStringFromObj(objPtr, (sizePtr)) : \
			tclStubsPtr->tcl_GetStringFromObj(objPtr, (Tcl_Size *)(void *)(sizePtr)))
#	define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \
		(sizeof(*(sizePtr)) <= sizeof(int) ? \
			tclStubsPtr->tclGetUnicodeFromObj(objPtr, (sizePtr)) : \
			tclStubsPtr->tcl_GetUnicodeFromObj(objPtr, (Tcl_Size *)(void *)(sizePtr)))
#   endif
#define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \
	(tclStubsPtr->tcl_GetIndexFromObjStruct((interp), (objPtr), (tablePtr), (offset), (msg), \
		(flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr)))
#define Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) \
	((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? tclStubsPtr->tcl_GetBooleanFromObj(interp, objPtr, (int *)(boolPtr)) : \
	Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)))
#define Tcl_GetBoolean(interp, src, boolPtr) \
	((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? tclStubsPtr->tcl_GetBoolean(interp, src, (int *)(boolPtr)) : \
	Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)))




#if TCL_MAJOR_VERSION > 8
#define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
	(sizeof(*(sizePtr)) <= sizeof(int) ? \
		tclStubsPtr->tclGetBytesFromObj(NULL, objPtr, (sizePtr)) : \
		tclStubsPtr->tcl_GetBytesFromObj(NULL, objPtr, (Tcl_Size *)(void *)(sizePtr)))
#else
#define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
	(sizeof(*(sizePtr)) <= sizeof(int) ? \
		tclStubsPtr->tclGetByteArrayFromObj(objPtr, (sizePtr)) : \
		tclStubsPtr->tcl_GetByteArrayFromObj(objPtr, (Tcl_Size *)(void *)(sizePtr)))
#endif




#else
#define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \
	(sizeof(*(sizePtr)) <= sizeof(int) ? \
		TclGetBytesFromObj(interp, objPtr, (sizePtr)) : \
		(Tcl_GetBytesFromObj)(interp, objPtr, (Tcl_Size *)(void *)(sizePtr)))
#define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \
	((Tcl_GetIndexFromObjStruct)((interp), (objPtr), (tablePtr), (offset), (msg), \
		(flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr)))
#define Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) \
	((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? Tcl_GetBooleanFromObj(interp, objPtr, (int *)(boolPtr)) : \
	Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)))
#define Tcl_GetBoolean(interp, src, boolPtr) \
	((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? Tcl_GetBoolean(interp, src, (int *)(boolPtr)) : \
	Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)))
#define Tcl_GetStringFromObj(objPtr, sizePtr) \
	(sizeof(*(sizePtr)) <= sizeof(int) ? \
		TclGetStringFromObj(objPtr, (sizePtr)) : \
		(Tcl_GetStringFromObj)(objPtr, (Tcl_Size *)(void *)(sizePtr)))
#define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
	(sizeof(*(sizePtr)) <= sizeof(int) ? \
		TclGetBytesFromObj(NULL, objPtr, (sizePtr)) : \
		(Tcl_GetBytesFromObj)(NULL, objPtr, (Tcl_Size *)(void *)(sizePtr)))
#define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \
	(sizeof(*(sizePtr)) <= sizeof(int) ? \
		TclGetUnicodeFromObj(objPtr, (sizePtr)) : \
		(Tcl_GetUnicodeFromObj)(objPtr, (Tcl_Size *)(void *)(sizePtr)))
#endif

#ifdef TCL_MEM_DEBUG
#   undef Tcl_Alloc
#   define Tcl_Alloc(x) \
    (Tcl_DbCkalloc((x), __FILE__, __LINE__))
#   undef Tcl_Free
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
#   define Tcl_WCharToUtfDString (sizeof(wchar_t) != sizeof(short) \
		? (char *(*)(const wchar_t *, Tcl_Size, Tcl_DString *))tclStubsPtr->tcl_UniCharToUtfDString \
		: (char *(*)(const wchar_t *, Tcl_Size, Tcl_DString *))Tcl_Char16ToUtfDString)
#   define Tcl_UtfToWCharDString (sizeof(wchar_t) != sizeof(short) \
		? (wchar_t *(*)(const char *, Tcl_Size, Tcl_DString *))tclStubsPtr->tcl_UtfToUniCharDString \
		: (wchar_t *(*)(const char *, Tcl_Size, Tcl_DString *))Tcl_UtfToChar16DString)
#   define Tcl_UtfToWChar (sizeof(wchar_t) != sizeof(short) \
		? (int (*)(const char *, wchar_t *))tclStubsPtr->tcl_UtfToUniChar \
		: (int (*)(const char *, wchar_t *))Tcl_UtfToChar16)
#   define Tcl_WCharLen (sizeof(wchar_t) != sizeof(short) \
		? (Tcl_Size (*)(wchar_t *))tclStubsPtr->tcl_UniCharLen \
		: (Tcl_Size (*)(wchar_t *))Tcl_Char16Len)

#   undef Tcl_ListObjGetElements
#   define Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr) (sizeof(*(objcPtr)) == sizeof(int) \
		? tclStubsPtr->tclListObjGetElements((interp), (listPtr), (int *)(void *)(objcPtr), (objvPtr)) \
		: tclStubsPtr->tcl_ListObjGetElements((interp), (listPtr), (size_t *)(void *)(objcPtr), (objvPtr)))
#   undef Tcl_ListObjLength
#   define Tcl_ListObjLength(interp, listPtr, lengthPtr) (sizeof(*(lengthPtr)) == sizeof(int) \
		? tclStubsPtr->tclListObjLength((interp), (listPtr), (int *)(void *)(lengthPtr)) \
		: tclStubsPtr->tcl_ListObjLength((interp), (listPtr), (size_t *)(void *)(lengthPtr)))
#   undef Tcl_DictObjSize
#   define Tcl_DictObjSize(interp, dictPtr, sizePtr) (sizeof(*(sizePtr)) == sizeof(int) \
		? tclStubsPtr->tclDictObjSize((interp), (dictPtr), (int *)(void *)(sizePtr)) \
		: tclStubsPtr->tcl_DictObjSize((interp), (dictPtr), (size_t *)(void *)(sizePtr)))
#   undef Tcl_SplitList
#   define Tcl_SplitList(interp, listStr, argcPtr, argvPtr) (sizeof(*(argcPtr)) == sizeof(int) \
		? tclStubsPtr->tclSplitList((interp), (listStr), (int *)(void *)(argcPtr), (argvPtr)) \
		: tclStubsPtr->tcl_SplitList((interp), (listStr), (size_t *)(void *)(argcPtr), (argvPtr)))
#   undef Tcl_SplitPath
#   define Tcl_SplitPath(path, argcPtr, argvPtr) (sizeof(*(argcPtr)) == sizeof(int) \
		? tclStubsPtr->tclSplitPath((path), (int *)(void *)(argcPtr), (argvPtr)) \
		: tclStubsPtr->tcl_SplitPath((path), (size_t *)(void *)(argcPtr), (argvPtr)))
#   undef Tcl_FSSplitPath
#   define Tcl_FSSplitPath(pathPtr, lenPtr) (sizeof(*(lenPtr)) == sizeof(int) \
		? tclStubsPtr->tclFSSplitPath((pathPtr), (int *)(void *)(lenPtr)) \
		: tclStubsPtr->tcl_FSSplitPath((pathPtr), (size_t *)(void *)(lenPtr)))
#   undef Tcl_ParseArgsObjv
#   define Tcl_ParseArgsObjv(interp, argTable, objcPtr, objv, remObjv) (sizeof(*(objcPtr)) == sizeof(int) \
		? tclStubsPtr->tclParseArgsObjv((interp), (argTable), (int *)(void *)(objcPtr), (objv), (remObjv)) \
		: tclStubsPtr->tcl_ParseArgsObjv((interp), (argTable), (size_t *)(void *)(objcPtr), (objv), (remObjv)))

#else
#   define Tcl_WCharToUtfDString (sizeof(wchar_t) != sizeof(short) \
		? (char *(*)(const wchar_t *, Tcl_Size, Tcl_DString *))Tcl_UniCharToUtfDString \
		: (char *(*)(const wchar_t *, Tcl_Size, Tcl_DString *))Tcl_Char16ToUtfDString)
#   define Tcl_UtfToWCharDString (sizeof(wchar_t) != sizeof(short) \
		? (wchar_t *(*)(const char *, Tcl_Size, Tcl_DString *))Tcl_UtfToUniCharDString \
		: (wchar_t *(*)(const char *, Tcl_Size, Tcl_DString *))Tcl_UtfToChar16DString)
#   define Tcl_UtfToWChar (sizeof(wchar_t) != sizeof(short) \
		? (int (*)(const char *, wchar_t *))Tcl_UtfToUniChar \
		: (int (*)(const char *, wchar_t *))Tcl_UtfToChar16)
#   define Tcl_WCharLen (sizeof(wchar_t) != sizeof(short) \
		? (Tcl_Size (*)(wchar_t *))Tcl_UniCharLen \
		: (Tcl_Size (*)(wchar_t *))Tcl_Char16Len)
#if !defined(BUILD_tcl)
#   define Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr) (sizeof(*(objcPtr)) == sizeof(int) \
		? TclListObjGetElements((interp), (listPtr), (int *)(void *)(objcPtr), (objvPtr)) \
		: (Tcl_ListObjGetElements)((interp), (listPtr), (size_t *)(void *)(objcPtr), (objvPtr)))
#   define Tcl_ListObjLength(interp, listPtr, lengthPtr) (sizeof(*(lengthPtr)) == sizeof(int) \
		? TclListObjLength((interp), (listPtr), (int *)(void *)(lengthPtr)) \
		: (Tcl_ListObjLength)((interp), (listPtr), (size_t *)(void *)(lengthPtr)))
#   define Tcl_DictObjSize(interp, dictPtr, sizePtr) (sizeof(*(sizePtr)) == sizeof(int) \
		? TclDictObjSize((interp), (dictPtr), (int *)(void *)(sizePtr)) \
		: (Tcl_DictObjSize)((interp), (dictPtr), (size_t *)(void *)(sizePtr)))
#   define Tcl_SplitList(interp, listStr, argcPtr, argvPtr) (sizeof(*(argcPtr)) == sizeof(int) \
		? TclSplitList((interp), (listStr), (int *)(void *)(argcPtr), (argvPtr)) \
		: (Tcl_SplitList)((interp), (listStr), (size_t *)(void *)(argcPtr), (argvPtr)))
#   define Tcl_SplitPath(path, argcPtr, argvPtr) (sizeof(*(argcPtr)) == sizeof(int) \
		? TclSplitPath((path), (int *)(void *)(argcPtr), (argvPtr)) \
		: (Tcl_SplitPath)((path), (size_t *)(void *)(argcPtr), (argvPtr)))
#   define Tcl_FSSplitPath(pathPtr, lenPtr) (sizeof(*(lenPtr)) == sizeof(int) \
		? TclFSSplitPath((pathPtr), (int *)(void *)(lenPtr)) \
		: (Tcl_FSSplitPath)((pathPtr), (size_t *)(void *)(lenPtr)))
#   define Tcl_ParseArgsObjv(interp, argTable, objcPtr, objv, remObjv) (sizeof(*(objcPtr)) == sizeof(int) \
		? TclParseArgsObjv((interp), (argTable), (int *)(void *)(objcPtr), (objv), (remObjv)) \
		: (Tcl_ParseArgsObjv)((interp), (argTable), (size_t *)(void *)(objcPtr), (objv), (remObjv)))
#endif /* !defined(BUILD_tcl) */
#endif

/*
 * Deprecated Tcl procedures:
 */

#define Tcl_EvalObj(interp, objPtr) \
    Tcl_EvalObjEx(interp, objPtr, 0)
#define Tcl_GlobalEvalObj(interp, objPtr) \
    Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL)

#if defined(TCL_8_COMPAT) && !defined(BUILD_tcl)
#   ifdef USE_TCL_STUBS
#	undef Tcl_Gets
#	undef Tcl_GetsObj
#	undef Tcl_Read
#	undef Tcl_Ungets
#	undef Tcl_Write
#	undef Tcl_ReadChars
#	undef Tcl_WriteChars
#	undef Tcl_WriteObj
#	undef Tcl_ReadRaw
#	undef Tcl_WriteRaw
#	define Tcl_Gets(chan, dsPtr) (((Tcl_WideInt)((tclStubsPtr->tcl_Gets)(chan, dsPtr)+1))-1)
#	define Tcl_GetsObj(chan, objPtr) (((Tcl_WideInt)((tclStubsPtr->tcl_GetsObj)(chan, objPtr)+1))-1)
#	define Tcl_Read(chan, bufPtr, toRead) (((Tcl_WideInt)((tclStubsPtr->tcl_Read)(chan, bufPtr, toRead)+1))-1)
#	define Tcl_Ungets(chan, str, len, atHead) (((Tcl_WideInt)((tclStubsPtr->tcl_Ungets)(chan, str, len, atHead)+1))-1)
#	define Tcl_Write(chan, s, slen) (((Tcl_WideInt)((tclStubsPtr->tcl_Write)(chan, s, slen)+1))-1)
#	define Tcl_ReadChars(channel, objPtr, charsToRead, appendFlag) (((Tcl_WideInt)((tclStubsPtr->tcl_ReadChars)(channel, objPtr, charsToRead, appendFlag)+1))-1)
#	define Tcl_WriteChars(chan, src, srcLen) (((Tcl_WideInt)((tclStubsPtr->tcl_WriteChars)(chan, src, srcLen)+1))-1)
#	define Tcl_WriteObj(chan, objPtr) (((Tcl_WideInt)((tclStubsPtr->tcl_WriteObj)(chan, objPtr)+1))-1)
#	define Tcl_ReadRaw(chan, dst, bytesToRead) (((Tcl_WideInt)((tclStubsPtr->tcl_ReadRaw)(chan, dst, bytesToRead)+1))-1)
#	define Tcl_WriteRaw(chan, src, srcLen) (((Tcl_WideInt)((tclStubsPtr->tcl_WriteRaw()(chan, src, srcLen)+1))-1)
#   else
#	define Tcl_Gets(chan, dsPtr) (((Tcl_WideInt)((Tcl_Gets)(chan, dsPtr)+1))-1)
#	define Tcl_GetsObj(chan, objPtr) (((Tcl_WideInt)((Tcl_GetsObj)(chan, objPtr)+1))-1)
#	define Tcl_Read(chan, bufPtr, toRead) (((Tcl_WideInt)((Tcl_Read)(chan, bufPtr, toRead)+1))-1)
#	define Tcl_Ungets(chan, str, len, atHead) (((Tcl_WideInt)((Tcl_Ungets)(chan, str, len, atHead)+1))-1)
#	define Tcl_Write(chan, s, slen) (((Tcl_WideInt)((Tcl_Write)(chan, s, slen)+1))-1)
#	define Tcl_ReadChars(channel, objPtr, charsToRead, appendFlag) (((Tcl_WideInt)((Tcl_ReadChars)(channel, objPtr, charsToRead, appendFlag)+1))-1)
#	define Tcl_WriteChars(chan, src, srcLen) (((Tcl_WideInt)((Tcl_WriteChars)(chan, src, srcLen)+1))-1)
#	define Tcl_WriteObj(chan, objPtr) (((Tcl_WideInt)((Tcl_WriteObj)(chan, objPtr)+1))-1)
#	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

#if TCL_MAJOR_VERSION > 8
#   undef Tcl_Close
#   define Tcl_Close(interp, chan) Tcl_CloseEx(interp, chan, 0)
#endif

#undef TclUtfCharComplete
#undef TclUtfNext
#undef TclUtfPrev
#ifndef TCL_NO_DEPRECATED
#   define Tcl_CreateSlave Tcl_CreateChild
#   define Tcl_GetSlave Tcl_GetChild
#   define Tcl_GetMaster Tcl_GetParent
#endif







#endif /* _TCLDECLS */







|
|



>


|
|


|
|


|
|


|
|


|
|


|
|


|
|
>








|
|



|

|
|

|
|

|
|

|
|

|
|

|
|

|
|












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














>
>
>
>
>
>

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
#   define Tcl_WCharToUtfDString (sizeof(wchar_t) != sizeof(short) \
		? (char *(*)(const wchar_t *, Tcl_Size, Tcl_DString *))tclStubsPtr->tcl_UniCharToUtfDString \
		: (char *(*)(const wchar_t *, Tcl_Size, Tcl_DString *))Tcl_Char16ToUtfDString)
#   define Tcl_UtfToWCharDString (sizeof(wchar_t) != sizeof(short) \
		? (wchar_t *(*)(const char *, Tcl_Size, Tcl_DString *))tclStubsPtr->tcl_UtfToUniCharDString \
		: (wchar_t *(*)(const char *, Tcl_Size, Tcl_DString *))Tcl_UtfToChar16DString)
#   define Tcl_UtfToWChar (sizeof(wchar_t) != sizeof(short) \
		? (Tcl_Size (*)(const char *, wchar_t *))tclStubsPtr->tcl_UtfToUniChar \
		: (Tcl_Size (*)(const char *, wchar_t *))Tcl_UtfToChar16)
#   define Tcl_WCharLen (sizeof(wchar_t) != sizeof(short) \
		? (Tcl_Size (*)(wchar_t *))tclStubsPtr->tcl_UniCharLen \
		: (Tcl_Size (*)(wchar_t *))Tcl_Char16Len)
#if TCL_MAJOR_VERSION < 9 || !defined(TCL_NO_DEPRECATED)
#   undef Tcl_ListObjGetElements
#   define Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr) (sizeof(*(objcPtr)) == sizeof(int) \
		? tclStubsPtr->tclListObjGetElements((interp), (listPtr), (objcPtr), (objvPtr)) \
		: tclStubsPtr->tcl_ListObjGetElements((interp), (listPtr), (Tcl_Size *)(void *)(objcPtr), (objvPtr)))
#   undef Tcl_ListObjLength
#   define Tcl_ListObjLength(interp, listPtr, lengthPtr) (sizeof(*(lengthPtr)) == sizeof(int) \
		? tclStubsPtr->tclListObjLength((interp), (listPtr), (lengthPtr)) \
		: tclStubsPtr->tcl_ListObjLength((interp), (listPtr), (Tcl_Size *)(void *)(lengthPtr)))
#   undef Tcl_DictObjSize
#   define Tcl_DictObjSize(interp, dictPtr, sizePtr) (sizeof(*(sizePtr)) == sizeof(int) \
		? tclStubsPtr->tclDictObjSize((interp), (dictPtr), (sizePtr)) \
		: tclStubsPtr->tcl_DictObjSize((interp), (dictPtr), (Tcl_Size *)(void *)(sizePtr)))
#   undef Tcl_SplitList
#   define Tcl_SplitList(interp, listStr, argcPtr, argvPtr) (sizeof(*(argcPtr)) == sizeof(int) \
		? tclStubsPtr->tclSplitList((interp), (listStr), (argcPtr), (argvPtr)) \
		: tclStubsPtr->tcl_SplitList((interp), (listStr), (Tcl_Size *)(void *)(argcPtr), (argvPtr)))
#   undef Tcl_SplitPath
#   define Tcl_SplitPath(path, argcPtr, argvPtr) (sizeof(*(argcPtr)) == sizeof(int) \
		? tclStubsPtr->tclSplitPath((path), (argcPtr), (argvPtr)) \
		: tclStubsPtr->tcl_SplitPath((path), (Tcl_Size *)(void *)(argcPtr), (argvPtr)))
#   undef Tcl_FSSplitPath
#   define Tcl_FSSplitPath(pathPtr, lenPtr) (sizeof(*(lenPtr)) == sizeof(int) \
		? tclStubsPtr->tclFSSplitPath((pathPtr), (lenPtr)) \
		: tclStubsPtr->tcl_FSSplitPath((pathPtr), (Tcl_Size *)(void *)(lenPtr)))
#   undef Tcl_ParseArgsObjv
#   define Tcl_ParseArgsObjv(interp, argTable, objcPtr, objv, remObjv) (sizeof(*(objcPtr)) == sizeof(int) \
		? tclStubsPtr->tclParseArgsObjv((interp), (argTable), (objcPtr), (objv), (remObjv)) \
		: tclStubsPtr->tcl_ParseArgsObjv((interp), (argTable), (Tcl_Size *)(void *)(objcPtr), (objv), (remObjv)))
#endif /* TCL_MAJOR_VERSION < 9 || !defined(TCL_NO_DEPRECATED) */
#else
#   define Tcl_WCharToUtfDString (sizeof(wchar_t) != sizeof(short) \
		? (char *(*)(const wchar_t *, Tcl_Size, Tcl_DString *))Tcl_UniCharToUtfDString \
		: (char *(*)(const wchar_t *, Tcl_Size, Tcl_DString *))Tcl_Char16ToUtfDString)
#   define Tcl_UtfToWCharDString (sizeof(wchar_t) != sizeof(short) \
		? (wchar_t *(*)(const char *, Tcl_Size, Tcl_DString *))Tcl_UtfToUniCharDString \
		: (wchar_t *(*)(const char *, Tcl_Size, Tcl_DString *))Tcl_UtfToChar16DString)
#   define Tcl_UtfToWChar (sizeof(wchar_t) != sizeof(short) \
		? (Tcl_Size (*)(const char *, wchar_t *))Tcl_UtfToUniChar \
		: (Tcl_Size (*)(const char *, wchar_t *))Tcl_UtfToChar16)
#   define Tcl_WCharLen (sizeof(wchar_t) != sizeof(short) \
		? (Tcl_Size (*)(wchar_t *))Tcl_UniCharLen \
		: (Tcl_Size (*)(wchar_t *))Tcl_Char16Len)
#if !defined(BUILD_tcl) && !defined(TCL_NO_DEPRECATED)
#   define Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr) (sizeof(*(objcPtr)) == sizeof(int) \
		? TclListObjGetElements((interp), (listPtr), (objcPtr), (objvPtr)) \
		: (Tcl_ListObjGetElements)((interp), (listPtr), (Tcl_Size *)(void *)(objcPtr), (objvPtr)))
#   define Tcl_ListObjLength(interp, listPtr, lengthPtr) (sizeof(*(lengthPtr)) == sizeof(int) \
		? TclListObjLength((interp), (listPtr), (lengthPtr)) \
		: (Tcl_ListObjLength)((interp), (listPtr), (Tcl_Size *)(void *)(lengthPtr)))
#   define Tcl_DictObjSize(interp, dictPtr, sizePtr) (sizeof(*(sizePtr)) == sizeof(int) \
		? TclDictObjSize((interp), (dictPtr), (sizePtr)) \
		: (Tcl_DictObjSize)((interp), (dictPtr), (Tcl_Size *)(void *)(sizePtr)))
#   define Tcl_SplitList(interp, listStr, argcPtr, argvPtr) (sizeof(*(argcPtr)) == sizeof(int) \
		? TclSplitList((interp), (listStr), (argcPtr), (argvPtr)) \
		: (Tcl_SplitList)((interp), (listStr), (Tcl_Size *)(void *)(argcPtr), (argvPtr)))
#   define Tcl_SplitPath(path, argcPtr, argvPtr) (sizeof(*(argcPtr)) == sizeof(int) \
		? TclSplitPath((path), (argcPtr), (argvPtr)) \
		: (Tcl_SplitPath)((path), (Tcl_Size *)(void *)(argcPtr), (argvPtr)))
#   define Tcl_FSSplitPath(pathPtr, lenPtr) (sizeof(*(lenPtr)) == sizeof(int) \
		? TclFSSplitPath((pathPtr), (lenPtr)) \
		: (Tcl_FSSplitPath)((pathPtr), (Tcl_Size *)(void *)(lenPtr)))
#   define Tcl_ParseArgsObjv(interp, argTable, objcPtr, objv, remObjv) (sizeof(*(objcPtr)) == sizeof(int) \
		? TclParseArgsObjv((interp), (argTable), (objcPtr), (objv), (remObjv)) \
		: (Tcl_ParseArgsObjv)((interp), (argTable), (Tcl_Size *)(void *)(objcPtr), (objv), (remObjv)))
#endif /* !defined(BUILD_tcl) */
#endif

/*
 * Deprecated Tcl procedures:
 */

#define Tcl_EvalObj(interp, objPtr) \
    Tcl_EvalObjEx(interp, objPtr, 0)
#define Tcl_GlobalEvalObj(interp, objPtr) \
    Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL)





































#if TCL_MAJOR_VERSION > 8
#   undef Tcl_Close
#   define Tcl_Close(interp, chan) Tcl_CloseEx(interp, chan, 0)
#endif

#undef TclUtfCharComplete
#undef TclUtfNext
#undef TclUtfPrev
#ifndef TCL_NO_DEPRECATED
#   define Tcl_CreateSlave Tcl_CreateChild
#   define Tcl_GetSlave Tcl_GetChild
#   define Tcl_GetMaster Tcl_GetParent
#endif

/* TIP #660 for 8.7 */
#if TCL_MAJOR_VERSION < 9
#   undef Tcl_GetSizeIntFromObj
#   define Tcl_GetSizeIntFromObj Tcl_GetIntFromObj
#endif

#endif /* _TCLDECLS */

Changes to generic/tclDictObj.c.

57
58
59
60
61
62
63


64
65
66
67
68
69
70
					Tcl_Obj *keyPtr);
static Tcl_NRPostProc		FinalizeDictUpdate;
static Tcl_NRPostProc		FinalizeDictWith;
static Tcl_ObjCmdProc		DictForNRCmd;
static Tcl_ObjCmdProc		DictMapNRCmd;
static Tcl_NRPostProc		DictForLoopCallback;
static Tcl_NRPostProc		DictMapLoopCallback;



/*
 * Table of dict subcommand names and implementations.
 */

static const EnsembleImplMap implementationMap[] = {
    {"append",	DictAppendCmd,	TclCompileDictAppendCmd, NULL, NULL, 0 },







>
>







57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
					Tcl_Obj *keyPtr);
static Tcl_NRPostProc		FinalizeDictUpdate;
static Tcl_NRPostProc		FinalizeDictWith;
static Tcl_ObjCmdProc		DictForNRCmd;
static Tcl_ObjCmdProc		DictMapNRCmd;
static Tcl_NRPostProc		DictForLoopCallback;
static Tcl_NRPostProc		DictMapLoopCallback;
static Tcl_ObjTypeLengthProc    DictAsListLength;
static Tcl_ObjTypeIndexProc     DictAsListIndex;

/*
 * Table of dict subcommand names and implementations.
 */

static const EnsembleImplMap implementationMap[] = {
    {"append",	DictAppendCmd,	TclCompileDictAppendCmd, NULL, NULL, 0 },
139
140
141
142
143
144
145
146
147
148
149











150
151
152
153
154
155
156
/*
 * The structure below defines the dictionary object type by means of
 * functions that can be invoked by generic object code.
 */

const Tcl_ObjType tclDictType = {
    "dict",
    FreeDictInternalRep,		/* freeIntRepProc */
    DupDictInternalRep,			/* dupIntRepProc */
    UpdateStringOfDict,			/* updateStringProc */
    SetDictFromAny			/* setFromAnyProc */











};

#define DictSetInternalRep(objPtr, dictRepPtr)				\
    do {                                                                \
        Tcl_ObjInternalRep ir;                                               \
        ir.twoPtrValue.ptr1 = (dictRepPtr);                             \
        ir.twoPtrValue.ptr2 = NULL;                                     \







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







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
/*
 * The structure below defines the dictionary object type by means of
 * functions that can be invoked by generic object code.
 */

const Tcl_ObjType tclDictType = {
    "dict",
    FreeDictInternalRep,	/* freeIntRepProc */
    DupDictInternalRep,		/* dupIntRepProc */
    UpdateStringOfDict,		/* updateStringProc */
    SetDictFromAny,		/* setFromAnyProc */
    TCL_OBJTYPE_V2(		/* Extended type for AbstractLists */
    DictAsListLength,		/* return "list" length of dict value w/o
				 * shimmering */
    DictAsListIndex,		/* return key or value at "list" index
				 * location.  (keysare at even indicies,
				 * values at odd indicies) */
    NULL,
    NULL,
    NULL,
    NULL,
    NULL)
};

#define DictSetInternalRep(objPtr, dictRepPtr)				\
    do {                                                                \
        Tcl_ObjInternalRep ir;                                               \
        ir.twoPtrValue.ptr1 = (dictRepPtr);                             \
        ir.twoPtrValue.ptr2 = NULL;                                     \
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
    Tcl_Obj *dictPtr)
{
#define LOCAL_SIZE 64
    char localFlags[LOCAL_SIZE], *flagPtr = NULL;
    Dict *dict;
    ChainEntry *cPtr;
    Tcl_Obj *keyPtr, *valuePtr;
    size_t i, length;
    TCL_HASH_TYPE bytesNeeded = 0;
    const char *elem;
    char *dst;

    /*
     * This field is the most useful one in the whole hash structure, and it
     * is not exposed by any API function...
     */

    size_t numElems;

    DictGetInternalRep(dictPtr, dict);

    assert (dict != NULL);

    numElems = dict->table.numEntries * 2;








|









|







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
    Tcl_Obj *dictPtr)
{
#define LOCAL_SIZE 64
    char localFlags[LOCAL_SIZE], *flagPtr = NULL;
    Dict *dict;
    ChainEntry *cPtr;
    Tcl_Obj *keyPtr, *valuePtr;
    Tcl_Size i, length;
    TCL_HASH_TYPE bytesNeeded = 0;
    const char *elem;
    char *dst;

    /*
     * This field is the most useful one in the whole hash structure, and it
     * is not exposed by any API function...
     */

    Tcl_Size numElems;

    DictGetInternalRep(dictPtr, dict);

    assert (dict != NULL);

    numElems = dict->table.numEntries * 2;

599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
    /*
     * Since lists and dictionaries have very closely-related string
     * representations (i.e. the same parsing code) we can safely special-case
     * the conversion from lists to dictionaries.
     */

    if (TclHasInternalRep(objPtr, &tclListType)) {
	size_t objc, i;
	Tcl_Obj **objv;

	/* Cannot fail, we already know the Tcl_ObjType is "list". */
	TclListObjGetElementsM(NULL, objPtr, &objc, &objv);
	if (objc & 1) {
	    goto missingValue;
	}







|







612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
    /*
     * Since lists and dictionaries have very closely-related string
     * representations (i.e. the same parsing code) we can safely special-case
     * the conversion from lists to dictionaries.
     */

    if (TclHasInternalRep(objPtr, &tclListType)) {
	Tcl_Size objc, i;
	Tcl_Obj **objv;

	/* Cannot fail, we already know the Tcl_ObjType is "list". */
	TclListObjGetElementsM(NULL, objPtr, &objc, &objv);
	if (objc & 1) {
	    goto missingValue;
	}
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650

		TclDecrRefCount(discardedValue);
	    }
	    Tcl_SetHashValue(hPtr, objv[i+1]);
	    Tcl_IncrRefCount(objv[i+1]); /* Since hash now holds ref to it */
	}
    } else {
	size_t length;
	const char *nextElem = Tcl_GetStringFromObj(objPtr, &length);
	const char *limit = (nextElem + length);

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

	    if (TclFindDictElement(interp, nextElem, (limit - nextElem),
		    &elemStart, &nextElem, &elemSize, &literal) != TCL_OK) {
		goto errorInFindDictElement;
	    }
	    if (elemStart == limit) {







|






|







642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663

		TclDecrRefCount(discardedValue);
	    }
	    Tcl_SetHashValue(hPtr, objv[i+1]);
	    Tcl_IncrRefCount(objv[i+1]); /* Since hash now holds ref to it */
	}
    } else {
	Tcl_Size length;
	const char *nextElem = Tcl_GetStringFromObj(objPtr, &length);
	const char *limit = (nextElem + length);

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

	    if (TclFindDictElement(interp, nextElem, (limit - nextElem),
		    &elemStart, &nextElem, &elemSize, &literal) != TCL_OK) {
		goto errorInFindDictElement;
	    }
	    if (elemStart == limit) {
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
 *	effects (other than potential conversion of objects to dictionaries.)
 *	If the flags argument is DICT_PATH_UPDATE, the following additional
 *	side effects occur. Shared dictionaries along the path are converted
 *	into unshared objects, and a backward-pointing chain is built using
 *	the chain fields of the dictionaries (for easy invalidation of string
 *	representations using InvalidateDictChain). If the flags argument has
 *	the DICT_PATH_CREATE bits set (and not the DICT_PATH_EXISTS bit),
 *	non-existant keys will be inserted with a value of an empty
 *	dictionary, resulting in the path being built.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclTraceDictPath(
    Tcl_Interp *interp,
    Tcl_Obj *dictPtr,
    size_t keyc,
    Tcl_Obj *const keyv[],
    int flags)
{
    Dict *dict, *newDict;
    size_t i;

    DictGetInternalRep(dictPtr, dict);
    if (dict == NULL) {
	if (SetDictFromAny(interp, dictPtr) != TCL_OK) {
	    return NULL;
	}
	DictGetInternalRep(dictPtr, dict);







|









|




|







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
 *	effects (other than potential conversion of objects to dictionaries.)
 *	If the flags argument is DICT_PATH_UPDATE, the following additional
 *	side effects occur. Shared dictionaries along the path are converted
 *	into unshared objects, and a backward-pointing chain is built using
 *	the chain fields of the dictionaries (for easy invalidation of string
 *	representations using InvalidateDictChain). If the flags argument has
 *	the DICT_PATH_CREATE bits set (and not the DICT_PATH_EXISTS bit),
 *	non-extant keys will be inserted with a value of an empty
 *	dictionary, resulting in the path being built.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclTraceDictPath(
    Tcl_Interp *interp,
    Tcl_Obj *dictPtr,
    Tcl_Size keyc,
    Tcl_Obj *const keyv[],
    int flags)
{
    Dict *dict, *newDict;
    Tcl_Size i;

    DictGetInternalRep(dictPtr, dict);
    if (dict == NULL) {
	if (SetDictFromAny(interp, dictPtr) != TCL_OK) {
	    return NULL;
	}
	DictGetInternalRep(dictPtr, dict);
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
}

/*
 *----------------------------------------------------------------------
 *
 * InvalidateDictChain --
 *
 *	Go through a dictionary chain (built by an updating invokation of
 *	TclTraceDictPath) and invalidate the string representations of all the
 *	dictionaries on the chain.
 *
 * Results:
 *	None
 *
 * Side effects:







|







870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
}

/*
 *----------------------------------------------------------------------
 *
 * InvalidateDictChain --
 *
 *	Go through a dictionary chain (built by an updating invocation of
 *	TclTraceDictPath) and invalidate the string representations of all the
 *	dictionaries on the chain.
 *
 * Results:
 *	None
 *
 * Side effects:
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
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *




















 * Tcl_DictObjSize --
 *
 *	How many key,value pairs are there in the dictionary?
 *
 * Results:
 *	A standard Tcl result. Updates the variable pointed to by sizePtr with
 *	the number of key,value pairs in the dictionary.
 *
 * Side effects:
 *	The dictPtr object is converted to a dictionary type if it is not a
 *	dictionary already.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_DictObjSize
int
Tcl_DictObjSize(
    Tcl_Interp *interp,
    Tcl_Obj *dictPtr,
    size_t *sizePtr)
{
    Dict *dict;

    dict = GetDictFromObj(interp, dictPtr);
    if (dict == NULL) {
	return TCL_ERROR;
    }







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




















|







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
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DictGetSize
 *
 *	Returns the size of dictPtr.  Caller must ensure that dictPtr has type
 *	'tclDicttype'.
 *
 *
 *----------------------------------------------------------------------
 */

Tcl_Size
TclDictGetSize(Tcl_Obj *dictPtr)
{
    Dict *dict;
    DictGetInternalRep(dictPtr, dict);
    return dict->table.numEntries;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DictObjSize --
 *
 *	How many key,value pairs are there in the dictionary?
 *
 * Results:
 *	A standard Tcl result. Updates the variable pointed to by sizePtr with
 *	the number of key,value pairs in the dictionary.
 *
 * Side effects:
 *	The dictPtr object is converted to a dictionary type if it is not a
 *	dictionary already.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_DictObjSize
int
Tcl_DictObjSize(
    Tcl_Interp *interp,
    Tcl_Obj *dictPtr,
    Tcl_Size *sizePtr)
{
    Dict *dict;

    dict = GetDictFromObj(interp, dictPtr);
    if (dict == NULL) {
	return TCL_ERROR;
    }
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
				 * written into when there are no further
				 * values in the dictionary, or a 0
				 * otherwise. */
{
    ChainEntry *cPtr;

    /*
     * If the searh is done; we do no work.
     */

    if (!searchPtr->epoch) {
	*donePtr = 1;
	return;
    }








|







1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
				 * written into when there are no further
				 * values in the dictionary, or a 0
				 * otherwise. */
{
    ChainEntry *cPtr;

    /*
     * If the search is done; we do no work.
     */

    if (!searchPtr->epoch) {
	*donePtr = 1;
	return;
    }

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

int
Tcl_DictObjPutKeyList(
    Tcl_Interp *interp,
    Tcl_Obj *dictPtr,
    size_t keyc,
    Tcl_Obj *const keyv[],
    Tcl_Obj *valuePtr)
{
    Dict *dict;
    Tcl_HashEntry *hPtr;
    int isNew;

    if (Tcl_IsShared(dictPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_DictObjPutKeyList");
    }
    if (keyc + 1 < 2) {
	Tcl_Panic("%s called with empty key list", "Tcl_DictObjPutKeyList");
    }

    dictPtr = TclTraceDictPath(interp, dictPtr, keyc-1,keyv, DICT_PATH_CREATE);
    if (dictPtr == NULL) {
	return TCL_ERROR;
    }







|










|







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

int
Tcl_DictObjPutKeyList(
    Tcl_Interp *interp,
    Tcl_Obj *dictPtr,
    Tcl_Size keyc,
    Tcl_Obj *const keyv[],
    Tcl_Obj *valuePtr)
{
    Dict *dict;
    Tcl_HashEntry *hPtr;
    int isNew;

    if (Tcl_IsShared(dictPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_DictObjPutKeyList");
    }
    if (keyc < 1) {
	Tcl_Panic("%s called with empty key list", "Tcl_DictObjPutKeyList");
    }

    dictPtr = TclTraceDictPath(interp, dictPtr, keyc-1,keyv, DICT_PATH_CREATE);
    if (dictPtr == NULL) {
	return TCL_ERROR;
    }
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
 *----------------------------------------------------------------------
 */

int
Tcl_DictObjRemoveKeyList(
    Tcl_Interp *interp,
    Tcl_Obj *dictPtr,
    size_t keyc,
    Tcl_Obj *const keyv[])
{
    Dict *dict;

    if (Tcl_IsShared(dictPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_DictObjRemoveKeyList");
    }







|







1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
 *----------------------------------------------------------------------
 */

int
Tcl_DictObjRemoveKeyList(
    Tcl_Interp *interp,
    Tcl_Obj *dictPtr,
    Tcl_Size keyc,
    Tcl_Obj *const keyv[])
{
    Dict *dict;

    if (Tcl_IsShared(dictPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_DictObjRemoveKeyList");
    }
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
DictSizeCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    int result;
	size_t size;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictionary");
	return TCL_ERROR;
    }
    result = Tcl_DictObjSize(interp, objv[1], &size);
    if (result == TCL_OK) {







|







2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
DictSizeCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    int result;
	Tcl_Size size;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictionary");
	return TCL_ERROR;
    }
    result = Tcl_DictObjSize(interp, objv[1], &size);
    if (result == TCL_OK) {
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
    int objc,
    Tcl_Obj *const *objv)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj;
    Tcl_Obj **varv, *keyObj, *valueObj;
    Tcl_DictSearch *searchPtr;
    size_t varc;
    int done;

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"{keyVarName valueVarName} dictionary script");
	return TCL_ERROR;
    }







|







2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
    int objc,
    Tcl_Obj *const *objv)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj;
    Tcl_Obj **varv, *keyObj, *valueObj;
    Tcl_DictSearch *searchPtr;
    Tcl_Size varc;
    int done;

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"{keyVarName valueVarName} dictionary script");
	return TCL_ERROR;
    }
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj **varv, *keyObj, *valueObj;
    DictMapStorage *storagePtr;
    size_t varc;
    int done;

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"{keyVarName valueVarName} dictionary script");
	return TCL_ERROR;
    }







|







2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj **varv, *keyObj, *valueObj;
    DictMapStorage *storagePtr;
    Tcl_Size varc;
    int done;

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"{keyVarName valueVarName} dictionary script");
	return TCL_ERROR;
    }
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
    enum FilterTypes {
	FILTER_KEYS, FILTER_SCRIPT, FILTER_VALUES
    } index;
    Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj;
    Tcl_Obj **varv, *keyObj = NULL, *valueObj = NULL, *resultObj, *boolObj;
    Tcl_DictSearch search;
    int done, result, satisfied;
    size_t varc;
    const char *pattern;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictionary filterType ?arg ...?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[2], filters, "filterType",







|







3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
    enum FilterTypes {
	FILTER_KEYS, FILTER_SCRIPT, FILTER_VALUES
    } index;
    Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj;
    Tcl_Obj **varv, *keyObj = NULL, *valueObj = NULL, *resultObj, *boolObj;
    Tcl_DictSearch search;
    int done, result, satisfied;
    Tcl_Size varc;
    const char *pattern;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictionary filterType ?arg ...?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[2], filters, "filterType",
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *dictPtr, *objPtr;
    int i;
    size_t dummy;

    if (objc < 5 || !(objc & 1)) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"dictVarName key varName ?key varName ...? script");
	return TCL_ERROR;
    }








|







3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *dictPtr, *objPtr;
    int i;
    Tcl_Size dummy;

    if (objc < 5 || !(objc & 1)) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"dictVarName key varName ?key varName ...? script");
	return TCL_ERROR;
    }

3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
FinalizeDictUpdate(
    void *data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj *dictPtr, *objPtr, **objv;
    Tcl_InterpState state;
    size_t i, objc;
    Tcl_Obj *varName = (Tcl_Obj *)data[0];
    Tcl_Obj *argsObj = (Tcl_Obj *)data[1];

    /*
     * ErrorInfo handling.
     */








|







3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
FinalizeDictUpdate(
    void *data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj *dictPtr, *objPtr, **objv;
    Tcl_InterpState state;
    Tcl_Size i, objc;
    Tcl_Obj *varName = (Tcl_Obj *)data[0];
    Tcl_Obj *argsObj = (Tcl_Obj *)data[1];

    /*
     * ErrorInfo handling.
     */

3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
static int
FinalizeDictWith(
    void *data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj **pathv;
    size_t pathc;
    Tcl_InterpState state;
    Tcl_Obj *varName = (Tcl_Obj *)data[0];
    Tcl_Obj *keysPtr = (Tcl_Obj *)data[1];
    Tcl_Obj *pathPtr = (Tcl_Obj *)data[2];
    Var *varPtr, *arrayPtr;

    if (result == TCL_ERROR) {







|







3507
3508
3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
static int
FinalizeDictWith(
    void *data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj **pathv;
    Tcl_Size pathc;
    Tcl_InterpState state;
    Tcl_Obj *varName = (Tcl_Obj *)data[0];
    Tcl_Obj *keysPtr = (Tcl_Obj *)data[1];
    Tcl_Obj *pathPtr = (Tcl_Obj *)data[2];
    Var *varPtr, *arrayPtr;

    if (result == TCL_ERROR) {
3551
3552
3553
3554
3555
3556
3557
3558
3559
3560
3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclDictWithInit(
    Tcl_Interp *interp,
    Tcl_Obj *dictPtr,
    size_t pathc,
    Tcl_Obj *const pathv[])
{
    Tcl_DictSearch s;
    Tcl_Obj *keyPtr, *valPtr, *keysPtr;
    int done;

    if (pathc + 1 > 1) {
	dictPtr = TclTraceDictPath(interp, dictPtr, pathc, pathv,
		DICT_PATH_READ);
	if (dictPtr == NULL) {
	    return NULL;
	}
    }








|






|







3584
3585
3586
3587
3588
3589
3590
3591
3592
3593
3594
3595
3596
3597
3598
3599
3600
3601
3602
3603
3604
3605
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclDictWithInit(
    Tcl_Interp *interp,
    Tcl_Obj *dictPtr,
    Tcl_Size pathc,
    Tcl_Obj *const pathv[])
{
    Tcl_DictSearch s;
    Tcl_Obj *keyPtr, *valPtr, *keysPtr;
    int done;

    if (pathc > 0) {
	dictPtr = TclTraceDictPath(interp, dictPtr, pathc, pathv,
		DICT_PATH_READ);
	if (dictPtr == NULL) {
	    return NULL;
	}
    }

3638
3639
3640
3641
3642
3643
3644
3645
3646
3647
3648
3649
3650
3651
3652
    int pathc,			/* The number of elements in the path into the
				 * dictionary. */
    Tcl_Obj *const pathv[],	/* The elements of the path to the subdict. */
    Tcl_Obj *keysPtr)		/* List of keys to be synchronized. This is
				 * the result value from TclDictWithInit. */
{
    Tcl_Obj *dictPtr, *leafPtr, *valPtr;
    size_t i, allocdict, keyc;
    Tcl_Obj **keyv;

    /*
     * If the dictionary variable doesn't exist, drop everything silently.
     */

    dictPtr = TclPtrGetVarIdx(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,







|







3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
    int pathc,			/* The number of elements in the path into the
				 * dictionary. */
    Tcl_Obj *const pathv[],	/* The elements of the path to the subdict. */
    Tcl_Obj *keysPtr)		/* List of keys to be synchronized. This is
				 * the result value from TclDictWithInit. */
{
    Tcl_Obj *dictPtr, *leafPtr, *valPtr;
    Tcl_Size i, allocdict, keyc;
    Tcl_Obj **keyv;

    /*
     * If the dictionary variable doesn't exist, drop everything silently.
     */

    dictPtr = TclPtrGetVarIdx(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
3669
3670
3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
    } else {
	allocdict = 0;
    }

    if (pathc > 0) {
	/*
	 * Want to get to the dictionary which we will update; need to do
	 * prepare-for-update de-sharing along the path *but* avoid generating
	 * an error on a non-existant path (we'll treat that the same as a
	 * non-existant variable. Luckily, the de-sharing operation isn't
	 * deeply damaging if we don't go on to update; it's just less than
	 * perfectly efficient (but no memory should be leaked).
	 */

	leafPtr = TclTraceDictPath(interp, dictPtr, pathc, pathv,
		DICT_PATH_EXISTS | DICT_PATH_UPDATE);
	if (leafPtr == NULL) {







|
|
|







3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
    } else {
	allocdict = 0;
    }

    if (pathc > 0) {
	/*
	 * Want to get to the dictionary which we will update; need to do
	 * prepare-for-update unsharing along the path *but* avoid generating
	 * an error on a non-extant path (we'll treat that the same as a
	 * non-extant variable. Luckily, the unsharing operation isn't
	 * deeply damaging if we don't go on to update; it's just less than
	 * perfectly efficient (but no memory should be leaked).
	 */

	leafPtr = TclTraceDictPath(interp, dictPtr, pathc, pathv,
		DICT_PATH_EXISTS | DICT_PATH_UPDATE);
	if (leafPtr == NULL) {
3763
3764
3765
3766
3767
3768
3769
3770
























































































































































3771
3772
3773
3774
3775
3776
Tcl_Command
TclInitDictCmd(
    Tcl_Interp *interp)
{
    return TclMakeEnsemble(interp, "dict", implementationMap);
}

/*
























































































































































 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */








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






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
Tcl_Command
TclInitDictCmd(
    Tcl_Interp *interp)
{
    return TclMakeEnsemble(interp, "dict", implementationMap);
}

/*
 *----------------------------------------------------------------------
 *
 * DictAsListLength --
 *
 *   Compute the length of a list as if the dict value were converted to a
 *   list.
 *
 *   Note: the list length may not match the dict size * 2.  This occurs when
 *   there are duplicate keys in the original string representation.
 *
 * Side Effects --
 *
 *   The intent is to have no side effects.
 */

static Tcl_Size
DictAsListLength(
    Tcl_Obj *objPtr)
{
    Tcl_Size estCount, length, llen;
    const char *limit, *nextElem = Tcl_GetStringFromObj(objPtr, &length);
    Tcl_Obj *elemPtr;

    /*
     * Allocate enough space to hold a (Tcl_Obj *) for each
     * (possible) list element.
     */

    estCount = TclMaxListLength(nextElem, length, &limit);
    estCount += (estCount == 0); /* Smallest list struct holds 1
				  * element. */
    elemPtr = Tcl_NewObj();

    llen = 0;

    while (nextElem < limit) {
	const char *elemStart;
	char *check;
	Tcl_Size elemSize;
	int literal;

	if (TCL_OK != TclFindElement(NULL, nextElem, limit - nextElem,
		          &elemStart, &nextElem, &elemSize, &literal)) {
	    Tcl_DecrRefCount(elemPtr);
	    return 0;
	}
	if (elemStart == limit) {
	    break;
	}

	TclInvalidateStringRep(elemPtr);
	check = Tcl_InitStringRep(elemPtr, literal ? elemStart : NULL,
				  elemSize);
	if (elemSize && check == NULL) {
	    Tcl_DecrRefCount(elemPtr);
	    return 0;
	}
	if (!literal) {
	    Tcl_InitStringRep(elemPtr, NULL,
			      TclCopyAndCollapse(elemSize, elemStart, check));
	}
	llen++;
    }
    Tcl_DecrRefCount(elemPtr);
    return llen;
}


/*
 *----------------------------------------------------------------------
 *
 * DictAsListIndex --
 *
 *   Return the key or value at the given "list" index, i.e., as if the string
 *   value where treated as a list. The intent is to support this list
 *   operation w/o causing the Obj value to shimmer into a List.
 *
 * Side Effects --
 *
 *   The intent is to have no side effects.
 *
 */

static int
DictAsListIndex(
    Tcl_Interp *interp,
    struct Tcl_Obj *objPtr,
    Tcl_Size index,
    Tcl_Obj** elemObjPtr)
{
    Tcl_Size /*estCount,*/ length, llen;
    const char *limit, *nextElem = Tcl_GetStringFromObj(objPtr, &length);
    Tcl_Obj *elemPtr;

    /*
     * Compute limit of the list string
     */

    TclMaxListLength(nextElem, length, &limit);
    elemPtr = Tcl_NewObj();

    llen = 0;

    /*
     * parse out each element until reaching the "index"th element.
     * Sure this is slow, but shimmering is slower.
     */
    while (nextElem < limit) {
	const char *elemStart;
	char *check;
	Tcl_Size elemSize;
	int literal;

	if (TCL_OK != TclFindElement(NULL, nextElem, limit - nextElem,
		          &elemStart, &nextElem, &elemSize, &literal)) {
	    Tcl_DecrRefCount(elemPtr);
	    return 0;
	}
	if (elemStart == limit) {
	    break;
	}

	TclInvalidateStringRep(elemPtr);
	check = Tcl_InitStringRep(elemPtr, literal ? elemStart : NULL,
				  elemSize);
	if (elemSize && check == NULL) {
	    Tcl_DecrRefCount(elemPtr);
	    if (interp) {
		// Need error message here
	    }
	    return TCL_ERROR;
	}
	if (!literal) {
	    Tcl_InitStringRep(elemPtr, NULL,
			      TclCopyAndCollapse(elemSize, elemStart, check));
	}
	if (llen == index) {
	    *elemObjPtr = elemPtr;
	    return TCL_OK;
	}
	llen++;
    }

    /*
     * Index is beyond end of list - return empty
     */
    Tcl_InitStringRep(elemPtr, NULL, 0);
    *elemObjPtr = elemPtr;
    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclDisassemble.c.

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
static Tcl_Obj *	DisassembleByteCodeAsDicts(Tcl_Obj *objPtr);
static Tcl_Obj *	DisassembleByteCodeObj(Tcl_Obj *objPtr);
static int		FormatInstruction(ByteCode *codePtr,
			    const unsigned char *pc, Tcl_Obj *bufferObj);
static void		GetLocationInformation(Proc *procPtr,
			    Tcl_Obj **fileObjPtr, int *linePtr);
static void		PrintSourceToObj(Tcl_Obj *appendObj,
			    const char *stringPtr, size_t maxChars);
static void		UpdateStringOfInstName(Tcl_Obj *objPtr);

/*
 * The structure below defines an instruction name Tcl object to allow
 * reporting of inner contexts in errorstack without string allocation.
 */

static const Tcl_ObjType instNameType = {
    "instname",			/* name */
    NULL,			/* freeIntRepProc */
    NULL,			/* dupIntRepProc */
    UpdateStringOfInstName,	/* updateStringProc */
    NULL,			/* setFromAnyProc */

};

#define InstNameSetInternalRep(objPtr, inst)				\
    do {							\
	Tcl_ObjInternalRep ir;					\
	ir.wideValue = (inst);					\
	Tcl_StoreInternalRep((objPtr), &instNameType, &ir);		\







|













>







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
static Tcl_Obj *	DisassembleByteCodeAsDicts(Tcl_Obj *objPtr);
static Tcl_Obj *	DisassembleByteCodeObj(Tcl_Obj *objPtr);
static int		FormatInstruction(ByteCode *codePtr,
			    const unsigned char *pc, Tcl_Obj *bufferObj);
static void		GetLocationInformation(Proc *procPtr,
			    Tcl_Obj **fileObjPtr, int *linePtr);
static void		PrintSourceToObj(Tcl_Obj *appendObj,
			    const char *stringPtr, Tcl_Size maxChars);
static void		UpdateStringOfInstName(Tcl_Obj *objPtr);

/*
 * The structure below defines an instruction name Tcl object to allow
 * reporting of inner contexts in errorstack without string allocation.
 */

static const Tcl_ObjType instNameType = {
    "instname",			/* name */
    NULL,			/* freeIntRepProc */
    NULL,			/* dupIntRepProc */
    UpdateStringOfInstName,	/* updateStringProc */
    NULL,			/* setFromAnyProc */
    TCL_OBJTYPE_V0
};

#define InstNameSetInternalRep(objPtr, inst)				\
    do {							\
	Tcl_ObjInternalRep ir;					\
	ir.wideValue = (inst);					\
	Tcl_StoreInternalRep((objPtr), &instNameType, &ir);		\
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
 */

void
TclPrintObject(
    FILE *outFile,		/* The file to print the source to. */
    Tcl_Obj *objPtr,		/* Points to the Tcl object whose string
				 * representation should be printed. */
    size_t maxChars)		/* Maximum number of chars to print. */
{
    char *bytes;
    size_t length;

    bytes = Tcl_GetStringFromObj(objPtr, &length);
    TclPrintSource(outFile, bytes, TclMin(length, maxChars));
}

/*
 *----------------------------------------------------------------------







|


|







190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
 */

void
TclPrintObject(
    FILE *outFile,		/* The file to print the source to. */
    Tcl_Obj *objPtr,		/* Points to the Tcl object whose string
				 * representation should be printed. */
    Tcl_Size maxChars)		/* Maximum number of chars to print. */
{
    char *bytes;
    Tcl_Size length;

    bytes = Tcl_GetStringFromObj(objPtr, &length);
    TclPrintSource(outFile, bytes, TclMin(length, maxChars));
}

/*
 *----------------------------------------------------------------------
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
 *----------------------------------------------------------------------
 */

void
TclPrintSource(
    FILE *outFile,		/* The file to print the source to. */
    const char *stringPtr,	/* The string to print. */
    size_t maxChars)		/* Maximum number of chars to print. */
{
    Tcl_Obj *bufferObj;

    TclNewObj(bufferObj);
    PrintSourceToObj(bufferObj, stringPtr, maxChars);
    fprintf(outFile, "%s", TclGetString(bufferObj));
    Tcl_DecrRefCount(bufferObj);







|







221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
 *----------------------------------------------------------------------
 */

void
TclPrintSource(
    FILE *outFile,		/* The file to print the source to. */
    const char *stringPtr,	/* The string to print. */
    Tcl_Size maxChars)		/* Maximum number of chars to print. */
{
    Tcl_Obj *bufferObj;

    TclNewObj(bufferObj);
    PrintSourceToObj(bufferObj, stringPtr, maxChars);
    fprintf(outFile, "%s", TclGetString(bufferObj));
    Tcl_DecrRefCount(bufferObj);
251
252
253
254
255
256
257
258

259
260
261
262
263
264
265
DisassembleByteCodeObj(
    Tcl_Obj *objPtr)		/* The bytecode object to disassemble. */
{
    ByteCode *codePtr;
    unsigned char *codeStart, *codeLimit, *pc;
    unsigned char *codeDeltaNext, *codeLengthNext;
    unsigned char *srcDeltaNext, *srcLengthNext;
    int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, i, line;

    Interp *iPtr;
    Tcl_Obj *bufferObj, *fileObj;

    ByteCodeGetInternalRep(objPtr, &tclByteCodeType, codePtr);

    iPtr = (Interp *) *codePtr->interpHandle;








|
>







252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
DisassembleByteCodeObj(
    Tcl_Obj *objPtr)		/* The bytecode object to disassemble. */
{
    ByteCode *codePtr;
    unsigned char *codeStart, *codeLimit, *pc;
    unsigned char *codeDeltaNext, *codeLengthNext;
    unsigned char *srcDeltaNext, *srcLengthNext;
    int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, line;
    Tcl_Size i;
    Interp *iPtr;
    Tcl_Obj *bufferObj, *fileObj;

    ByteCodeGetInternalRep(objPtr, &tclByteCodeType, codePtr);

    iPtr = (Interp *) *codePtr->interpHandle;

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
    numCmds = codePtr->numCommands;

    /*
     * Print header lines describing the ByteCode.
     */

    Tcl_AppendPrintfToObj(bufferObj,
	    "ByteCode %p, refCt %" TCL_Z_MODIFIER "u, epoch %" TCL_Z_MODIFIER "u, interp %p (epoch %" TCL_Z_MODIFIER "u)\n",
	    codePtr, codePtr->refCount, codePtr->compileEpoch, iPtr, iPtr->compileEpoch);
    Tcl_AppendToObj(bufferObj, "  Source ", -1);
    PrintSourceToObj(bufferObj, codePtr->source,
	    TclMin(codePtr->numSrcBytes, 55));
    GetLocationInformation(codePtr->procPtr, &fileObj, &line);
    if (line >= 0 && fileObj != NULL) {
	Tcl_AppendPrintfToObj(bufferObj, "\n  File \"%s\" Line %d",
		TclGetString(fileObj), line);
    }
    Tcl_AppendPrintfToObj(bufferObj,
	    "\n  Cmds %d, src %" TCL_Z_MODIFIER "u, inst %" TCL_Z_MODIFIER "u, litObjs %" TCL_Z_MODIFIER "u, aux %" TCL_Z_MODIFIER "u, stkDepth %" TCL_Z_MODIFIER "u, code/src %.2f\n",
	    numCmds, codePtr->numSrcBytes, codePtr->numCodeBytes,
	    codePtr->numLitObjects, codePtr->numAuxDataItems,
	    codePtr->maxStackDepth,
#ifdef TCL_COMPILE_STATS
	    codePtr->numSrcBytes?
		    codePtr->structureSize/(float)codePtr->numSrcBytes :
#endif
	    0.0);

#ifdef TCL_COMPILE_STATS
    Tcl_AppendPrintfToObj(bufferObj,
	    "  Code %" TCL_Z_MODIFIER "u = header %" TCL_Z_MODIFIER "u+inst %" TCL_Z_MODIFIER "u+litObj %"
	    TCL_Z_MODIFIER "u+exc %" TCL_Z_MODIFIER "u+aux %" TCL_Z_MODIFIER "u+cmdMap %" TCL_Z_MODIFIER "u\n",
	    codePtr->structureSize,
	    offsetof(ByteCode, localCachePtr),
	    codePtr->numCodeBytes,
	    codePtr->numLitObjects * sizeof(Tcl_Obj *),
	    codePtr->numExceptRanges*sizeof(ExceptionRange),
	    codePtr->numAuxDataItems * sizeof(AuxData),
	    codePtr->numCmdLocBytes);
#endif /* TCL_COMPILE_STATS */

    /*
     * If the ByteCode is the compiled body of a Tcl procedure, print
     * information about that procedure. Note that we don't know the
     * procedure's name since ByteCode's can be shared among procedures.
     */

    if (codePtr->procPtr != NULL) {
	Proc *procPtr = codePtr->procPtr;
	int numCompiledLocals = procPtr->numCompiledLocals;

	Tcl_AppendPrintfToObj(bufferObj,
		"  Proc %p, refCt %" TCL_Z_MODIFIER "u, args %" TCL_Z_MODIFIER "u, compiled locals %d\n",
		procPtr, procPtr->refCount, procPtr->numArgs,
		numCompiledLocals);
	if (numCompiledLocals > 0) {
	    CompiledLocal *localPtr = procPtr->firstLocalPtr;

	    for (i = 0;  i < numCompiledLocals;  i++) {
		Tcl_AppendPrintfToObj(bufferObj,
			"      slot %d%s%s%s%s%s%s", i,
			(localPtr->flags & (VAR_ARRAY|VAR_LINK)) ? "" : ", scalar",
			(localPtr->flags & VAR_ARRAY) ? ", array" : "",
			(localPtr->flags & VAR_LINK) ? ", link" : "",
			(localPtr->flags & VAR_ARGUMENT) ? ", arg" : "",
			(localPtr->flags & VAR_TEMPORARY) ? ", temp" : "",
			(localPtr->flags & VAR_RESOLVED) ? ", resolved" : "");
		if (TclIsVarTemporary(localPtr)) {







|










|











|
|

















|


|







|







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
    numCmds = codePtr->numCommands;

    /*
     * Print header lines describing the ByteCode.
     */

    Tcl_AppendPrintfToObj(bufferObj,
	    "ByteCode %p, refCt %" TCL_SIZE_MODIFIER "u, epoch %" TCL_SIZE_MODIFIER "u, interp %p (epoch %" TCL_SIZE_MODIFIER "u)\n",
	    codePtr, codePtr->refCount, codePtr->compileEpoch, iPtr, iPtr->compileEpoch);
    Tcl_AppendToObj(bufferObj, "  Source ", -1);
    PrintSourceToObj(bufferObj, codePtr->source,
	    TclMin(codePtr->numSrcBytes, 55));
    GetLocationInformation(codePtr->procPtr, &fileObj, &line);
    if (line >= 0 && fileObj != NULL) {
	Tcl_AppendPrintfToObj(bufferObj, "\n  File \"%s\" Line %d",
		TclGetString(fileObj), line);
    }
    Tcl_AppendPrintfToObj(bufferObj,
	    "\n  Cmds %d, src %" TCL_SIZE_MODIFIER "u, inst %" TCL_SIZE_MODIFIER "u, litObjs %" TCL_SIZE_MODIFIER "u, aux %" TCL_SIZE_MODIFIER "u, stkDepth %" TCL_SIZE_MODIFIER "u, code/src %.2f\n",
	    numCmds, codePtr->numSrcBytes, codePtr->numCodeBytes,
	    codePtr->numLitObjects, codePtr->numAuxDataItems,
	    codePtr->maxStackDepth,
#ifdef TCL_COMPILE_STATS
	    codePtr->numSrcBytes?
		    codePtr->structureSize/(float)codePtr->numSrcBytes :
#endif
	    0.0);

#ifdef TCL_COMPILE_STATS
    Tcl_AppendPrintfToObj(bufferObj,
	    "  Code %" TCL_Z_MODIFIER "u = header %" TCL_Z_MODIFIER "u+inst %" TCL_SIZE_MODIFIER "u+litObj %"
	    TCL_Z_MODIFIER "u+exc %" TCL_Z_MODIFIER "u+aux %" TCL_Z_MODIFIER "u+cmdMap %" TCL_SIZE_MODIFIER "u\n",
	    codePtr->structureSize,
	    offsetof(ByteCode, localCachePtr),
	    codePtr->numCodeBytes,
	    codePtr->numLitObjects * sizeof(Tcl_Obj *),
	    codePtr->numExceptRanges*sizeof(ExceptionRange),
	    codePtr->numAuxDataItems * sizeof(AuxData),
	    codePtr->numCmdLocBytes);
#endif /* TCL_COMPILE_STATS */

    /*
     * If the ByteCode is the compiled body of a Tcl procedure, print
     * information about that procedure. Note that we don't know the
     * procedure's name since ByteCode's can be shared among procedures.
     */

    if (codePtr->procPtr != NULL) {
	Proc *procPtr = codePtr->procPtr;
	Tcl_Size numCompiledLocals = procPtr->numCompiledLocals;

	Tcl_AppendPrintfToObj(bufferObj,
		"  Proc %p, refCt %" TCL_SIZE_MODIFIER "u, args %" TCL_SIZE_MODIFIER "u, compiled locals %" TCL_SIZE_MODIFIER "u\n",
		procPtr, procPtr->refCount, procPtr->numArgs,
		numCompiledLocals);
	if (numCompiledLocals > 0) {
	    CompiledLocal *localPtr = procPtr->firstLocalPtr;

	    for (i = 0;  i < numCompiledLocals;  i++) {
		Tcl_AppendPrintfToObj(bufferObj,
			"      slot %" TCL_SIZE_MODIFIER "u%s%s%s%s%s%s", i,
			(localPtr->flags & (VAR_ARRAY|VAR_LINK)) ? "" : ", scalar",
			(localPtr->flags & VAR_ARRAY) ? ", array" : "",
			(localPtr->flags & VAR_LINK) ? ", link" : "",
			(localPtr->flags & VAR_ARGUMENT) ? ", arg" : "",
			(localPtr->flags & VAR_TEMPORARY) ? ", temp" : "",
			(localPtr->flags & VAR_RESOLVED) ? ", resolved" : "");
		if (TclIsVarTemporary(localPtr)) {
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
    }

    /*
     * Print the ExceptionRange array.
     */

    if ((int)codePtr->numExceptRanges > 0) {
	Tcl_AppendPrintfToObj(bufferObj, "  Exception ranges %" TCL_Z_MODIFIER "u, depth %" TCL_Z_MODIFIER "u:\n",
		codePtr->numExceptRanges, codePtr->maxExceptDepth);
	for (i = 0;  i < (int)codePtr->numExceptRanges;  i++) {
	    ExceptionRange *rangePtr = &codePtr->exceptArrayPtr[i];

	    Tcl_AppendPrintfToObj(bufferObj,
		    "      %d: level %" TCL_Z_MODIFIER "u, %s, pc %" TCL_Z_MODIFIER "u-%" TCL_Z_MODIFIER "u, ",
		    i, rangePtr->nestingLevel,
		    (rangePtr->type==LOOP_EXCEPTION_RANGE ? "loop" : "catch"),
		    rangePtr->codeOffset,
		    (rangePtr->codeOffset + rangePtr->numCodeBytes - 1));
	    switch (rangePtr->type) {
	    case LOOP_EXCEPTION_RANGE:
		Tcl_AppendPrintfToObj(bufferObj, "continue %" TCL_Z_MODIFIER "u, break %" TCL_Z_MODIFIER "u\n",
			rangePtr->continueOffset, rangePtr->breakOffset);
		break;
	    case CATCH_EXCEPTION_RANGE:
		Tcl_AppendPrintfToObj(bufferObj, "catch %" TCL_Z_MODIFIER "u\n",
			rangePtr->catchOffset);
		break;
	    default:
		Tcl_Panic("DisassembleByteCodeObj: bad ExceptionRange type %d",
			rangePtr->type);
	    }
	}







|





|






|



|







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
    }

    /*
     * Print the ExceptionRange array.
     */

    if ((int)codePtr->numExceptRanges > 0) {
	Tcl_AppendPrintfToObj(bufferObj, "  Exception ranges %" TCL_SIZE_MODIFIER "u, depth %" TCL_SIZE_MODIFIER "u:\n",
		codePtr->numExceptRanges, codePtr->maxExceptDepth);
	for (i = 0;  i < (int)codePtr->numExceptRanges;  i++) {
	    ExceptionRange *rangePtr = &codePtr->exceptArrayPtr[i];

	    Tcl_AppendPrintfToObj(bufferObj,
		    "      %" TCL_SIZE_MODIFIER "u: level %" TCL_SIZE_MODIFIER "u, %s, pc %" TCL_SIZE_MODIFIER "u-%" TCL_SIZE_MODIFIER "u, ",
		    i, rangePtr->nestingLevel,
		    (rangePtr->type==LOOP_EXCEPTION_RANGE ? "loop" : "catch"),
		    rangePtr->codeOffset,
		    (rangePtr->codeOffset + rangePtr->numCodeBytes - 1));
	    switch (rangePtr->type) {
	    case LOOP_EXCEPTION_RANGE:
		Tcl_AppendPrintfToObj(bufferObj, "continue %" TCL_SIZE_MODIFIER "u, break %" TCL_SIZE_MODIFIER "u\n",
			rangePtr->continueOffset, rangePtr->breakOffset);
		break;
	    case CATCH_EXCEPTION_RANGE:
		Tcl_AppendPrintfToObj(bufferObj, "catch %" TCL_SIZE_MODIFIER "u\n",
			rangePtr->catchOffset);
		break;
	    default:
		Tcl_Panic("DisassembleByteCodeObj: bad ExceptionRange type %d",
			rangePtr->type);
	    }
	}
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
	    srcLen = TclGetInt4AtPtr(srcLengthNext);
	    srcLengthNext += 4;
	} else {
	    srcLen = TclGetInt1AtPtr(srcLengthNext);
	    srcLengthNext++;
	}

	Tcl_AppendPrintfToObj(bufferObj, "%s%4d: pc %d-%d, src %d-%d",
		((i % 2)? "     " : "\n   "),
		(i+1), codeOffset, (codeOffset + codeLen - 1),
		srcOffset, (srcOffset + srcLen - 1));
    }
    if (numCmds > 0) {
	Tcl_AppendToObj(bufferObj, "\n", -1);
    }







|







442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
	    srcLen = TclGetInt4AtPtr(srcLengthNext);
	    srcLengthNext += 4;
	} else {
	    srcLen = TclGetInt1AtPtr(srcLengthNext);
	    srcLengthNext++;
	}

	Tcl_AppendPrintfToObj(bufferObj, "%s%4" TCL_SIZE_MODIFIER "u: pc %d-%d, src %d-%d",
		((i % 2)? "     " : "\n   "),
		(i+1), codeOffset, (codeOffset + codeLen - 1),
		srcOffset, (srcOffset + srcLen - 1));
    }
    if (numCmds > 0) {
	Tcl_AppendToObj(bufferObj, "\n", -1);
    }
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
	 */

	while ((pc-codeStart) < codeOffset) {
	    Tcl_AppendToObj(bufferObj, "    ", -1);
	    pc += FormatInstruction(codePtr, pc, bufferObj);
	}

	Tcl_AppendPrintfToObj(bufferObj, "  Command %d: ", i+1);
	PrintSourceToObj(bufferObj, (codePtr->source + srcOffset),
		TclMin(srcLen, 55));
	Tcl_AppendToObj(bufferObj, "\n", -1);
    }
    if (pc < codeLimit) {
	/*
	 * Print instructions after the last command.







|







501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
	 */

	while ((pc-codeStart) < codeOffset) {
	    Tcl_AppendToObj(bufferObj, "    ", -1);
	    pc += FormatInstruction(codePtr, pc, bufferObj);
	}

	Tcl_AppendPrintfToObj(bufferObj, "  Command %" TCL_SIZE_MODIFIER "u: ", i+1);
	PrintSourceToObj(bufferObj, (codePtr->source + srcOffset),
		TclMin(srcLen, 55));
	Tcl_AppendToObj(bufferObj, "\n", -1);
    }
    if (pc < codeLimit) {
	/*
	 * Print instructions after the last command.
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
{
    Proc *procPtr = codePtr->procPtr;
    unsigned char opCode = *pc;
    const InstructionDesc *instDesc = &tclInstructionTable[opCode];
    unsigned char *codeStart = codePtr->codeStart;
    unsigned pcOffset = pc - codeStart;
    int opnd = 0, i, j, numBytes = 1;
    int localCt = procPtr ? (int)procPtr->numCompiledLocals : 0;
    CompiledLocal *localPtr = procPtr ? procPtr->firstLocalPtr : NULL;
    char suffixBuffer[128];	/* Additional info to print after main opcode
				 * and immediates. */
    char *suffixSrc = NULL;
    Tcl_Obj *suffixObj = NULL;
    AuxData *auxPtr = NULL;








|







541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
{
    Proc *procPtr = codePtr->procPtr;
    unsigned char opCode = *pc;
    const InstructionDesc *instDesc = &tclInstructionTable[opCode];
    unsigned char *codeStart = codePtr->codeStart;
    unsigned pcOffset = pc - codeStart;
    int opnd = 0, i, j, numBytes = 1;
    Tcl_Size localCt = procPtr ? procPtr->numCompiledLocals : 0;
    CompiledLocal *localPtr = procPtr ? procPtr->firstLocalPtr : NULL;
    char suffixBuffer[128];	/* Additional info to print after main opcode
				 * and immediates. */
    char *suffixSrc = NULL;
    Tcl_Obj *suffixObj = NULL;
    AuxData *auxPtr = NULL;

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
	case OPERAND_UINT1:
	    opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++;
	    Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd);
	    break;
	case OPERAND_UINT4:
	    opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4;
	    if (opCode == INST_START_CMD) {
		sprintf(suffixBuffer+strlen(suffixBuffer),
			", %u cmds start here", opnd);
	    }
	    Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd);
	    break;
	case OPERAND_OFFSET1:
	    opnd = TclGetInt1AtPtr(pc+numBytes); numBytes++;
	    sprintf(suffixBuffer, "pc %u", pcOffset+opnd);
	    Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
	    break;
	case OPERAND_OFFSET4:
	    opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4;
	    if (opCode == INST_START_CMD) {
		sprintf(suffixBuffer, "next cmd at pc %u", pcOffset+opnd);
	    } else {
		sprintf(suffixBuffer, "pc %u", pcOffset+opnd);
	    }
	    Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
	    break;
	case OPERAND_LIT1:
	    opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++;
	    suffixObj = codePtr->objArrayPtr[opnd];
	    Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd);







|






|





|

|







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
	case OPERAND_UINT1:
	    opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++;
	    Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd);
	    break;
	case OPERAND_UINT4:
	    opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4;
	    if (opCode == INST_START_CMD) {
		snprintf(suffixBuffer+strlen(suffixBuffer), sizeof(suffixBuffer) - strlen(suffixBuffer),
			", %u cmds start here", opnd);
	    }
	    Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd);
	    break;
	case OPERAND_OFFSET1:
	    opnd = TclGetInt1AtPtr(pc+numBytes); numBytes++;
	    snprintf(suffixBuffer, sizeof(suffixBuffer), "pc %u", pcOffset+opnd);
	    Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
	    break;
	case OPERAND_OFFSET4:
	    opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4;
	    if (opCode == INST_START_CMD) {
		snprintf(suffixBuffer, sizeof(suffixBuffer), "next cmd at pc %u", pcOffset+opnd);
	    } else {
		snprintf(suffixBuffer, sizeof(suffixBuffer), "pc %u", pcOffset+opnd);
	    }
	    Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
	    break;
	case OPERAND_LIT1:
	    opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++;
	    suffixObj = codePtr->objArrayPtr[opnd];
	    Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd);
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
	    goto printLVTindex;
	case OPERAND_LVT4:
	    opnd = TclGetUInt4AtPtr(pc+numBytes);
	    numBytes += 4;
	printLVTindex:
	    if (localPtr != NULL) {
		if (opnd >= localCt) {
		    Tcl_Panic("FormatInstruction: bad local var index %u (%u locals)",
			    opnd, localCt);
		}
		for (j = 0;  j < opnd;  j++) {
		    localPtr = localPtr->nextPtr;
		}
		if (TclIsVarTemporary(localPtr)) {
		    sprintf(suffixBuffer, "temp var %u", opnd);
		} else {
		    sprintf(suffixBuffer, "var ");
		    suffixSrc = localPtr->name;
		}
	    }
	    Tcl_AppendPrintfToObj(bufferObj, "%%v%u ", opnd);
	    break;
	case OPERAND_SCLS1:
	    opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++;
	    Tcl_AppendPrintfToObj(bufferObj, "%s ",
		    tclStringClassTable[opnd].name);
	    break;
	case OPERAND_NONE:
	default:
	    break;
	}
    }
    if (suffixObj) {
	const char *bytes;
	size_t length;

	Tcl_AppendToObj(bufferObj, "\t# ", -1);
	bytes = Tcl_GetStringFromObj(codePtr->objArrayPtr[opnd], &length);
	PrintSourceToObj(bufferObj, bytes, TclMin(length, 40));
    } else if (suffixBuffer[0]) {
	Tcl_AppendPrintfToObj(bufferObj, "\t# %s", suffixBuffer);
	if (suffixSrc) {







|






|

|

















|







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
	    goto printLVTindex;
	case OPERAND_LVT4:
	    opnd = TclGetUInt4AtPtr(pc+numBytes);
	    numBytes += 4;
	printLVTindex:
	    if (localPtr != NULL) {
		if (opnd >= localCt) {
		    Tcl_Panic("FormatInstruction: bad local var index %u (%" TCL_SIZE_MODIFIER "u locals)",
			    opnd, localCt);
		}
		for (j = 0;  j < opnd;  j++) {
		    localPtr = localPtr->nextPtr;
		}
		if (TclIsVarTemporary(localPtr)) {
		    snprintf(suffixBuffer, sizeof(suffixBuffer), "temp var %u", opnd);
		} else {
		    snprintf(suffixBuffer, sizeof(suffixBuffer), "var ");
		    suffixSrc = localPtr->name;
		}
	    }
	    Tcl_AppendPrintfToObj(bufferObj, "%%v%u ", opnd);
	    break;
	case OPERAND_SCLS1:
	    opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++;
	    Tcl_AppendPrintfToObj(bufferObj, "%s ",
		    tclStringClassTable[opnd].name);
	    break;
	case OPERAND_NONE:
	default:
	    break;
	}
    }
    if (suffixObj) {
	const char *bytes;
	Tcl_Size length;

	Tcl_AppendToObj(bufferObj, "\t# ", -1);
	bytes = Tcl_GetStringFromObj(codePtr->objArrayPtr[opnd], &length);
	PrintSourceToObj(bufferObj, bytes, TclMin(length, 40));
    } else if (suffixBuffer[0]) {
	Tcl_AppendPrintfToObj(bufferObj, "\t# %s", suffixBuffer);
	if (suffixSrc) {
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699

Tcl_Obj *
TclGetInnerContext(
    Tcl_Interp *interp,
    const unsigned char *pc,
    Tcl_Obj **tosPtr)
{
    size_t objc = 0;
    Tcl_Obj *result;
    Interp *iPtr = (Interp *) interp;

    switch (*pc) {
    case INST_STR_LEN:
    case INST_LNOT:
    case INST_BITNOT:







|







687
688
689
690
691
692
693
694
695
696
697
698
699
700
701

Tcl_Obj *
TclGetInnerContext(
    Tcl_Interp *interp,
    const unsigned char *pc,
    Tcl_Obj **tosPtr)
{
    Tcl_Size objc = 0;
    Tcl_Obj *result;
    Interp *iPtr = (Interp *) interp;

    switch (*pc) {
    case INST_STR_LEN:
    case INST_LNOT:
    case INST_BITNOT:
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768

    result = iPtr->innerContext;
    if (Tcl_IsShared(result)) {
        Tcl_DecrRefCount(result);
        iPtr->innerContext = result = Tcl_NewListObj(objc + 1, NULL);
        Tcl_IncrRefCount(result);
    } else {
        size_t len;

        /*
         * Reset while keeping the list internalrep as much as possible.
         */

	TclListObjLengthM(interp, result, &len);
        Tcl_ListObjReplace(interp, result, 0, len, 0, NULL);







|







756
757
758
759
760
761
762
763
764
765
766
767
768
769
770

    result = iPtr->innerContext;
    if (Tcl_IsShared(result)) {
        Tcl_DecrRefCount(result);
        iPtr->innerContext = result = Tcl_NewListObj(objc + 1, NULL);
        Tcl_IncrRefCount(result);
    } else {
        Tcl_Size len;

        /*
         * Reset while keeping the list internalrep as much as possible.
         */

	TclListObjLengthM(interp, result, &len);
        Tcl_ListObjReplace(interp, result, 0, len, 0, NULL);
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
    Tcl_Obj *objPtr)
{
    size_t inst;	/* NOTE: We know this is really an unsigned char */
    char *dst;

    InstNameGetInternalRep(objPtr, inst);

    if (inst > LAST_INST_OPCODE) {
	dst = Tcl_InitStringRep(objPtr, NULL, TCL_INTEGER_SPACE + 5);
	TclOOM(dst, TCL_INTEGER_SPACE + 5);
        sprintf(dst, "inst_%" TCL_Z_MODIFIER "u", inst);
	(void) Tcl_InitStringRep(objPtr, NULL, strlen(dst));
    } else {
	const char *s = tclInstructionTable[inst].name;
	size_t len = strlen(s);
	dst = Tcl_InitStringRep(objPtr, s, len);
	TclOOM(dst, len);
    }







|


|







830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
    Tcl_Obj *objPtr)
{
    size_t inst;	/* NOTE: We know this is really an unsigned char */
    char *dst;

    InstNameGetInternalRep(objPtr, inst);

    if (inst >= LAST_INST_OPCODE) {
	dst = Tcl_InitStringRep(objPtr, NULL, TCL_INTEGER_SPACE + 5);
	TclOOM(dst, TCL_INTEGER_SPACE + 5);
        snprintf(dst, TCL_INTEGER_SPACE + 5, "inst_%" TCL_Z_MODIFIER "u", inst);
	(void) Tcl_InitStringRep(objPtr, NULL, strlen(dst));
    } else {
	const char *s = tclInstructionTable[inst].name;
	size_t len = strlen(s);
	dst = Tcl_InitStringRep(objPtr, s, len);
	TclOOM(dst, len);
    }
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
 *----------------------------------------------------------------------
 */

static void
PrintSourceToObj(
    Tcl_Obj *appendObj,		/* The object to print the source to. */
    const char *stringPtr,	/* The string to print. */
    size_t maxChars)		/* Maximum number of chars to print. */
{
    const char *p;
    size_t i = 0, len;

    if (stringPtr == NULL) {
	Tcl_AppendToObj(appendObj, "\"\"", -1);
	return;
    }

    Tcl_AppendToObj(appendObj, "\"", -1);







|


|







857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
 *----------------------------------------------------------------------
 */

static void
PrintSourceToObj(
    Tcl_Obj *appendObj,		/* The object to print the source to. */
    const char *stringPtr,	/* The string to print. */
    Tcl_Size maxChars)		/* Maximum number of chars to print. */
{
    const char *p;
    Tcl_Size i = 0, len;

    if (stringPtr == NULL) {
	Tcl_AppendToObj(appendObj, "\"\"", -1);
	return;
    }

    Tcl_AppendToObj(appendObj, "\"", -1);
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
DisassembleByteCodeAsDicts(
    Tcl_Obj *objPtr)		/* The bytecode-holding value to take apart */
{
    ByteCode *codePtr;
    Tcl_Obj *description, *literals, *variables, *instructions, *inst;
    Tcl_Obj *aux, *exn, *commands, *file;
    unsigned char *pc, *opnd, *codeOffPtr, *codeLenPtr, *srcOffPtr, *srcLenPtr;
    int codeOffset, codeLength, sourceOffset, sourceLength;
    int i, val, line;

    ByteCodeGetInternalRep(objPtr, &tclByteCodeType, codePtr);

    /*
     * Get the literals from the bytecode.
     */

    TclNewObj(literals);
    for (i=0 ; i<(int)codePtr->numLitObjects ; i++) {
	Tcl_ListObjAppendElement(NULL, literals, codePtr->objArrayPtr[i]);
    }

    /*
     * Get the variables from the bytecode.
     */

    TclNewObj(variables);
    if (codePtr->procPtr) {
	int localCount = codePtr->procPtr->numCompiledLocals;
	CompiledLocal *localPtr = codePtr->procPtr->firstLocalPtr;

	for (i=0 ; i<localCount ; i++,localPtr=localPtr->nextPtr) {
	    Tcl_Obj *descriptor[2];

	    TclNewObj(descriptor[0]);
	    if (!(localPtr->flags & (VAR_ARRAY|VAR_LINK))) {







|
|








|









|







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
DisassembleByteCodeAsDicts(
    Tcl_Obj *objPtr)		/* The bytecode-holding value to take apart */
{
    ByteCode *codePtr;
    Tcl_Obj *description, *literals, *variables, *instructions, *inst;
    Tcl_Obj *aux, *exn, *commands, *file;
    unsigned char *pc, *opnd, *codeOffPtr, *codeLenPtr, *srcOffPtr, *srcLenPtr;
    int codeOffset, codeLength, sourceOffset, sourceLength, val, line;
    Tcl_Size i;

    ByteCodeGetInternalRep(objPtr, &tclByteCodeType, codePtr);

    /*
     * Get the literals from the bytecode.
     */

    TclNewObj(literals);
    for (i=0 ; i<codePtr->numLitObjects ; i++) {
	Tcl_ListObjAppendElement(NULL, literals, codePtr->objArrayPtr[i]);
    }

    /*
     * Get the variables from the bytecode.
     */

    TclNewObj(variables);
    if (codePtr->procPtr) {
	Tcl_Size localCount = codePtr->procPtr->numCompiledLocals;
	CompiledLocal *localPtr = codePtr->procPtr->firstLocalPtr;

	for (i=0 ; i<localCount ; i++,localPtr=localPtr->nextPtr) {
	    Tcl_Obj *descriptor[2];

	    TclNewObj(descriptor[0]);
	    if (!(localPtr->flags & (VAR_ARRAY|VAR_LINK))) {
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
    TclNewObj(exn);
    for (i=0 ; i<(int)codePtr->numExceptRanges ; i++) {
	ExceptionRange *rangePtr = &codePtr->exceptArrayPtr[i];

	switch (rangePtr->type) {
	case LOOP_EXCEPTION_RANGE:
	    Tcl_ListObjAppendElement(NULL, exn, Tcl_ObjPrintf(
		    "type %s level %" TCL_Z_MODIFIER "u from %" TCL_Z_MODIFIER "u to %" TCL_Z_MODIFIER "u break %" TCL_Z_MODIFIER "u continue %" TCL_Z_MODIFIER "u",
		    "loop", rangePtr->nestingLevel, rangePtr->codeOffset,
		    rangePtr->codeOffset + rangePtr->numCodeBytes - 1,
		    rangePtr->breakOffset, rangePtr->continueOffset));
	    break;
	case CATCH_EXCEPTION_RANGE:
	    Tcl_ListObjAppendElement(NULL, exn, Tcl_ObjPrintf(
		    "type %s level %" TCL_Z_MODIFIER "u from %" TCL_Z_MODIFIER "u to %" TCL_Z_MODIFIER "u catch %" TCL_Z_MODIFIER "u",
		    "catch", rangePtr->nestingLevel, rangePtr->codeOffset,
		    rangePtr->codeOffset + rangePtr->numCodeBytes - 1,
		    rangePtr->catchOffset));
	    break;
	}
    }








|






|







1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
    TclNewObj(exn);
    for (i=0 ; i<(int)codePtr->numExceptRanges ; i++) {
	ExceptionRange *rangePtr = &codePtr->exceptArrayPtr[i];

	switch (rangePtr->type) {
	case LOOP_EXCEPTION_RANGE:
	    Tcl_ListObjAppendElement(NULL, exn, Tcl_ObjPrintf(
		    "type %s level %" TCL_SIZE_MODIFIER "u from %" TCL_SIZE_MODIFIER "u to %" TCL_SIZE_MODIFIER "u break %" TCL_SIZE_MODIFIER "u continue %" TCL_SIZE_MODIFIER "u",
		    "loop", rangePtr->nestingLevel, rangePtr->codeOffset,
		    rangePtr->codeOffset + rangePtr->numCodeBytes - 1,
		    rangePtr->breakOffset, rangePtr->continueOffset));
	    break;
	case CATCH_EXCEPTION_RANGE:
	    Tcl_ListObjAppendElement(NULL, exn, Tcl_ObjPrintf(
		    "type %s level %" TCL_SIZE_MODIFIER "u from %" TCL_SIZE_MODIFIER "u to %" TCL_SIZE_MODIFIER "u catch %" TCL_SIZE_MODIFIER "u",
		    "catch", rangePtr->nestingLevel, rangePtr->codeOffset,
		    rangePtr->codeOffset + rangePtr->numCodeBytes - 1,
		    rangePtr->catchOffset));
	    break;
	}
    }

Changes to generic/tclEncoding.c.

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

13
14
15
16
17
18
19
/*
 * tclEncoding.c --
 *
 *	Contains the implementation of the encoding conversion package.
 *
 * Copyright © 1996-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"


typedef size_t (LengthProc)(const char *src);

/*
 * The following data structure represents an encoding, which describes how to
 * convert between various character sets and UTF-8.
 */












>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/*
 * tclEncoding.c --
 *
 *	Contains the implementation of the encoding conversion package.
 *
 * Copyright © 1996-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include <assert.h>

typedef size_t (LengthProc)(const char *src);

/*
 * The following data structure represents an encoding, which describes how to
 * convert between various character sets and UTF-8.
 */
29
30
31
32
33
34
35


36
37
38
39
40
41
42
43
44
45
46
47
48
49
				 * into UTF-8. */
    Tcl_EncodingConvertProc *fromUtfProc;
				/* Function to convert from UTF-8 into
				 * external encoding. */
    Tcl_EncodingFreeProc *freeProc;
				/* If non-NULL, function to call when this
				 * encoding is deleted. */


    int nullSize;		/* Number of 0x00 bytes that signify
				 * end-of-string in this encoding. This number
				 * is used to determine the source string
				 * length when the srcLen argument is
				 * negative. This number can be 1, 2, or 4. */
    void *clientData;	/* Arbitrary value associated with encoding
				 * type. Passed to conversion functions. */
    LengthProc *lengthProc;	/* Function to compute length of
				 * null-terminated strings in this encoding.
				 * If nullSize is 1, this is strlen; if
				 * nullSize is 2, this is a function that
				 * returns the number of bytes in a 0x0000
				 * terminated string; if nullSize is 4, this
				 * is a function that returns the number of







>
>
|




<
<







30
31
32
33
34
35
36
37
38
39
40
41
42
43


44
45
46
47
48
49
50
				 * into UTF-8. */
    Tcl_EncodingConvertProc *fromUtfProc;
				/* Function to convert from UTF-8 into
				 * external encoding. */
    Tcl_EncodingFreeProc *freeProc;
				/* If non-NULL, function to call when this
				 * encoding is deleted. */
    void *clientData;	/* Arbitrary value associated with encoding
				 * type. Passed to conversion functions. */
    Tcl_Size nullSize;	/* Number of 0x00 bytes that signify
				 * end-of-string in this encoding. This number
				 * is used to determine the source string
				 * length when the srcLen argument is
				 * negative. This number can be 1, 2, or 4. */


    LengthProc *lengthProc;	/* Function to compute length of
				 * null-terminated strings in this encoding.
				 * If nullSize is 1, this is strlen; if
				 * nullSize is 2, this is a function that
				 * returns the number of bytes in a 0x0000
				 * terminated string; if nullSize is 4, this
				 * is a function that returns the number of
182
183
184
185
186
187
188






























189
190
191
192
193
194
195
 * the system encoding is used to perform the conversion.
 */

static Tcl_Encoding defaultEncoding = NULL;
static Tcl_Encoding systemEncoding = NULL;
Tcl_Encoding tclIdentityEncoding = NULL;































/*
 * The following variable is used in the sparse matrix code for a
 * TableEncoding to represent a page in the table that has no entries.
 */

static unsigned short emptyPage[256];








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







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
 * the system encoding is used to perform the conversion.
 */

static Tcl_Encoding defaultEncoding = NULL;
static Tcl_Encoding systemEncoding = NULL;
Tcl_Encoding tclIdentityEncoding = NULL;

/*
 * Names of encoding profiles and corresponding integer values.
 * Keep alphabetical order for error messages.
 */
static struct TclEncodingProfiles {
    const char *name;
    int value;
} encodingProfiles[] = {
    {"replace", TCL_ENCODING_PROFILE_REPLACE},
    {"strict", TCL_ENCODING_PROFILE_STRICT},
    {"tcl8", TCL_ENCODING_PROFILE_TCL8},
};
#define PROFILE_TCL8(flags_)                                           \
    ((ENCODING_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_TCL8)   \
     || (ENCODING_PROFILE_GET(flags_) == 0                         \
	 && TCL_ENCODING_PROFILE_DEFAULT == TCL_ENCODING_PROFILE_TCL8))
#define PROFILE_STRICT(flags_)                                         \
    ((ENCODING_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_STRICT) \
     || (ENCODING_PROFILE_GET(flags_) == 0                         \
	 && TCL_ENCODING_PROFILE_DEFAULT == TCL_ENCODING_PROFILE_STRICT))
#define PROFILE_REPLACE(flags_)                                         \
    ((ENCODING_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_REPLACE) \
     || (ENCODING_PROFILE_GET(flags_) == 0                          \
	 && TCL_ENCODING_PROFILE_DEFAULT == TCL_ENCODING_PROFILE_REPLACE))

#define UNICODE_REPLACE_CHAR ((Tcl_UniChar)0xFFFD)
#define SURROGATE(c_)      (((c_) & ~0x7FF) == 0xD800)
#define HIGH_SURROGATE(c_) (((c_) & ~0x3FF) == 0xD800)
#define LOW_SURROGATE(c_)  (((c_) & ~0x3FF) == 0xDC00)

/*
 * The following variable is used in the sparse matrix code for a
 * TableEncoding to represent a page in the table that has no entries.
 */

static unsigned short emptyPage[256];

224
225
226
227
228
229
230

231
232
233
234
235
236
237
238

239




240

241
242
243
244
245
246
247
static Tcl_EncodingConvertProc	UtfToUtf32Proc;
static Tcl_EncodingConvertProc	Utf16ToUtfProc;
static Tcl_EncodingConvertProc	UtfToUtf16Proc;
static Tcl_EncodingConvertProc	UtfToUcs2Proc;
static Tcl_EncodingConvertProc	UtfToUtfProc;
static Tcl_EncodingConvertProc	Iso88591FromUtfProc;
static Tcl_EncodingConvertProc	Iso88591ToUtfProc;


/*
 * A Tcl_ObjType for holding a cached Tcl_Encoding in the twoPtrValue.ptr1 field
 * of the internalrep. This should help the lifetime of encodings be more useful.
 * See concerns raised in [Bug 1077262].
 */

static const Tcl_ObjType encodingType = {

    "encoding", FreeEncodingInternalRep, DupEncodingInternalRep, NULL, NULL




};

#define EncodingSetInternalRep(objPtr, encoding)				\
    do {								\
	Tcl_ObjInternalRep ir;						\
	ir.twoPtrValue.ptr1 = (encoding);				\
	ir.twoPtrValue.ptr2 = NULL;					\
	Tcl_StoreInternalRep((objPtr), &encodingType, &ir);			\
    } while (0)







>








>
|
>
>
>
>

>







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
static Tcl_EncodingConvertProc	UtfToUtf32Proc;
static Tcl_EncodingConvertProc	Utf16ToUtfProc;
static Tcl_EncodingConvertProc	UtfToUtf16Proc;
static Tcl_EncodingConvertProc	UtfToUcs2Proc;
static Tcl_EncodingConvertProc	UtfToUtfProc;
static Tcl_EncodingConvertProc	Iso88591FromUtfProc;
static Tcl_EncodingConvertProc	Iso88591ToUtfProc;


/*
 * A Tcl_ObjType for holding a cached Tcl_Encoding in the twoPtrValue.ptr1 field
 * of the internalrep. This should help the lifetime of encodings be more useful.
 * See concerns raised in [Bug 1077262].
 */

static const Tcl_ObjType encodingType = {
    "encoding",
    FreeEncodingInternalRep,
    DupEncodingInternalRep,
    NULL,
    NULL,
    TCL_OBJTYPE_V0
};

#define EncodingSetInternalRep(objPtr, encoding)				\
    do {								\
	Tcl_ObjInternalRep ir;						\
	ir.twoPtrValue.ptr1 = (encoding);				\
	ir.twoPtrValue.ptr2 = NULL;					\
	Tcl_StoreInternalRep((objPtr), &encodingType, &ir);			\
    } while (0)
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
 *----------------------------------------------------------------------
 */

int
Tcl_SetEncodingSearchPath(
    Tcl_Obj *searchPath)
{
    size_t dummy;

    if (TCL_ERROR == TclListObjLengthM(NULL, searchPath, &dummy)) {
	return TCL_ERROR;
    }
    TclSetProcessGlobalValue(&encodingSearchPath, searchPath, NULL);
    return TCL_OK;
}







|







402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
 *----------------------------------------------------------------------
 */

int
Tcl_SetEncodingSearchPath(
    Tcl_Obj *searchPath)
{
    Tcl_Size dummy;

    if (TCL_ERROR == TclListObjLengthM(NULL, searchPath, &dummy)) {
	return TCL_ERROR;
    }
    TclSetProcessGlobalValue(&encodingSearchPath, searchPath, NULL);
    return TCL_OK;
}
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
 *----------------------------------------------------------------------
 */

void
TclSetLibraryPath(
    Tcl_Obj *path)
{
    size_t dummy;

    if (TCL_ERROR == TclListObjLengthM(NULL, path, &dummy)) {
	return;
    }
    TclSetProcessGlobalValue(&libraryPath, path, NULL);
}








|







449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
 *----------------------------------------------------------------------
 */

void
TclSetLibraryPath(
    Tcl_Obj *path)
{
    Tcl_Size dummy;

    if (TCL_ERROR == TclListObjLengthM(NULL, path, &dummy)) {
	return;
    }
    TclSetProcessGlobalValue(&libraryPath, path, NULL);
}

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
 *
 *---------------------------------------------------------------------------
 */

static void
FillEncodingFileMap(void)
{
    size_t i, numDirs = 0;
    Tcl_Obj *map, *searchPath;

    searchPath = Tcl_GetEncodingSearchPath();
    Tcl_IncrRefCount(searchPath);
    TclListObjLengthM(NULL, searchPath, &numDirs);
    map = Tcl_NewDictObj();
    Tcl_IncrRefCount(map);

    for (i = numDirs-1; i != TCL_INDEX_NONE; i--) {
	/*
	 * Iterate backwards through the search path so as we overwrite
	 * entries found, we favor files earlier on the search path.
	 */

	size_t j, numFiles;
	Tcl_Obj *directory, *matchFileList;
	Tcl_Obj **filev;
	Tcl_GlobTypeData readableFiles = {
	    TCL_GLOB_TYPE_FILE, TCL_GLOB_PERM_R, NULL, NULL
	};

	TclNewObj(matchFileList);







|














|







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

static void
FillEncodingFileMap(void)
{
    Tcl_Size i, numDirs = 0;
    Tcl_Obj *map, *searchPath;

    searchPath = Tcl_GetEncodingSearchPath();
    Tcl_IncrRefCount(searchPath);
    TclListObjLengthM(NULL, searchPath, &numDirs);
    map = Tcl_NewDictObj();
    Tcl_IncrRefCount(map);

    for (i = numDirs-1; i != TCL_INDEX_NONE; i--) {
	/*
	 * Iterate backwards through the search path so as we overwrite
	 * entries found, we favor files earlier on the search path.
	 */

	Tcl_Size j, numFiles;
	Tcl_Obj *directory, *matchFileList;
	Tcl_Obj **filev;
	Tcl_GlobTypeData readableFiles = {
	    TCL_GLOB_TYPE_FILE, TCL_GLOB_PERM_R, NULL, NULL
	};

	TclNewObj(matchFileList);
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
 *
 * Side effects:
 *	Depends on the memory, object, and IO subsystems.
 *
 *---------------------------------------------------------------------------
 */

/* Since TCL_ENCODING_MODIFIED is only used for utf-8/cesu-8 and

 * TCL_ENCODING_LE is only used for  utf-16/utf-32/ucs-2. re-use the same value */




#define TCL_ENCODING_LE		TCL_ENCODING_MODIFIED	/* Little-endian encoding */
#define TCL_ENCODING_UTF	0x200	/* For UTF-8 encoding, allow 4-byte output sequences */


void
TclInitEncodingSubsystem(void)
{
    Tcl_EncodingType type;
    TableEncodingData *dataPtr;
    unsigned size;
    unsigned short i;
    union {
        char c;
        short s;
    } isLe;


    if (encodingsInitialized) {
	return;
    }


    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







|
>
|
>
>
>
>
|
|
>









|
|

>





>
|
>
>







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
 *
 * Side effects:
 *	Depends on the memory, object, and IO subsystems.
 *
 *---------------------------------------------------------------------------
 */

/*
 * NOTE: THESE BIT DEFINITIONS SHOULD NOT OVERLAP WITH INTERNAL USE BITS
 * DEFINED IN tcl.h (TCL_ENCODING_* et al). Be cognizant of this
 * when adding bits. TODO - should really be defined in a single file.
 *
 * To prevent conflicting bits, only define bits within 0xff00 mask here.
 */
#define TCL_ENCODING_LE	0x100   /* Used to distinguish LE/BE variants */
#define ENCODING_UTF	0x200	/* For UTF-8 encoding, allow 4-byte output sequences */
#define ENCODING_INPUT	0x400   /* For UTF-8/CESU-8 encoding, means external -> internal */

void
TclInitEncodingSubsystem(void)
{
    Tcl_EncodingType type;
    TableEncodingData *dataPtr;
    unsigned size;
    unsigned short i;
    union {
	char c;
	short s;
    } isLe;
    int leFlags;

    if (encodingsInitialized) {
	return;
    }

    /* Note: This DEPENDS on TCL_ENCODING_LE being defined in least sig byte */
    isLe.s = 1;
    leFlags = isLe.c ? TCL_ENCODING_LE : 0;

    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
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
    tclIdentityEncoding = Tcl_CreateEncoding(&type);

    type.encodingName	= "utf-8";
    type.toUtfProc	= UtfToUtfProc;
    type.fromUtfProc	= UtfToUtfProc;
    type.freeProc	= NULL;
    type.nullSize	= 1;
    type.clientData	= INT2PTR(TCL_ENCODING_UTF);
    Tcl_CreateEncoding(&type);
    type.clientData	= INT2PTR(0);
    type.encodingName	= "cesu-8";
    Tcl_CreateEncoding(&type);

    type.toUtfProc	= Utf16ToUtfProc;
    type.fromUtfProc    = UtfToUcs2Proc;
    type.freeProc	= NULL;
    type.nullSize	= 2;
    type.encodingName   = "ucs-2le";
    type.clientData	= INT2PTR(TCL_ENCODING_LE);
    Tcl_CreateEncoding(&type);
    type.encodingName   = "ucs-2be";
    type.clientData	= INT2PTR(0);
    Tcl_CreateEncoding(&type);
    type.encodingName   = "ucs-2";
    type.clientData	= INT2PTR(isLe.c);
    Tcl_CreateEncoding(&type);

    type.toUtfProc	= Utf32ToUtfProc;
    type.fromUtfProc    = UtfToUtf32Proc;
    type.freeProc	= NULL;
    type.nullSize	= 4;
    type.encodingName   = "utf-32le";
    type.clientData	= INT2PTR(TCL_ENCODING_LE);
    Tcl_CreateEncoding(&type);
    type.encodingName   = "utf-32be";
    type.clientData	= INT2PTR(0);
    Tcl_CreateEncoding(&type);
    type.encodingName   = "utf-32";
    type.clientData	= INT2PTR(isLe.c);
    Tcl_CreateEncoding(&type);

    type.toUtfProc	= Utf16ToUtfProc;
    type.fromUtfProc    = UtfToUtf16Proc;
    type.freeProc	= NULL;
    type.nullSize	= 2;
    type.encodingName   = "utf-16le";
    type.clientData	= INT2PTR(TCL_ENCODING_LE);
    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);

#ifndef TCL_NO_DEPRECATED
    type.encodingName   = "unicode";
    Tcl_CreateEncoding(&type);
#endif








|

|











|


|










|


|










|


|







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
    tclIdentityEncoding = Tcl_CreateEncoding(&type);

    type.encodingName	= "utf-8";
    type.toUtfProc	= UtfToUtfProc;
    type.fromUtfProc	= UtfToUtfProc;
    type.freeProc	= NULL;
    type.nullSize	= 1;
    type.clientData	= INT2PTR(ENCODING_UTF);
    Tcl_CreateEncoding(&type);
    type.clientData	= NULL;
    type.encodingName	= "cesu-8";
    Tcl_CreateEncoding(&type);

    type.toUtfProc	= Utf16ToUtfProc;
    type.fromUtfProc    = UtfToUcs2Proc;
    type.freeProc	= NULL;
    type.nullSize	= 2;
    type.encodingName   = "ucs-2le";
    type.clientData	= INT2PTR(TCL_ENCODING_LE);
    Tcl_CreateEncoding(&type);
    type.encodingName   = "ucs-2be";
    type.clientData	= NULL;
    Tcl_CreateEncoding(&type);
    type.encodingName   = "ucs-2";
    type.clientData	= INT2PTR(leFlags);
    Tcl_CreateEncoding(&type);

    type.toUtfProc	= Utf32ToUtfProc;
    type.fromUtfProc    = UtfToUtf32Proc;
    type.freeProc	= NULL;
    type.nullSize	= 4;
    type.encodingName   = "utf-32le";
    type.clientData	= INT2PTR(TCL_ENCODING_LE);
    Tcl_CreateEncoding(&type);
    type.encodingName   = "utf-32be";
    type.clientData	= NULL;
    Tcl_CreateEncoding(&type);
    type.encodingName   = "utf-32";
    type.clientData	= INT2PTR(leFlags);
    Tcl_CreateEncoding(&type);

    type.toUtfProc	= Utf16ToUtfProc;
    type.fromUtfProc    = UtfToUtf16Proc;
    type.freeProc	= NULL;
    type.nullSize	= 2;
    type.encodingName   = "utf-16le";
    type.clientData	= INT2PTR(TCL_ENCODING_LE);
    Tcl_CreateEncoding(&type);
    type.encodingName   = "utf-16be";
    type.clientData	= NULL;
    Tcl_CreateEncoding(&type);
    type.encodingName   = "utf-16";
    type.clientData	= INT2PTR(leFlags);
    Tcl_CreateEncoding(&type);

#ifndef TCL_NO_DEPRECATED
    type.encodingName   = "unicode";
    Tcl_CreateEncoding(&type);
#endif

820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
}

/*
 *-------------------------------------------------------------------------
 *
 * Tcl_GetEncodingName --
 *
 *	Given an encoding, return the name that was used to constuct the
 *	encoding.
 *
 * Results:
 *	The name of the encoding.
 *
 * Side effects:
 *	None.







|







868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
}

/*
 *-------------------------------------------------------------------------
 *
 * Tcl_GetEncodingName --
 *
 *	Given an encoding, return the name that was used to construct the
 *	encoding.
 *
 * Results:
 *	The name of the encoding.
 *
 * Side effects:
 *	None.
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899

    Tcl_MutexLock(&encodingMutex);
    for (hPtr = Tcl_FirstHashEntry(&encodingTable, &search); hPtr != NULL;
	    hPtr = Tcl_NextHashEntry(&search)) {
	Encoding *encodingPtr = (Encoding *)Tcl_GetHashValue(hPtr);

	Tcl_CreateHashEntry(&table,
		Tcl_NewStringObj(encodingPtr->name, -1), &dummy);
    }
    Tcl_MutexUnlock(&encodingMutex);

    FillEncodingFileMap();
    map = TclGetProcessGlobalValue(&encodingFileMap);

    /*







|







933
934
935
936
937
938
939
940
941
942
943
944
945
946
947

    Tcl_MutexLock(&encodingMutex);
    for (hPtr = Tcl_FirstHashEntry(&encodingTable, &search); hPtr != NULL;
	    hPtr = Tcl_NextHashEntry(&search)) {
	Encoding *encodingPtr = (Encoding *)Tcl_GetHashValue(hPtr);

	Tcl_CreateHashEntry(&table,
		Tcl_NewStringObj(encodingPtr->name, TCL_INDEX_NONE), &dummy);
    }
    Tcl_MutexUnlock(&encodingMutex);

    FillEncodingFileMap();
    map = TclGetProcessGlobalValue(&encodingFileMap);

    /*
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
 *
 * Tcl_GetEncodingNulLength --
 *
 *	Given an encoding, return the number of nul bytes used for the
 *      string termination.
 *
 * Results:
 *	The name of the encoding.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */
int
Tcl_GetEncodingNulLength(
    Tcl_Encoding encoding)
{
    if (encoding == NULL) {
	encoding = systemEncoding;
    }








|






|







971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
 *
 * Tcl_GetEncodingNulLength --
 *
 *	Given an encoding, return the number of nul bytes used for the
 *      string termination.
 *
 * Results:
 *	The number of nul bytes used for the string termination.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */
Tcl_Size
Tcl_GetEncodingNulLength(
    Tcl_Encoding encoding)
{
    if (encoding == NULL) {
	encoding = systemEncoding;
    }

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

#undef Tcl_ExternalToUtfDString
char *
Tcl_ExternalToUtfDString(
    Tcl_Encoding encoding,	/* The encoding for the source string, or NULL
				 * for the default system encoding. */
    const char *src,		/* Source string in specified encoding. */
    size_t srcLen,		/* Source string length in bytes, or -1 for
				 * encoding-specific string length. */
    Tcl_DString *dstPtr)	/* Uninitialized or free DString in which the
				 * converted string is stored. */
{
    Tcl_ExternalToUtfDStringEx(encoding, src, srcLen, TCL_ENCODING_NOCOMPLAIN, dstPtr);

    return Tcl_DStringValue(dstPtr);
}


/*
 *-------------------------------------------------------------------------
 *
 * Tcl_ExternalToUtfDStringEx --
 *
 *	Convert a source buffer from the specified encoding into UTF-8.
 *	The parameter flags controls the behavior, if any of the bytes in
 *	the source buffer are invalid or cannot be represented in utf-8.
 *	Possible flags values:

 *	TCL_ENCODING_NOCOMPLAIN: replace invalid characters/bytes by a default
 *	fallback character. Always return -1 (Default in Tcl 8.7).
 *	TCL_ENCODING_MODIFIED: convert NULL bytes to \xC0\x80 in stead of 0x00.
 *	Only valid for "utf-8" and "cesu-8". This flag may be used together
 *	with the other flags.

 *
 * Results:
 *	The converted bytes are stored in the DString, which is then NULL
 *	terminated in an encoding-specific manner. The return value is


 *	the error position in the source string or -1 if no conversion error


 *	is reported.
  *
 * Side effects:








 *	None.



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

size_t
Tcl_ExternalToUtfDStringEx(

    Tcl_Encoding encoding,	/* The encoding for the source string, or NULL
				 * for the default system encoding. */
    const char *src,		/* Source string in specified encoding. */
    size_t srcLen,			/* Source string length in bytes, or TCL_INDEX_NONE for
				 * encoding-specific string length. */
    int flags,			/* Conversion control flags. */
    Tcl_DString *dstPtr)	/* Uninitialized or free DString in which the
				 * converted string is stored. */



{
    char *dst;
    Tcl_EncodingState state;
    const Encoding *encodingPtr;
    int result, soFar, srcRead, dstWrote, dstChars;
    size_t dstLen;
    const char *srcStart = src;


    Tcl_DStringInit(dstPtr);












    dst = Tcl_DStringValue(dstPtr);
    dstLen = dstPtr->spaceAvl - 1;

    if (encoding == NULL) {
	encoding = systemEncoding;
    }
    encodingPtr = (Encoding *) encoding;

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

    while (1) {











	result = encodingPtr->toUtfProc(encodingPtr->clientData, src, srcLen,
		flags, &state, dst, dstLen, &srcRead, &dstWrote, &dstChars);

	soFar = dst + dstWrote - Tcl_DStringValue(dstPtr);

	src += srcRead;









	if (result != TCL_CONVERT_NOSPACE) {



	    Tcl_DStringSetLength(dstPtr, soFar);





	    return (result == TCL_OK) ? TCL_INDEX_NONE : (size_t)(src - srcStart);













	}




	flags &= ~TCL_ENCODING_START;
	srcLen -= srcRead;

	if (Tcl_DStringLength(dstPtr) == 0) {
	    Tcl_DStringSetLength(dstPtr, dstLen);
	}
	Tcl_DStringSetLength(dstPtr, 2 * Tcl_DStringLength(dstPtr) + 1);
	dst = Tcl_DStringValue(dstPtr) + soFar;
	dstLen = Tcl_DStringLength(dstPtr) - soFar - 1;
    }







|




|
>










|


>
|
<
|
|
|
>


<
|
>
>
|
>
>
|
|

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




|

>



|


|

>
>
>




|
|


>

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






|







|

|



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

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

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

|
>







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

#undef Tcl_ExternalToUtfDString
char *
Tcl_ExternalToUtfDString(
    Tcl_Encoding encoding,	/* The encoding for the source string, or NULL
				 * for the default system encoding. */
    const char *src,		/* Source string in specified encoding. */
    Tcl_Size srcLen,		/* Source string length in bytes, or < 0 for
				 * encoding-specific string length. */
    Tcl_DString *dstPtr)	/* Uninitialized or free DString in which the
				 * converted string is stored. */
{
    Tcl_ExternalToUtfDStringEx(
	NULL, encoding, src, srcLen, TCL_ENCODING_PROFILE_TCL8, dstPtr, NULL);
    return Tcl_DStringValue(dstPtr);
}


/*
 *-------------------------------------------------------------------------
 *
 * Tcl_ExternalToUtfDStringEx --
 *
 *	Convert a source buffer from the specified encoding into UTF-8.
 *	"flags" controls the behavior if any of the bytes in
 *	the source buffer are invalid or cannot be represented in utf-8.
 *	Possible flags values:
 *	target encoding. It should be composed by OR-ing the following:
 *	- *At most one* of TCL_ENCODING_PROFILE{DEFAULT,TCL8,STRICT}

 *	- TCL_ENCODING_STOPONERROR: Backward compatibility. Sets the profile
 *	  to TCL_ENCODING_PROFILE_STRICT overriding any specified profile flags
 *      Any other flag bits will cause an error to be returned (for future
 *      compatibility)
 *
 * Results:

 *      The return value is one of
 *        TCL_OK: success. Converted string in *dstPtr
 *        TCL_ERROR: error in passed parameters. Error message in interp
 *        TCL_CONVERT_MULTIBYTE: source ends in truncated multibyte sequence
 *        TCL_CONVERT_SYNTAX: source is not conformant to encoding definition
 *        TCL_CONVERT_UNKNOWN: source contained a character that could not
 *            be represented in target encoding.
 *
 * Side effects:
 *
 *      TCL_OK: The converted bytes are stored in the DString and NUL
 *          terminated in an encoding-specific manner.
 *      TCL_ERROR: an error, message is stored in the interp if not NULL.
 *      TCL_CONVERT_*: if errorLocPtr is NULL, an error message is stored
 *          in the interpreter (if not NULL). If errorLocPtr is not NULL,
 *          no error message is stored as it is expected the caller is
 *          interested in whatever is decoded so far and not treating this
 *          as an error condition.
 *
 *      In addition, *dstPtr is always initialized and must be cleared
 *      by the caller irrespective of the return code.
 *
 *-------------------------------------------------------------------------
 */

int
Tcl_ExternalToUtfDStringEx(
    Tcl_Interp *interp,         /* For error messages. May be NULL. */
    Tcl_Encoding encoding,	/* The encoding for the source string, or NULL
				 * for the default system encoding. */
    const char *src,		/* Source string in specified encoding. */
    Tcl_Size srcLen,			/* Source string length in bytes, or < 0 for
				 * encoding-specific string length. */
    int flags,			/* Conversion control flags. */
    Tcl_DString *dstPtr,	/* Uninitialized or free DString in which the
				 * converted string is stored. */
    Tcl_Size *errorLocPtr)      /* Where to store the error location
                                   (or TCL_INDEX_NONE if no error). May
				   be NULL. */
{
    char *dst;
    Tcl_EncodingState state;
    const Encoding *encodingPtr;
    int result;
    Tcl_Size dstLen, soFar;
    const char *srcStart = src;

    /* DO FIRST - Must always be initialized before returning */
    Tcl_DStringInit(dstPtr);

    if (flags & (TCL_ENCODING_START|TCL_ENCODING_END)) {
	/* TODO - what other flags are illegal? - See TIP 656 */
	Tcl_SetObjResult(
	    interp,
	    Tcl_NewStringObj(
		"Parameter error: TCL_ENCODING_{START,STOP} bits set in flags.",
		TCL_INDEX_NONE));
	Tcl_SetErrorCode(interp, "TCL", "ENCODING", "ILLEGALFLAGS", NULL);
	return TCL_ERROR;
    }

    dst = Tcl_DStringValue(dstPtr);
    dstLen = dstPtr->spaceAvl - 1;

    if (encoding == NULL) {
	encoding = systemEncoding;
    }
    encodingPtr = (Encoding *)encoding;

    if (src == NULL) {
	srcLen = 0;
    } else if (srcLen == TCL_INDEX_NONE) {
	srcLen = encodingPtr->lengthProc(src);
    }

    flags |= TCL_ENCODING_START;
    if (encodingPtr->toUtfProc == UtfToUtfProc) {
	flags |= ENCODING_INPUT;
    }

    while (1) {
	int srcChunkLen, srcChunkRead;
	int dstChunkLen, dstChunkWrote, dstChunkChars;

	if (srcLen > INT_MAX) {
	    srcChunkLen = INT_MAX;
	} else {
	    srcChunkLen = srcLen;
	    flags |= TCL_ENCODING_END; /* Last chunk */
	}
	dstChunkLen = dstLen > INT_MAX ? INT_MAX : dstLen;

	result = encodingPtr->toUtfProc(encodingPtr->clientData, src,
		srcChunkLen, flags, &state, dst, dstChunkLen,
		&srcChunkRead, &dstChunkWrote, &dstChunkChars);
	soFar = dst + dstChunkWrote - Tcl_DStringValue(dstPtr);

	src += srcChunkRead;

	/*
	 * Keep looping in two case -
	 *   - our destination buffer did not have enough room
	 *   - we had not passed in all the data and error indicated fragment
	 *     of a multibyte character
	 * In both cases we have to grow buffer, move the input source pointer
	 * and loop. Otherwise, return the result we got.
	 */
	if ((result != TCL_CONVERT_NOSPACE) &&
	    !(result == TCL_CONVERT_MULTIBYTE && (flags & TCL_ENCODING_END))) {
	    Tcl_Size nBytesProcessed = (src - srcStart);

	    Tcl_DStringSetLength(dstPtr, soFar);
	    if (errorLocPtr) {
		/*
		 * Do not write error message into interpreter if caller
		 * wants to know error location.
		 */
		*errorLocPtr = result == TCL_OK ? TCL_INDEX_NONE : nBytesProcessed;
	    } else {
		/* Caller wants error message on failure */
		if (result != TCL_OK && interp != NULL) {
		    char buf[TCL_INTEGER_SPACE];
		    snprintf(buf, sizeof(buf), "%" TCL_Z_MODIFIER "u", nBytesProcessed);
		    Tcl_SetObjResult(
			interp,
			Tcl_ObjPrintf("unexpected byte sequence starting at index %"
				      TCL_Z_MODIFIER "u: '\\x%02X'",
				      nBytesProcessed,
				      UCHAR(srcStart[nBytesProcessed])));
		    Tcl_SetErrorCode(
			interp, "TCL", "ENCODING", "ILLEGALSEQUENCE", buf, NULL);
		}
	    }
	    return result;
	}

	flags &= ~TCL_ENCODING_START;
	srcLen -= srcChunkRead;

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

int
Tcl_ExternalToUtf(
    TCL_UNUSED(Tcl_Interp *),	/* TODO: Re-examine this. */
    Tcl_Encoding encoding,	/* The encoding for the source string, or NULL
				 * for the default system encoding. */
    const char *src,		/* Source string in specified encoding. */
    size_t srcLen,		/* Source string length in bytes, or -1
				 * for encoding-specific string length. */
    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. */
    size_t 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







|
|








|







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

int
Tcl_ExternalToUtf(
    TCL_UNUSED(Tcl_Interp *),	/* TODO: Re-examine this. */
    Tcl_Encoding encoding,	/* The encoding for the source string, or NULL
				 * for the default system encoding. */
    const char *src,		/* Source string in specified encoding. */
    Tcl_Size srcLen,		/* Source string length in bytes, or TCL_INDEX_NONE for
				 * encoding-specific string length. */
    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. */
    Tcl_Size 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
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
	srcLen = 0;
    } else if (srcLen == TCL_INDEX_NONE) {
	srcLen = encodingPtr->lengthProc(src);
    }
    if (statePtr == NULL) {
	flags |= TCL_ENCODING_START | TCL_ENCODING_END;
	statePtr = &state;







    }
    if (srcReadPtr == NULL) {
	srcReadPtr = &srcRead;
    }
    if (dstWrotePtr == NULL) {
	dstWrotePtr = &dstWrote;
    }
    if (dstCharsPtr == NULL) {
	dstCharsPtr = &dstChars;
	flags &= ~TCL_ENCODING_CHAR_LIMIT;
    } else if (charLimited) {
	maxChars = *dstCharsPtr;
    }

    if (!noTerminate) {



	/*
	 * If there are any null characters in the middle of the buffer,
	 * they will converted to the UTF-8 null character (\xC0\x80). To get
	 * the actual \0 at the end of the destination buffer, we need to
	 * append it manually.  First make room for it...
	 */

	dstLen--;



    }

    if (encodingPtr->toUtfProc == UtfToUtfProc) {
	flags |= TCL_ENCODING_MODIFIED | TCL_ENCODING_UTF;
    }
    do {
	Tcl_EncodingState savedState = *statePtr;

	result = encodingPtr->toUtfProc(encodingPtr->clientData, src, srcLen,
		flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr,
		dstCharsPtr);







>
>
>
>
>
>
>















>
>
>








>
>
>
|
>

|







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
	srcLen = 0;
    } else if (srcLen == TCL_INDEX_NONE) {
	srcLen = encodingPtr->lengthProc(src);
    }
    if (statePtr == NULL) {
	flags |= TCL_ENCODING_START | TCL_ENCODING_END;
	statePtr = &state;
    }
    if (srcLen > INT_MAX) {
	srcLen = INT_MAX;
	flags &= ~TCL_ENCODING_END;
    }
    if (dstLen > INT_MAX) {
	dstLen = INT_MAX;
    }
    if (srcReadPtr == NULL) {
	srcReadPtr = &srcRead;
    }
    if (dstWrotePtr == NULL) {
	dstWrotePtr = &dstWrote;
    }
    if (dstCharsPtr == NULL) {
	dstCharsPtr = &dstChars;
	flags &= ~TCL_ENCODING_CHAR_LIMIT;
    } else if (charLimited) {
	maxChars = *dstCharsPtr;
    }

    if (!noTerminate) {
        if (dstLen < 1) {
            return TCL_CONVERT_NOSPACE;
        }
	/*
	 * If there are any null characters in the middle of the buffer,
	 * they will converted to the UTF-8 null character (\xC0\x80). To get
	 * the actual \0 at the end of the destination buffer, we need to
	 * append it manually.  First make room for it...
	 */

	dstLen--;
    } else {
	if (dstLen <= 0 && srcLen > 0) {
	    return TCL_CONVERT_NOSPACE;
	}
    }
    if (encodingPtr->toUtfProc == UtfToUtfProc) {
	flags |= ENCODING_INPUT;
    }
    do {
	Tcl_EncodingState savedState = *statePtr;

	result = encodingPtr->toUtfProc(encodingPtr->clientData, src, srcLen,
		flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr,
		dstCharsPtr);
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
 */
#undef Tcl_UtfToExternalDString
char *
Tcl_UtfToExternalDString(
    Tcl_Encoding encoding,	/* The encoding for the converted string, or
				 * NULL for the default system encoding. */
    const char *src,		/* Source string in UTF-8. */
    size_t srcLen,		/* Source string length in bytes, or -1 for
				 * strlen(). */
    Tcl_DString *dstPtr)	/* Uninitialized or free DString in which the
				 * converted string is stored. */
{
    Tcl_UtfToExternalDStringEx(encoding, src, srcLen, TCL_ENCODING_NOCOMPLAIN, dstPtr);

    return Tcl_DStringValue(dstPtr);
}


/*
 *-------------------------------------------------------------------------
 *
 * Tcl_UtfToExternalDStringEx --
 *
 *	Convert a source buffer from UTF-8 to the specified encoding.
 *	The parameter flags controls the behavior, if any of the bytes in
 *	the source buffer are invalid or cannot be represented in the
 *	target encoding.
 *	Possible flags values:
 *	TCL_ENCODING_NOCOMPLAIN: replace invalid characters/bytes by a default
 *	fallback character. Always return -1 (Default in Tcl 8.7).
 *	TCL_ENCODING_MODIFIED: convert NULL bytes to \xC0\x80 in stead of 0x00.
 *	Only valid for "utf-8" and "cesu-8". This flag may be used together
 *	with the other flags.
 *
 * Results:
 *	The converted bytes are stored in the DString, which is then NULL
 *	terminated in an encoding-specific manner. The return value is


 *	the error position in the source string or -1 if no conversion error


 *	is reported.
 *
 * Side effects:








 *	None.



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

size_t
Tcl_UtfToExternalDStringEx(

    Tcl_Encoding encoding,	/* The encoding for the converted string, or
				 * NULL for the default system encoding. */
    const char *src,		/* Source string in UTF-8. */
    size_t srcLen,			/* Source string length in bytes, or < 0 for
				 * strlen(). */
    int flags,	/* Conversion control flags. */
    Tcl_DString *dstPtr)	/* Uninitialized or free DString in which the
				 * converted string is stored. */



{
    char *dst;
    Tcl_EncodingState state;
    const Encoding *encodingPtr;
    int result, soFar, srcRead, dstWrote, dstChars;
    const char *srcStart = src;
    size_t dstLen;


    Tcl_DStringInit(dstPtr);












    dst = Tcl_DStringValue(dstPtr);
    dstLen = dstPtr->spaceAvl - 1;

    if (encoding == NULL) {
	encoding = systemEncoding;
    }
    encodingPtr = (Encoding *) encoding;

    if (src == NULL) {
	srcLen = 0;
    } else if (srcLen == TCL_INDEX_NONE) {
	srcLen = strlen(src);
    }

    flags |= TCL_ENCODING_START | TCL_ENCODING_END;
    while (1) {











	result = encodingPtr->fromUtfProc(encodingPtr->clientData, src,
		srcLen, flags, &state, dst, dstLen,
		&srcRead, &dstWrote, &dstChars);
	soFar = dst + dstWrote - Tcl_DStringValue(dstPtr);


	src += srcRead;









	if (result != TCL_CONVERT_NOSPACE) {


	    int i = soFar + encodingPtr->nullSize - 1;

	    while (i >= soFar) {
		Tcl_DStringSetLength(dstPtr, i--);
	    }





	    return (result == TCL_OK) ? TCL_INDEX_NONE : (size_t)(src - srcStart);




















	}

	flags &= ~TCL_ENCODING_START;
	srcLen -= srcRead;

	if (Tcl_DStringLength(dstPtr) == 0) {
	    Tcl_DStringSetLength(dstPtr, dstLen);
	}
	Tcl_DStringSetLength(dstPtr, 2 * Tcl_DStringLength(dstPtr) + 1);
	dst = Tcl_DStringValue(dstPtr) + soFar;
	dstLen = Tcl_DStringLength(dstPtr) - soFar - 1;
    }







|




|
>












|
|
|
<
|
<
<


<
|
>
>
|
>
>
|


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




|

>



|

|
|

>
>
>




|

|

>

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













>
|

>
>
>
>
>
>
>
>
>
>
>

|
|
|

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



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



|
>







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
 */
#undef Tcl_UtfToExternalDString
char *
Tcl_UtfToExternalDString(
    Tcl_Encoding encoding,	/* The encoding for the converted string, or
				 * NULL for the default system encoding. */
    const char *src,		/* Source string in UTF-8. */
    Tcl_Size srcLen,		/* Source string length in bytes, or < 0 for
				 * strlen(). */
    Tcl_DString *dstPtr)	/* Uninitialized or free DString in which the
				 * converted string is stored. */
{
    Tcl_UtfToExternalDStringEx(
	NULL, encoding, src, srcLen, TCL_ENCODING_PROFILE_TCL8, dstPtr, NULL);
    return Tcl_DStringValue(dstPtr);
}


/*
 *-------------------------------------------------------------------------
 *
 * Tcl_UtfToExternalDStringEx --
 *
 *	Convert a source buffer from UTF-8 to the specified encoding.
 *	The parameter flags controls the behavior, if any of the bytes in
 *	the source buffer are invalid or cannot be represented in the
 *	target encoding. It should be composed by OR-ing the following:
 *	- *At most one* of TCL_ENCODING_PROFILE{DEFAULT,TCL8,STRICT}
 *	- TCL_ENCODING_STOPONERROR: Backward compatibility. Sets the profile

 *	  to TCL_ENCODING_PROFILE_STRICT overriding any specified profile flags


 *
 * Results:

 *      The return value is one of
 *        TCL_OK: success. Converted string in *dstPtr
 *        TCL_ERROR: error in passed parameters. Error message in interp
 *        TCL_CONVERT_MULTIBYTE: source ends in truncated multibyte sequence
 *        TCL_CONVERT_SYNTAX: source is not conformant to encoding definition
 *        TCL_CONVERT_UNKNOWN: source contained a character that could not
 *            be represented in target encoding.
 *
 * Side effects:
 *
 *      TCL_OK: The converted bytes are stored in the DString and NUL
 *          terminated in an encoding-specific manner
 *      TCL_ERROR: an error, message is stored in the interp if not NULL.
 *      TCL_CONVERT_*: if errorLocPtr is NULL, an error message is stored
 *          in the interpreter (if not NULL). If errorLocPtr is not NULL,
 *          no error message is stored as it is expected the caller is
 *          interested in whatever is decoded so far and not treating this
 *          as an error condition.
 *
 *      In addition, *dstPtr is always initialized and must be cleared
 *      by the caller irrespective of the return code.
 *
 *-------------------------------------------------------------------------
 */

int
Tcl_UtfToExternalDStringEx(
    Tcl_Interp *interp,         /* For error messages. May be NULL. */
    Tcl_Encoding encoding,	/* The encoding for the converted string, or
				 * NULL for the default system encoding. */
    const char *src,		/* Source string in UTF-8. */
    Tcl_Size srcLen,		/* Source string length in bytes, or < 0 for
				 * strlen(). */
    int flags,			/* Conversion control flags. */
    Tcl_DString *dstPtr,	/* Uninitialized or free DString in which the
				 * converted string is stored. */
    Tcl_Size *errorLocPtr)      /* Where to store the error location
                                   (or TCL_INDEX_NONE if no error). May
				   be NULL. */
{
    char *dst;
    Tcl_EncodingState state;
    const Encoding *encodingPtr;
    int result;
    const char *srcStart = src;
    Tcl_Size dstLen, soFar;

    /* DO FIRST - must always be initialized on return */
    Tcl_DStringInit(dstPtr);

    if (flags & (TCL_ENCODING_START|TCL_ENCODING_END)) {
	/* TODO - what other flags are illegal? - See TIP 656 */
	Tcl_SetObjResult(
	    interp,
	    Tcl_NewStringObj(
		"Parameter error: TCL_ENCODING_{START,STOP} bits set in flags.",
		TCL_INDEX_NONE));
	Tcl_SetErrorCode(interp, "TCL", "ENCODING", "ILLEGALFLAGS", NULL);
	return TCL_ERROR;
    }

    dst = Tcl_DStringValue(dstPtr);
    dstLen = dstPtr->spaceAvl - 1;

    if (encoding == NULL) {
	encoding = systemEncoding;
    }
    encodingPtr = (Encoding *) encoding;

    if (src == NULL) {
	srcLen = 0;
    } else if (srcLen == TCL_INDEX_NONE) {
	srcLen = strlen(src);
    }

    flags |= TCL_ENCODING_START;
    while (1) {
	int srcChunkLen, srcChunkRead;
	int dstChunkLen, dstChunkWrote, dstChunkChars;

	if (srcLen > INT_MAX) {
	    srcChunkLen = INT_MAX;
	} else {
	    srcChunkLen = srcLen;
	    flags |= TCL_ENCODING_END; /* Last chunk */
	}
	dstChunkLen = dstLen > INT_MAX ? INT_MAX : dstLen;

	result = encodingPtr->fromUtfProc(encodingPtr->clientData, src,
					  srcChunkLen, flags, &state, dst, dstChunkLen,
					  &srcChunkRead, &dstChunkWrote, &dstChunkChars);
	soFar = dst + dstChunkWrote - Tcl_DStringValue(dstPtr);

	/* Move past the part processed in this go around */
	src += srcChunkRead;

	/*
	 * Keep looping in two case -
	 *   - our destination buffer did not have enough room
	 *   - we had not passed in all the data and error indicated fragment
	 *     of a multibyte character
	 * In both cases we have to grow buffer, move the input source pointer
	 * and loop. Otherwise, return the result we got.
	 */
	if ((result != TCL_CONVERT_NOSPACE) &&
	    !(result == TCL_CONVERT_MULTIBYTE && (flags & TCL_ENCODING_END))) {
	    Tcl_Size nBytesProcessed = (src - srcStart);
	    Tcl_Size i = soFar + encodingPtr->nullSize - 1;
	    /* Loop as DStringSetLength only stores one nul byte at a time */
	    while (i >= soFar) {
		Tcl_DStringSetLength(dstPtr, i--);
	    }
	    if (errorLocPtr) {
		/*
		 * Do not write error message into interpreter if caller
		 * wants to know error location.
		 */
		*errorLocPtr = result == TCL_OK ? TCL_INDEX_NONE : nBytesProcessed;
	    } else {
		/* Caller wants error message on failure */
		if (result != TCL_OK && interp != NULL) {
		    Tcl_Size pos = Tcl_NumUtfChars(srcStart, nBytesProcessed);
		    int ucs4;
		    char buf[TCL_INTEGER_SPACE];
		    TclUtfToUCS4(&srcStart[nBytesProcessed], &ucs4);
		    snprintf(buf, sizeof(buf), "%" TCL_Z_MODIFIER "u", nBytesProcessed);
		    Tcl_SetObjResult(
			interp,
			Tcl_ObjPrintf(
			    "unexpected character at index %" TCL_Z_MODIFIER
			    "u: 'U+%06X'",
			    pos,
			    ucs4));
		    Tcl_SetErrorCode(interp, "TCL", "ENCODING", "ILLEGALSEQUENCE",
				     buf, NULL);
		}
	    }
	    return result;
	}

	flags &= ~TCL_ENCODING_START;
	srcLen -= srcChunkRead;

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

int
Tcl_UtfToExternal(
    TCL_UNUSED(Tcl_Interp *),	/* TODO: Re-examine this. */
    Tcl_Encoding encoding,	/* The encoding for the converted string, or
				 * NULL for the default system encoding. */
    const char *src,		/* Source string in UTF-8. */
    size_t srcLen,		/* Source string length in bytes, or -1
				 * for strlen(). */
    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. */
    size_t 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







|
|








|







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

int
Tcl_UtfToExternal(
    TCL_UNUSED(Tcl_Interp *),	/* TODO: Re-examine this. */
    Tcl_Encoding encoding,	/* The encoding for the converted string, or
				 * NULL for the default system encoding. */
    const char *src,		/* Source string in UTF-8. */
    Tcl_Size srcLen,		/* Source string length in bytes, or TCL_INDEX_NONE for
				 * strlen(). */
    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. */
    Tcl_Size 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
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
	srcLen = 0;
    } else if (srcLen == TCL_INDEX_NONE) {
	srcLen = strlen(src);
    }
    if (statePtr == NULL) {
	flags |= TCL_ENCODING_START | TCL_ENCODING_END;
	statePtr = &state;







    }
    if (srcReadPtr == NULL) {
	srcReadPtr = &srcRead;
    }
    if (dstWrotePtr == NULL) {
	dstWrotePtr = &dstWrote;
    }
    if (dstCharsPtr == NULL) {
	dstCharsPtr = &dstChars;
    }




    dstLen -= encodingPtr->nullSize;
    result = encodingPtr->fromUtfProc(encodingPtr->clientData, src, srcLen,
	    flags, statePtr, dst, dstLen, srcReadPtr,
	    dstWrotePtr, dstCharsPtr);




    memset(&dst[*dstWrotePtr], '\0', encodingPtr->nullSize);

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







>
>
>
>
>
>
>











>
>
>




>
>
>
>







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
	srcLen = 0;
    } else if (srcLen == TCL_INDEX_NONE) {
	srcLen = strlen(src);
    }
    if (statePtr == NULL) {
	flags |= TCL_ENCODING_START | TCL_ENCODING_END;
	statePtr = &state;
    }
    if (srcLen > INT_MAX) {
	srcLen = INT_MAX;
	flags &= ~TCL_ENCODING_END;
    }
    if (dstLen > INT_MAX) {
	dstLen = INT_MAX;
    }
    if (srcReadPtr == NULL) {
	srcReadPtr = &srcRead;
    }
    if (dstWrotePtr == NULL) {
	dstWrotePtr = &dstWrote;
    }
    if (dstCharsPtr == NULL) {
	dstCharsPtr = &dstChars;
    }

    if (dstLen < encodingPtr->nullSize) {
	return TCL_CONVERT_NOSPACE;
    }
    dstLen -= encodingPtr->nullSize;
    result = encodingPtr->fromUtfProc(encodingPtr->clientData, src, srcLen,
	    flags, statePtr, dst, dstLen, srcReadPtr,
	    dstWrotePtr, dstCharsPtr);
    /*
     * Buffer is terminated irrespective of result. Not sure this is
     * reasonable but keep for historical/compatibility reasons.
     */
    memset(&dst[*dstWrotePtr], '\0', encodingPtr->nullSize);

    return result;
}

/*
 *---------------------------------------------------------------------------
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

static Tcl_Channel
OpenEncodingFileChannel(
    Tcl_Interp *interp,		/* Interp for error reporting, if not NULL. */
    const char *name)		/* The name of the encoding file on disk and
				 * also the name for new encoding. */
{
    Tcl_Obj *nameObj = Tcl_NewStringObj(name, -1);
    Tcl_Obj *fileNameObj = Tcl_DuplicateObj(nameObj);
    Tcl_Obj *searchPath = Tcl_DuplicateObj(Tcl_GetEncodingSearchPath());
    Tcl_Obj *map = TclGetProcessGlobalValue(&encodingFileMap);
    Tcl_Obj **dir, *path, *directory = NULL;
    Tcl_Channel chan = NULL;
    size_t i, numDirs;

    TclListObjGetElementsM(NULL, searchPath, &numDirs, &dir);
    Tcl_IncrRefCount(nameObj);
    Tcl_AppendToObj(fileNameObj, ".enc", -1);
    Tcl_IncrRefCount(fileNameObj);
    Tcl_DictObjGet(NULL, map, nameObj, &directory);

    /*
     * Check that any cached directory is still on the encoding search path.
     */








|





|



|







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

static Tcl_Channel
OpenEncodingFileChannel(
    Tcl_Interp *interp,		/* Interp for error reporting, if not NULL. */
    const char *name)		/* The name of the encoding file on disk and
				 * also the name for new encoding. */
{
    Tcl_Obj *nameObj = Tcl_NewStringObj(name, TCL_INDEX_NONE);
    Tcl_Obj *fileNameObj = Tcl_DuplicateObj(nameObj);
    Tcl_Obj *searchPath = Tcl_DuplicateObj(Tcl_GetEncodingSearchPath());
    Tcl_Obj *map = TclGetProcessGlobalValue(&encodingFileMap);
    Tcl_Obj **dir, *path, *directory = NULL;
    Tcl_Channel chan = NULL;
    Tcl_Size i, numDirs;

    TclListObjGetElementsM(NULL, searchPath, &numDirs, &dir);
    Tcl_IncrRefCount(nameObj);
    Tcl_AppendToObj(fileNameObj, ".enc", TCL_INDEX_NONE);
    Tcl_IncrRefCount(fileNameObj);
    Tcl_DictObjGet(NULL, map, nameObj, &directory);

    /*
     * Check that any cached directory is still on the encoding search path.
     */

1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
    pageMemPtr = (unsigned short *) (dataPtr->toUnicode + 256);

    TclNewObj(objPtr);
    Tcl_IncrRefCount(objPtr);
    for (i = 0; i < numPages; i++) {
	int ch;
	const char *p;
	size_t expected = 3 + 16 * (16 * 4 + 1);

	if (Tcl_ReadChars(chan, objPtr, expected, 0) != expected) {
	    return NULL;
	}
	p = TclGetString(objPtr);
	hi = (staticHex[UCHAR(p[0])] << 4) + staticHex[UCHAR(p[1])];
	dataPtr->toUnicode[hi] = pageMemPtr;







|







2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
    pageMemPtr = (unsigned short *) (dataPtr->toUnicode + 256);

    TclNewObj(objPtr);
    Tcl_IncrRefCount(objPtr);
    for (i = 0; i < numPages; i++) {
	int ch;
	const char *p;
	Tcl_Size expected = 3 + 16 * (16 * 4 + 1);

	if (Tcl_ReadChars(chan, objPtr, expected, 0) != expected) {
	    return NULL;
	}
	p = TclGetString(objPtr);
	hi = (staticHex[UCHAR(p[0])] << 4) + staticHex[UCHAR(p[1])];
	dataPtr->toUnicode[hi] = pageMemPtr;
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
    Tcl_EncodingType type;

    init[0] = '\0';
    final[0] = '\0';
    Tcl_DStringInit(&escapeData);

    while (1) {
	size_t argc;
	const char **argv;
	char *line;
	Tcl_DString lineString;

	Tcl_DStringInit(&lineString);
	if (Tcl_Gets(chan, &lineString) == TCL_IO_FAILURE) {
	    break;







|







2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
    Tcl_EncodingType type;

    init[0] = '\0';
    final[0] = '\0';
    Tcl_DStringInit(&escapeData);

    while (1) {
	Tcl_Size argc;
	const char **argv;
	char *line;
	Tcl_DString lineString;

	Tcl_DStringInit(&lineString);
	if (Tcl_Gets(chan, &lineString) == TCL_IO_FAILURE) {
	    break;
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
		   Tcl_FreeEncoding((Tcl_Encoding) e);
		   e = NULL;
		}
		est.encodingPtr = e;
		Tcl_DStringAppend(&escapeData, (char *) &est, sizeof(est));
	    }
	}
	Tcl_Free((void *)argv);
	Tcl_DStringFree(&lineString);
    }

    size = offsetof(EscapeEncodingData, subTables)
	    + Tcl_DStringLength(&escapeData);
    dataPtr = (EscapeEncodingData *)Tcl_Alloc(size);
    dataPtr->initLen = strlen(init);







|







2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
		   Tcl_FreeEncoding((Tcl_Encoding) e);
		   e = NULL;
		}
		est.encodingPtr = e;
		Tcl_DStringAppend(&escapeData, (char *) &est, sizeof(est));
	    }
	}
	Tcl_Free(argv);
	Tcl_DStringFree(&lineString);
    }

    size = offsetof(EscapeEncodingData, subTables)
	    + Tcl_DStringLength(&escapeData);
    dataPtr = (EscapeEncodingData *)Tcl_Alloc(size);
    dataPtr->initLen = strlen(init);
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
    int result;

    result = TCL_OK;
    dstLen -= TCL_UTF_MAX - 1;
    if (dstLen < 0) {
	dstLen = 0;
    }

    if ((flags & TCL_ENCODING_CHAR_LIMIT) && srcLen > *dstCharsPtr) {
	srcLen = *dstCharsPtr;
    }
    if (srcLen > dstLen) {
	srcLen = dstLen;
	result = TCL_CONVERT_NOSPACE;
    }

    *srcReadPtr = srcLen;
    *dstWrotePtr = srcLen;
    *dstCharsPtr = srcLen;
    memcpy(dst, src, srcLen);
    return result;
}

/*
 *-------------------------------------------------------------------------
 *
 * UtfToUtfProc --
 *
 *	Convert from UTF-8 to UTF-8. Note that the UTF-8 to UTF-8 translation
 *	is not a no-op, because it will turn a stream of improperly formed
 *	UTF-8 into a properly formed stream.
 *
 * Results:
 *	Returns TCL_OK if conversion was successful.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

#define STOPONERROR (!(flags & TCL_ENCODING_NOCOMPLAIN))

static int
UtfToUtfProc(
    void *clientData,	/* additional flags, e.g. TCL_ENCODING_MODIFIED */
    const char *src,		/* Source string in UTF-8. */
    int srcLen,			/* Source string length in bytes. */
    int flags,			/* Conversion control flags. */
    TCL_UNUSED(Tcl_EncodingState *),
    char *dst,			/* Output buffer in which converted string is
				 * stored. */
    int dstLen,			/* The maximum length of output buffer in
				 * bytes. */
    int *srcReadPtr,		/* Filled with the number of bytes from the
				 * source string that were converted. This may







>




















|
|
|










<
<


|


|







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

    result = TCL_OK;
    dstLen -= TCL_UTF_MAX - 1;
    if (dstLen < 0) {
	dstLen = 0;
    }
    flags = TclEncodingSetProfileFlags(flags);
    if ((flags & TCL_ENCODING_CHAR_LIMIT) && srcLen > *dstCharsPtr) {
	srcLen = *dstCharsPtr;
    }
    if (srcLen > dstLen) {
	srcLen = dstLen;
	result = TCL_CONVERT_NOSPACE;
    }

    *srcReadPtr = srcLen;
    *dstWrotePtr = srcLen;
    *dstCharsPtr = srcLen;
    memcpy(dst, src, srcLen);
    return result;
}

/*
 *-------------------------------------------------------------------------
 *
 * UtfToUtfProc --
 *
 *	Converts from UTF-8 to UTF-8. Note that the 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.
 *
 * Results:
 *	Returns TCL_OK if conversion was successful.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */



static int
UtfToUtfProc(
    void *clientData,		/* additional flags */
    const char *src,		/* Source string in UTF-8. */
    int srcLen,			/* Source string length in bytes. */
    int flags,			/* TCL_ENCODING_* conversion control flags. */
    TCL_UNUSED(Tcl_EncodingState *),
    char *dst,			/* Output buffer in which converted string is
				 * stored. */
    int dstLen,			/* The maximum length of output buffer in
				 * bytes. */
    int *srcReadPtr,		/* Filled with the number of bytes from the
				 * source string that were converted. This may
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
				 * correspond to the bytes stored in the
				 * output buffer. */
{
    const char *srcStart, *srcEnd, *srcClose;
    const char *dstStart, *dstEnd;
    int result, numChars, charLimit = INT_MAX;
    int ch;


    result = TCL_OK;

    srcStart = src;
    srcEnd = src + srcLen;
    srcClose = srcEnd;

    if ((flags & TCL_ENCODING_END) == 0) {
	srcClose -= 6;
    }
    if (flags & TCL_ENCODING_CHAR_LIMIT) {
	charLimit = *dstCharsPtr;
    }

    dstStart = dst;
    flags |= PTR2INT(clientData);
    dstEnd = dst + dstLen - ((flags & TCL_ENCODING_UTF) ? TCL_UTF_MAX : 6);












    for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {

	if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) {
	    /*
	     * If there is more string to follow, this will ensure that the
	     * last UTF-8 character in the source buffer hasn't been cut off.
	     */

	    result = TCL_CONVERT_MULTIBYTE;
	    break;
	}
	if (dst > dstEnd) {
	    result = TCL_CONVERT_NOSPACE;
	    break;
	}
	if (UCHAR(*src) < 0x80 && !((UCHAR(*src) == 0) && (flags & TCL_ENCODING_MODIFIED))) {
	    /*
	     * Copy 7bit characters, but skip null-bytes when we are in input
	     * mode, so that they get converted to 0xC080.
	     */

	    *dst++ = *src++;
	} else if ((UCHAR(*src) == 0xC0) && (src + 1 < srcEnd)
		&& (UCHAR(src[1]) == 0x80) && (!(flags & TCL_ENCODING_MODIFIED) || ((flags & TCL_ENCODING_STRICT) == TCL_ENCODING_STRICT))) {


	    /*
	     * If in input mode, and -strict is specified: This is an error.
	     */
	    if (flags & TCL_ENCODING_MODIFIED) {





		result = TCL_CONVERT_UNKNOWN;
		break;
	    }

	    /*
	     * Convert 0xC080 to real nulls when we are in output mode, with or without '-strict'.
	     */
	    *dst++ = 0;
	    src += 2;


	} else if (!Tcl_UtfCharComplete(src, srcEnd - src)) {
	    /*

	     * Always check before using TclUtfToUCS4. Not doing can so
	     * cause it run beyond the end of the buffer! If we happen such an
	     * incomplete char its bytes are made to represent themselves
	     * unless the user has explicitly asked to be told.
	     */

	    if (flags & TCL_ENCODING_MODIFIED) {


		if ((STOPONERROR) && (flags & TCL_ENCODING_CHAR_LIMIT)) {
		    result = TCL_CONVERT_MULTIBYTE;

		    break;
		}


		ch = UCHAR(*src++);

	    } else {

		char chbuf[2];
		chbuf[0] = UCHAR(*src++); chbuf[1] = 0;
		TclUtfToUCS4(chbuf, &ch);
	    }
	    dst += Tcl_UniCharToUtf(ch, dst);
	} else {
	    const char *saveSrc = src;
	    size_t len = TclUtfToUCS4(src, &ch);

	    if ((len < 2) && (ch != 0) && STOPONERROR

		    && (flags & TCL_ENCODING_MODIFIED)) {




		result = TCL_CONVERT_SYNTAX;
		break;


	    }




	    src += len;
	    if (!(flags & TCL_ENCODING_UTF) && (ch > 0x3FF)) {
		if (ch > 0xFFFF) {
		    /* CESU-8 6-byte sequence for chars > U+FFFF */
		    ch -= 0x10000;
		    *dst++ = 0xED;
		    *dst++ = (char) (((ch >> 16) & 0x0F) | 0xA0);
		    *dst++ = (char) (((ch >> 10) & 0x3F) | 0x80);
		    ch = (ch & 0x0CFF) | 0xDC00;
		}
#if TCL_UTF_MAX < 4
	    cesu8:
#endif
		*dst++ = (char) (((ch >> 12) | 0xE0) & 0xEF);
		*dst++ = (char) (((ch >> 6) | 0x80) & 0xBF);
		*dst++ = (char) ((ch | 0x80) & 0xBF);
		continue;
#if TCL_UTF_MAX < 4
	    } else if ((ch | 0x7FF) == 0xDFFF) {
		/*
		 * A surrogate character is detected, handle especially.
		 */









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

		if (((low & ~0x3FF) != 0xDC00) || (ch & 0x400)) {

		    if (STOPONERROR) {
			result = TCL_CONVERT_UNKNOWN;
			src = saveSrc;
			break;
		    }
		    goto cesu8;
		}
		src += len;
		dst += Tcl_UniCharToUtf(ch, dst);
		ch = low;

#endif
	    } else if (!Tcl_UniCharIsUnicode(ch)) {

		if (STOPONERROR) {
		    result = TCL_CONVERT_UNKNOWN;
		    src = saveSrc;
		    break;
		}

		if (!(flags & TCL_ENCODING_MODIFIED)) {


		    ch = 0xFFFD;
		}

	    }
	    dst += Tcl_UniCharToUtf(ch, dst);
	}
    }

    *srcReadPtr = src - srcStart;
    *dstWrotePtr = dst - dstStart;







>






>









|

>
>
>
>
>
>
>
>
>
>
>

>













|


|

<

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


>
|
|
|
|


|
>
>
|
|
>


>
>
|
>

>






|

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

|
















|



>
>
>
>
|
>
>
>
>
|
|

|

|
|
|
|
|
|
|
|
|
|
>

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







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
				 * correspond to the bytes stored in the
				 * output buffer. */
{
    const char *srcStart, *srcEnd, *srcClose;
    const char *dstStart, *dstEnd;
    int result, numChars, charLimit = INT_MAX;
    int ch;
    int profile;

    result = TCL_OK;

    srcStart = src;
    srcEnd = src + srcLen;
    srcClose = srcEnd;
    flags = TclEncodingSetProfileFlags(flags);
    if ((flags & TCL_ENCODING_END) == 0) {
	srcClose -= 6;
    }
    if (flags & TCL_ENCODING_CHAR_LIMIT) {
	charLimit = *dstCharsPtr;
    }

    dstStart = dst;
    flags |= PTR2INT(clientData);
    dstEnd = dst + dstLen - ((flags & ENCODING_UTF) ? TCL_UTF_MAX : 6);


#if TCL_UTF_MAX < 4
    /* Initialize the buffer so that some random data doesn't trick
     * Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
     * Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
     * prior non-stateful nature, this call to memset can also be removed.
     */
    memset(dst, 0xff, dstLen);
#endif

    profile = ENCODING_PROFILE_GET(flags);
    for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {

	if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) {
	    /*
	     * If there is more string to follow, this will ensure that the
	     * last UTF-8 character in the source buffer hasn't been cut off.
	     */

	    result = TCL_CONVERT_MULTIBYTE;
	    break;
	}
	if (dst > dstEnd) {
	    result = TCL_CONVERT_NOSPACE;
	    break;
	}
	if (UCHAR(*src) < 0x80 && !((UCHAR(*src) == 0) && (flags & ENCODING_INPUT))) {
	    /*
	     * Copy 7bit characters, but skip null-bytes when we are in input
	     * mode, so that they get converted to \xC0\x80.
	     */

	    *dst++ = *src++;
	} else if ((UCHAR(*src) == 0xC0) && (src + 1 < srcEnd) &&
		 (UCHAR(src[1]) == 0x80) &&
		 (!(flags & ENCODING_INPUT) || PROFILE_STRICT(profile) ||
		  PROFILE_REPLACE(profile))) {
	    /* Special sequence \xC0\x80 */


	    if ((PROFILE_STRICT(profile) || PROFILE_REPLACE(profile)) && (flags & ENCODING_INPUT)) {
		if (PROFILE_REPLACE(profile)) {
		   dst += Tcl_UniCharToUtf(UNICODE_REPLACE_CHAR, dst);
		   src += 2;
		} else {
		   /* PROFILE_STRICT */
		   result = TCL_CONVERT_SYNTAX;
		   break;
		}
	    } else {
		/*
		 * For output convert 0xC080 to a real null.
		 */
		*dst++ = 0;
		src += 2;
	    }

	} else if (!Tcl_UtfCharComplete(src, srcEnd - src)) {
	    /*
	     * Incomplete byte sequence.
		 * Always check before using TclUtfToUCS4. Not doing so can cause it
		 * run beyond the end of the buffer! If we happen on such an incomplete
		 * char its bytes are made to represent themselves unless the user has
		 * explicitly asked to be told.
	     */

	    if (flags & ENCODING_INPUT) {
		/* Incomplete bytes for modified UTF-8 target */
		if (PROFILE_STRICT(profile)) {
		    result = (flags & TCL_ENCODING_CHAR_LIMIT)
			       ? TCL_CONVERT_MULTIBYTE
			       : TCL_CONVERT_SYNTAX;
		    break;
		}
	    }
	    if (PROFILE_REPLACE(profile)) {
		ch = UNICODE_REPLACE_CHAR;
		++src;
	    } else {
		/* TCL_ENCODING_PROFILE_TCL8 */
		char chbuf[2];
		chbuf[0] = UCHAR(*src++); chbuf[1] = 0;
		TclUtfToUCS4(chbuf, &ch);
	    }
	    dst += Tcl_UniCharToUtf(ch, dst);
	} else {
	    int isInvalid = 0;
	    size_t len = TclUtfToUCS4(src, &ch);
	    if (flags & ENCODING_INPUT) {
		if ((len < 2) && (ch != 0)) {
		    isInvalid = 1;
		} else if ((ch > 0xFFFF) && !(flags & ENCODING_UTF)) {
		    isInvalid = 1;
		}
		if (isInvalid) {
		    if (PROFILE_STRICT(profile)) {
			result = TCL_CONVERT_SYNTAX;
			break;
		    } else if (PROFILE_REPLACE(profile)) {
			ch = UNICODE_REPLACE_CHAR;
		    }
		}
	    }

	    const char *saveSrc = src;
	    src += len;
	    if (!(flags & ENCODING_UTF) && !(flags & ENCODING_INPUT) && (ch > 0x3FF)) {
		if (ch > 0xFFFF) {
		    /* CESU-8 6-byte sequence for chars > U+FFFF */
		    ch -= 0x10000;
		    *dst++ = 0xED;
		    *dst++ = (char) (((ch >> 16) & 0x0F) | 0xA0);
		    *dst++ = (char) (((ch >> 10) & 0x3F) | 0x80);
		    ch = (ch & 0x0CFF) | 0xDC00;
		}
#if TCL_UTF_MAX < 4
	    cesu8:
#endif
		*dst++ = (char) (((ch >> 12) | 0xE0) & 0xEF);
		*dst++ = (char) (((ch >> 6) | 0x80) & 0xBF);
		*dst++ = (char) ((ch | 0x80) & 0xBF);
		continue;
#if TCL_UTF_MAX < 4
	    } else if (SURROGATE(ch)) {
		/*
		 * A surrogate character is detected, handle especially.
		 */
		if (PROFILE_STRICT(profile) && (flags & ENCODING_UTF)) {
		    result = TCL_CONVERT_UNKNOWN;
		    src = saveSrc;
		    break;
		}
		if (PROFILE_REPLACE(profile)) {
		    /* TODO - is this right for cesu8 or should we fall through below? */
		    ch = UNICODE_REPLACE_CHAR;
		} else {
		    int low = ch;
		    len = (src <= srcEnd - 3) ? TclUtfToUCS4(src, &low) : 0;

		    if ((!LOW_SURROGATE(low)) || (ch & 0x400)) {

			if (PROFILE_STRICT(profile)) {
			    result = TCL_CONVERT_UNKNOWN;
			    src = saveSrc;
			    break;
			}
			goto cesu8;
		    }
		    src += len;
		    dst += Tcl_UniCharToUtf(ch, dst);
		    ch = low;
		}
#endif
	    } else if (PROFILE_STRICT(profile) &&
		       (!(flags & ENCODING_INPUT)) &&
		       SURROGATE(ch)) {
		result = TCL_CONVERT_UNKNOWN;
		src = saveSrc;
		break;

	    } else if (PROFILE_STRICT(profile) &&
		       (flags & ENCODING_INPUT) &&
		       SURROGATE(ch)) {
		result = TCL_CONVERT_SYNTAX;
		src = saveSrc;

		break;
	    }
	    dst += Tcl_UniCharToUtf(ch, dst);
	}
    }

    *srcReadPtr = src - srcStart;
    *dstWrotePtr = dst - dstStart;
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
    int *dstCharsPtr)		/* Filled with the number of characters that
				 * correspond to the bytes stored in the
				 * output buffer. */
{
    const char *srcStart, *srcEnd;
    const char *dstEnd, *dstStart;
    int result, numChars, charLimit = INT_MAX;
    int ch;


    flags |= PTR2INT(clientData);
    if (flags & TCL_ENCODING_CHAR_LIMIT) {
	charLimit = *dstCharsPtr;
    }
    result = TCL_OK;










    /*
     * Check alignment with utf-32 (4 == sizeof(UTF-32))
     */





    if ((srcLen % 4) != 0) {










	result = TCL_CONVERT_MULTIBYTE;
	srcLen &= -4;
    }


    srcStart = src;
    srcEnd = src + srcLen;

    dstStart = dst;
    dstEnd = dst + dstLen - TCL_UTF_MAX;

    for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
	if (dst > dstEnd) {
	    result = TCL_CONVERT_NOSPACE;
	    break;
	}




	if (flags & TCL_ENCODING_LE) {
	    ch = (src[3] & 0xFF) << 24 | (src[2] & 0xFF) << 16 | (src[1] & 0xFF) << 8 | (src[0] & 0xFF);
	} else {
	    ch = (src[0] & 0xFF) << 24 | (src[1] & 0xFF) << 16 | (src[2] & 0xFF) << 8 | (src[3] & 0xFF);






















	}

	/*
	 * Special case for 1-byte utf chars for speed. Make sure we work with
	 * unsigned short-size data.
	 */

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





	    dst += Tcl_UniCharToUtf(ch, dst);
	}
	src += sizeof(unsigned int);



























    }

    *srcReadPtr = src - srcStart;
    *dstWrotePtr = dst - dstStart;
    *dstCharsPtr = numChars;
    return result;
}







|

>






>
>
>
>
>
>
>
>
>



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

|

>













>
>
>

|

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







|


>
>
>
>
>


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







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
    int *dstCharsPtr)		/* Filled with the number of characters that
				 * correspond to the bytes stored in the
				 * output buffer. */
{
    const char *srcStart, *srcEnd;
    const char *dstEnd, *dstStart;
    int result, numChars, charLimit = INT_MAX;
    int ch = 0, bytesLeft = srcLen % 4;

    flags = TclEncodingSetProfileFlags(flags);
    flags |= PTR2INT(clientData);
    if (flags & TCL_ENCODING_CHAR_LIMIT) {
	charLimit = *dstCharsPtr;
    }
    result = TCL_OK;

#if TCL_UTF_MAX < 4
    /* Initialize the buffer so that some random data doesn't trick
     * Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
     * Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
     * prior non-stateful nature, this call to memset can also be removed.
     */
    memset(dst, 0xff, dstLen);
#endif

    /*
     * Check alignment with utf-32 (4 == sizeof(UTF-32))
     */
    if (bytesLeft != 0) {
	/* We have a truncated code unit */
	result = TCL_CONVERT_MULTIBYTE;
	srcLen -= bytesLeft;
    }

#if TCL_UTF_MAX < 4
    /*
     * If last code point is a high surrogate, we cannot handle that yet,
     * unless we are at the end.
     */

    if (!(flags & TCL_ENCODING_END) && (srcLen >= 4) &&
	    ((src[srcLen - ((flags & TCL_ENCODING_LE)?3:2)] & 0xFC) == 0xD8) &&
	    ((src[srcLen - ((flags & TCL_ENCODING_LE)?2:3)]) == 0) &&
	    ((src[srcLen - ((flags & TCL_ENCODING_LE)?1:4)]) == 0)) {
	result = TCL_CONVERT_MULTIBYTE;
	srcLen-= 4;
    }
#endif

    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 TCL_UTF_MAX < 4
	int prev = ch;
#endif
	if (flags & TCL_ENCODING_LE) {
	    ch = (unsigned int)(src[3] & 0xFF) << 24 | (src[2] & 0xFF) << 16 | (src[1] & 0xFF) << 8 | (src[0] & 0xFF);
	} else {
	    ch = (unsigned int)(src[0] & 0xFF) << 24 | (src[1] & 0xFF) << 16 | (src[2] & 0xFF) << 8 | (src[3] & 0xFF);
	}
#if TCL_UTF_MAX < 4
	if (HIGH_SURROGATE(prev) && !LOW_SURROGATE(ch)) {
	    /* Bug [10c2c17c32]. If Hi surrogate not followed by Lo surrogate, finish 3-byte UTF-8 */
	    dst += Tcl_UniCharToUtf(-1, dst);
	}
#endif

	if ((unsigned)ch > 0x10FFFF) {
	    ch = UNICODE_REPLACE_CHAR;
	    if (PROFILE_STRICT(flags)) {
		result = TCL_CONVERT_SYNTAX;
		break;
	    }
	} else if (PROFILE_STRICT(flags) && SURROGATE(ch)) {
	    result = TCL_CONVERT_SYNTAX;
#if TCL_UTF_MAX < 4
	    ch = 0;
#endif
	    break;
	} else if (PROFILE_REPLACE(flags) && SURROGATE(ch)) {
	    ch = UNICODE_REPLACE_CHAR;
	}

	/*
	 * Special case for 1-byte utf chars for speed. Make sure we work with
	 * unsigned short-size data.
	 */

	if ((unsigned)ch - 1 < 0x7F) {
	    *dst++ = (ch & 0xFF);
	} else {
#if TCL_UTF_MAX < 4
	    if (!HIGH_SURROGATE(prev) && LOW_SURROGATE(ch)) {
		*dst = 0; /* In case of lower surrogate, don't try to combine */
	    }
#endif
	    dst += Tcl_UniCharToUtf(ch, dst);
	}
	src += 4;
    }

    /*
     * If we had a truncated code unit at the end AND this is the last
     * fragment AND profile is not "strict", stick FFFD in its place.
     */
#if TCL_UTF_MAX < 4
    if (HIGH_SURROGATE(ch)) {
	/* Bug [10c2c17c32]. If Hi surrogate, finish 3-byte UTF-8 */
	dst += Tcl_UniCharToUtf(-1, dst);
    }
#endif

    if ((flags & TCL_ENCODING_END) && (result == TCL_CONVERT_MULTIBYTE)) {
	if (dst > dstEnd) {
	    result = TCL_CONVERT_NOSPACE;
	} else {
	    if (PROFILE_STRICT(flags)) {
		result = TCL_CONVERT_SYNTAX;
	    } else {
		/* PROFILE_REPLACE or PROFILE_TCL8 */
		result = TCL_OK;
		dst += Tcl_UniCharToUtf(UNICODE_REPLACE_CHAR, dst);
		numChars++;
		src += bytesLeft; /* Go past truncated code unit */
	    }
	}
    }

    *srcReadPtr = src - srcStart;
    *dstWrotePtr = dst - dstStart;
    *dstCharsPtr = numChars;
    return result;
}
2556
2557
2558
2559
2560
2561
2562

2563
2564
2565
2566
2567
2568
2569
    const char *srcStart, *srcEnd, *srcClose, *dstStart, *dstEnd;
    int result, numChars;
    int ch, len;

    srcStart = src;
    srcEnd = src + srcLen;
    srcClose = srcEnd;

    if ((flags & TCL_ENCODING_END) == 0) {
	srcClose -= TCL_UTF_MAX;
    }

    dstStart = dst;
    dstEnd = dst + dstLen - sizeof(Tcl_UniChar);
    flags |= PTR2INT(clientData);







>







2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
    const char *srcStart, *srcEnd, *srcClose, *dstStart, *dstEnd;
    int result, numChars;
    int ch, len;

    srcStart = src;
    srcEnd = src + srcLen;
    srcClose = srcEnd;
    flags = TclEncodingSetProfileFlags(flags);
    if ((flags & TCL_ENCODING_END) == 0) {
	srcClose -= TCL_UTF_MAX;
    }

    dstStart = dst;
    dstEnd = dst + dstLen - sizeof(Tcl_UniChar);
    flags |= PTR2INT(clientData);
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591

2592

2593
2594
2595
2596
2597
2598
2599
	    break;
	}
	if (dst > dstEnd) {
	    result = TCL_CONVERT_NOSPACE;
	    break;
	}
	len = TclUtfToUCS4(src, &ch);
	if (!Tcl_UniCharIsUnicode(ch)) {
	    if (STOPONERROR) {
		result = TCL_CONVERT_UNKNOWN;
		break;
	    }

	    ch = 0xFFFD;

	}
	src += len;
	if (flags & TCL_ENCODING_LE) {
	    *dst++ = (ch & 0xFF);
	    *dst++ = ((ch >> 8) & 0xFF);
	    *dst++ = ((ch >> 16) & 0xFF);
	    *dst++ = ((ch >> 24) & 0xFF);







|
|



>
|
>







2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
	    break;
	}
	if (dst > dstEnd) {
	    result = TCL_CONVERT_NOSPACE;
	    break;
	}
	len = TclUtfToUCS4(src, &ch);
	if (SURROGATE(ch)) {
	    if (PROFILE_STRICT(flags)) {
		result = TCL_CONVERT_UNKNOWN;
		break;
	    }
	    if (PROFILE_REPLACE(flags)) {
		ch = UNICODE_REPLACE_CHAR;
	    }
	}
	src += len;
	if (flags & TCL_ENCODING_LE) {
	    *dst++ = (ch & 0xFF);
	    *dst++ = ((ch >> 8) & 0xFF);
	    *dst++ = ((ch >> 16) & 0xFF);
	    *dst++ = ((ch >> 24) & 0xFF);
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
    int *dstCharsPtr)		/* Filled with the number of characters that
				 * correspond to the bytes stored in the
				 * output buffer. */
{
    const char *srcStart, *srcEnd;
    const char *dstEnd, *dstStart;
    int result, numChars, charLimit = INT_MAX;
    unsigned short ch;


    flags |= PTR2INT(clientData);
    if (flags & TCL_ENCODING_CHAR_LIMIT) {
	charLimit = *dstCharsPtr;
    }
    result = TCL_OK;










    /*
     * Check alignment with utf-16 (2 == sizeof(UTF-16))
     */

    if ((srcLen % 2) != 0) {
	result = TCL_CONVERT_MULTIBYTE;
	srcLen--;
    }

    /*
     * If last code point is a high surrogate, we cannot handle that yet.

     */

    if ((srcLen >= 2) &&
	    ((src[srcLen - ((flags & TCL_ENCODING_LE)?1:2)] & 0xFC) == 0xD8)) {
	result = TCL_CONVERT_MULTIBYTE;
	srcLen-= 2;
    }

    srcStart = src;
    srcEnd = src + srcLen;

    dstStart = dst;
    dstEnd = dst + dstLen - TCL_UTF_MAX;

    for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
	if (dst > dstEnd) {
	    result = TCL_CONVERT_NOSPACE;
	    break;
	}


	if (flags & TCL_ENCODING_LE) {
	    ch = (src[1] & 0xFF) << 8 | (src[0] & 0xFF);
	} else {
	    ch = (src[0] & 0xFF) << 8 | (src[1] & 0xFF);

























	}

	/*
	 * Special case for 1-byte utf chars for speed. Make sure we work with
	 * unsigned short-size data.
	 */

	if (ch && ch < 0x80) {
	    *dst++ = (ch & 0xFF);







	} else {




	    dst += Tcl_UniCharToUtf(ch | TCL_COMBINE, dst);
	}

	src += sizeof(unsigned short);

































    }

    *srcReadPtr = src - srcStart;
    *dstWrotePtr = dst - dstStart;
    *dstCharsPtr = numChars;
    return result;
}







|

>





>
>
>
>
>
>
>
>
>











|
>


|











|





>




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







|

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

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







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
    int *dstCharsPtr)		/* Filled with the number of characters that
				 * correspond to the bytes stored in the
				 * output buffer. */
{
    const char *srcStart, *srcEnd;
    const char *dstEnd, *dstStart;
    int result, numChars, charLimit = INT_MAX;
    unsigned short ch = 0;

    flags = TclEncodingSetProfileFlags(flags);
    flags |= PTR2INT(clientData);
    if (flags & TCL_ENCODING_CHAR_LIMIT) {
	charLimit = *dstCharsPtr;
    }
    result = TCL_OK;

#if TCL_UTF_MAX < 4
    /* Initialize the buffer so that some random data doesn't trick
     * Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
     * Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
     * prior non-stateful nature, this call to memset can also be removed.
     */
    memset(dst, 0xff, dstLen);
#endif

    /*
     * 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,
     * unless we are at the end.
     */

    if (!(flags & TCL_ENCODING_END) && (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; src += 2, numChars++) {
	if (dst > dstEnd) {
	    result = TCL_CONVERT_NOSPACE;
	    break;
	}

	unsigned short prev = ch;
	if (flags & TCL_ENCODING_LE) {
	    ch = (src[1] & 0xFF) << 8 | (src[0] & 0xFF);
	} else {
	    ch = (src[0] & 0xFF) << 8 | (src[1] & 0xFF);
	}
	if (HIGH_SURROGATE(prev) && !LOW_SURROGATE(ch)) {
	    if (PROFILE_STRICT(flags)) {
		result = TCL_CONVERT_SYNTAX;
		src -= 2; /* Go back to beginning of high surrogate */
		dst--; /* Also undo writing a single byte too much */
		numChars--;
		break;
	    } else if (PROFILE_REPLACE(flags)) {
		/*
		 * Previous loop wrote a single byte to mark the high surrogate.
		 * Replace it with the replacement character. Further, restart
		 * current loop iteration since need to recheck destination space
		 * and reset processing of current character.
		 */
		ch = UNICODE_REPLACE_CHAR;
		dst--;
		dst += Tcl_UniCharToUtf(ch, dst);
		src -= 2;
		numChars--;
		continue;
	    } else {
	    /* Bug [10c2c17c32]. If Hi surrogate not followed by Lo surrogate, finish 3-byte UTF-8 */
		dst += Tcl_UniCharToUtf(-1, dst);
	    }
	}

	/*
	 * Special case for 1-byte utf chars for speed. Make sure we work with
	 * unsigned short-size data.
	 */

	if ((unsigned)ch - 1 < 0x7F) {
	    *dst++ = (ch & 0xFF);
	} else if (HIGH_SURROGATE(prev) || HIGH_SURROGATE(ch)) {
	    dst += Tcl_UniCharToUtf(ch | TCL_COMBINE, dst);
	} else if (LOW_SURROGATE(ch) && !PROFILE_TCL8(flags)) {
	    /* Lo surrogate not preceded by Hi surrogate and not tcl8 profile */
	    if (PROFILE_STRICT(flags)) {
		result = TCL_CONVERT_UNKNOWN;
		break;
	    } else {
		/* PROFILE_REPLACE */
		dst += Tcl_UniCharToUtf(UNICODE_REPLACE_CHAR, dst);
	    }
	} else {
	    dst += Tcl_UniCharToUtf(ch, dst);
	}
    }

    if (HIGH_SURROGATE(ch)) {
	if (PROFILE_STRICT(flags)) {
	    result = TCL_CONVERT_SYNTAX;
	    src -= 2;
	    dst--;
	    numChars--;
	} else if (PROFILE_REPLACE(flags)) {
	    dst--;
	    dst += Tcl_UniCharToUtf(UNICODE_REPLACE_CHAR, dst);
	} else {
	    /* Bug [10c2c17c32]. If Hi surrogate, finish 3-byte UTF-8 */
	    dst += Tcl_UniCharToUtf(-1, dst);
	}
    }

    /*
     * If we had a truncated code unit at the end AND this is the last
     * fragment AND profile is not "strict", stick FFFD in its place.
     */
    if ((flags & TCL_ENCODING_END) && (result == TCL_CONVERT_MULTIBYTE)) {
	if (dst > dstEnd) {
	    result = TCL_CONVERT_NOSPACE;
	} else {
	    if (PROFILE_STRICT(flags)) {
		result = TCL_CONVERT_SYNTAX;
	    } else {
		/* PROFILE_REPLACE or PROFILE_TCL8 */
		result = TCL_OK;
		dst += Tcl_UniCharToUtf(UNICODE_REPLACE_CHAR, dst);
		numChars++;
		src++; /* Go past truncated code unit */
	    }
	}
    }

    *srcReadPtr = src - srcStart;
    *dstWrotePtr = dst - dstStart;
    *dstCharsPtr = numChars;
    return result;
}
2759
2760
2761
2762
2763
2764
2765

2766
2767
2768
2769
2770
2771
2772
    const char *srcStart, *srcEnd, *srcClose, *dstStart, *dstEnd;
    int result, numChars;
    int ch, len;

    srcStart = src;
    srcEnd = src + srcLen;
    srcClose = srcEnd;

    if ((flags & TCL_ENCODING_END) == 0) {
	srcClose -= TCL_UTF_MAX;
    }

    dstStart = dst;
    dstEnd   = dst + dstLen - sizeof(Tcl_UniChar);
    flags |= PTR2INT(clientData);







>







3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
    const char *srcStart, *srcEnd, *srcClose, *dstStart, *dstEnd;
    int result, numChars;
    int ch, len;

    srcStart = src;
    srcEnd = src + srcLen;
    srcClose = srcEnd;
    flags = TclEncodingSetProfileFlags(flags);
    if ((flags & TCL_ENCODING_END) == 0) {
	srcClose -= TCL_UTF_MAX;
    }

    dstStart = dst;
    dstEnd   = dst + dstLen - sizeof(Tcl_UniChar);
    flags |= PTR2INT(clientData);
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794

2795

2796
2797
2798
2799
2800
2801
2802
	    break;
	}
	if (dst > dstEnd) {
	    result = TCL_CONVERT_NOSPACE;
	    break;
	}
	len = TclUtfToUCS4(src, &ch);
	if (!Tcl_UniCharIsUnicode(ch)) {
	    if (STOPONERROR) {
		result = TCL_CONVERT_UNKNOWN;
		break;
	    }

	    ch = 0xFFFD;

	}
	src += len;
	if (flags & TCL_ENCODING_LE) {
	    if (ch <= 0xFFFF) {
		*dst++ = (ch & 0xFF);
		*dst++ = (ch >> 8);
	    } else {







|
|



>
|
>







3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
	    break;
	}
	if (dst > dstEnd) {
	    result = TCL_CONVERT_NOSPACE;
	    break;
	}
	len = TclUtfToUCS4(src, &ch);
	if (SURROGATE(ch)) {
	    if (PROFILE_STRICT(flags)) {
		result = TCL_CONVERT_UNKNOWN;
		break;
	    }
	    if (PROFILE_REPLACE(flags)) {
		ch = UNICODE_REPLACE_CHAR;
	    }
	}
	src += len;
	if (flags & TCL_ENCODING_LE) {
	    if (ch <= 0xFFFF) {
		*dst++ = (ch & 0xFF);
		*dst++ = (ch >> 8);
	    } else {
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871

2872
2873
2874
2875
2876
2877
2878
				 * 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;
#if TCL_UTF_MAX < 4
    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;
    }







|
<
<
<


>







3316
3317
3318
3319
3320
3321
3322
3323



3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
				 * 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, len;



    Tcl_UniChar ch = 0;

    flags = TclEncodingSetProfileFlags(flags);
    flags |= PTR2INT(clientData);
    srcStart = src;
    srcEnd = src + srcLen;
    srcClose = srcEnd;
    if ((flags & TCL_ENCODING_END) == 0) {
	srcClose -= TCL_UTF_MAX;
    }
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
	    break;
	}
	if (dst > dstEnd) {
	    result = TCL_CONVERT_NOSPACE;
	    break;
	}
#if TCL_UTF_MAX < 4
	src += (len = TclUtfToUniChar(src, &ch));
	if ((ch >= 0xD800) && (len < 3)) {





	    src += TclUtfToUniChar(src, &ch);
	    ch = 0xFFFD;
	}
#else
	src += TclUtfToUniChar(src, &ch);
	if (ch > 0xFFFF) {




	    ch = 0xFFFD;
	}
#endif







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

	if (flags & TCL_ENCODING_LE) {







|

>
>
>
>
>

|


|

>
>
>
>
|


>
>
>
>
>
>







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
	    break;
	}
	if (dst > dstEnd) {
	    result = TCL_CONVERT_NOSPACE;
	    break;
	}
#if TCL_UTF_MAX < 4
	len = TclUtfToUniChar(src, &ch);
	if ((ch >= 0xD800) && (len < 3)) {
	    if (PROFILE_STRICT(flags)) {
		result = TCL_CONVERT_UNKNOWN;
		break;
	    }
	    src += len;
	    src += TclUtfToUniChar(src, &ch);
	    ch = UNICODE_REPLACE_CHAR;
	}
#else
	len = TclUtfToUniChar(src, &ch);
	if (ch > 0xFFFF) {
	    if (PROFILE_STRICT(flags)) {
		result = TCL_CONVERT_UNKNOWN;
		break;
	    }
	    ch = UNICODE_REPLACE_CHAR;
	}
#endif
	if (PROFILE_STRICT(flags) && SURROGATE(ch)) {
	    result = TCL_CONVERT_SYNTAX;
	    break;
	}

	src += len;

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

	if (flags & TCL_ENCODING_LE) {
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
    const char *dstEnd, *dstStart, *prefixBytes;
    int result, byte, numChars, charLimit = INT_MAX;
    Tcl_UniChar ch = 0;
    const unsigned short *const *toUnicode;
    const unsigned short *pageZero;
    TableEncodingData *dataPtr = (TableEncodingData *)clientData;


    if (flags & TCL_ENCODING_CHAR_LIMIT) {
	charLimit = *dstCharsPtr;
    }
    srcStart = src;
    srcEnd = src + srcLen;

    dstStart = dst;
    dstEnd = dst + dstLen - TCL_UTF_MAX;










    toUnicode = (const unsigned short *const *) dataPtr->toUnicode;
    prefixBytes = dataPtr->prefixBytes;
    pageZero = toUnicode[0];

    result = TCL_OK;
    for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
	if (dst > dstEnd) {
	    result = TCL_CONVERT_NOSPACE;
	    break;
	}
	byte = *((unsigned char *) src);
	if (prefixBytes[byte]) {
	    src++;
	    if (src >= srcEnd) {

		src--;

		result = TCL_CONVERT_MULTIBYTE;
		break;







	    }

	    ch = toUnicode[byte][*((unsigned char *) src)];

	} else {
	    ch = pageZero[byte];
	}
	if ((ch == 0) && (byte != 0)) {

	    if (STOPONERROR) {
		result = TCL_CONVERT_SYNTAX;
		break;
	    }
	    if (prefixBytes[byte]) {
		src--;
	    }



	    ch = (Tcl_UniChar) byte;

	}

	/*
	 * Special case for 1-byte utf chars for speed.
	 */

	if (ch && ch < 0x80) {
	    *dst++ = (char) ch;
	} else {
	    dst += Tcl_UniCharToUtf(ch, dst);
	}
	src++;
    }


    *srcReadPtr = src - srcStart;
    *dstWrotePtr = dst - dstStart;
    *dstCharsPtr = numChars;
    return result;
}

/*







>








>
>
>
>
>
>
>
>
>













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




>
|






>
>
>
|
>



|


|







>







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
    const char *dstEnd, *dstStart, *prefixBytes;
    int result, byte, numChars, charLimit = INT_MAX;
    Tcl_UniChar ch = 0;
    const unsigned short *const *toUnicode;
    const unsigned short *pageZero;
    TableEncodingData *dataPtr = (TableEncodingData *)clientData;

    flags = TclEncodingSetProfileFlags(flags);
    if (flags & TCL_ENCODING_CHAR_LIMIT) {
	charLimit = *dstCharsPtr;
    }
    srcStart = src;
    srcEnd = src + srcLen;

    dstStart = dst;
    dstEnd = dst + dstLen - TCL_UTF_MAX;

#if TCL_UTF_MAX < 4
    /* Initialize the buffer so that some random data doesn't trick
     * Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
     * Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
     * prior non-stateful nature, this call to memset can also be removed.
     */
    memset(dst, 0xff, dstLen);
#endif

    toUnicode = (const unsigned short *const *) dataPtr->toUnicode;
    prefixBytes = dataPtr->prefixBytes;
    pageZero = toUnicode[0];

    result = TCL_OK;
    for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
	if (dst > dstEnd) {
	    result = TCL_CONVERT_NOSPACE;
	    break;
	}
	byte = *((unsigned char *) src);
	if (prefixBytes[byte]) {

	    if (src >= srcEnd-1) {
		/* Prefix byte but nothing after it */
		if (!(flags & TCL_ENCODING_END)) {
		    /* More data to come */
		    result = TCL_CONVERT_MULTIBYTE;
		    break;
		} else if (PROFILE_STRICT(flags)) {
		    result = TCL_CONVERT_SYNTAX;
		    break;
		} else if (PROFILE_REPLACE(flags)) {
		    ch = UNICODE_REPLACE_CHAR;
		} else {
		    ch = (Tcl_UniChar)byte;
		}
	    } else {
		ch = toUnicode[byte][*((unsigned char *)++src)];
	    }
	} else {
	    ch = pageZero[byte];
	}
	if ((ch == 0) && (byte != 0)) {
	    /* Prefix+suffix pair is invalid */
	    if (PROFILE_STRICT(flags)) {
		result = TCL_CONVERT_SYNTAX;
		break;
	    }
	    if (prefixBytes[byte]) {
		src--;
	    }
	    if (PROFILE_REPLACE(flags)) {
		ch = UNICODE_REPLACE_CHAR;
	    } else {
		ch = (Tcl_UniChar)byte;
	    }
	}

	/*
	 * Special case for 1-byte Utf chars for speed.
	 */

	if ((unsigned)ch - 1 < 0x7F) {
	    *dst++ = (char) ch;
	} else {
	    dst += Tcl_UniCharToUtf(ch, dst);
	}
	src++;
    }

    assert(src <= srcEnd);
    *srcReadPtr = src - srcStart;
    *dstWrotePtr = dst - dstStart;
    *dstCharsPtr = numChars;
    return result;
}

/*
3088
3089
3090
3091
3092
3093
3094

3095
3096
3097
3098
3099
3100
3101

    prefixBytes = dataPtr->prefixBytes;
    fromUnicode = (const unsigned short *const *) dataPtr->fromUnicode;

    srcStart = src;
    srcEnd = src + srcLen;
    srcClose = srcEnd;

    if ((flags & TCL_ENCODING_END) == 0) {
	srcClose -= TCL_UTF_MAX;
    }

    dstStart = dst;
    dstEnd = dst + dstLen - 1;








>







3584
3585
3586
3587
3588
3589
3590
3591
3592
3593
3594
3595
3596
3597
3598

    prefixBytes = dataPtr->prefixBytes;
    fromUnicode = (const unsigned short *const *) dataPtr->fromUnicode;

    srcStart = src;
    srcEnd = src + srcLen;
    srcClose = srcEnd;
    flags = TclEncodingSetProfileFlags(flags);
    if ((flags & TCL_ENCODING_END) == 0) {
	srcClose -= TCL_UTF_MAX;
    }

    dstStart = dst;
    dstEnd = dst + dstLen - 1;

3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
	if (!len) {
	    word = 0;
	} else
#endif
	    word = fromUnicode[(ch >> 8)][ch & 0xFF];

	if ((word == 0) && (ch != 0)) {
	    if ((STOPONERROR) && (flags & TCL_ENCODING_CHAR_LIMIT)) {
		result = TCL_CONVERT_UNKNOWN;
		break;
	    }
	    word = dataPtr->fallback;
	}
	if (prefixBytes[(word >> 8)] != 0) {
	    if (dst + 1 > dstEnd) {
		result = TCL_CONVERT_NOSPACE;
		break;
	    }
	    dst[0] = (char) (word >> 8);







|



|







3617
3618
3619
3620
3621
3622
3623
3624
3625
3626
3627
3628
3629
3630
3631
3632
3633
3634
3635
	if (!len) {
	    word = 0;
	} else
#endif
	    word = fromUnicode[(ch >> 8)][ch & 0xFF];

	if ((word == 0) && (ch != 0)) {
	    if (PROFILE_STRICT(flags)) {
		result = TCL_CONVERT_UNKNOWN;
		break;
	    }
	    word = dataPtr->fallback; /* Both profiles REPLACE and TCL8 */
	}
	if (prefixBytes[(word >> 8)] != 0) {
	    if (dst + 1 > dstEnd) {
		result = TCL_CONVERT_NOSPACE;
		break;
	    }
	    dst[0] = (char) (word >> 8);
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
				 * correspond to the bytes stored in the
				 * output buffer. */
{
    const char *srcStart, *srcEnd;
    const char *dstEnd, *dstStart;
    int result, numChars, charLimit = INT_MAX;


    if (flags & TCL_ENCODING_CHAR_LIMIT) {
	charLimit = *dstCharsPtr;
    }
    srcStart = src;
    srcEnd = src + srcLen;

    dstStart = dst;
    dstEnd = dst + dstLen - TCL_UTF_MAX;










    result = TCL_OK;
    for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
	Tcl_UniChar ch = 0;

	if (dst > dstEnd) {
	    result = TCL_CONVERT_NOSPACE;
	    break;
	}
	ch = (Tcl_UniChar) *((unsigned char *) src);

	/*
	 * Special case for 1-byte utf chars for speed.
	 */

	if (ch && ch < 0x80) {
	    *dst++ = (char) ch;
	} else {
	    dst += Tcl_UniCharToUtf(ch, dst);
	}
	src++;
    }








>








>
>
>
>
>
>
>
>
>















|







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
				 * correspond to the bytes stored in the
				 * output buffer. */
{
    const char *srcStart, *srcEnd;
    const char *dstEnd, *dstStart;
    int result, numChars, charLimit = INT_MAX;

    flags = TclEncodingSetProfileFlags(flags);
    if (flags & TCL_ENCODING_CHAR_LIMIT) {
	charLimit = *dstCharsPtr;
    }
    srcStart = src;
    srcEnd = src + srcLen;

    dstStart = dst;
    dstEnd = dst + dstLen - TCL_UTF_MAX;

#if TCL_UTF_MAX < 4
    /* Initialize the buffer so that some random data doesn't trick
     * Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
     * Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
     * prior non-stateful nature, this call to memset can also be removed.
     */
    memset(dst, 0xff, dstLen);
#endif

    result = TCL_OK;
    for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
	Tcl_UniChar ch = 0;

	if (dst > dstEnd) {
	    result = TCL_CONVERT_NOSPACE;
	    break;
	}
	ch = (Tcl_UniChar) *((unsigned char *) src);

	/*
	 * Special case for 1-byte utf chars for speed.
	 */

	if ((unsigned)ch - 1 < 0x7F) {
	    *dst++ = (char) ch;
	} else {
	    dst += Tcl_UniCharToUtf(ch, dst);
	}
	src++;
    }

3278
3279
3280
3281
3282
3283
3284

3285
3286
3287
3288
3289
3290
3291
    const char *dstStart, *dstEnd;
    int result = TCL_OK, numChars;
    Tcl_UniChar ch = 0;

    srcStart = src;
    srcEnd = src + srcLen;
    srcClose = srcEnd;

    if ((flags & TCL_ENCODING_END) == 0) {
	srcClose -= TCL_UTF_MAX;
    }

    dstStart = dst;
    dstEnd = dst + dstLen - 1;








>







3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
    const char *dstStart, *dstEnd;
    int result = TCL_OK, numChars;
    Tcl_UniChar ch = 0;

    srcStart = src;
    srcEnd = src + srcLen;
    srcClose = srcEnd;
    flags = TclEncodingSetProfileFlags(flags);
    if ((flags & TCL_ENCODING_END) == 0) {
	srcClose -= TCL_UTF_MAX;
    }

    dstStart = dst;
    dstEnd = dst + dstLen - 1;

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

	if (ch > 0xFF
#if TCL_UTF_MAX < 4
		|| ((ch >= 0xD800) && (len < 3))
#endif
		) {
	    if (STOPONERROR) {
		result = TCL_CONVERT_UNKNOWN;
		break;
	    }
#if TCL_UTF_MAX < 4
	    if ((ch >= 0xD800) && (len < 3)) {
		len = 4;
	    }
#endif
	    /*
	     * Plunge on, using '?' as a fallback character.
	     */

	    ch = (Tcl_UniChar) '?';
	}

	if (dst > dstEnd) {
	    result = TCL_CONVERT_NOSPACE;
	    break;
	}
	*(dst++) = (char) ch;







|












|







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

	if (ch > 0xFF
#if TCL_UTF_MAX < 4
		|| ((ch >= 0xD800) && (len < 3))
#endif
		) {
	    if (PROFILE_STRICT(flags)) {
		result = TCL_CONVERT_UNKNOWN;
		break;
	    }
#if TCL_UTF_MAX < 4
	    if ((ch >= 0xD800) && (len < 3)) {
		len = 4;
	    }
#endif
	    /*
	     * Plunge on, using '?' as a fallback character.
	     */

	    ch = (Tcl_UniChar) '?'; /* Profiles TCL8 and REPLACE */
	}

	if (dst > dstEnd) {
	    result = TCL_CONVERT_NOSPACE;
	    break;
	}
	*(dst++) = (char) ch;
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
    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) {
	charLimit = *dstCharsPtr;
    }
    result = TCL_OK;
    tablePrefixBytes = NULL;
    tableToUnicode = NULL;
    prefixBytes = dataPtr->prefixBytes;
    encodingPtr = NULL;

    srcStart = src;
    srcEnd = src + srcLen;

    dstStart = dst;
    dstEnd = dst + dstLen - TCL_UTF_MAX;










    state = PTR2INT(*statePtr);
    if (flags & TCL_ENCODING_START) {
	state = 0;
    }

    for (numChars = 0; src < srcEnd && numChars <= charLimit; ) {







>














>
>
>
>
>
>
>
>
>







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

    flags = TclEncodingSetProfileFlags(flags);
    if (flags & TCL_ENCODING_CHAR_LIMIT) {
	charLimit = *dstCharsPtr;
    }
    result = TCL_OK;
    tablePrefixBytes = NULL;
    tableToUnicode = NULL;
    prefixBytes = dataPtr->prefixBytes;
    encodingPtr = NULL;

    srcStart = src;
    srcEnd = src + srcLen;

    dstStart = dst;
    dstEnd = dst + dstLen - TCL_UTF_MAX;

#if TCL_UTF_MAX < 4
    /* Initialize the buffer so that some random data doesn't trick
     * Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
     * Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
     * prior non-stateful nature, this call to memset can also be removed.
     */
    memset(dst, 0xff, dstLen);
#endif

    state = PTR2INT(*statePtr);
    if (flags & TCL_ENCODING_START) {
	state = 0;
    }

    for (numChars = 0; src < srcEnd && numChars <= charLimit; ) {
3535
3536
3537
3538
3539
3540
3541
3542
3543
3544
3545
3546
3547
3548
3549
3550
3551
3552
3553
	     * We have a split-up or unrecognized escape sequence. If we
	     * checked all the sequences, then it's a syntax error, otherwise
	     * we need more bytes to determine a match.
	     */

	    if ((checked == dataPtr->numSubTables + 2)
		    || (flags & TCL_ENCODING_END)) {
		if (!STOPONERROR) {
		    /*
		     * Skip the unknown escape sequence.
		     */

		    src += longest;
		    continue;
		}
		result = TCL_CONVERT_SYNTAX;
	    } else {
		result = TCL_CONVERT_MULTIBYTE;
	    }







|
<
|
<
|







4053
4054
4055
4056
4057
4058
4059
4060

4061

4062
4063
4064
4065
4066
4067
4068
4069
	     * We have a split-up or unrecognized escape sequence. If we
	     * checked all the sequences, then it's a syntax error, otherwise
	     * we need more bytes to determine a match.
	     */

	    if ((checked == dataPtr->numSubTables + 2)
		    || (flags & TCL_ENCODING_END)) {
		if (!PROFILE_STRICT(flags)) {

		    /* Unknown escape sequence */

		    dst += Tcl_UniCharToUtf(UNICODE_REPLACE_CHAR, dst);
		    src += longest;
		    continue;
		}
		result = TCL_CONVERT_SYNTAX;
	    } else {
		result = TCL_CONVERT_MULTIBYTE;
	    }
3647
3648
3649
3650
3651
3652
3653

3654
3655
3656
3657
3658
3659
3660
    Tcl_UniChar ch = 0;

    result = TCL_OK;

    srcStart = src;
    srcEnd = src + srcLen;
    srcClose = srcEnd;

    if ((flags & TCL_ENCODING_END) == 0) {
	srcClose -= TCL_UTF_MAX;
    }

    dstStart = dst;
    dstEnd = dst + dstLen - 1;








>







4163
4164
4165
4166
4167
4168
4169
4170
4171
4172
4173
4174
4175
4176
4177
    Tcl_UniChar ch = 0;

    result = TCL_OK;

    srcStart = src;
    srcEnd = src + srcLen;
    srcClose = srcEnd;
    flags = TclEncodingSetProfileFlags(flags);
    if ((flags & TCL_ENCODING_END) == 0) {
	srcClose -= TCL_UTF_MAX;
    }

    dstStart = dst;
    dstEnd = dst + dstLen - 1;

3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
		if (word != 0) {
		    break;
		}
	    }

	    if (word == 0) {
		state = oldState;
		if (STOPONERROR) {
		    result = TCL_CONVERT_UNKNOWN;
		    break;
		}
		encodingPtr = GetTableEncoding(dataPtr, state);
		tableDataPtr = (const TableEncodingData *)encodingPtr->clientData;
		word = tableDataPtr->fallback;
	    }







|







4227
4228
4229
4230
4231
4232
4233
4234
4235
4236
4237
4238
4239
4240
4241
		if (word != 0) {
		    break;
		}
	    }

	    if (word == 0) {
		state = oldState;
		if (PROFILE_STRICT(flags)) {
		    result = TCL_CONVERT_UNKNOWN;
		    break;
		}
		encodingPtr = GetTableEncoding(dataPtr, state);
		tableDataPtr = (const TableEncodingData *)encodingPtr->clientData;
		word = tableDataPtr->fallback;
	    }
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
 *
 *-------------------------------------------------------------------------
 */

static void
InitializeEncodingSearchPath(
    char **valuePtr,
    size_t *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
    const char *bytes;
    size_t i, numDirs;
    size_t numBytes;
    Tcl_Obj *libPathObj, *encodingObj, *searchPathObj;

    TclNewLiteralStringObj(encodingObj, "encoding");
    TclNewObj(searchPathObj);
    Tcl_IncrRefCount(encodingObj);
    Tcl_IncrRefCount(searchPathObj);
    libPathObj = TclGetLibraryPath();







|



|
<







4478
4479
4480
4481
4482
4483
4484
4485
4486
4487
4488
4489

4490
4491
4492
4493
4494
4495
4496
 *
 *-------------------------------------------------------------------------
 */

static void
InitializeEncodingSearchPath(
    char **valuePtr,
    TCL_HASH_TYPE *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
    const char *bytes;
    Tcl_Size i, numDirs, numBytes;

    Tcl_Obj *libPathObj, *encodingObj, *searchPathObj;

    TclNewLiteralStringObj(encodingObj, "encoding");
    TclNewObj(searchPathObj);
    Tcl_IncrRefCount(encodingObj);
    Tcl_IncrRefCount(searchPathObj);
    libPathObj = TclGetLibraryPath();
4004
4005
4006
4007
4008
4009
4010
4011
































































































































































4012
4013
4014
4015
4016
4017

    *lengthPtr = numBytes;
    *valuePtr = (char *)Tcl_Alloc(numBytes + 1);
    memcpy(*valuePtr, bytes, numBytes + 1);
    Tcl_DecrRefCount(searchPathObj);
}

/*
































































































































































 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */








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






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

    *lengthPtr = numBytes;
    *valuePtr = (char *)Tcl_Alloc(numBytes + 1);
    memcpy(*valuePtr, bytes, numBytes + 1);
    Tcl_DecrRefCount(searchPathObj);
}

/*
 *------------------------------------------------------------------------
 *
 * TclEncodingProfileParseName --
 *
 *	Maps an encoding profile name to its integer equivalent.
 *
 * Results:
 *	TCL_OK on success or TCL_ERROR on failure.
 *
 * Side effects:
 *	Returns the profile enum value in *profilePtr
 *
 *------------------------------------------------------------------------
 */
int
TclEncodingProfileNameToId(
    Tcl_Interp *interp,		/* For error messages. May be NULL */
    const char *profileName,	/* Name of profile */
    int *profilePtr)  		/* Output */
{
    size_t i;
    size_t numProfiles = sizeof(encodingProfiles) / sizeof(encodingProfiles[0]);

    for (i = 0; i < numProfiles; ++i) {
	if (!strcmp(profileName, encodingProfiles[i].name)) {
	    *profilePtr = encodingProfiles[i].value;
	    return TCL_OK;
	}
    }
    if (interp) {
	Tcl_Obj *errorObj;
	/* This code assumes at least two profiles :-) */
	errorObj =
	    Tcl_ObjPrintf("bad profile name \"%s\": must be",
		profileName);
	for (i = 0; i < (numProfiles - 1); ++i) {
	    Tcl_AppendStringsToObj(
		errorObj, " ", encodingProfiles[i].name, ",", NULL);
	}
	Tcl_AppendStringsToObj(
	    errorObj, " or ", encodingProfiles[numProfiles-1].name, NULL);

	Tcl_SetObjResult(interp, errorObj);
	Tcl_SetErrorCode(
	    interp, "TCL", "ENCODING", "PROFILE", profileName, NULL);
    }
    return TCL_ERROR;
}

/*
 *------------------------------------------------------------------------
 *
 * TclEncodingProfileValueToName --
 *
 *	Maps an encoding profile value to its name.
 *
 * Results:
 *	Pointer to the name or NULL on failure. Caller must not make
 *	not modify the string and must make a copy to hold on to it.
 *
 * Side effects:
 *	None.
 *------------------------------------------------------------------------
 */
const char *
TclEncodingProfileIdToName(
    Tcl_Interp *interp,		/* For error messages. May be NULL */
    int profileValue)		/* Profile #define value */
{
    size_t i;

    for (i = 0; i < sizeof(encodingProfiles) / sizeof(encodingProfiles[0]); ++i) {
	if (profileValue == encodingProfiles[i].value) {
	    return encodingProfiles[i].name;
	}
    }
    if (interp) {
	Tcl_SetObjResult(
	    interp,
	    Tcl_ObjPrintf(
		"Internal error. Bad profile id \"%d\".",
		profileValue));
	Tcl_SetErrorCode(
	    interp, "TCL", "ENCODING", "PROFILEID", NULL);
    }
    return NULL;
}

/*
 *------------------------------------------------------------------------
 *
 * TclEncodingSetProfileFlags --
 *
 *	Maps the flags supported in the encoding C API's to internal flags.
 *
 *	For backward compatibility reasons, TCL_ENCODING_STOPONERROR is
 *	is mapped to the TCL_ENCODING_PROFILE_STRICT overwriting any profile
 *	specified.
 *
 *	If no profile or an invalid profile is specified, it is set to
 *	the default.
 *
 * Results:
 *    Internal encoding flag mask.
 *
 * Side effects:
 *    None.
 *
 *------------------------------------------------------------------------
 */
int TclEncodingSetProfileFlags(int flags)
{
    if (flags & TCL_ENCODING_STOPONERROR) {
	ENCODING_PROFILE_SET(flags, TCL_ENCODING_PROFILE_STRICT);
    } else {
	int profile = ENCODING_PROFILE_GET(flags);
	switch (profile) {
	case TCL_ENCODING_PROFILE_TCL8:
	case TCL_ENCODING_PROFILE_STRICT:
	case TCL_ENCODING_PROFILE_REPLACE:
	    break;
	case 0: /* Unspecified by caller */
	default:
	    ENCODING_PROFILE_SET(flags, TCL_ENCODING_PROFILE_DEFAULT);
	    break;
	}
    }
    return flags;
}

/*
 *------------------------------------------------------------------------
 *
 * TclGetEncodingProfiles --
 *
 *	Get the list of supported encoding profiles.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The list of profile names is stored in the interpreter result.
 *
 *------------------------------------------------------------------------
 */
void
TclGetEncodingProfiles(Tcl_Interp *interp)
{
    size_t i, n;
    Tcl_Obj *objPtr;
    n = sizeof(encodingProfiles) / sizeof(encodingProfiles[0]);
    objPtr = Tcl_NewListObj(n, NULL);
    for (i = 0; i < n; ++i) {
	Tcl_ListObjAppendElement(
	    interp, objPtr, Tcl_NewStringObj(encodingProfiles[i].name, TCL_INDEX_NONE));
    }
    Tcl_SetObjResult(interp, objPtr);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclEnsemble.c.

77
78
79
80
81
82
83
84

85
86
87
88
89
90
91
 */

static const Tcl_ObjType ensembleCmdType = {
    "ensembleCommand",		/* the type's name */
    FreeEnsembleCmdRep,		/* freeIntRepProc */
    DupEnsembleCmdRep,		/* dupIntRepProc */
    NULL,			/* updateStringProc */
    NULL			/* setFromAnyProc */

};

#define ECRSetInternalRep(objPtr, ecRepPtr)					\
    do {								\
	Tcl_ObjInternalRep ir;						\
	ir.twoPtrValue.ptr1 = (ecRepPtr);				\
	ir.twoPtrValue.ptr2 = NULL;					\







|
>







77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
 */

static const Tcl_ObjType ensembleCmdType = {
    "ensembleCommand",		/* the type's name */
    FreeEnsembleCmdRep,		/* freeIntRepProc */
    DupEnsembleCmdRep,		/* dupIntRepProc */
    NULL,			/* updateStringProc */
    NULL,			/* setFromAnyProc */
    TCL_OBJTYPE_V0
};

#define ECRSetInternalRep(objPtr, ecRepPtr)					\
    do {								\
	Tcl_ObjInternalRep ir;						\
	ir.twoPtrValue.ptr1 = (ecRepPtr);				\
	ir.twoPtrValue.ptr2 = NULL;					\
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115

/*
 * The internal rep for caching ensemble subcommand lookups and spelling
 * corrections.
 */

typedef struct {
    size_t epoch;               /* Used to confirm when the data in this
                                 * really structure matches up with the
                                 * ensemble. */
    Command *token;             /* Reference to the command for which this
                                 * structure is a cache of the resolution. */
    Tcl_Obj *fix;               /* Corrected spelling, if needed. */
    Tcl_HashEntry *hPtr;        /* Direct link to entry in the subcommand hash
                                 * table. */







|







102
103
104
105
106
107
108
109
110
111
112
113
114
115
116

/*
 * The internal rep for caching ensemble subcommand lookups and spelling
 * corrections.
 */

typedef struct {
    Tcl_Size epoch;               /* Used to confirm when the data in this
                                 * really structure matches up with the
                                 * ensemble. */
    Command *token;             /* Reference to the command for which this
                                 * structure is a cache of the resolution. */
    Tcl_Obj *fix;               /* Corrected spelling, if needed. */
    Tcl_HashEntry *hPtr;        /* Direct link to entry in the subcommand hash
                                 * table. */
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
	    "subcommand", 0, &index) != TCL_OK) {
	return TCL_ERROR;
    }

    switch (index) {
    case ENS_CREATE: {
	const char *name;
	size_t len;
	int allocatedMapFlag = 0;
	/*
	 * Defaults
	 */
	Tcl_Obj *subcmdObj = NULL;
	Tcl_Obj *mapObj = NULL;
	int permitPrefix = 1;







|







185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
	    "subcommand", 0, &index) != TCL_OK) {
	return TCL_ERROR;
    }

    switch (index) {
    case ENS_CREATE: {
	const char *name;
	Tcl_Size len;
	int allocatedMapFlag = 0;
	/*
	 * Defaults
	 */
	Tcl_Obj *subcmdObj = NULL;
	Tcl_Obj *mapObj = NULL;
	int permitPrefix = 1;
307
308
309
310
311
312
313
314










315
316
317
318
319
320
321

			if (nsPtr->parentPtr) {
			    Tcl_AppendStringsToObj(newCmd, "::", NULL);
			}
			Tcl_AppendObjToObj(newCmd, listv[0]);
			Tcl_ListObjReplace(NULL, newList, 0, 1, 1, &newCmd);
			if (patchedDict == NULL) {
			    patchedDict = Tcl_DuplicateObj(objv[1]);










			}
			Tcl_DictObjPut(NULL, patchedDict, subcmdWordsObj,
				newList);
		    }
		    Tcl_DictObjNext(&search, &subcmdWordsObj, &listObj,
			    &done);
		} while (!done);







|
>
>
>
>
>
>
>
>
>
>







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

			if (nsPtr->parentPtr) {
			    Tcl_AppendStringsToObj(newCmd, "::", NULL);
			}
			Tcl_AppendObjToObj(newCmd, listv[0]);
			Tcl_ListObjReplace(NULL, newList, 0, 1, 1, &newCmd);
			if (patchedDict == NULL) {
			    patchedDict = TclDuplicatePureObj(
				interp, objv[1], &tclDictType);
			    if (!patchedDict) {
				if (allocatedMapFlag) {
				    Tcl_DecrRefCount(mapObj);
				}
				Tcl_DecrRefCount(newList);
				Tcl_DecrRefCount(newCmd);
				Tcl_DecrRefCount(patchedDict);
				return TCL_ERROR;
			    }
			}
			Tcl_DictObjPut(NULL, patchedDict, subcmdWordsObj,
				newList);
		    }
		    Tcl_DictObjNext(&search, &subcmdWordsObj, &listObj,
			    &done);
		} while (!done);
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
		    Tcl_NewStringObj(ensembleConfigOptions[CONF_UNKNOWN],-1));
	    Tcl_GetEnsembleUnknownHandler(NULL, token, &tmpObj);
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    (tmpObj != NULL) ? tmpObj : Tcl_NewObj());

	    Tcl_SetObjResult(interp, resultObj);
	} else {
	    size_t len;
	    int allocatedMapFlag = 0;
	    Tcl_Obj *subcmdObj = NULL, *mapObj = NULL, *paramObj = NULL,
		    *unknownObj = NULL; /* Defaults, silence gcc 4 warnings */
	    int permitPrefix, flags = 0;	/* silence gcc 4 warning */

	    Tcl_GetEnsembleSubcommandList(NULL, token, &subcmdObj);
	    Tcl_GetEnsembleMappingDict(NULL, token, &mapObj);







|







509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
		    Tcl_NewStringObj(ensembleConfigOptions[CONF_UNKNOWN],-1));
	    Tcl_GetEnsembleUnknownHandler(NULL, token, &tmpObj);
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    (tmpObj != NULL) ? tmpObj : Tcl_NewObj());

	    Tcl_SetObjResult(interp, resultObj);
	} else {
	    Tcl_Size len;
	    int allocatedMapFlag = 0;
	    Tcl_Obj *subcmdObj = NULL, *mapObj = NULL, *paramObj = NULL,
		    *unknownObj = NULL; /* Defaults, silence gcc 4 warnings */
	    int permitPrefix, flags = 0;	/* silence gcc 4 warning */

	    Tcl_GetEnsembleSubcommandList(NULL, token, &subcmdObj);
	    Tcl_GetEnsembleMappingDict(NULL, token, &mapObj);
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
			goto freeMapAndError;
		    }
		    if (done) {
			mapObj = NULL;
			continue;
		    }
		    do {
			if (TclListObjGetElementsM(interp, listObj, &len,
				&listv) != TCL_OK) {
			    Tcl_DictObjDone(&search);
			    if (patchedDict) {
				Tcl_DecrRefCount(patchedDict);
			    }
			    goto freeMapAndError;
			}
			if (len < 1) {
			    Tcl_SetObjResult(interp, Tcl_NewStringObj(
				    "ensemble subcommand implementations "
				    "must be non-empty lists", -1));
			    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE",
				    "EMPTY_TARGET", NULL);
			    Tcl_DictObjDone(&search);
			    if (patchedDict) {
				Tcl_DecrRefCount(patchedDict);
			    }
			    goto freeMapAndError;








			}
			cmd = TclGetString(listv[0]);
			if (!(cmd[0] == ':' && cmd[1] == ':')) {
			    Tcl_Obj *newList = Tcl_DuplicateObj(listObj);







			    Tcl_Obj *newCmd = NewNsObj((Tcl_Namespace*)nsPtr);

			    if (nsPtr->parentPtr) {
				Tcl_AppendStringsToObj(newCmd, "::", NULL);
			    }
			    Tcl_AppendObjToObj(newCmd, listv[0]);
			    Tcl_ListObjReplace(NULL, newList, 0, 1, 1,
				    &newCmd);
			    if (patchedDict == NULL) {
				patchedDict = Tcl_DuplicateObj(objv[1]);




			    }
			    Tcl_DictObjPut(NULL, patchedDict, subcmdWordsObj,
				    newList);
			}
			Tcl_DictObjNext(&search, &subcmdWordsObj, &listObj,
				&done);
		    } while (!done);







|
|

















>
>
>
>
>
>
>
>



|
>
>
>
>
>
>
>









|
>
>
>
>







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
			goto freeMapAndError;
		    }
		    if (done) {
			mapObj = NULL;
			continue;
		    }
		    do {
			if (TclListObjLengthM(interp, listObj, &len
				) != TCL_OK) {
			    Tcl_DictObjDone(&search);
			    if (patchedDict) {
				Tcl_DecrRefCount(patchedDict);
			    }
			    goto freeMapAndError;
			}
			if (len < 1) {
			    Tcl_SetObjResult(interp, Tcl_NewStringObj(
				    "ensemble subcommand implementations "
				    "must be non-empty lists", -1));
			    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE",
				    "EMPTY_TARGET", NULL);
			    Tcl_DictObjDone(&search);
			    if (patchedDict) {
				Tcl_DecrRefCount(patchedDict);
			    }
			    goto freeMapAndError;
			}
			if (TclListObjGetElementsM(interp, listObj, &len,
				&listv) != TCL_OK) {
			    Tcl_DictObjDone(&search);
			    if (patchedDict) {
				Tcl_DecrRefCount(patchedDict);
			    }
			    goto freeMapAndError;
			}
			cmd = TclGetString(listv[0]);
			if (!(cmd[0] == ':' && cmd[1] == ':')) {
			    Tcl_Obj *newList = TclDuplicatePureObj(
				interp, listObj, &tclListType);
			    if (!newList) {
				if (patchedDict) {
				    Tcl_DecrRefCount(patchedDict);
				}
				goto freeMapAndError;
			    }
			    Tcl_Obj *newCmd = NewNsObj((Tcl_Namespace*)nsPtr);

			    if (nsPtr->parentPtr) {
				Tcl_AppendStringsToObj(newCmd, "::", NULL);
			    }
			    Tcl_AppendObjToObj(newCmd, listv[0]);
			    Tcl_ListObjReplace(NULL, newList, 0, 1, 1,
				    &newCmd);
			    if (patchedDict == NULL) {
				patchedDict = TclDuplicatePureObj(
				    interp, objv[1], &tclListType);
				if (!patchedDict) {
				    goto freeMapAndError;
				}
			    }
			    Tcl_DictObjPut(NULL, patchedDict, subcmdWordsObj,
				    newList);
			}
			Tcl_DictObjNext(&search, &subcmdWordsObj, &listObj,
				&done);
		    } while (!done);
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"command is not an ensemble", -1));
	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	return TCL_ERROR;
    }
    if (subcmdList != NULL) {
	size_t length;

	if (TclListObjLengthM(interp, subcmdList, &length) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (length < 1) {
	    subcmdList = NULL;
	}







|







820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"command is not an ensemble", -1));
	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	return TCL_ERROR;
    }
    if (subcmdList != NULL) {
	Tcl_Size length;

	if (TclListObjLengthM(interp, subcmdList, &length) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (length < 1) {
	    subcmdList = NULL;
	}
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
    Tcl_Interp *interp,
    Tcl_Command token,
    Tcl_Obj *paramList)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;
    Tcl_Obj *oldList;
    size_t length;

    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"command is not an ensemble", -1));
	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	return TCL_ERROR;
    }







|







887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
    Tcl_Interp *interp,
    Tcl_Command token,
    Tcl_Obj *paramList)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;
    Tcl_Obj *oldList;
    Tcl_Size length;

    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"command is not an ensemble", -1));
	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	return TCL_ERROR;
    }
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"command is not an ensemble", -1));
	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	return TCL_ERROR;
    }
    if (mapDict != NULL) {
	size_t size;
	int done;
	Tcl_DictSearch search;
	Tcl_Obj *valuePtr;

	if (Tcl_DictObjSize(interp, mapDict, &size) != TCL_OK) {
	    return TCL_ERROR;
	}







|







972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"command is not an ensemble", -1));
	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	return TCL_ERROR;
    }
    if (mapDict != NULL) {
	Tcl_Size size;
	int done;
	Tcl_DictSearch search;
	Tcl_Obj *valuePtr;

	if (Tcl_DictObjSize(interp, mapDict, &size) != TCL_OK) {
	    return TCL_ERROR;
	}
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"command is not an ensemble", -1));
	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	return TCL_ERROR;
    }
    if (unknownList != NULL) {
	size_t length;

	if (TclListObjLengthM(interp, unknownList, &length) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (length < 1) {
	    unknownList = NULL;
	}







|







1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"command is not an ensemble", -1));
	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	return TCL_ERROR;
    }
    if (unknownList != NULL) {
	Tcl_Size length;

	if (TclListObjLengthM(interp, unknownList, &length) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (length < 1) {
	    unknownList = NULL;
	}
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
    const EnsembleImplMap map[]) /* The subcommands to create */
{
    Tcl_Command ensemble;
    Tcl_Namespace *ns;
    Tcl_DString buf, hiddenBuf;
    const char **nameParts = NULL;
    const char *cmdName = NULL;
    size_t i, nameCount = 0;
    int ensembleFlags = 0, hiddenLen;

    /*
     * Construct the path for the ensemble namespace and create it.
     */

    Tcl_DStringInit(&buf);







|







1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
    const EnsembleImplMap map[]) /* The subcommands to create */
{
    Tcl_Command ensemble;
    Tcl_Namespace *ns;
    Tcl_DString buf, hiddenBuf;
    const char **nameParts = NULL;
    const char *cmdName = NULL;
    Tcl_Size i, nameCount = 0;
    int ensembleFlags = 0, hiddenLen;

    /*
     * Construct the path for the ensemble namespace and create it.
     */

    Tcl_DStringInit(&buf);
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
				 * subcommand. */
    Tcl_HashEntry *hPtr;	/* Used for efficient lookup of fully
				 * specified but not yet cached command
				 * names. */
    int reparseCount = 0;	/* Number of reparses. */
    Tcl_Obj *errorObj;		/* Used for building error messages. */
    Tcl_Obj *subObj;
    size_t subIdx;

    /*
     * Must recheck objc since numParameters might have changed. See test
     * namespace-53.9.
     */

  restartEnsembleParse:
    subIdx = 1 + ensemblePtr->numParameters;
    if ((size_t)objc < subIdx + 1) {
	/*
	 * No subcommand argument. Make error message.
	 */

	Tcl_DString buf;	/* Message being built */

	Tcl_DStringInit(&buf);







|








|







1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
				 * subcommand. */
    Tcl_HashEntry *hPtr;	/* Used for efficient lookup of fully
				 * specified but not yet cached command
				 * names. */
    int reparseCount = 0;	/* Number of reparses. */
    Tcl_Obj *errorObj;		/* Used for building error messages. */
    Tcl_Obj *subObj;
    Tcl_Size subIdx;

    /*
     * Must recheck objc since numParameters might have changed. See test
     * namespace-53.9.
     */

  restartEnsembleParse:
    subIdx = 1 + ensemblePtr->numParameters;
    if (objc < subIdx + 1) {
	/*
	 * No subcommand argument. Make error message.
	 */

	Tcl_DString buf;	/* Message being built */

	Tcl_DStringInit(&buf);
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
	 * the export table, scan the sorted array for matches.
	 */

	const char *subcmdName; /* Name of the subcommand or unique prefix of
				 * it (a non-unique prefix produces an error).
				 */
	char *fullName = NULL;	/* Full name of the subcommand. */
	size_t stringLength, i;
	size_t tableLength = ensemblePtr->subcommandTable.numEntries;
	Tcl_Obj *fix;

	subcmdName = Tcl_GetStringFromObj(subObj, &stringLength);
	for (i=0 ; i<tableLength ; i++) {
	    int cmp = strncmp(subcmdName,
		    ensemblePtr->subcommandArrayPtr[i],
		    stringLength);







|
|







1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
	 * the export table, scan the sorted array for matches.
	 */

	const char *subcmdName; /* Name of the subcommand or unique prefix of
				 * it (a non-unique prefix produces an error).
				 */
	char *fullName = NULL;	/* Full name of the subcommand. */
	Tcl_Size stringLength, i;
	Tcl_Size tableLength = ensemblePtr->subcommandTable.numEntries;
	Tcl_Obj *fix;

	subcmdName = Tcl_GetStringFromObj(subObj, &stringLength);
	for (i=0 ; i<tableLength ; i++) {
	    int cmp = strncmp(subcmdName,
		    ensemblePtr->subcommandArrayPtr[i],
		    stringLength);
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
     * not be the same length as the number of arguments to this ensemble
     * command, and then handing it to the main command-lookup engine. In
     * theory, the command could be looked up right here using the namespace in
     * which it is guaranteed to exist,
     *
     *   ((Q: That's not true if the -map option is used, is it?))
     *
     * but don't do that because cacheing of the command object should help.
     */

    {
	Tcl_Obj *copyPtr;	/* The list of words to dispatch on.
				 * Will be freed by the dispatch engine. */
	Tcl_Obj **copyObjv;
	size_t copyObjc, prefixObjc;

	TclListObjLengthM(NULL, prefixObj, &prefixObjc);

	if (objc == 2) {
	    copyPtr = TclListObjCopy(NULL, prefixObj);




	} else {
	    copyPtr = Tcl_NewListObj(objc - 2 + prefixObjc, NULL);
	    Tcl_ListObjAppendList(NULL, copyPtr, prefixObj);
	    Tcl_ListObjReplace(NULL, copyPtr, LIST_MAX, 0,
		    ensemblePtr->numParameters, objv + 1);
	    Tcl_ListObjReplace(NULL, copyPtr, LIST_MAX, 0,
		    objc - 2 - ensemblePtr->numParameters,







|






|




|
>
>
>
>







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
     * not be the same length as the number of arguments to this ensemble
     * command, and then handing it to the main command-lookup engine. In
     * theory, the command could be looked up right here using the namespace in
     * which it is guaranteed to exist,
     *
     *   ((Q: That's not true if the -map option is used, is it?))
     *
     * but don't do that because caching of the command object should help.
     */

    {
	Tcl_Obj *copyPtr;	/* The list of words to dispatch on.
				 * Will be freed by the dispatch engine. */
	Tcl_Obj **copyObjv;
	Tcl_Size copyObjc, prefixObjc;

	TclListObjLengthM(NULL, prefixObj, &prefixObjc);

	if (objc == 2) {
	    copyPtr = TclDuplicatePureObj(
		interp, prefixObj, &tclListType);
	    if (!copyPtr) {
		return TCL_ERROR;
	    }
	} else {
	    copyPtr = Tcl_NewListObj(objc - 2 + prefixObjc, NULL);
	    Tcl_ListObjAppendList(NULL, copyPtr, prefixObj);
	    Tcl_ListObjReplace(NULL, copyPtr, LIST_MAX, 0,
		    ensemblePtr->numParameters, objv + 1);
	    Tcl_ListObjReplace(NULL, copyPtr, LIST_MAX, 0,
		    objc - 2 - ensemblePtr->numParameters,
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
    }
    errorObj = Tcl_ObjPrintf("unknown%s subcommand \"%s\": must be ",
	    (ensemblePtr->flags & TCL_ENSEMBLE_PREFIX ? " or ambiguous" : ""),
	    TclGetString(subObj));
    if (ensemblePtr->subcommandTable.numEntries == 1) {
	Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[0], -1);
    } else {
	size_t i;

	for (i=0 ; i<ensemblePtr->subcommandTable.numEntries-1 ; i++) {
	    Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[i], -1);
	    Tcl_AppendToObj(errorObj, ", ", 2);
	}
	Tcl_AppendPrintfToObj(errorObj, "or %s",
		ensemblePtr->subcommandArrayPtr[i]);







|







2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
    }
    errorObj = Tcl_ObjPrintf("unknown%s subcommand \"%s\": must be ",
	    (ensemblePtr->flags & TCL_ENSEMBLE_PREFIX ? " or ambiguous" : ""),
	    TclGetString(subObj));
    if (ensemblePtr->subcommandTable.numEntries == 1) {
	Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[0], -1);
    } else {
	Tcl_Size i;

	for (i=0 ; i<ensemblePtr->subcommandTable.numEntries-1 ; i++) {
	    Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[i], -1);
	    Tcl_AppendToObj(errorObj, ", ", 2);
	}
	Tcl_AppendPrintfToObj(errorObj, "or %s",
		ensemblePtr->subcommandArrayPtr[i]);
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
 *
 *----------------------------------------------------------------------
 */

int
TclInitRewriteEnsemble(
    Tcl_Interp *interp,
    size_t numRemoved,
    size_t numInserted,
    Tcl_Obj *const *objv)
{
    Interp *iPtr = (Interp *) interp;

    int isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);

    if (isRootEnsemble) {
	iPtr->ensembleRewrite.sourceObjs = objv;
	iPtr->ensembleRewrite.numRemovedObjs = numRemoved;
	iPtr->ensembleRewrite.numInsertedObjs = numInserted;
    } else {
	size_t numIns = iPtr->ensembleRewrite.numInsertedObjs;

	if (numIns < numRemoved) {
	    iPtr->ensembleRewrite.numRemovedObjs += numRemoved - numIns;
	    iPtr->ensembleRewrite.numInsertedObjs = numInserted;
	} else {
	    iPtr->ensembleRewrite.numInsertedObjs += numInserted - numRemoved;
	}







|
|











|







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

int
TclInitRewriteEnsemble(
    Tcl_Interp *interp,
    Tcl_Size numRemoved,
    Tcl_Size numInserted,
    Tcl_Obj *const *objv)
{
    Interp *iPtr = (Interp *) interp;

    int isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);

    if (isRootEnsemble) {
	iPtr->ensembleRewrite.sourceObjs = objv;
	iPtr->ensembleRewrite.numRemovedObjs = numRemoved;
	iPtr->ensembleRewrite.numInsertedObjs = numInserted;
    } else {
	Tcl_Size numIns = iPtr->ensembleRewrite.numInsertedObjs;

	if (numIns < numRemoved) {
	    iPtr->ensembleRewrite.numRemovedObjs += numRemoved - numIns;
	    iPtr->ensembleRewrite.numInsertedObjs = numInserted;
	} else {
	    iPtr->ensembleRewrite.numInsertedObjs += numInserted - numRemoved;
	}
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
    return result;
}

void
TclSpellFix(
    Tcl_Interp *interp,
    Tcl_Obj *const *objv,
    size_t objc,
    size_t badIdx,
    Tcl_Obj *bad,
    Tcl_Obj *fix)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *const *search;
    Tcl_Obj **store;
    size_t idx;
    size_t size;

    if (iPtr->ensembleRewrite.sourceObjs == NULL) {
	iPtr->ensembleRewrite.sourceObjs = objv;
	iPtr->ensembleRewrite.numRemovedObjs = 0;
	iPtr->ensembleRewrite.numInsertedObjs = 0;
    }








|
|






|
|







2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
    return result;
}

void
TclSpellFix(
    Tcl_Interp *interp,
    Tcl_Obj *const *objv,
    Tcl_Size objc,
    Tcl_Size badIdx,
    Tcl_Obj *bad,
    Tcl_Obj *fix)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *const *search;
    Tcl_Obj **store;
    Tcl_Size idx;
    Tcl_Size size;

    if (iPtr->ensembleRewrite.sourceObjs == NULL) {
	iPtr->ensembleRewrite.sourceObjs = objv;
	iPtr->ensembleRewrite.numRemovedObjs = 0;
	iPtr->ensembleRewrite.numInsertedObjs = 0;
    }

2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
 *----------------------------------------------------------------------
 */

Tcl_Obj *const *
TclFetchEnsembleRoot(
    Tcl_Interp *interp,
    Tcl_Obj *const *objv,
    size_t objc,
    size_t *objcPtr)
{
    Tcl_Obj *const *sourceObjs;
    Interp *iPtr = (Interp *) interp;

    if (iPtr->ensembleRewrite.sourceObjs) {
	*objcPtr = objc + iPtr->ensembleRewrite.numRemovedObjs
		- iPtr->ensembleRewrite.numInsertedObjs;







|
|







2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
 *----------------------------------------------------------------------
 */

Tcl_Obj *const *
TclFetchEnsembleRoot(
    Tcl_Interp *interp,
    Tcl_Obj *const *objv,
    Tcl_Size objc,
    Tcl_Size *objcPtr)
{
    Tcl_Obj *const *sourceObjs;
    Interp *iPtr = (Interp *) interp;

    if (iPtr->ensembleRewrite.sourceObjs) {
	*objcPtr = objc + iPtr->ensembleRewrite.numRemovedObjs
		- iPtr->ensembleRewrite.numInsertedObjs;
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
EnsembleUnknownCallback(
    Tcl_Interp *interp,
    EnsembleConfig *ensemblePtr,
    int objc,
    Tcl_Obj *const objv[],
    Tcl_Obj **prefixObjPtr)
{
    size_t paramc;
    int result;
	size_t i, prefixObjc;
    Tcl_Obj **paramv, *unknownCmd, *ensObj;

    /*
     * Create the "unknown" command callback to determine what to do.
     */


    unknownCmd = Tcl_DuplicateObj(ensemblePtr->unknownHandler);



    TclNewObj(ensObj);
    Tcl_GetCommandFullName(interp, ensemblePtr->token, ensObj);
    Tcl_ListObjAppendElement(NULL, unknownCmd, ensObj);
    for (i = 1 ; i < (size_t)objc ; i++) {
	Tcl_ListObjAppendElement(NULL, unknownCmd, objv[i]);
    }
    TclListObjGetElementsM(NULL, unknownCmd, &paramc, &paramv);
    Tcl_IncrRefCount(unknownCmd);

    /*
     * Call the "unknown" handler.  No attempt to NRE-enable this as deep







|

|






>
|
>
>
>



|







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
EnsembleUnknownCallback(
    Tcl_Interp *interp,
    EnsembleConfig *ensemblePtr,
    int objc,
    Tcl_Obj *const objv[],
    Tcl_Obj **prefixObjPtr)
{
    Tcl_Size paramc;
    int result;
    Tcl_Size i, prefixObjc;
    Tcl_Obj **paramv, *unknownCmd, *ensObj;

    /*
     * Create the "unknown" command callback to determine what to do.
     */

    unknownCmd = TclDuplicatePureObj(
	interp, ensemblePtr->unknownHandler, &tclListType);
    if (!unknownCmd) {
	return TCL_ERROR;
    }
    TclNewObj(ensObj);
    Tcl_GetCommandFullName(interp, ensemblePtr->token, ensObj);
    Tcl_ListObjAppendElement(NULL, unknownCmd, ensObj);
    for (i = 1 ; i < objc ; i++) {
	Tcl_ListObjAppendElement(NULL, unknownCmd, objv[i]);
    }
    TclListObjGetElementsM(NULL, unknownCmd, &paramc, &paramv);
    Tcl_IncrRefCount(unknownCmd);

    /*
     * Call the "unknown" handler.  No attempt to NRE-enable this as deep
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

static void
BuildEnsembleConfig(
    EnsembleConfig *ensemblePtr)
{
    Tcl_HashSearch search;	/* Used for scanning the commands in
				 * the namespace for this ensemble. */
    size_t i, j;
    int isNew;
    Tcl_HashTable *hash = &ensemblePtr->subcommandTable;
    Tcl_HashEntry *hPtr;
    Tcl_Obj *mapDict = ensemblePtr->subcommandDict;
    Tcl_Obj *subList = ensemblePtr->subcmdList;

    ClearTable(ensemblePtr);
    Tcl_InitHashTable(hash, TCL_STRING_KEYS);

    if (subList) {
        size_t subc;
        Tcl_Obj **subv, *target, *cmdObj, *cmdPrefixObj;
        const char *name;

        /*
         * There is a list of exactly what subcommands go in the table.
         * Determine the target for each.
         */







|










|







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

static void
BuildEnsembleConfig(
    EnsembleConfig *ensemblePtr)
{
    Tcl_HashSearch search;	/* Used for scanning the commands in
				 * the namespace for this ensemble. */
    Tcl_Size i, j;
    int isNew;
    Tcl_HashTable *hash = &ensemblePtr->subcommandTable;
    Tcl_HashEntry *hPtr;
    Tcl_Obj *mapDict = ensemblePtr->subcommandDict;
    Tcl_Obj *subList = ensemblePtr->subcmdList;

    ClearTable(ensemblePtr);
    Tcl_InitHashTable(hash, TCL_STRING_KEYS);

    if (subList) {
        Tcl_Size subc;
        Tcl_Obj **subv, *target, *cmdObj, *cmdPrefixObj;
        const char *name;

        /*
         * There is a list of exactly what subcommands go in the table.
         * Determine the target for each.
         */
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
    Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
    Tcl_Obj *mapObj, *subcmdObj, *targetCmdObj, *listObj, **elems;
    Tcl_Obj *replaced, *replacement;
    Tcl_Command ensemble = (Tcl_Command) cmdPtr;
    Command *oldCmdPtr = cmdPtr, *newCmdPtr;
    int result, flags = 0, depth = 1, invokeAnyway = 0;
    int ourResult = TCL_ERROR;
    size_t i, len, numBytes;
    const char *word;

    TclNewObj(replaced);
    Tcl_IncrRefCount(replaced);
    if ((int)parsePtr->numWords <= depth) {
	goto failed;
    }
    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	/*
	 * Too hard.
	 */








|




|







2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
    Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
    Tcl_Obj *mapObj, *subcmdObj, *targetCmdObj, *listObj, **elems;
    Tcl_Obj *replaced, *replacement;
    Tcl_Command ensemble = (Tcl_Command) cmdPtr;
    Command *oldCmdPtr = cmdPtr, *newCmdPtr;
    int result, flags = 0, depth = 1, invokeAnyway = 0;
    int ourResult = TCL_ERROR;
    Tcl_Size i, len, numBytes;
    const char *word;

    TclNewObj(replaced);
    Tcl_IncrRefCount(replaced);
    if (parsePtr->numWords <= depth) {
	goto failed;
    }
    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	/*
	 * Too hard.
	 */

2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
     * Check to see if there's also a subcommand list; must check to see if
     * the subcommand we are calling is in that list if it exists, since that
     * list filters the entries in the map.
     */

    (void) Tcl_GetEnsembleSubcommandList(NULL, ensemble, &listObj);
    if (listObj != NULL) {
	size_t sclen;
	const char *str;
	Tcl_Obj *matchObj = NULL;

	if (TclListObjGetElementsM(NULL, listObj, &len, &elems) != TCL_OK) {
	    goto failed;
	}
	for (i=0 ; i<len ; i++) {







|







3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
     * Check to see if there's also a subcommand list; must check to see if
     * the subcommand we are calling is in that list if it exists, since that
     * list filters the entries in the map.
     */

    (void) Tcl_GetEnsembleSubcommandList(NULL, ensemble, &listObj);
    if (listObj != NULL) {
	Tcl_Size sclen;
	const char *str;
	Tcl_Obj *matchObj = NULL;

	if (TclListObjGetElementsM(NULL, listObj, &len, &elems) != TCL_OK) {
	    goto failed;
	}
	for (i=0 ; i<len ; i++) {
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
    return ourResult;
}

int
TclAttemptCompileProc(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    size_t depth,
    Command *cmdPtr,
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;
    int result;
    size_t i;
    Tcl_Token *saveTokenPtr = parsePtr->tokenPtr;
    size_t savedStackDepth = envPtr->currStackDepth;
    unsigned savedCodeNext = envPtr->codeNext - envPtr->codeStart;
    size_t savedAuxDataArrayNext = envPtr->auxDataArrayNext;
    size_t savedExceptArrayNext = envPtr->exceptArrayNext;
#ifdef TCL_COMPILE_DEBUG
    size_t savedExceptDepth = envPtr->exceptDepth;
#endif

    if (cmdPtr->compileProc == NULL) {
	return TCL_ERROR;
    }

    /*







|





|

|

|
|

|







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

int
TclAttemptCompileProc(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Tcl_Size depth,
    Command *cmdPtr,
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;
    int result;
    Tcl_Size i;
    Tcl_Token *saveTokenPtr = parsePtr->tokenPtr;
    Tcl_Size savedStackDepth = envPtr->currStackDepth;
    unsigned savedCodeNext = envPtr->codeNext - envPtr->codeStart;
    Tcl_Size savedAuxDataArrayNext = envPtr->auxDataArrayNext;
    Tcl_Size savedExceptArrayNext = envPtr->exceptArrayNext;
#ifdef TCL_COMPILE_DEBUG
    Tcl_Size savedExceptDepth = envPtr->exceptDepth;
#endif

    if (cmdPtr->compileProc == NULL) {
	return TCL_ERROR;
    }

    /*
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;
    Tcl_Token *tokPtr;
    Tcl_Obj *objPtr, **words;
    const char *bytes;
    int cmdLit, extraLiteralFlags = LITERAL_CMD_NAME;
    size_t i, numWords, length;

    /*
     * Push the words of the command. Take care; the command words may be
     * scripts that have backslashes in them, and [info frame 0] can see the
     * difference. Hence the call to TclContinuationsEnterDerived...
     */








|







3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;
    Tcl_Token *tokPtr;
    Tcl_Obj *objPtr, **words;
    const char *bytes;
    int cmdLit, extraLiteralFlags = LITERAL_CMD_NAME;
    Tcl_Size i, numWords, length;

    /*
     * Push the words of the command. Take care; the command words may be
     * scripts that have backslashes in them, and [info frame 0] can see the
     * difference. Hence the call to TclContinuationsEnterDerived...
     */

Changes to generic/tclEnv.c.

46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
    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
				 * subsystem swaps around the environ array
				 * like we do. */
    size_t ourEnvironSize;		/* Non-zero means that the environ array was
				 * malloced and has this many total entries
				 * allocated to it (not all may be in use at
				 * once). Zero means that the environment
				 * array is in its original static state. */
#endif
} env;








|







46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
    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
				 * subsystem swaps around the environ array
				 * like we do. */
    Tcl_Size ourEnvironSize;	/* Non-zero means that the environ array was
				 * malloced and has this many total entries
				 * allocated to it (not all may be in use at
				 * once). Zero means that the environment
				 * array is in its original static state. */
#endif
} env;

249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
void
TclSetEnv(
    const char *name,		/* Name of variable whose value is to be set
				 * (UTF-8). */
    const char *value)		/* New value for variable (UTF-8). */
{
    Tcl_DString envString;
    size_t nameLength, valueLength;
    size_t index, length;
    char *p, *oldValue;
    const techar *p2;

    /*
     * Figure out where the entry is going to go. If the name doesn't already
     * exist, enlarge the array if necessary to make room. If the name exists,
     * free its old entry.







|
|







249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
void
TclSetEnv(
    const char *name,		/* Name of variable whose value is to be set
				 * (UTF-8). */
    const char *value)		/* New value for variable (UTF-8). */
{
    Tcl_DString envString;
    Tcl_Size nameLength, valueLength;
    Tcl_Size index, length;
    char *p, *oldValue;
    const techar *p2;

    /*
     * Figure out where the entry is going to go. If the name doesn't already
     * exist, enlarge the array if necessary to make room. If the name exists,
     * free its old entry.
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
    char *value;

    if (assignment == NULL) {
	return 0;
    }

    /*
     * First convert the native string to UTF. Then separate the string into
     * name and value parts, and call TclSetEnv to do all of the real work.
     */

    name = Tcl_ExternalToUtfDString(NULL, assignment, -1, &nameString);
    value = (char *)strchr(name, '=');

    if ((value != NULL) && (value != name)) {
	value[0] = '\0';
#if defined(_WIN32)
	if (tenviron == NULL) {
	    /*







|



|







398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
    char *value;

    if (assignment == NULL) {
	return 0;
    }

    /*
     * First convert the native string to Utf. Then separate the string into
     * name and value parts, and call TclSetEnv to do all of the real work.
     */

    name = Tcl_ExternalToUtfDString(NULL, assignment, TCL_INDEX_NONE, &nameString);
    value = (char *)strchr(name, '=');

    if ((value != NULL) && (value != name)) {
	value[0] = '\0';
#if defined(_WIN32)
	if (tenviron == NULL) {
	    /*
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
 */

void
TclUnsetEnv(
    const char *name)		/* Name of variable to remove (UTF-8). */
{
    char *oldValue;
    size_t length, index;
#ifdef USE_PUTENV_FOR_UNSET
    Tcl_DString envString;
    char *string;
#else
    char **envPtr;
#endif /* USE_PUTENV_FOR_UNSET */

    Tcl_MutexLock(&envMutex);
    index = TclpFindVariable(name, &length);

    /*
     * First make sure that the environment variable exists to avoid doing
     * needless work and to avoid recursion on the unset.
     */

    if (index == TCL_INDEX_NONE) {
	Tcl_MutexUnlock(&envMutex);
	return;
    }

    /*
     * Remember the old value so we can free it if Tcl created the string.
     */







|















|







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

void
TclUnsetEnv(
    const char *name)		/* Name of variable to remove (UTF-8). */
{
    char *oldValue;
    Tcl_Size length, index;
#ifdef USE_PUTENV_FOR_UNSET
    Tcl_DString envString;
    char *string;
#else
    char **envPtr;
#endif /* USE_PUTENV_FOR_UNSET */

    Tcl_MutexLock(&envMutex);
    index = TclpFindVariable(name, &length);

    /*
     * First make sure that the environment variable exists to avoid doing
     * needless work and to avoid recursion on the unset.
     */

    if (index == -1) {
	Tcl_MutexUnlock(&envMutex);
	return;
    }

    /*
     * Remember the old value so we can free it if Tcl created the string.
     */
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
TclGetEnv(
    const char *name,		/* Name of environment variable to find
				 * (UTF-8). */
    Tcl_DString *valuePtr)	/* Uninitialized or free DString in which the
				 * value of the environment variable is
				 * stored. */
{
    size_t length, index;
    const char *result;

    Tcl_MutexLock(&envMutex);
    index = TclpFindVariable(name, &length);
    result = NULL;
    if (index != TCL_INDEX_NONE) {
	Tcl_DString envStr;

	result = tenviron2utfdstr(tenviron[index], -1, &envStr);
	result += length;
	if (*result == '=') {
	    result++;
	    Tcl_DStringInit(valuePtr);







|





|







564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
TclGetEnv(
    const char *name,		/* Name of environment variable to find
				 * (UTF-8). */
    Tcl_DString *valuePtr)	/* Uninitialized or free DString in which the
				 * value of the environment variable is
				 * stored. */
{
    Tcl_Size length, index;
    const char *result;

    Tcl_MutexLock(&envMutex);
    index = TclpFindVariable(name, &length);
    result = NULL;
    if (index != -1) {
	Tcl_DString envStr;

	result = tenviron2utfdstr(tenviron[index], -1, &envStr);
	result += length;
	if (*result == '=') {
	    result++;
	    Tcl_DStringInit(valuePtr);

Changes to generic/tclEvent.c.

220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235




236
237
238
239
240
241
242
     * that could lead us here.
     */

    Tcl_Preserve(assocPtr);
    Tcl_Preserve(interp);
    while (assocPtr->firstBgPtr != NULL) {
	int code;
	size_t prefixObjc;
	Tcl_Obj **prefixObjv, **tempObjv;

	/*
	 * Note we copy the handler command prefix each pass through, so we do
	 * support one handler setting another handler.
	 */

	Tcl_Obj *copyObj = TclListObjCopy(NULL, assocPtr->cmdPrefix);





	errPtr = assocPtr->firstBgPtr;

	TclListObjGetElementsM(NULL, copyObj, &prefixObjc, &prefixObjv);
	tempObjv = (Tcl_Obj**)Tcl_Alloc((prefixObjc+2) * sizeof(Tcl_Obj *));
	memcpy(tempObjv, prefixObjv, prefixObjc*sizeof(Tcl_Obj *));
	tempObjv[prefixObjc] = errPtr->errorMsg;







|







|
>
>
>
>







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
     * that could lead us here.
     */

    Tcl_Preserve(assocPtr);
    Tcl_Preserve(interp);
    while (assocPtr->firstBgPtr != NULL) {
	int code;
	Tcl_Size prefixObjc;
	Tcl_Obj **prefixObjv, **tempObjv;

	/*
	 * Note we copy the handler command prefix each pass through, so we do
	 * support one handler setting another handler.
	 */

	Tcl_Obj *copyObj = TclDuplicatePureObj(
	    interp, assocPtr->cmdPrefix, &tclListType);
	if (!copyObj) {
	    return;
	}

	errPtr = assocPtr->firstBgPtr;

	TclListObjGetElementsM(NULL, copyObj, &prefixObjc, &prefixObjv);
	tempObjv = (Tcl_Obj**)Tcl_Alloc((prefixObjc+2) * sizeof(Tcl_Obj *));
	memcpy(tempObjv, prefixObjv, prefixObjc*sizeof(Tcl_Obj *));
	tempObjv[prefixObjc] = errPtr->errorMsg;
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
		    Tcl_RestoreInterpState(interp, saved);
		    Tcl_WriteObj(errChannel, Tcl_GetVar2Ex(interp,
			    "errorInfo", NULL, TCL_GLOBAL_ONLY));
		    Tcl_WriteChars(errChannel, "\n", -1);
		} else {
		    Tcl_DiscardInterpState(saved);
		    Tcl_WriteChars(errChannel,
			    "bgerror failed to handle background error.\n",-1);
		    Tcl_WriteChars(errChannel, "    Original error: ", -1);
		    Tcl_WriteObj(errChannel, tempObjv[1]);
		    Tcl_WriteChars(errChannel, "\n", -1);
		    Tcl_WriteChars(errChannel, "    Error in bgerror: ", -1);
		    Tcl_WriteObj(errChannel, resultPtr);
		    Tcl_WriteChars(errChannel, "\n", -1);
		}







|







478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
		    Tcl_RestoreInterpState(interp, saved);
		    Tcl_WriteObj(errChannel, Tcl_GetVar2Ex(interp,
			    "errorInfo", NULL, TCL_GLOBAL_ONLY));
		    Tcl_WriteChars(errChannel, "\n", -1);
		} else {
		    Tcl_DiscardInterpState(saved);
		    Tcl_WriteChars(errChannel,
			    "bgerror failed to handle background error.\n", -1);
		    Tcl_WriteChars(errChannel, "    Original error: ", -1);
		    Tcl_WriteObj(errChannel, tempObjv[1]);
		    Tcl_WriteChars(errChannel, "\n", -1);
		    Tcl_WriteChars(errChannel, "    Error in bgerror: ", -1);
		    Tcl_WriteObj(errChannel, resultPtr);
		    Tcl_WriteChars(errChannel, "\n", -1);
		}
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
/*
 *----------------------------------------------------------------------
 *
 * BgErrorDeleteProc --
 *
 *	This function is associated with the "tclBgError" assoc data for an
 *	interpreter; it is invoked when the interpreter is deleted in order to
 *	free the information assoicated with any pending error reports.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Background error information is freed: if there were any pending error
 *	reports, they are canceled.







|







589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
/*
 *----------------------------------------------------------------------
 *
 * BgErrorDeleteProc --
 *
 *	This function is associated with the "tclBgError" assoc data for an
 *	interpreter; it is invoked when the interpreter is deleted in order to
 *	free the information associated with any pending error reports.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Background error information is freed: if there were any pending error
 *	reports, they are canceled.
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
    Tcl_MutexLock(&exitMutex);
    currentAppExitPtr = appExitPtr;
    Tcl_MutexUnlock(&exitMutex);

    /*
     * Warning: this function SHOULD NOT return, as there is code that depends
     * on Tcl_Exit never returning. In fact, we will Tcl_Panic if anyone
     * returns, so critical is this dependcy.
     *
     * If subsystems are not (yet) initialized, proper Tcl-finalization is
     * impossible, so fallback to system exit, see bug-[f8a33ce3db5d8cc2].
     */

    if (currentAppExitPtr) {








|







957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
    Tcl_MutexLock(&exitMutex);
    currentAppExitPtr = appExitPtr;
    Tcl_MutexUnlock(&exitMutex);

    /*
     * Warning: this function SHOULD NOT return, as there is code that depends
     * on Tcl_Exit never returning. In fact, we will Tcl_Panic if anyone
     * returns, so critical is this dependency.
     *
     * If subsystems are not (yet) initialized, proper Tcl-finalization is
     * impossible, so fallback to system exit, see bug-[f8a33ce3db5d8cc2].
     */

    if (currentAppExitPtr) {

1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
{
    if (inExit != 0) {
	Tcl_Panic("Tcl_InitSubsystems called while exiting");
    }

    if (subsystemsInitialized == 0) {
	/*
	 * Double check inside the mutex. There are definitly calls back into
	 * this routine from some of the functions below.
	 */

	TclpInitLock();
	if (subsystemsInitialized == 0) {

		/*







|







1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
{
    if (inExit != 0) {
	Tcl_Panic("Tcl_InitSubsystems called while exiting");
    }

    if (subsystemsInitialized == 0) {
	/*
	 * Double check inside the mutex. There are definitely calls back into
	 * this routine from some of the functions below.
	 */

	TclpInitLock();
	if (subsystemsInitialized == 0) {

		/*
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
 *----------------------------------------------------------------------
 */

int
Tcl_CreateThread(
    Tcl_ThreadId *idPtr,	/* Return, the ID of the thread */
    Tcl_ThreadCreateProc *proc,	/* Main() function of the thread */
    void *clientData,	/* The one argument to Main() */
    size_t stackSize,		/* Size of stack for the new thread */
    int flags)			/* Flags controlling behaviour of the new
				 * thread. */
{
#if TCL_THREADS
    ThreadClientData *cdPtr = (ThreadClientData *)Tcl_Alloc(sizeof(ThreadClientData));
    int result;








|
|







2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
 *----------------------------------------------------------------------
 */

int
Tcl_CreateThread(
    Tcl_ThreadId *idPtr,	/* Return, the ID of the thread */
    Tcl_ThreadCreateProc *proc,	/* Main() function of the thread */
    void *clientData,		/* The one argument to Main() */
    TCL_HASH_TYPE stackSize,	/* Size of stack for the new thread */
    int flags)			/* Flags controlling behaviour of the new
				 * thread. */
{
#if TCL_THREADS
    ThreadClientData *cdPtr = (ThreadClientData *)Tcl_Alloc(sizeof(ThreadClientData));
    int result;

Changes to generic/tclExecute.c.

15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclCompile.h"
#include "tclOOInt.h"
#include "tclTomMath.h"
#include "tclAbstractList.h"
#include <math.h>
#include <assert.h>

/*
 * Hack to determine whether we may expect IEEE floating point. The hack is
 * formally incorrect in that non-IEEE platforms might have the same precision
 * and range, but VAX, IBM, and Cray do not; are there any other floating







<







15
16
17
18
19
20
21

22
23
24
25
26
27
28
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclCompile.h"
#include "tclOOInt.h"
#include "tclTomMath.h"

#include <math.h>
#include <assert.h>

/*
 * Hack to determine whether we may expect IEEE floating point. The hack is
 * formally incorrect in that non-IEEE platforms might have the same precision
 * and range, but VAX, IBM, and Cray do not; are there any other floating
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
 * Minimal data required to fully reconstruct the execution state.
 */

typedef struct {
    ByteCode *codePtr;		/* Constant until the BC returns */
				/* -----------------------------------------*/
    Tcl_Obj **catchTop;		/* These fields are used on return TO this */
    Tcl_Obj *auxObjList;	/* this level: they record the state when a */
    CmdFrame cmdFrame;		/* new codePtr was received for NR */
                                /* execution. */
    Tcl_Obj *stack[1];		/* Start of the actual combined catch and obj
				 * stacks; the struct will be expanded as
				 * necessary */
} TEBCdata;

#define TEBC_YIELD() \
    do {						\







|
|
<







108
109
110
111
112
113
114
115
116

117
118
119
120
121
122
123
 * Minimal data required to fully reconstruct the execution state.
 */

typedef struct {
    ByteCode *codePtr;		/* Constant until the BC returns */
				/* -----------------------------------------*/
    Tcl_Obj **catchTop;		/* These fields are used on return TO this */
    Tcl_Obj *auxObjList;	/* level: they record the state when a new */
    CmdFrame cmdFrame;		/* codePtr was received for NR execution. */

    Tcl_Obj *stack[1];		/* Start of the actual combined catch and obj
				 * stacks; the struct will be expanded as
				 * necessary */
} TEBCdata;

#define TEBC_YIELD() \
    do {						\
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

#define OBJ_AT_TOS	*tosPtr

#define OBJ_UNDER_TOS	*(tosPtr-1)

#define OBJ_AT_DEPTH(n)	*(tosPtr-(n))

#define CURR_DEPTH	((size_t)(tosPtr - initTosPtr))

#define STACK_BASE(esPtr) ((esPtr)->stackWords - 1)

/*
 * Macros used to trace instruction execution. The macros TRACE,
 * TRACE_WITH_OBJ, and O2S are only used inside TclNRExecuteByteCode. O2S is
 * only used in TRACE* calls to get a string from an object.
 */

#ifdef TCL_COMPILE_DEBUG
#   define TRACE(a) \
    while (traceInstructions) {					\
	fprintf(stdout, "%2" TCL_Z_MODIFIER "u: %2" TCL_Z_MODIFIER "u (%" TCL_Z_MODIFIER "u) %s ", iPtr->numLevels,	\
		CURR_DEPTH,				\
		(size_t)(pc - codePtr->codeStart),		\
		GetOpcodeName(pc));				\
	printf a;						\
	break;							\
    }
#   define TRACE_APPEND(a) \
    while (traceInstructions) {		\
	printf a;			\
	break;				\
    }
#   define TRACE_ERROR(interp) \
    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
#   define TRACE_WITH_OBJ(a, objPtr) \
    while (traceInstructions) {					\
	fprintf(stdout, "%2" TCL_Z_MODIFIER "u: %2" TCL_Z_MODIFIER "u (%" TCL_Z_MODIFIER "u) %s ", iPtr->numLevels,	\
		CURR_DEPTH,				\
		(size_t)(pc - codePtr->codeStart),		\
		GetOpcodeName(pc));				\
	printf a;						\
	TclPrintObject(stdout, objPtr, 30);			\
	fprintf(stdout, "\n");					\
	break;							\
    }
#   define O2S(objPtr) \







|












|

|













|

|







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

#define OBJ_AT_TOS	*tosPtr

#define OBJ_UNDER_TOS	*(tosPtr-1)

#define OBJ_AT_DEPTH(n)	*(tosPtr-(n))

#define CURR_DEPTH	(tosPtr - initTosPtr)

#define STACK_BASE(esPtr) ((esPtr)->stackWords - 1)

/*
 * Macros used to trace instruction execution. The macros TRACE,
 * TRACE_WITH_OBJ, and O2S are only used inside TclNRExecuteByteCode. O2S is
 * only used in TRACE* calls to get a string from an object.
 */

#ifdef TCL_COMPILE_DEBUG
#   define TRACE(a) \
    while (traceInstructions) {					\
	fprintf(stdout, "%2" TCL_SIZE_MODIFIER "d: %2" TCL_T_MODIFIER "d (%" TCL_T_MODIFIER "d) %s ", iPtr->numLevels,	\
		CURR_DEPTH,				\
		(pc - codePtr->codeStart),		\
		GetOpcodeName(pc));				\
	printf a;						\
	break;							\
    }
#   define TRACE_APPEND(a) \
    while (traceInstructions) {		\
	printf a;			\
	break;				\
    }
#   define TRACE_ERROR(interp) \
    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
#   define TRACE_WITH_OBJ(a, objPtr) \
    while (traceInstructions) {					\
	fprintf(stdout, "%2" TCL_SIZE_MODIFIER "d: %2" TCL_T_MODIFIER "d (%" TCL_T_MODIFIER "d) %s ", iPtr->numLevels,	\
		CURR_DEPTH,				\
		(pc - codePtr->codeStart),		\
		GetOpcodeName(pc));				\
	printf a;						\
	TclPrintObject(stdout, objPtr, 30);			\
	fprintf(stdout, "\n");					\
	break;							\
    }
#   define O2S(objPtr) \
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
			    Tcl_Obj *valuePtr, Tcl_Obj *value2Ptr);
static Tcl_Obj *	ExecuteExtendedUnaryMathOp(int opcode,
			    Tcl_Obj *valuePtr);
static void		FreeExprCodeInternalRep(Tcl_Obj *objPtr);
static ExceptionRange *	GetExceptRangeForPc(const unsigned char *pc,
			    int searchMode, ByteCode *codePtr);
static const char *	GetSrcInfoForPc(const unsigned char *pc,
			    ByteCode *codePtr, size_t *lengthPtr,
			    const unsigned char **pcBeg, int *cmdIdxPtr);
static Tcl_Obj **	GrowEvaluationStack(ExecEnv *eePtr, size_t growth,
			    int move);
static void		IllegalExprOperandType(Tcl_Interp *interp,
			    const unsigned char *pc, Tcl_Obj *opndPtr);
static void		InitByteCodeExecution(Tcl_Interp *interp);
static inline int	wordSkip(void *ptr);
static void		ReleaseDictIterator(Tcl_Obj *objPtr);
/* Useful elsewhere, make available in tclInt.h or stubs? */
static Tcl_Obj **	StackAllocWords(Tcl_Interp *interp, size_t numWords);
static Tcl_Obj **	StackReallocWords(Tcl_Interp *interp, size_t numWords);
static Tcl_NRPostProc	CopyCallback;
static Tcl_NRPostProc	ExprObjCallback;
static Tcl_NRPostProc	FinalizeOONext;
static Tcl_NRPostProc	FinalizeOONextFilter;
static Tcl_NRPostProc   TEBCresume;

/*
 * The structure below defines a bytecode Tcl object type to hold the
 * compiled bytecode for Tcl expressions.
 */

static const Tcl_ObjType exprCodeType = {
    "exprcode",
    FreeExprCodeInternalRep,	/* freeIntRepProc */
    DupExprCodeInternalRep,	/* dupIntRepProc */
    NULL,			/* updateStringProc */
    NULL			/* setFromAnyProc */

};

/*
 * Custom object type only used in this file; values of its type should never
 * be seen by user scripts.
 */

static const Tcl_ObjType dictIteratorType = {
    "dictIterator",
    ReleaseDictIterator,
    NULL, NULL, NULL

};

/*
 *----------------------------------------------------------------------
 *
 * ReleaseDictIterator --
 *







|

|







|
|
















|
>










|
>







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
			    Tcl_Obj *valuePtr, Tcl_Obj *value2Ptr);
static Tcl_Obj *	ExecuteExtendedUnaryMathOp(int opcode,
			    Tcl_Obj *valuePtr);
static void		FreeExprCodeInternalRep(Tcl_Obj *objPtr);
static ExceptionRange *	GetExceptRangeForPc(const unsigned char *pc,
			    int searchMode, ByteCode *codePtr);
static const char *	GetSrcInfoForPc(const unsigned char *pc,
			    ByteCode *codePtr, Tcl_Size *lengthPtr,
			    const unsigned char **pcBeg, int *cmdIdxPtr);
static Tcl_Obj **	GrowEvaluationStack(ExecEnv *eePtr, TCL_HASH_TYPE growth,
			    int move);
static void		IllegalExprOperandType(Tcl_Interp *interp,
			    const unsigned char *pc, Tcl_Obj *opndPtr);
static void		InitByteCodeExecution(Tcl_Interp *interp);
static inline int	wordSkip(void *ptr);
static void		ReleaseDictIterator(Tcl_Obj *objPtr);
/* Useful elsewhere, make available in tclInt.h or stubs? */
static Tcl_Obj **	StackAllocWords(Tcl_Interp *interp, TCL_HASH_TYPE numWords);
static Tcl_Obj **	StackReallocWords(Tcl_Interp *interp, TCL_HASH_TYPE numWords);
static Tcl_NRPostProc	CopyCallback;
static Tcl_NRPostProc	ExprObjCallback;
static Tcl_NRPostProc	FinalizeOONext;
static Tcl_NRPostProc	FinalizeOONextFilter;
static Tcl_NRPostProc   TEBCresume;

/*
 * The structure below defines a bytecode Tcl object type to hold the
 * compiled bytecode for Tcl expressions.
 */

static const Tcl_ObjType exprCodeType = {
    "exprcode",
    FreeExprCodeInternalRep,	/* freeIntRepProc */
    DupExprCodeInternalRep,	/* dupIntRepProc */
    NULL,			/* updateStringProc */
    NULL,			/* setFromAnyProc */
    TCL_OBJTYPE_V0
};

/*
 * Custom object type only used in this file; values of its type should never
 * be seen by user scripts.
 */

static const Tcl_ObjType dictIteratorType = {
    "dictIterator",
    ReleaseDictIterator,
    NULL, NULL, NULL,
    TCL_OBJTYPE_V0
};

/*
 *----------------------------------------------------------------------
 *
 * ReleaseDictIterator --
 *
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
 *----------------------------------------------------------------------
 */

ExecEnv *
TclCreateExecEnv(
    Tcl_Interp *interp,		/* Interpreter for which the execution
				 * environment is being created. */
    size_t size)			/* The initial stack size, in number of words
				 * [sizeof(Tcl_Obj*)] */
{
    ExecEnv *eePtr = (ExecEnv *)Tcl_Alloc(sizeof(ExecEnv));
    ExecStack *esPtr = (ExecStack *)Tcl_Alloc(offsetof(ExecStack, stackWords)
	    + size * sizeof(Tcl_Obj *));

    eePtr->execStackPtr = esPtr;







|







788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
 *----------------------------------------------------------------------
 */

ExecEnv *
TclCreateExecEnv(
    Tcl_Interp *interp,		/* Interpreter for which the execution
				 * environment is being created. */
    TCL_HASH_TYPE size)		/* The initial stack size, in number of words
				 * [sizeof(Tcl_Obj*)] */
{
    ExecEnv *eePtr = (ExecEnv *)Tcl_Alloc(sizeof(ExecEnv));
    ExecStack *esPtr = (ExecStack *)Tcl_Alloc(offsetof(ExecStack, stackWords)
	    + size * sizeof(Tcl_Obj *));

    eePtr->execStackPtr = esPtr;
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
 *----------------------------------------------------------------------
 */

static Tcl_Obj **
GrowEvaluationStack(
    ExecEnv *eePtr,		/* Points to the ExecEnv with an evaluation
				 * stack to enlarge. */
    size_t growth1,			/* How much larger than the current used
				 * size. */
    int move)			/* 1 if move words since last marker. */
{
    ExecStack *esPtr = eePtr->execStackPtr, *oldPtr = NULL;
    size_t newBytes;
    int growth = growth1;
    int newElems, currElems, needed = growth - (esPtr->endPtr - esPtr->tosPtr);
    Tcl_Obj **markerPtr = esPtr->markerPtr, **memStart;
    int moveWords = 0;

    if (move) {
	if (!markerPtr) {
	    Tcl_Panic("STACK: Reallocating with no previous alloc");
	}
	if (needed <= 0) {
	    return MEMSTART(markerPtr);







|




|
|
|

|







970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
 *----------------------------------------------------------------------
 */

static Tcl_Obj **
GrowEvaluationStack(
    ExecEnv *eePtr,		/* Points to the ExecEnv with an evaluation
				 * stack to enlarge. */
    TCL_HASH_TYPE growth1,		/* How much larger than the current used
				 * size. */
    int move)			/* 1 if move words since last marker. */
{
    ExecStack *esPtr = eePtr->execStackPtr, *oldPtr = NULL;
    TCL_HASH_TYPE newBytes;
    Tcl_Size growth = growth1;
    Tcl_Size newElems, currElems, needed = growth - (esPtr->endPtr - esPtr->tosPtr);
    Tcl_Obj **markerPtr = esPtr->markerPtr, **memStart;
    Tcl_Size moveWords = 0;

    if (move) {
	if (!markerPtr) {
	    Tcl_Panic("STACK: Reallocating with no previous alloc");
	}
	if (needed <= 0) {
	    return MEMSTART(markerPtr);
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
 *
 *--------------------------------------------------------------
 */

static Tcl_Obj **
StackAllocWords(
    Tcl_Interp *interp,
    size_t numWords)
{
    /*
     * Note that GrowEvaluationStack sets a marker in the stack. This marker
     * is read when rewinding, e.g., by TclStackFree.
     */

    Interp *iPtr = (Interp *) interp;
    ExecEnv *eePtr = iPtr->execEnvPtr;
    Tcl_Obj **resPtr = GrowEvaluationStack(eePtr, numWords, 0);

    eePtr->execStackPtr->tosPtr += numWords;
    return resPtr;
}

static Tcl_Obj **
StackReallocWords(
    Tcl_Interp *interp,
    size_t numWords)
{
    Interp *iPtr = (Interp *) interp;
    ExecEnv *eePtr = iPtr->execEnvPtr;
    Tcl_Obj **resPtr = GrowEvaluationStack(eePtr, numWords, 1);

    eePtr->execStackPtr->tosPtr += numWords;
    return resPtr;







|

















|







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

static Tcl_Obj **
StackAllocWords(
    Tcl_Interp *interp,
    TCL_HASH_TYPE numWords)
{
    /*
     * Note that GrowEvaluationStack sets a marker in the stack. This marker
     * is read when rewinding, e.g., by TclStackFree.
     */

    Interp *iPtr = (Interp *) interp;
    ExecEnv *eePtr = iPtr->execEnvPtr;
    Tcl_Obj **resPtr = GrowEvaluationStack(eePtr, numWords, 0);

    eePtr->execStackPtr->tosPtr += numWords;
    return resPtr;
}

static Tcl_Obj **
StackReallocWords(
    Tcl_Interp *interp,
    TCL_HASH_TYPE numWords)
{
    Interp *iPtr = (Interp *) interp;
    ExecEnv *eePtr = iPtr->execEnvPtr;
    Tcl_Obj **resPtr = GrowEvaluationStack(eePtr, numWords, 1);

    eePtr->execStackPtr->tosPtr += numWords;
    return resPtr;
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
	eePtr->execStackPtr = esPtr;
    }
}

void *
TclStackAlloc(
    Tcl_Interp *interp,
    size_t numBytes)
{
    Interp *iPtr = (Interp *) interp;
    size_t numWords;

    if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
	return (void *) Tcl_Alloc(numBytes);
    }
    numWords = (numBytes + (sizeof(Tcl_Obj *) - 1))/sizeof(Tcl_Obj *);
    return StackAllocWords(interp, numWords);
}

void *
TclStackRealloc(
    Tcl_Interp *interp,
    void *ptr,
    size_t numBytes)
{
    Interp *iPtr = (Interp *) interp;
    ExecEnv *eePtr;
    ExecStack *esPtr;
    Tcl_Obj **markerPtr;
    size_t numWords;

    if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
	return Tcl_Realloc(ptr, numBytes);
    }

    eePtr = iPtr->execEnvPtr;
    esPtr = eePtr->execStackPtr;







|


|


|









|





|







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
	eePtr->execStackPtr = esPtr;
    }
}

void *
TclStackAlloc(
    Tcl_Interp *interp,
    TCL_HASH_TYPE numBytes)
{
    Interp *iPtr = (Interp *) interp;
    TCL_HASH_TYPE numWords;

    if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
	return Tcl_Alloc(numBytes);
    }
    numWords = (numBytes + (sizeof(Tcl_Obj *) - 1))/sizeof(Tcl_Obj *);
    return StackAllocWords(interp, numWords);
}

void *
TclStackRealloc(
    Tcl_Interp *interp,
    void *ptr,
    TCL_HASH_TYPE numBytes)
{
    Interp *iPtr = (Interp *) interp;
    ExecEnv *eePtr;
    ExecStack *esPtr;
    Tcl_Obj **markerPtr;
    TCL_HASH_TYPE numWords;

    if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
	return Tcl_Realloc(ptr, numBytes);
    }

    eePtr = iPtr->execEnvPtr;
    esPtr = eePtr->execStackPtr;
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
    }

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

	size_t length;
	const char *string = Tcl_GetStringFromObj(objPtr, &length);

	TclInitCompileEnv(interp, &compEnv, string, length, NULL, 0);
	TclCompileExpr(interp, string, length, &compEnv, 0);

	/*
	 * Successful compilation. If the expression yielded no instructions,







|







1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
    }

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

	Tcl_Size 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,
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
	 * has to be recompiled to get the correct locations. Not doing this
	 * will execute the saved bytecode with data for a different location,
	 * causing 'info frame' to point to the wrong place in the sources.
	 *
	 * Future optimizations ...
	 * (1) Save the location data (ExtCmdLoc) keyed by start line. In that
	 *     case we recompile once per location of the literal, but not
	 *     continously, because the moment we have all locations we do not
	 *     need to recompile any longer.
	 *
	 * (2) Alternative: Do not recompile, tell the execution engine the
	 *     offset between saved starting line and actual one. Then modify
	 *     the users to adjust the locations they have by this offset.
	 *
	 * (3) Alternative 2: Do not fully recompile, adjust just the location







|







1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
	 * has to be recompiled to get the correct locations. Not doing this
	 * will execute the saved bytecode with data for a different location,
	 * causing 'info frame' to point to the wrong place in the sources.
	 *
	 * Future optimizations ...
	 * (1) Save the location data (ExtCmdLoc) keyed by start line. In that
	 *     case we recompile once per location of the literal, but not
	 *     continuously, because the moment we have all locations we do not
	 *     need to recompile any longer.
	 *
	 * (2) Alternative: Do not recompile, tell the execution engine the
	 *     offset between saved starting line and actual one. Then modify
	 *     the users to adjust the locations they have by this offset.
	 *
	 * (3) Alternative 2: Do not fully recompile, adjust just the location
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
		     */

		    Tcl_DecrRefCount(ctxCopyPtr->data.eval.path);
		    ctxCopyPtr->data.eval.path = NULL;
		}
	    }

	    if ((size_t)word < ctxCopyPtr->nline) {
		/*
		 * Note: We do not care if the line[word] is -1. This is a
		 * difference and requires a recompile (location changed from
		 * absolute to relative, literal is used fixed and through
		 * variable)
		 *
		 * Example:







|







1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
		     */

		    Tcl_DecrRefCount(ctxCopyPtr->data.eval.path);
		    ctxCopyPtr->data.eval.path = NULL;
		}
	    }

	    if (word < ctxCopyPtr->nline) {
		/*
		 * Note: We do not care if the line[word] is -1. This is a
		 * difference and requires a recompile (location changed from
		 * absolute to relative, literal is used fixed and through
		 * variable)
		 *
		 * Example:
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
}

/*
 *----------------------------------------------------------------------
 *
 * TclIncrObj --
 *
 *	Increment an integeral value in a Tcl_Obj by an integeral value held
 *	in another Tcl_Obj. Caller is responsible for making sure we can
 *	update the first object.
 *
 * Results:
 *	TCL_ERROR if either object is non-integer, and TCL_OK otherwise. On
 *	error, an error message is left in the interpreter (if it is not NULL,
 *	of course).
 *
 * Side effects:
 *	valuePtr gets the new incrmented value.
 *
 *----------------------------------------------------------------------
 */

int
TclIncrObj(
    Tcl_Interp *interp,







|









|







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
}

/*
 *----------------------------------------------------------------------
 *
 * TclIncrObj --
 *
 *	Increment an integral value in a Tcl_Obj by an integral value held
 *	in another Tcl_Obj. Caller is responsible for making sure we can
 *	update the first object.
 *
 * Results:
 *	TCL_ERROR if either object is non-integer, and TCL_OK otherwise. On
 *	error, an error message is left in the interpreter (if it is not NULL,
 *	of course).
 *
 * Side effects:
 *	valuePtr gets the new incremented value.
 *
 *----------------------------------------------------------------------
 */

int
TclIncrObj(
    Tcl_Interp *interp,
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
int
TclNRExecuteByteCode(
    Tcl_Interp *interp,		/* Token for command interpreter. */
    ByteCode *codePtr)		/* The bytecode sequence to interpret. */
{
    Interp *iPtr = (Interp *) interp;
    TEBCdata *TD;
    size_t size = sizeof(TEBCdata) - 1
	    + (codePtr->maxStackDepth + codePtr->maxExceptDepth)
		* sizeof(void *);
    size_t numWords = (size + sizeof(Tcl_Obj *) - 1) / sizeof(Tcl_Obj *);

    TclPreserveByteCode(codePtr);

    /*
     * Reserve the stack, setup the TEBCdataPtr (TD) and CallFrame
     *
     * The execution uses a unified stack: first a TEBCdata, immediately







|


|







1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
int
TclNRExecuteByteCode(
    Tcl_Interp *interp,		/* Token for command interpreter. */
    ByteCode *codePtr)		/* The bytecode sequence to interpret. */
{
    Interp *iPtr = (Interp *) interp;
    TEBCdata *TD;
    TCL_HASH_TYPE size = sizeof(TEBCdata) - 1
	    + (codePtr->maxStackDepth + codePtr->maxExceptDepth)
		* sizeof(void *);
    TCL_HASH_TYPE numWords = (size + sizeof(Tcl_Obj *) - 1) / sizeof(Tcl_Obj *);

    TclPreserveByteCode(codePtr);

    /*
     * Reserve the stack, setup the TEBCdataPtr (TD) and CallFrame
     *
     * The execution uses a unified stack: first a TEBCdata, immediately
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
     * Locals - variables that are used within opcodes or bounded sections of
     * the file (jumps between opcodes within a family).
     * NOTE: These are now mostly defined locally where needed.
     */

    Tcl_Obj *objPtr, *valuePtr, *value2Ptr, *part1Ptr, *part2Ptr, *tmpPtr;
    Tcl_Obj **objv = NULL;
    size_t length, objc = 0;
    int opnd, pcAdjustment;
    Var *varPtr, *arrayPtr;
#ifdef TCL_COMPILE_DEBUG
    char cmdNameBuf[21];
#endif

#ifdef TCL_COMPILE_DEBUG
    int starting = 1;
    traceInstructions = (tclTraceExec == 3);
#endif

    TEBC_DATA_DIG();

#ifdef TCL_COMPILE_DEBUG
    if (!pc && (tclTraceExec >= 2)) {
	PrintByteCodeInfo(codePtr);
	fprintf(stdout, "  Starting stack top=%" TCL_Z_MODIFIER "u\n", CURR_DEPTH);
	fflush(stdout);
    }
#endif

    if (!pc) {
	/* bytecode is starting from scratch */
	pc = codePtr->codeStart;







|
















|







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
     * Locals - variables that are used within opcodes or bounded sections of
     * the file (jumps between opcodes within a family).
     * NOTE: These are now mostly defined locally where needed.
     */

    Tcl_Obj *objPtr, *valuePtr, *value2Ptr, *part1Ptr, *part2Ptr, *tmpPtr;
    Tcl_Obj **objv = NULL;
    Tcl_Size length, objc = 0;
    int opnd, pcAdjustment;
    Var *varPtr, *arrayPtr;
#ifdef TCL_COMPILE_DEBUG
    char cmdNameBuf[21];
#endif

#ifdef TCL_COMPILE_DEBUG
    int starting = 1;
    traceInstructions = (tclTraceExec == 3);
#endif

    TEBC_DATA_DIG();

#ifdef TCL_COMPILE_DEBUG
    if (!pc && (tclTraceExec >= 2)) {
	PrintByteCodeInfo(codePtr);
	fprintf(stdout, "  Starting stack top=%" TCL_T_MODIFIER "d\n", CURR_DEPTH);
	fflush(stdout);
    }
#endif

    if (!pc) {
	/* bytecode is starting from scratch */
	pc = codePtr->codeStart;
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
	}

	/*
	 * Push the call's object result and continue execution with the next
	 * instruction.
	 */

	TRACE_WITH_OBJ(("%" TCL_Z_MODIFIER "u => ... after \"%.20s\": TCL_OK, result=",
		objc, cmdNameBuf), Tcl_GetObjResult(interp));

	/*
	 * Obtain and reset interp's result to avoid possible duplications of
	 * objects [Bug 781585]. We do not call Tcl_ResetResult to avoid any
	 * side effects caused by the resetting of errorInfo and errorCode
	 * [Bug 804681], which are not needed here. We chose instead to







|







2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
	}

	/*
	 * Push the call's object result and continue execution with the next
	 * instruction.
	 */

	TRACE_WITH_OBJ(("%" TCL_SIZE_MODIFIER "d => ... after \"%.20s\": TCL_OK, result=",
		objc, cmdNameBuf), Tcl_GetObjResult(interp));

	/*
	 * Obtain and reset interp's result to avoid possible duplications of
	 * objects [Bug 781585]. We do not call Tcl_ResetResult to avoid any
	 * side effects caused by the resetting of errorInfo and errorCode
	 * [Bug 804681], which are not needed here. We chose instead to
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
#ifdef TCL_COMPILE_DEBUG
    /*
     * Skip the stack depth check if an expansion is in progress.
     */

    CHECK_STACK();
    if (traceInstructions) {
	fprintf(stdout, "%2" TCL_Z_MODIFIER "u: %2" TCL_Z_MODIFIER "u ", iPtr->numLevels, CURR_DEPTH);
	TclPrintInstruction(codePtr, pc);
	fflush(stdout);
    }
#endif /* TCL_COMPILE_DEBUG */

    TCL_DTRACE_INST_NEXT();








|







2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
#ifdef TCL_COMPILE_DEBUG
    /*
     * Skip the stack depth check if an expansion is in progress.
     */

    CHECK_STACK();
    if (traceInstructions) {
	fprintf(stdout, "%2" TCL_SIZE_MODIFIER "d: %2" TCL_T_MODIFIER "d ", iPtr->numLevels, CURR_DEPTH);
	TclPrintInstruction(codePtr, pc);
	fflush(stdout);
    }
#endif /* TCL_COMPILE_DEBUG */

    TCL_DTRACE_INST_NEXT();

2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
	}

#ifdef TCL_COMPILE_DEBUG
	if (tclTraceExec >= 2) {
	    if (traceInstructions) {
		TRACE_APPEND(("YIELD...\n"));
	    } else {
		fprintf(stdout, "%" TCL_Z_MODIFIER "d: (%" TCL_Z_MODIFIER "u) yielding value \"%.30s\"\n",
			iPtr->numLevels, (size_t)(pc - codePtr->codeStart),
			Tcl_GetString(OBJ_AT_TOS));
	    }
	    fflush(stdout);
	}
#endif
	yieldParameter = NULL;	/*==CORO_ACTIVATE_YIELD*/
	Tcl_SetObjResult(interp, OBJ_AT_TOS);







|
|







2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
	}

#ifdef TCL_COMPILE_DEBUG
	if (tclTraceExec >= 2) {
	    if (traceInstructions) {
		TRACE_APPEND(("YIELD...\n"));
	    } else {
		fprintf(stdout, "%" TCL_SIZE_MODIFIER "d: (%" TCL_T_MODIFIER "d) yielding value \"%.30s\"\n",
			iPtr->numLevels, (pc - codePtr->codeStart),
			Tcl_GetString(OBJ_AT_TOS));
	    }
	    fflush(stdout);
	}
#endif
	yieldParameter = NULL;	/*==CORO_ACTIVATE_YIELD*/
	Tcl_SetObjResult(interp, OBJ_AT_TOS);
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

#ifdef TCL_COMPILE_DEBUG
	if (tclTraceExec >= 2) {
	    if (traceInstructions) {
		TRACE(("[%.30s] => YIELD...\n", O2S(valuePtr)));
	    } else {
		/* FIXME: What is the right thing to trace? */
		fprintf(stdout, "%" TCL_Z_MODIFIER "d: (%" TCL_Z_MODIFIER "u) yielding to [%.30s]\n",
			iPtr->numLevels, (size_t)(pc - codePtr->codeStart),
			TclGetString(valuePtr));
	    }
	    fflush(stdout);
	}
#endif

	/*
	 * Install a tailcall record in the caller and continue with the
	 * yield. The yield is switched into multi-return mode (via the
	 * 'yieldParameter').
	 */

	Tcl_IncrRefCount(valuePtr);
	iPtr->execEnvPtr = corPtr->callerEEPtr;

	TclSetTailcall(interp, valuePtr);
	corPtr->yieldPtr = valuePtr;
	iPtr->execEnvPtr = corPtr->eePtr;
	yieldParameter = INT2PTR(1);	/*==CORO_ACTIVATE_YIELDM*/

    doYield:
	/* TIP #280: Record the last piece of info needed by







|
|












<

>







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

#ifdef TCL_COMPILE_DEBUG
	if (tclTraceExec >= 2) {
	    if (traceInstructions) {
		TRACE(("[%.30s] => YIELD...\n", O2S(valuePtr)));
	    } else {
		/* FIXME: What is the right thing to trace? */
		fprintf(stdout, "%" TCL_SIZE_MODIFIER "d: (%" TCL_T_MODIFIER "d) yielding to [%.30s]\n",
			iPtr->numLevels, (pc - codePtr->codeStart),
			TclGetString(valuePtr));
	    }
	    fflush(stdout);
	}
#endif

	/*
	 * Install a tailcall record in the caller and continue with the
	 * yield. The yield is switched into multi-return mode (via the
	 * 'yieldParameter').
	 */


	iPtr->execEnvPtr = corPtr->callerEEPtr;
	Tcl_IncrRefCount(valuePtr);
	TclSetTailcall(interp, valuePtr);
	corPtr->yieldPtr = valuePtr;
	iPtr->execEnvPtr = corPtr->eePtr;
	yieldParameter = INT2PTR(1);	/*==CORO_ACTIVATE_YIELDM*/

    doYield:
	/* TIP #280: Record the last piece of info needed by
2594
2595
2596
2597
2598
2599
2600

2601
2602
2603

2604
2605
2606
2607

2608
2609
2610
2611
2612
2613
2614
	NEXT_INST_F(5, 0, 0);
    }
    break;

    case INST_STR_CONCAT1:

	opnd = TclGetUInt1AtPtr(pc+1);

	objResultPtr = TclStringCat(interp, opnd, &OBJ_AT_DEPTH(opnd-1),
		TCL_STRING_IN_PLACE);
	if (objResultPtr == NULL) {

	    TRACE_ERROR(interp);
	    goto gotError;
	}


	TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
	NEXT_INST_V(2, opnd, 1);
    break;

    case INST_CONCAT_STK:
	/*
	 * Pop the opnd (objc) top stack elements, run through Tcl_ConcatObj,







>



>




>







2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
	NEXT_INST_F(5, 0, 0);
    }
    break;

    case INST_STR_CONCAT1:

	opnd = TclGetUInt1AtPtr(pc+1);
	DECACHE_STACK_INFO();
	objResultPtr = TclStringCat(interp, opnd, &OBJ_AT_DEPTH(opnd-1),
		TCL_STRING_IN_PLACE);
	if (objResultPtr == NULL) {
	    CACHE_STACK_INFO();
	    TRACE_ERROR(interp);
	    goto gotError;
	}

	CACHE_STACK_INFO();
	TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
	NEXT_INST_V(2, opnd, 1);
    break;

    case INST_CONCAT_STK:
	/*
	 * Pop the opnd (objc) top stack elements, run through Tcl_ConcatObj,
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
	 * we do not define a special tclObjType for it. It is not dangerous
	 * as the obj is never passed anywhere, so that all manipulations are
	 * performed here and in INST_INVOKE_EXPANDED (in case of an expansion
	 * error, also in INST_EXPAND_STKTOP).
	 */

	TclNewObj(objPtr);
	objPtr->internalRep.twoPtrValue.ptr2 = UINT2PTR(CURR_DEPTH);
	objPtr->length = 0;
	PUSH_TAUX_OBJ(objPtr);
	TRACE(("=> mark depth as %" TCL_Z_MODIFIER "u\n", CURR_DEPTH));
	NEXT_INST_F(1, 0, 0);
    break;

    case INST_EXPAND_DROP:
	/*
	 * Drops an element of the auxObjList, popping stack elements to
	 * restore the stack to the state before the point where the aux
	 * element was created.
	 */

	CLANG_ASSERT(auxObjList);
	objc = CURR_DEPTH - PTR2UINT(auxObjList->internalRep.twoPtrValue.ptr2);
	POP_TAUX_OBJ();
#ifdef TCL_COMPILE_DEBUG
	/* Ugly abuse! */
	starting = 1;
#endif
	TRACE(("=> drop %" TCL_Z_MODIFIER "u items\n", objc));
	NEXT_INST_V(1, objc, 0);

    case INST_EXPAND_STKTOP: {
	size_t i;
	TEBCdata *newTD;
	ptrdiff_t oldCatchTopOff, oldTosPtrOff;

	/*
	 * Make sure that the element at stackTop is a list; if not, just
	 * leave with an error. Note that the element from the expand list
	 * will be removed at checkForCatch.







|


|











|





|



|







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
	 * we do not define a special tclObjType for it. It is not dangerous
	 * as the obj is never passed anywhere, so that all manipulations are
	 * performed here and in INST_INVOKE_EXPANDED (in case of an expansion
	 * error, also in INST_EXPAND_STKTOP).
	 */

	TclNewObj(objPtr);
	objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(CURR_DEPTH);
	objPtr->length = 0;
	PUSH_TAUX_OBJ(objPtr);
	TRACE(("=> mark depth as %" TCL_T_MODIFIER "d\n", CURR_DEPTH));
	NEXT_INST_F(1, 0, 0);
    break;

    case INST_EXPAND_DROP:
	/*
	 * Drops an element of the auxObjList, popping stack elements to
	 * restore the stack to the state before the point where the aux
	 * element was created.
	 */

	CLANG_ASSERT(auxObjList);
	objc = CURR_DEPTH - PTR2INT(auxObjList->internalRep.twoPtrValue.ptr2);
	POP_TAUX_OBJ();
#ifdef TCL_COMPILE_DEBUG
	/* Ugly abuse! */
	starting = 1;
#endif
	TRACE(("=> drop %" TCL_SIZE_MODIFIER "d items\n", objc));
	NEXT_INST_V(1, objc, 0);

    case INST_EXPAND_STKTOP: {
	Tcl_Size i;
	TEBCdata *newTD;
	ptrdiff_t oldCatchTopOff, oldTosPtrOff;

	/*
	 * Make sure that the element at stackTop is a list; if not, just
	 * leave with an error. Note that the element from the expand list
	 * will be removed at checkForCatch.
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
	TEBC_YIELD();
	/* add TEBCResume for object at top of stack */
	return TclNRExecuteByteCode(interp,
		    TclCompileObj(interp, OBJ_AT_TOS, NULL, 0));

    case INST_INVOKE_EXPANDED:
	CLANG_ASSERT(auxObjList);
	objc = CURR_DEPTH - PTR2UINT(auxObjList->internalRep.twoPtrValue.ptr2);
	POP_TAUX_OBJ();
	if (objc) {
	    pcAdjustment = 1;
	    goto doInvocation;
	}

	/*







|







2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
	TEBC_YIELD();
	/* add TEBCResume for object at top of stack */
	return TclNRExecuteByteCode(interp,
		    TclCompileObj(interp, OBJ_AT_TOS, NULL, 0));

    case INST_INVOKE_EXPANDED:
	CLANG_ASSERT(auxObjList);
	objc = CURR_DEPTH - PTR2INT(auxObjList->internalRep.twoPtrValue.ptr2);
	POP_TAUX_OBJ();
	if (objc) {
	    pcAdjustment = 1;
	    goto doInvocation;
	}

	/*
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805

    doInvocation:
	objv = &OBJ_AT_DEPTH(objc-1);
	cleanup = objc;

#ifdef TCL_COMPILE_DEBUG
	if (tclTraceExec >= 2) {
	    size_t i;

	    if (traceInstructions) {
		strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
		TRACE(("%" TCL_Z_MODIFIER "u => call ", objc));
	    } else {
		fprintf(stdout, "%" TCL_Z_MODIFIER "d: (%" TCL_Z_MODIFIER "u) invoking ", iPtr->numLevels,
			(size_t)(pc - codePtr->codeStart));
	    }
	    for (i = 0;  i < objc;  i++) {
		TclPrintObject(stdout, objv[i], 15);
		fprintf(stdout, " ");
	    }
	    fprintf(stdout, "\n");
	    fflush(stdout);







|



|

|
|







2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808

    doInvocation:
	objv = &OBJ_AT_DEPTH(objc-1);
	cleanup = objc;

#ifdef TCL_COMPILE_DEBUG
	if (tclTraceExec >= 2) {
	    Tcl_Size i;

	    if (traceInstructions) {
		strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
		TRACE(("%" TCL_SIZE_MODIFIER "d => call ", objc));
	    } else {
		fprintf(stdout, "%" TCL_SIZE_MODIFIER "d: (%" TCL_T_MODIFIER "d) invoking ", iPtr->numLevels,
			(pc - codePtr->codeStart));
	    }
	    for (i = 0;  i < objc;  i++) {
		TclPrintObject(stdout, objv[i], 15);
		fprintf(stdout, " ");
	    }
	    fprintf(stdout, "\n");
	    fflush(stdout);
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
	    ArgumentBCEnter(interp, codePtr, TD, pc, objc, objv);
	}

	DECACHE_STACK_INFO();

	pc += pcAdjustment;
	TEBC_YIELD();



	return TclNREvalObjv(interp, objc, objv,
		TCL_EVAL_NOERR | TCL_EVAL_SOURCE_IN_FRAME, NULL);


    case INST_INVOKE_REPLACE:
	objc = TclGetUInt4AtPtr(pc+1);
	opnd = TclGetUInt1AtPtr(pc+5);
	objPtr = POP_OBJECT();
	objv = &OBJ_AT_DEPTH(objc-1);
	cleanup = objc;
#ifdef TCL_COMPILE_DEBUG
	if (tclTraceExec >= 2) {
	    size_t i;

	    if (traceInstructions) {
		strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
		TRACE(("%" TCL_Z_MODIFIER "u => call (implementation %s) ", objc, O2S(objPtr)));
	    } else {
		fprintf(stdout,
			"%" TCL_Z_MODIFIER "d: (%" TCL_Z_MODIFIER "u) invoking (using implementation %s) ",
			iPtr->numLevels, (size_t)(pc - codePtr->codeStart),
			O2S(objPtr));
	    }
	    for (i = 0;  i < objc;  i++) {
		if (i < (size_t)opnd) {
		    fprintf(stdout, "<");
		    TclPrintObject(stdout, objv[i], 15);
		    fprintf(stdout, ">");
		} else {
		    TclPrintObject(stdout, objv[i], 15);
		}
		fprintf(stdout, " ");







>
>
>
|

>









|






|
|



|







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
	    ArgumentBCEnter(interp, codePtr, TD, pc, objc, objv);
	}

	DECACHE_STACK_INFO();

	pc += pcAdjustment;
	TEBC_YIELD();
	if (objc > INT_MAX) {
	    return TclCommandWordLimitError(interp, objc);
	} else {
	    return TclNREvalObjv(interp, objc, objv,
		TCL_EVAL_NOERR | TCL_EVAL_SOURCE_IN_FRAME, NULL);
	}

    case INST_INVOKE_REPLACE:
	objc = TclGetUInt4AtPtr(pc+1);
	opnd = TclGetUInt1AtPtr(pc+5);
	objPtr = POP_OBJECT();
	objv = &OBJ_AT_DEPTH(objc-1);
	cleanup = objc;
#ifdef TCL_COMPILE_DEBUG
	if (tclTraceExec >= 2) {
	    Tcl_Size i;

	    if (traceInstructions) {
		strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
		TRACE(("%" TCL_Z_MODIFIER "u => call (implementation %s) ", objc, O2S(objPtr)));
	    } else {
		fprintf(stdout,
			"%" TCL_Z_MODIFIER "d: (%" TCL_T_MODIFIER "u) invoking (using implementation %s) ",
			iPtr->numLevels, (pc - codePtr->codeStart),
			O2S(objPtr));
	    }
	    for (i = 0;  i < objc;  i++) {
		if (i < opnd) {
		    fprintf(stdout, "<");
		    TclPrintObject(stdout, objv[i], 15);
		    fprintf(stdout, ">");
		} else {
		    TclPrintObject(stdout, objv[i], 15);
		}
		fprintf(stdout, " ");
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
     * WARNING: more 'goto' here than your doctor recommended! The different
     * instructions set the value of some variables and then jump to somme
     * common execution code.
     */

    {
	int storeFlags;
	size_t len;

    case INST_STORE_ARRAY4:
	opnd = TclGetUInt4AtPtr(pc+1);
	pcAdjustment = 5;
	goto doStoreArrayDirect;

    case INST_STORE_ARRAY1:







|







3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
     * WARNING: more 'goto' here than your doctor recommended! The different
     * instructions set the value of some variables and then jump to somme
     * common execution code.
     */

    {
	int storeFlags;
	Tcl_Size len;

    case INST_STORE_ARRAY4:
	opnd = TclGetUInt4AtPtr(pc+1);
	pcAdjustment = 5;
	goto doStoreArrayDirect;

    case INST_STORE_ARRAY1:
3366
3367
3368
3369
3370
3371
3372
3373





3374
3375
3376
3377
3378
3379
3380
    lappendListDirect:
	objResultPtr = varPtr->value.objPtr;
	if (TclListObjLengthM(interp, objResultPtr, &len) != TCL_OK) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	if (Tcl_IsShared(objResultPtr)) {
	    Tcl_Obj *newValue = Tcl_DuplicateObj(objResultPtr);






	    TclDecrRefCount(objResultPtr);
	    varPtr->value.objPtr = objResultPtr = newValue;
	    Tcl_IncrRefCount(newValue);
	}
	if (TclListObjAppendElements(interp, objResultPtr, objc, objv)
		!= TCL_OK) {







|
>
>
>
>
>







3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
    lappendListDirect:
	objResultPtr = varPtr->value.objPtr;
	if (TclListObjLengthM(interp, objResultPtr, &len) != TCL_OK) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	if (Tcl_IsShared(objResultPtr)) {
	    Tcl_Obj *newValue = TclDuplicatePureObj(
		    interp, objResultPtr, &tclListType);
	    if (!newValue) {
		TRACE_ERROR(interp);
		goto gotError;
	    }

	    TclDecrRefCount(objResultPtr);
	    varPtr->value.objPtr = objResultPtr = newValue;
	    Tcl_IncrRefCount(newValue);
	}
	if (TclListObjAppendElements(interp, objResultPtr, objc, objv)
		!= TCL_OK) {
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
	    if (!objResultPtr) {
		valueToAssign = valuePtr;
	    } else if (TclListObjLengthM(interp, objResultPtr, &len)!=TCL_OK) {
		TRACE_ERROR(interp);
		goto gotError;
	    } else {
		if (Tcl_IsShared(objResultPtr)) {
		    valueToAssign = Tcl_DuplicateObj(objResultPtr);




		    createdNewObj = 1;
		} else {
		    valueToAssign = objResultPtr;
		}
		if (TclListObjAppendElements(interp, valueToAssign,
			objc, objv) != TCL_OK) {
		    if (createdNewObj) {
			TclDecrRefCount(valueToAssign);
		    }
		    goto errorInLappendListPtr;
		}
	    }
	    DECACHE_STACK_INFO();
	    Tcl_IncrRefCount(valueToAssign);
	    objResultPtr = TclPtrSetVarIdx(interp, varPtr, arrayPtr, part1Ptr,
		    part2Ptr, valueToAssign, TCL_LEAVE_ERR_MSG, opnd);
	    TclDecrRefCount(valueToAssign);
	    CACHE_STACK_INFO();
	    if (!objResultPtr) {
	    errorInLappendListPtr:
		TRACE_ERROR(interp);
		goto gotError;
	    }
	}
	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	NEXT_INST_V(pcAdjustment, cleanup, 1);
    }

    /*
     *	   End of INST_STORE and related instructions.
     * -----------------------------------------------------------------
     *	   Start of INST_INCR instructions.
     *
     * WARNING: more 'goto' here than your doctor recommended! The different
     * instructions set the value of some variables and then jump to somme
     * common execution code.
     */

/*TODO: Consider more untangling here; merge with LOAD and STORE ? */

    {
	Tcl_Obj *incrPtr;







|
>
>
>
>













<


<

















|







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
	    if (!objResultPtr) {
		valueToAssign = valuePtr;
	    } else if (TclListObjLengthM(interp, objResultPtr, &len)!=TCL_OK) {
		TRACE_ERROR(interp);
		goto gotError;
	    } else {
		if (Tcl_IsShared(objResultPtr)) {
		    valueToAssign = TclDuplicatePureObj(
			interp, objResultPtr, &tclListType);
		    if (!valueToAssign) {
			goto errorInLappendListPtr;
		    }
		    createdNewObj = 1;
		} else {
		    valueToAssign = objResultPtr;
		}
		if (TclListObjAppendElements(interp, valueToAssign,
			objc, objv) != TCL_OK) {
		    if (createdNewObj) {
			TclDecrRefCount(valueToAssign);
		    }
		    goto errorInLappendListPtr;
		}
	    }
	    DECACHE_STACK_INFO();

	    objResultPtr = TclPtrSetVarIdx(interp, varPtr, arrayPtr, part1Ptr,
		    part2Ptr, valueToAssign, TCL_LEAVE_ERR_MSG, opnd);

	    CACHE_STACK_INFO();
	    if (!objResultPtr) {
	    errorInLappendListPtr:
		TRACE_ERROR(interp);
		goto gotError;
	    }
	}
	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	NEXT_INST_V(pcAdjustment, cleanup, 1);
    }

    /*
     *	   End of INST_STORE and related instructions.
     * -----------------------------------------------------------------
     *	   Start of INST_INCR instructions.
     *
     * WARNING: more 'goto' here than your doctor recommended! The different
     * instructions set the value of some variables and then jump to some
     * common execution code.
     */

/*TODO: Consider more untangling here; merge with LOAD and STORE ? */

    {
	Tcl_Obj *incrPtr;
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
     *	   Start of TclOO support instructions.
     */

    {
	Object *oPtr;
	CallFrame *framePtr;
	CallContext *contextPtr;
	size_t skip, newDepth;

    case INST_TCLOO_SELF:
	framePtr = iPtr->varFramePtr;
	if (framePtr == NULL ||
		!(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
	    TRACE(("=> ERROR: no TclOO call context\n"));
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(







|







4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375
4376
4377
     *	   Start of TclOO support instructions.
     */

    {
	Object *oPtr;
	CallFrame *framePtr;
	CallContext *contextPtr;
	Tcl_Size skip, newDepth;

    case INST_TCLOO_SELF:
	framePtr = iPtr->varFramePtr;
	if (framePtr == NULL ||
		!(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
	    TRACE(("=> ERROR: no TclOO call context\n"));
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
4401
4402
4403
4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
	oPtr = (Object *) Tcl_GetObjectFromObj(interp, valuePtr);
	if (oPtr == NULL) {
	    TRACE_APPEND(("ERROR: \"%.30s\" not object\n", O2S(valuePtr)));
	    goto gotError;
	} else {
	    Class *classPtr = oPtr->classPtr;
	    struct MInvoke *miPtr;
	    size_t i;
	    const char *methodType;

	    if (classPtr == NULL) {
		TRACE_APPEND(("ERROR: \"%.30s\" not class\n", O2S(valuePtr)));
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"\"%s\" is not a class", TclGetString(valuePtr)));
		DECACHE_STACK_INFO();







|







4415
4416
4417
4418
4419
4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
	oPtr = (Object *) Tcl_GetObjectFromObj(interp, valuePtr);
	if (oPtr == NULL) {
	    TRACE_APPEND(("ERROR: \"%.30s\" not object\n", O2S(valuePtr)));
	    goto gotError;
	} else {
	    Class *classPtr = oPtr->classPtr;
	    struct MInvoke *miPtr;
	    Tcl_Size i;
	    const char *methodType;

	    if (classPtr == NULL) {
		TRACE_APPEND(("ERROR: \"%.30s\" not class\n", O2S(valuePtr)));
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"\"%s\" is not a class", TclGetString(valuePtr)));
		DECACHE_STACK_INFO();
4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
4441
4442
			miPtr->mPtr->declaringClassPtr == classPtr) {
		    newDepth = i;
#ifdef TCL_COMPILE_DEBUG
		    if (tclTraceExec >= 2) {
			if (traceInstructions) {
			    strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
			} else {
			    fprintf(stdout, "%" TCL_Z_MODIFIER "d: (%" TCL_Z_MODIFIER "u) invoking ",
				    iPtr->numLevels,
				    (size_t)(pc - codePtr->codeStart));
			}
			for (i = 0;  i < (size_t)opnd;  i++) {
			    TclPrintObject(stdout, objv[i], 15);
			    fprintf(stdout, " ");
			}
			fprintf(stdout, "\n");
			fflush(stdout);
		    }
#endif /*TCL_COMPILE_DEBUG*/







|



|







4438
4439
4440
4441
4442
4443
4444
4445
4446
4447
4448
4449
4450
4451
4452
4453
4454
4455
4456
			miPtr->mPtr->declaringClassPtr == classPtr) {
		    newDepth = i;
#ifdef TCL_COMPILE_DEBUG
		    if (tclTraceExec >= 2) {
			if (traceInstructions) {
			    strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
			} else {
			    fprintf(stdout, "%" TCL_SIZE_MODIFIER "d: (%" TCL_T_MODIFIER "d) invoking ",
				    iPtr->numLevels,
				    (size_t)(pc - codePtr->codeStart));
			}
			for (i = 0;  i < opnd;  i++) {
			    TclPrintObject(stdout, objv[i], 15);
			    fprintf(stdout, " ");
			}
			fprintf(stdout, "\n");
			fflush(stdout);
		    }
#endif /*TCL_COMPILE_DEBUG*/
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
4538
4539
4540
4541
#ifdef TCL_COMPILE_DEBUG
	} else if (tclTraceExec >= 2) {
	    int i;

	    if (traceInstructions) {
		strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
	    } else {
		fprintf(stdout, "%" TCL_Z_MODIFIER "d: (%" TCL_Z_MODIFIER "u) invoking ",
			iPtr->numLevels, (size_t)(pc - codePtr->codeStart));
	    }
	    for (i = 0;  i < opnd;  i++) {
		TclPrintObject(stdout, objv[i], 15);
		fprintf(stdout, " ");
	    }
	    fprintf(stdout, "\n");
	    fflush(stdout);







|
|







4540
4541
4542
4543
4544
4545
4546
4547
4548
4549
4550
4551
4552
4553
4554
4555
#ifdef TCL_COMPILE_DEBUG
	} else if (tclTraceExec >= 2) {
	    int i;

	    if (traceInstructions) {
		strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
	    } else {
		fprintf(stdout, "%" TCL_SIZE_MODIFIER "d: (%" TCL_Z_MODIFIER "u) invoking ",
			iPtr->numLevels, (pc - codePtr->codeStart));
	    }
	    for (i = 0;  i < opnd;  i++) {
		TclPrintObject(stdout, objv[i], 15);
		fprintf(stdout, " ");
	    }
	    fprintf(stdout, "\n");
	    fflush(stdout);
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
     *     End of TclOO support instructions.
     * -----------------------------------------------------------------
     *	   Start of INST_LIST and related instructions.
     */

    {
	int numIndices, nocase, match, cflags;
	size_t slength, length2, fromIdx, toIdx, index, s1len, s2len;
	const char *s1, *s2;

    case INST_LIST:
	/*
	 * Pop the opnd (objc) top stack elements into a new list obj and then
	 * decrement their ref counts.
	 */

	opnd = TclGetUInt4AtPtr(pc+1);
	objResultPtr = Tcl_NewListObj(opnd, &OBJ_AT_DEPTH(opnd-1));
	TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
	NEXT_INST_V(5, opnd, 1);

    case INST_LIST_LENGTH:
	TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS)));
	if (TclListObjLengthM(interp, OBJ_AT_TOS, &length) != TCL_OK) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	TclNewIntObj(objResultPtr, length);
	TRACE_APPEND(("%" TCL_Z_MODIFIER "u\n", length));
	NEXT_INST_F(1, 1, 1);

    case INST_LIST_INDEX:	/* lindex with objc == 3 */
	value2Ptr = OBJ_AT_TOS;
	valuePtr = OBJ_UNDER_TOS;
	TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));

	/* special case for AbstractList */
	if (TclHasInternalRep(valuePtr,&tclAbstractListType)) {

	    length = Tcl_AbstractListObjLength(valuePtr);
	    if (TclGetIntForIndexM(interp, value2Ptr, length-1, &index)!=TCL_OK) {
		CACHE_STACK_INFO();
		TRACE_ERROR(interp);
		goto gotError;
	    }
	    if (Tcl_AbstractListObjIndex(interp, valuePtr, index, &objResultPtr)!=TCL_OK) {
		CACHE_STACK_INFO();
		TRACE_ERROR(interp);
		goto gotError;
	    }
	    Tcl_IncrRefCount(objResultPtr); // reference held here
	    goto lindexDone;
	}

	/*
	 * Extract the desired list element.
	 */



	/* TODO: handle AbstractList here? */
	if ((TclListObjGetElementsM(interp, valuePtr, &objc, &objv) == TCL_OK)

		&& !TclHasInternalRep(value2Ptr, &tclListType)) {








	    int code;






	    DECACHE_STACK_INFO();
	    code = TclGetIntForIndexM(interp, value2Ptr, objc-1, &index);

	    CACHE_STACK_INFO();
	    if (code == TCL_OK) {
		TclDecrRefCount(value2Ptr);
		tosPtr--;
		pcAdjustment = 1;
		goto lindexFastPath;
	    }
	    Tcl_ResetResult(interp);
	}



	objResultPtr = TclLindexList(interp, valuePtr, value2Ptr);


    lindexDone:
	if (!objResultPtr) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}








|




















|








|
>
|





|












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

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

>







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
     *     End of TclOO support instructions.
     * -----------------------------------------------------------------
     *	   Start of INST_LIST and related instructions.
     */

    {
	int numIndices, nocase, match, cflags;
	Tcl_Size slength, length2, fromIdx, toIdx, index, s1len, s2len;
	const char *s1, *s2;

    case INST_LIST:
	/*
	 * Pop the opnd (objc) top stack elements into a new list obj and then
	 * decrement their ref counts.
	 */

	opnd = TclGetUInt4AtPtr(pc+1);
	objResultPtr = Tcl_NewListObj(opnd, &OBJ_AT_DEPTH(opnd-1));
	TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
	NEXT_INST_V(5, opnd, 1);

    case INST_LIST_LENGTH:
	TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS)));
	if (TclListObjLengthM(interp, OBJ_AT_TOS, &length) != TCL_OK) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	TclNewIntObj(objResultPtr, length);
	TRACE_APPEND(("%" TCL_SIZE_MODIFIER "d\n", length));
	NEXT_INST_F(1, 1, 1);

    case INST_LIST_INDEX:	/* lindex with objc == 3 */
	value2Ptr = OBJ_AT_TOS;
	valuePtr = OBJ_UNDER_TOS;
	TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));

	/* special case for AbstractList */
	if (TclObjTypeHasProc(valuePtr,indexProc)) {
	    DECACHE_STACK_INFO();
	    length = TclObjTypeHasProc(valuePtr, lengthProc)(valuePtr);
	    if (TclGetIntForIndexM(interp, value2Ptr, length-1, &index)!=TCL_OK) {
		CACHE_STACK_INFO();
		TRACE_ERROR(interp);
		goto gotError;
	    }
	    if (Tcl_ObjTypeIndex(interp, valuePtr, index, &objResultPtr)!=TCL_OK) {
		CACHE_STACK_INFO();
		TRACE_ERROR(interp);
		goto gotError;
	    }
	    Tcl_IncrRefCount(objResultPtr); // reference held here
	    goto lindexDone;
	}

	/*
	 * Extract the desired list element.
	 */

	{
	    Tcl_Size value2Length;
	    Tcl_Obj *indexListPtr = value2Ptr;
	    if ((TclListObjGetElementsM(interp, valuePtr, &objc, &objv) == TCL_OK)
		&& (
		    !TclHasInternalRep(value2Ptr, &tclListType)
		    ||
		    ((Tcl_ListObjLength(interp,value2Ptr,&value2Length),
			value2Length == 1
			    ? (indexListPtr = TclListObjGetElement(value2Ptr, 0), 1)
			    : 0
		    ))
		)
	    ) {
		int code;

		/* increment the refCount of value2Ptr because TclListObjGetElement may
		 * have just extracted it from a list in the condition for this block.
		 */
		Tcl_IncrRefCount(indexListPtr);

		DECACHE_STACK_INFO();
		code = TclGetIntForIndexM(interp, indexListPtr, objc-1, &index);
		TclDecrRefCount(indexListPtr);
		CACHE_STACK_INFO();
		if (code == TCL_OK) {
		    Tcl_DecrRefCount(value2Ptr);
		    tosPtr--;
		    pcAdjustment = 1;
		    goto lindexFastPath;
		}
		Tcl_ResetResult(interp);
	    }
	}

	DECACHE_STACK_INFO();
	objResultPtr = TclLindexList(interp, valuePtr, value2Ptr);
	CACHE_STACK_INFO();

    lindexDone:
	if (!objResultPtr) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}

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

	/*
	 * Get the contents of the list, making sure that it really is a list
	 * in the process.
	 */

	/* special case for AbstractList */
	if (TclHasInternalRep(valuePtr,&tclAbstractListType)) {
	    length = Tcl_AbstractListObjLength(valuePtr);

	    /* Decode end-offset index values. */
	    index = TclIndexDecode(opnd, length-1);

	    /* Compute value @ index */

	    if (Tcl_AbstractListObjIndex(interp, valuePtr, index, &objResultPtr)!=TCL_OK) {
		CACHE_STACK_INFO();
		TRACE_ERROR(interp);
		goto gotError;
	    }


	    pcAdjustment = 5;
	    goto lindexFastPath2;
	}

	/* List case */
	if (TclListObjGetElementsM(interp, valuePtr, &objc, &objv) != TCL_OK) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}

	/* Decode end-offset index values. */

	index = TclIndexDecode(opnd, objc - 1);
	pcAdjustment = 5;

    lindexFastPath:
	if (index < (size_t)objc) {
	    objResultPtr = objv[index];
	} else {
	    TclNewObj(objResultPtr);
	}

    lindexFastPath2:








|
|





>
|




>

















|







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

	/*
	 * Get the contents of the list, making sure that it really is a list
	 * in the process.
	 */

	/* special case for AbstractList */
	if (TclObjTypeHasProc(valuePtr,indexProc)) {
	    length = TclObjTypeHasProc(valuePtr, lengthProc)(valuePtr);

	    /* Decode end-offset index values. */
	    index = TclIndexDecode(opnd, length-1);

	    /* Compute value @ index */
	    DECACHE_STACK_INFO();
	    if (Tcl_ObjTypeIndex(interp, valuePtr, index, &objResultPtr)!=TCL_OK) {
		CACHE_STACK_INFO();
		TRACE_ERROR(interp);
		goto gotError;
	    }
	    CACHE_STACK_INFO();

	    pcAdjustment = 5;
	    goto lindexFastPath2;
	}

	/* List case */
	if (TclListObjGetElementsM(interp, valuePtr, &objc, &objv) != TCL_OK) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}

	/* Decode end-offset index values. */

	index = TclIndexDecode(opnd, objc - 1);
	pcAdjustment = 5;

    lindexFastPath:
	if (index >= 0 && index < objc) {
	    objResultPtr = objv[index];
	} else {
	    TclNewObj(objResultPtr);
	}

    lindexFastPath2:

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
	valuePtr = POP_OBJECT();
	Tcl_DecrRefCount(valuePtr); /* This one should be done here */

	/*
	 * Compute the new variable value.
	 */

	if (TclAbstractListHasProc(valuePtr, TCL_ABSL_SLICE)) {


	    objResultPtr = Tcl_AbstractListSetElement(interp,
		valuePtr, numIndices,
	        &OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS);
	} else {
	    objResultPtr = TclLsetFlat(interp, valuePtr, numIndices,
		&OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS);
	}
	if (!objResultPtr) {

	    TRACE_ERROR(interp);
	    goto gotError;
	}

	/*
	 * Set result.
	 */

	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
	NEXT_INST_V(5, numIndices+1, -1);

    case INST_LSET_LIST:	/* 'lset' with 4 args */
	/*
	 * Get the old value of variable, and remove the stack ref. This is
	 * safe because the variable still references the object; the ref







|
>
>
|







>







|







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
	valuePtr = POP_OBJECT();
	Tcl_DecrRefCount(valuePtr); /* This one should be done here */

	/*
	 * Compute the new variable value.
	 */

	if (TclObjTypeHasProc(valuePtr, setElementProc)) {

	    DECACHE_STACK_INFO();
	    objResultPtr = Tcl_ObjTypeSetElement(interp,
		valuePtr, numIndices,
	        &OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS);
	} else {
	    objResultPtr = TclLsetFlat(interp, valuePtr, numIndices,
		&OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS);
	}
	if (!objResultPtr) {
	    CACHE_STACK_INFO();
	    TRACE_ERROR(interp);
	    goto gotError;
	}

	/*
	 * Set result.
	 */
	CACHE_STACK_INFO();
	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
	NEXT_INST_V(5, numIndices+1, -1);

    case INST_LSET_LIST:	/* 'lset' with 4 args */
	/*
	 * Get the old value of variable, and remove the stack ref. This is
	 * safe because the variable still references the object; the ref
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
	    TclNewObj(objResultPtr);
	    TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr)));
	    NEXT_INST_F(9, 1, 1);
	}
	toIdx = TclIndexDecode(toIdx, objc - 1);
	if (toIdx == TCL_INDEX_NONE) {
	    goto emptyList;
	} else if (toIdx + 1 >= (size_t)objc + 1) {
	    toIdx = objc - 1;
	}

	assert (toIdx < (size_t)objc);
	/*
	assert ( fromIdx != TCL_INDEX_NONE );
	 *
	 * Extra safety for legacy bytecodes:
	 */
	if (fromIdx == TCL_INDEX_NONE) {
	    fromIdx = TCL_INDEX_START;
	}

	fromIdx = TclIndexDecode(fromIdx, objc - 1);

	if (TclAbstractListHasProc(valuePtr, TCL_ABSL_SLICE)) {

	    if (Tcl_AbstractListObjRange(interp, valuePtr, fromIdx, toIdx, &objResultPtr) != TCL_OK) {
		TRACE_ERROR(interp);
		goto gotError;
	    }
	} else {
	    objResultPtr = TclListObjRange(valuePtr, fromIdx, toIdx);
	}







	TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr)));
	NEXT_INST_F(9, 1, 1);

    case INST_LIST_IN:
    case INST_LIST_NOT_IN:	/* Basic list containment operators. */
	value2Ptr = OBJ_AT_TOS;
	valuePtr = OBJ_UNDER_TOS;

	s1 = Tcl_GetStringFromObj(valuePtr, &s1len);
	TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
	if (TclListObjLengthM(interp, value2Ptr, &length) != TCL_OK) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	match = 0;
	if (length > 0) {
	    size_t i = 0;
	    Tcl_Obj *o;
	    int isAbstractList = TclHasInternalRep(value2Ptr,&tclAbstractListType);

	    /*
	     * An empty list doesn't match anything.
	     */

	    do {
		if (isAbstractList) {

		    if (Tcl_AbstractListObjIndex(interp, value2Ptr, i, &o) != TCL_OK) {

			TRACE_ERROR(interp);
			goto gotError;
		    }

		} else {
		    Tcl_ListObjIndex(NULL, value2Ptr, i, &o);
		}
		if (o != NULL) {
		    s2 = Tcl_GetStringFromObj(o, &s2len);
		} else {
		    s2 = "";
		    s2len = 0;
		}
		if (s1len == s2len) {
		    match = (memcmp(s1, s2, s1len) == 0);
		}
		if (isAbstractList) {

		    TclDecrRefCount(o);
		}
		i++;
	    } while (i < length && match == 0);
	}

	if (*pc == INST_LIST_NOT_IN) {
	    match = !match;
	}







|



|











|
>
|
<
|


|

>
>
>
>
|
>
>
















|

|







>
|
>



>












|
>
|
|







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
	    TclNewObj(objResultPtr);
	    TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr)));
	    NEXT_INST_F(9, 1, 1);
	}
	toIdx = TclIndexDecode(toIdx, objc - 1);
	if (toIdx == TCL_INDEX_NONE) {
	    goto emptyList;
	} else if (toIdx >= objc) {
	    toIdx = objc - 1;
	}

	assert (toIdx >= 0 && toIdx < objc);
	/*
	assert ( fromIdx != TCL_INDEX_NONE );
	 *
	 * Extra safety for legacy bytecodes:
	 */
	if (fromIdx == TCL_INDEX_NONE) {
	    fromIdx = TCL_INDEX_START;
	}

	fromIdx = TclIndexDecode(fromIdx, objc - 1);

	if (TclObjTypeHasProc(valuePtr, sliceProc)) {
	    DECACHE_STACK_INFO();
	    if (Tcl_ObjTypeSlice(interp, valuePtr, fromIdx, toIdx, &objResultPtr) != TCL_OK) {

		objResultPtr = NULL;
	    }
	} else {
	    objResultPtr = TclListObjRange(interp, valuePtr, fromIdx, toIdx);
	}
	if (objResultPtr == NULL) {
	    CACHE_STACK_INFO();
	    TRACE_ERROR(interp);
	    goto gotError;
	}

	CACHE_STACK_INFO();
	TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr)));
	NEXT_INST_F(9, 1, 1);

    case INST_LIST_IN:
    case INST_LIST_NOT_IN:	/* Basic list containment operators. */
	value2Ptr = OBJ_AT_TOS;
	valuePtr = OBJ_UNDER_TOS;

	s1 = Tcl_GetStringFromObj(valuePtr, &s1len);
	TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
	if (TclListObjLengthM(interp, value2Ptr, &length) != TCL_OK) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	match = 0;
	if (length > 0) {
	    Tcl_Size i = 0;
	    Tcl_Obj *o;
	    int isAbstractList = TclObjTypeHasProc(value2Ptr,indexProc) != NULL;

	    /*
	     * An empty list doesn't match anything.
	     */

	    do {
		if (isAbstractList) {
		    DECACHE_STACK_INFO();
		    if (Tcl_ObjTypeIndex(interp, value2Ptr, i, &o) != TCL_OK) {
			CACHE_STACK_INFO();
			TRACE_ERROR(interp);
			goto gotError;
		    }
		    CACHE_STACK_INFO();
		} else {
		    Tcl_ListObjIndex(NULL, value2Ptr, i, &o);
		}
		if (o != NULL) {
		    s2 = Tcl_GetStringFromObj(o, &s2len);
		} else {
		    s2 = "";
		    s2len = 0;
		}
		if (s1len == s2len) {
		    match = (memcmp(s1, s2, s1len) == 0);
		}

		/* Could be an ephemeral abstract obj */
		Tcl_BumpObj(o);

		i++;
	    } while (i < length && match == 0);
	}

	if (*pc == INST_LIST_NOT_IN) {
	    match = !match;
	}
5038
5039
5040
5041
5042
5043
5044
5045
5046
5047
5048
5049
5050
5051
5052
	    }
	    TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 1, 0);
	}

    case INST_LREPLACE4:
	{
	Tcl_Size numToDelete, numNewElems;
	int end_indicator;
	int haveSecondIndex, flags;
	Tcl_Obj *fromIdxObj, *toIdxObj;
	opnd = TclGetInt4AtPtr(pc + 1);
	flags = TclGetInt1AtPtr(pc + 5);

	/* Stack: ... listobj index1 ?index2? new1 ... newN */







|







5088
5089
5090
5091
5092
5093
5094
5095
5096
5097
5098
5099
5100
5101
5102
	    }
	    TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 1, 0);
	}

    case INST_LREPLACE4:
	{
	TCL_HASH_TYPE numToDelete, numNewElems;
	int end_indicator;
	int haveSecondIndex, flags;
	Tcl_Obj *fromIdxObj, *toIdxObj;
	opnd = TclGetInt4AtPtr(pc + 1);
	flags = TclGetInt1AtPtr(pc + 5);

	/* Stack: ... listobj index1 ?index2? new1 ... newN */
5072
5073
5074
5075
5076
5077
5078
5079
5080
5081
5082
5083
5084
5085
5086
5087
	    != TCL_OK) {
	    CACHE_STACK_INFO();
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	if (fromIdx == TCL_INDEX_NONE) {
	    fromIdx = 0;
	}
	else if (fromIdx > length) {
	    fromIdx = length;
	}
	numToDelete = 0;
	if (toIdxObj) {
	    if (TclGetIntForIndexM(
		    interp, toIdxObj, length - end_indicator, &toIdx)
		!= TCL_OK) {







<
|







5122
5123
5124
5125
5126
5127
5128

5129
5130
5131
5132
5133
5134
5135
5136
	    != TCL_OK) {
	    CACHE_STACK_INFO();
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	if (fromIdx == TCL_INDEX_NONE) {
	    fromIdx = 0;

	} else if (fromIdx > length) {
	    fromIdx = length;
	}
	numToDelete = 0;
	if (toIdxObj) {
	    if (TclGetIntForIndexM(
		    interp, toIdxObj, length - end_indicator, &toIdx)
		!= TCL_OK) {
5112
5113
5114
5115
5116
5117
5118
5119
5120
5121
5122
5123
5124
5125
5126
5127
		!= TCL_OK) {
		TRACE_ERROR(interp);
		Tcl_DecrRefCount(objResultPtr);
		goto gotError;
	    }
	    TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
	    NEXT_INST_V(6, opnd, 1);
	}
	else {
	    if (Tcl_ListObjReplace(interp,
				   valuePtr,
				   fromIdx,
				   numToDelete,
				   numNewElems,
				   &OBJ_AT_DEPTH(numNewElems - 1))
		!= TCL_OK) {







<
|







5161
5162
5163
5164
5165
5166
5167

5168
5169
5170
5171
5172
5173
5174
5175
		!= TCL_OK) {
		TRACE_ERROR(interp);
		Tcl_DecrRefCount(objResultPtr);
		goto gotError;
	    }
	    TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
	    NEXT_INST_V(6, opnd, 1);

	} else {
	    if (Tcl_ListObjReplace(interp,
				   valuePtr,
				   fromIdx,
				   numToDelete,
				   numNewElems,
				   &OBJ_AT_DEPTH(numNewElems - 1))
		!= TCL_OK) {
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

    case INST_STR_INDEX:
	value2Ptr = OBJ_AT_TOS;
	valuePtr = OBJ_UNDER_TOS;
	TRACE(("\"%.20s\" %.20s => ", O2S(valuePtr), O2S(value2Ptr)));

	/*
	 * Get char length to calulate what 'end' means.
	 */

	slength = Tcl_GetCharLength(valuePtr);
	DECACHE_STACK_INFO();
	if (TclGetIntForIndexM(interp, value2Ptr, slength-1, &index)!=TCL_OK) {
	    CACHE_STACK_INFO();
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	CACHE_STACK_INFO();

	if (index >= slength) {
	    TclNewObj(objResultPtr);
	} else if (TclIsPureByteArray(valuePtr)) {
	    objResultPtr = Tcl_NewByteArrayObj(
		    Tcl_GetBytesFromObj(NULL, valuePtr, (size_t *)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);








|











|



|







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

    case INST_STR_INDEX:
	value2Ptr = OBJ_AT_TOS;
	valuePtr = OBJ_UNDER_TOS;
	TRACE(("\"%.20s\" %.20s => ", O2S(valuePtr), O2S(value2Ptr)));

	/*
	 * Get char length to calculate what 'end' means.
	 */

	slength = Tcl_GetCharLength(valuePtr);
	DECACHE_STACK_INFO();
	if (TclGetIntForIndexM(interp, value2Ptr, slength-1, &index)!=TCL_OK) {
	    CACHE_STACK_INFO();
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	CACHE_STACK_INFO();

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

5359
5360
5361
5362
5363
5364
5365
5366
5367
5368
5369
5370
5371
5372
5373
	    objResultPtr = Tcl_GetRange(valuePtr, fromIdx, toIdx);
	}
	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	NEXT_INST_F(9, 1, 1);

    {
	Tcl_UniChar *ustring1, *ustring2, *ustring3, *end, *p;
	size_t length3;
	Tcl_Obj *value3Ptr;

    case INST_STR_REPLACE:
	value3Ptr = POP_OBJECT();
	valuePtr = OBJ_AT_DEPTH(2);
	slength = Tcl_GetCharLength(valuePtr) - 1;
	TRACE(("\"%.20s\" %s %s \"%.20s\" => ", O2S(valuePtr),







|







5407
5408
5409
5410
5411
5412
5413
5414
5415
5416
5417
5418
5419
5420
5421
	    objResultPtr = Tcl_GetRange(valuePtr, fromIdx, toIdx);
	}
	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	NEXT_INST_F(9, 1, 1);

    {
	Tcl_UniChar *ustring1, *ustring2, *ustring3, *end, *p;
	Tcl_Size length3;
	Tcl_Obj *value3Ptr;

    case INST_STR_REPLACE:
	value3Ptr = POP_OBJECT();
	valuePtr = OBJ_AT_DEPTH(2);
	slength = Tcl_GetCharLength(valuePtr) - 1;
	TRACE(("\"%.20s\" %s %s \"%.20s\" => ", O2S(valuePtr),
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
	}
	CACHE_STACK_INFO();
	TclDecrRefCount(OBJ_AT_TOS);
	(void) POP_OBJECT();
	TclDecrRefCount(OBJ_AT_TOS);
	(void) POP_OBJECT();

	if ((toIdx == TCL_INDEX_NONE) ||
		(fromIdx + 1 > slength + 1) ||
		(toIdx + 1 < fromIdx + 1)) {
	    TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr)));
	    TclDecrRefCount(value3Ptr);
	    NEXT_INST_F(1, 0, 0);
	}

	if (fromIdx == TCL_INDEX_NONE) {
	    fromIdx = TCL_INDEX_START;
	}

	if (toIdx + 1 > slength + 1) {
	    toIdx = slength;
	}

	if ((fromIdx == TCL_INDEX_START) && (toIdx == slength)) {
	    TclDecrRefCount(OBJ_AT_TOS);
	    OBJ_AT_TOS = value3Ptr;
	    TRACE_APPEND(("\"%.30s\"\n", O2S(value3Ptr)));
	    NEXT_INST_F(1, 0, 0);
	}

	objResultPtr = TclStringReplace(interp, valuePtr, fromIdx,







|
|
|





|
|


|



|







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
	}
	CACHE_STACK_INFO();
	TclDecrRefCount(OBJ_AT_TOS);
	(void) POP_OBJECT();
	TclDecrRefCount(OBJ_AT_TOS);
	(void) POP_OBJECT();

	if ((toIdx < 0) ||
		(fromIdx > slength) ||
		(toIdx < fromIdx)) {
	    TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr)));
	    TclDecrRefCount(value3Ptr);
	    NEXT_INST_F(1, 0, 0);
	}

	if (fromIdx < 0) {
	    fromIdx = 0;
	}

	if (toIdx > slength) {
	    toIdx = slength;
	}

	if ((fromIdx == 0) && (toIdx == slength)) {
	    TclDecrRefCount(OBJ_AT_TOS);
	    OBJ_AT_TOS = value3Ptr;
	    TRACE_APPEND(("\"%.30s\"\n", O2S(value3Ptr)));
	    NEXT_INST_F(1, 0, 0);
	}

	objResultPtr = TclStringReplace(interp, valuePtr, fromIdx,
5457
5458
5459
5460
5461
5462
5463
5464
5465
5466
5467
5468
5469
5470
5471

	objResultPtr = Tcl_NewUnicodeObj(ustring1, 0);
	p = ustring1;
	end = ustring1 + slength;
	for (; ustring1 < end; ustring1++) {
	    if ((*ustring1 == *ustring2) &&
		/* Fix bug [69218ab7b]: restrict max compare length. */
		((size_t)(end-ustring1) >= length2) && (length2==1 ||
		    memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length2)
			    == 0)) {
		if (p != ustring1) {
		    Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1-p);
		    p = ustring1 + length2;
		} else {
		    p += length2;







|







5505
5506
5507
5508
5509
5510
5511
5512
5513
5514
5515
5516
5517
5518
5519

	objResultPtr = Tcl_NewUnicodeObj(ustring1, 0);
	p = ustring1;
	end = ustring1 + slength;
	for (; ustring1 < end; ustring1++) {
	    if ((*ustring1 == *ustring2) &&
		/* Fix bug [69218ab7b]: restrict max compare length. */
		((end-ustring1) >= length2) && (length2==1 ||
		    memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length2)
			    == 0)) {
		if (p != ustring1) {
		    Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1-p);
		    p = ustring1 + length2;
		} else {
		    p += length2;
5491
5492
5493
5494
5495
5496
5497
5498
5499
5500
5501
5502
5503
5504
5505
	objResultPtr = TclStringFirst(OBJ_UNDER_TOS, OBJ_AT_TOS, 0);

	TRACE(("%.20s %.20s => %s\n",
		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), O2S(objResultPtr)));
	NEXT_INST_F(1, 2, 1);

    case INST_STR_FIND_LAST:
	objResultPtr = TclStringLast(OBJ_UNDER_TOS, OBJ_AT_TOS, INT_MAX - 1);

	TRACE(("%.20s %.20s => %s\n",
		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), O2S(objResultPtr)));
	NEXT_INST_F(1, 2, 1);

    case INST_STR_CLASS:
	opnd = TclGetInt1AtPtr(pc+1);







|







5539
5540
5541
5542
5543
5544
5545
5546
5547
5548
5549
5550
5551
5552
5553
	objResultPtr = TclStringFirst(OBJ_UNDER_TOS, OBJ_AT_TOS, 0);

	TRACE(("%.20s %.20s => %s\n",
		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), O2S(objResultPtr)));
	NEXT_INST_F(1, 2, 1);

    case INST_STR_FIND_LAST:
	objResultPtr = TclStringLast(OBJ_UNDER_TOS, OBJ_AT_TOS, TCL_SIZE_MAX - 1);

	TRACE(("%.20s %.20s => %s\n",
		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), O2S(objResultPtr)));
	NEXT_INST_F(1, 2, 1);

    case INST_STR_CLASS:
	opnd = TclGetInt1AtPtr(pc+1);
5537
5538
5539
5540
5541
5542
5543
5544
5545
5546
5547
5548
5549
5550
5551
5552
5553
		|| TclHasInternalRep(value2Ptr, &tclStringType)) {
	    Tcl_UniChar *ustring1, *ustring2;

	    ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &slength);
	    ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2);
	    match = TclUniCharMatch(ustring1, slength, ustring2, length2,
		    nocase);
	} else if (TclIsPureByteArray(valuePtr) && !nocase) {
	    unsigned char *bytes1, *bytes2;
	    size_t wlen1 = 0, wlen2 = 0;

	    bytes1 = Tcl_GetByteArrayFromObj(valuePtr, &wlen1);
	    bytes2 = Tcl_GetByteArrayFromObj(value2Ptr, &wlen2);
	    match = TclByteArrayMatch(bytes1, wlen1, bytes2, wlen2, 0);
	} else {
	    match = Tcl_StringCaseMatch(TclGetString(valuePtr),
		    TclGetString(value2Ptr), nocase);







|

|







5585
5586
5587
5588
5589
5590
5591
5592
5593
5594
5595
5596
5597
5598
5599
5600
5601
		|| TclHasInternalRep(value2Ptr, &tclStringType)) {
	    Tcl_UniChar *ustring1, *ustring2;

	    ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &slength);
	    ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2);
	    match = TclUniCharMatch(ustring1, slength, ustring2, length2,
		    nocase);
	} else if (TclIsPureByteArray(valuePtr) && TclIsPureByteArray(value2Ptr) && !nocase) {
	    unsigned char *bytes1, *bytes2;
	    Tcl_Size wlen1 = 0, wlen2 = 0;

	    bytes1 = Tcl_GetByteArrayFromObj(valuePtr, &wlen1);
	    bytes2 = Tcl_GetByteArrayFromObj(value2Ptr, &wlen2);
	    match = TclByteArrayMatch(bytes1, wlen1, bytes2, wlen2, 0);
	} else {
	    match = Tcl_StringCaseMatch(TclGetString(valuePtr),
		    TclGetString(value2Ptr), nocase);
5564
5565
5566
5567
5568
5569
5570
5571
5572
5573
5574
5575
5576
5577
5578
	 * Peep-hole optimisation: if you're about to jump, do jump from here.
	 */

	JUMP_PEEPHOLE_F(match, 2, 2);

    {
	const char *string1, *string2;
	size_t trim1, trim2;

    case INST_STR_TRIM_LEFT:
	valuePtr = OBJ_UNDER_TOS;	/* String */
	value2Ptr = OBJ_AT_TOS;		/* TrimSet */
	string2 = Tcl_GetStringFromObj(value2Ptr, &length2);
	string1 = Tcl_GetStringFromObj(valuePtr, &slength);
	trim1 = TclTrimLeft(string1, slength, string2, length2);







|







5612
5613
5614
5615
5616
5617
5618
5619
5620
5621
5622
5623
5624
5625
5626
	 * Peep-hole optimisation: if you're about to jump, do jump from here.
	 */

	JUMP_PEEPHOLE_F(match, 2, 2);

    {
	const char *string1, *string2;
	Tcl_Size trim1, trim2;

    case INST_STR_TRIM_LEFT:
	valuePtr = OBJ_UNDER_TOS;	/* String */
	value2Ptr = OBJ_AT_TOS;		/* TrimSet */
	string2 = Tcl_GetStringFromObj(value2Ptr, &length2);
	string1 = Tcl_GetStringFromObj(valuePtr, &slength);
	trim1 = TclTrimLeft(string1, slength, string2, length2);
6374
6375
6376
6377
6378
6379
6380
6381
6382
6383
6384
6385
6386
6387
6388
6389
6390
	TRACE(("=> CONTINUE!\n"));
	goto processExceptionReturn;

    {
	ForeachInfo *infoPtr;
	Tcl_Obj *listPtr, **elements;
	ForeachVarList *varListPtr;
	size_t numLists, listLen, numVars, listTmpDepth;
	size_t iterNum, iterMax, iterTmp;
	size_t varIndex, valIndex, i, j;

    case INST_FOREACH_START:
	/*
	 * Initialize the data for the looping construct, pushing the
	 * corresponding Tcl_Objs to the stack.
	 */








|
|
|







6422
6423
6424
6425
6426
6427
6428
6429
6430
6431
6432
6433
6434
6435
6436
6437
6438
	TRACE(("=> CONTINUE!\n"));
	goto processExceptionReturn;

    {
	ForeachInfo *infoPtr;
	Tcl_Obj *listPtr, **elements;
	ForeachVarList *varListPtr;
	Tcl_Size numLists, listLen, numVars, listTmpDepth;
	Tcl_Size iterNum, iterMax, iterTmp;
	Tcl_Size varIndex, valIndex, i, j;

    case INST_FOREACH_START:
	/*
	 * Initialize the data for the looping construct, pushing the
	 * corresponding Tcl_Objs to the stack.
	 */

6399
6400
6401
6402
6403
6404
6405

6406

6407
6408
6409
6410
6411
6412




6413
6414
6415
6416
6417
6418
6419

	iterMax = 0;
	listTmpDepth = numLists-1;
	for (i = 0;  i < numLists;  i++) {
	    varListPtr = infoPtr->varLists[i];
	    numVars = varListPtr->numVars;
	    listPtr = OBJ_AT_DEPTH(listTmpDepth);

	    if (TclListObjLengthM(interp, listPtr, &listLen) != TCL_OK) {

		TRACE_APPEND(("ERROR converting list %" TCL_Z_MODIFIER "d, \"%s\": %s",
			i, O2S(listPtr), O2S(Tcl_GetObjResult(interp))));
		goto gotError;
	    }
	    if (Tcl_IsShared(listPtr)) {
		objPtr = TclListObjCopy(NULL, listPtr);




		Tcl_IncrRefCount(objPtr);
		Tcl_DecrRefCount(listPtr);
		OBJ_AT_DEPTH(listTmpDepth) = objPtr;
	    }
	    iterTmp = (listLen + (numVars - 1))/numVars;
	    if (iterTmp > iterMax) {
		iterMax = iterTmp;







>

>





|
>
>
>
>







6447
6448
6449
6450
6451
6452
6453
6454
6455
6456
6457
6458
6459
6460
6461
6462
6463
6464
6465
6466
6467
6468
6469
6470
6471
6472
6473

	iterMax = 0;
	listTmpDepth = numLists-1;
	for (i = 0;  i < numLists;  i++) {
	    varListPtr = infoPtr->varLists[i];
	    numVars = varListPtr->numVars;
	    listPtr = OBJ_AT_DEPTH(listTmpDepth);
	    DECACHE_STACK_INFO();
	    if (TclListObjLengthM(interp, listPtr, &listLen) != TCL_OK) {
		CACHE_STACK_INFO();
		TRACE_APPEND(("ERROR converting list %" TCL_Z_MODIFIER "d, \"%s\": %s",
			i, O2S(listPtr), O2S(Tcl_GetObjResult(interp))));
		goto gotError;
	    }
	    if (Tcl_IsShared(listPtr)) {
		objPtr = TclDuplicatePureObj(
		    interp, listPtr, &tclListType);
		if (!objPtr) {
		    goto gotError;
		}
		Tcl_IncrRefCount(objPtr);
		Tcl_DecrRefCount(listPtr);
		OBJ_AT_DEPTH(listTmpDepth) = objPtr;
	    }
	    iterTmp = (listLen + (numVars - 1))/numVars;
	    if (iterTmp > iterMax) {
		iterMax = iterTmp;
6446
6447
6448
6449
6450
6451
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
	/*
	 * Jump directly to the INST_FOREACH_STEP instruction; the C code just
	 * falls through.
	 */

	pc += 5 - infoPtr->loopCtTemp;

    case INST_FOREACH_STEP:
	/*
	 * "Step" a foreach loop (i.e., begin its next iteration) by assigning
	 * the next value list element to each loop var.
	 */

	tmpPtr = OBJ_AT_TOS;
	infoPtr = (ForeachInfo *)tmpPtr->internalRep.twoPtrValue.ptr1;
	numLists = infoPtr->numLists;
	TRACE(("=> "));

	tmpPtr = OBJ_AT_DEPTH(1);
	iterNum = (size_t)tmpPtr->internalRep.twoPtrValue.ptr1;
	iterMax = (size_t)tmpPtr->internalRep.twoPtrValue.ptr2;

	/*
	 * If some list still has a remaining list element iterate one more
	 * time. Assign to var the next element from its value list.
	 */

	if (iterNum < iterMax) {

	    /*
	     * Set the variables and jump back to run the body
	     */

	    tmpPtr->internalRep.twoPtrValue.ptr1 =(void *)(iterNum + 1);

	    listTmpDepth = numLists + 1;

	    for (i = 0;  i < numLists;  i++) {
		varListPtr = infoPtr->varLists[i];
		numVars = varListPtr->numVars;

		listPtr = OBJ_AT_DEPTH(listTmpDepth);


		TclListObjGetElementsM(interp, listPtr, &listLen, &elements);







		valIndex = (iterNum * numVars);
		for (j = 0;  j < numVars;  j++) {
		    if (valIndex >= listLen) {
			TclNewObj(valuePtr);
		    } else {
			valuePtr = elements[valIndex];







|




















>













>
>
|
>
>
>
>
>
>







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
	/*
	 * Jump directly to the INST_FOREACH_STEP instruction; the C code just
	 * falls through.
	 */

	pc += 5 - infoPtr->loopCtTemp;

    case INST_FOREACH_STEP: /* TODO: address abstract list indexing here! */
	/*
	 * "Step" a foreach loop (i.e., begin its next iteration) by assigning
	 * the next value list element to each loop var.
	 */

	tmpPtr = OBJ_AT_TOS;
	infoPtr = (ForeachInfo *)tmpPtr->internalRep.twoPtrValue.ptr1;
	numLists = infoPtr->numLists;
	TRACE(("=> "));

	tmpPtr = OBJ_AT_DEPTH(1);
	iterNum = (size_t)tmpPtr->internalRep.twoPtrValue.ptr1;
	iterMax = (size_t)tmpPtr->internalRep.twoPtrValue.ptr2;

	/*
	 * If some list still has a remaining list element iterate one more
	 * time. Assign to var the next element from its value list.
	 */

	if (iterNum < iterMax) {
	    int status;
	    /*
	     * Set the variables and jump back to run the body
	     */

	    tmpPtr->internalRep.twoPtrValue.ptr1 =(void *)(iterNum + 1);

	    listTmpDepth = numLists + 1;

	    for (i = 0;  i < numLists;  i++) {
		varListPtr = infoPtr->varLists[i];
		numVars = varListPtr->numVars;

		listPtr = OBJ_AT_DEPTH(listTmpDepth);
		DECACHE_STACK_INFO();
		status = TclListObjGetElementsM(
		    interp, listPtr, &listLen, &elements);
		if (status != TCL_OK) {
		    CACHE_STACK_INFO();
		    goto gotError;
		}
		CACHE_STACK_INFO();


		valIndex = (iterNum * numVars);
		for (j = 0;  j < numVars;  j++) {
		    if (valIndex >= listLen) {
			TclNewObj(valuePtr);
		    } else {
			valuePtr = elements[valIndex];
6509
6510
6511
6512
6513
6514
6515
6516
6517
6518
6519
6520
6521
6522
6523
			    Tcl_IncrRefCount(valuePtr);
			}
		    } else {
			DECACHE_STACK_INFO();
			if (TclPtrSetVarIdx(interp, varPtr, NULL, NULL, NULL,
				valuePtr, TCL_LEAVE_ERR_MSG, varIndex)==NULL){
			    CACHE_STACK_INFO();
			    TRACE_APPEND(("ERROR init. index temp %" TCL_Z_MODIFIER "u: %.30s",
				    varIndex, O2S(Tcl_GetObjResult(interp))));
			    goto gotError;
			}
			CACHE_STACK_INFO();
		    }
		    valIndex++;
		}







|







6572
6573
6574
6575
6576
6577
6578
6579
6580
6581
6582
6583
6584
6585
6586
			    Tcl_IncrRefCount(valuePtr);
			}
		    } else {
			DECACHE_STACK_INFO();
			if (TclPtrSetVarIdx(interp, varPtr, NULL, NULL, NULL,
				valuePtr, TCL_LEAVE_ERR_MSG, varIndex)==NULL){
			    CACHE_STACK_INFO();
			    TRACE_APPEND(("ERROR init. index temp %" TCL_SIZE_MODIFIER "d: %.30s",
				    varIndex, O2S(Tcl_GetObjResult(interp))));
			    goto gotError;
			}
			CACHE_STACK_INFO();
		    }
		    valIndex++;
		}
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
	 *   - collecting obj (unshared)
	 * The instruction lappends the result to the collecting obj.
	 */

	tmpPtr = OBJ_AT_DEPTH(1);
	infoPtr = (ForeachInfo *)tmpPtr->internalRep.twoPtrValue.ptr1;
	numLists = infoPtr->numLists;
	TRACE_APPEND(("=> appending to list at depth %" TCL_Z_MODIFIER "u\n", 3 + numLists));

	objPtr = OBJ_AT_DEPTH(3 + numLists);
	Tcl_ListObjAppendElement(NULL, objPtr, OBJ_AT_TOS);
	NEXT_INST_F(1, 1, 0);
    }
    break;

    case INST_BEGIN_CATCH4:
	/*
	 * Record start of the catch command with exception range index equal
	 * to the operand. Push the current stack depth onto the special catch
	 * stack.
	 */

	*(++catchTop) = (Tcl_Obj *)UINT2PTR(CURR_DEPTH);
	TRACE(("%u => catchTop=%" TCL_Z_MODIFIER "u, stackTop=%" TCL_Z_MODIFIER "u\n",
		TclGetUInt4AtPtr(pc+1), (size_t)(catchTop - initCatchTop - 1),
		CURR_DEPTH));
	NEXT_INST_F(5, 0, 0);
    break;

    case INST_END_CATCH:
	catchTop--;
	DECACHE_STACK_INFO();







|














|
|
|







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
	 *   - collecting obj (unshared)
	 * The instruction lappends the result to the collecting obj.
	 */

	tmpPtr = OBJ_AT_DEPTH(1);
	infoPtr = (ForeachInfo *)tmpPtr->internalRep.twoPtrValue.ptr1;
	numLists = infoPtr->numLists;
	TRACE_APPEND(("=> appending to list at depth %" TCL_SIZE_MODIFIER "d\n", 3 + numLists));

	objPtr = OBJ_AT_DEPTH(3 + numLists);
	Tcl_ListObjAppendElement(NULL, objPtr, OBJ_AT_TOS);
	NEXT_INST_F(1, 1, 0);
    }
    break;

    case INST_BEGIN_CATCH4:
	/*
	 * Record start of the catch command with exception range index equal
	 * to the operand. Push the current stack depth onto the special catch
	 * stack.
	 */

	*(++catchTop) = (Tcl_Obj *)INT2PTR(CURR_DEPTH);
	TRACE(("%u => catchTop=%" TCL_T_MODIFIER "d, stackTop=%" TCL_T_MODIFIER "d\n",
		TclGetUInt4AtPtr(pc+1), (catchTop - initCatchTop - 1),
		CURR_DEPTH));
	NEXT_INST_F(5, 0, 0);
    break;

    case INST_END_CATCH:
	catchTop--;
	DECACHE_STACK_INFO();
6639
6640
6641
6642
6643
6644
6645
6646
6647
6648
6649
6650
6651
6652
6653
6654
6655
6656
6657
6658
6659
6660
    /*
     * -----------------------------------------------------------------
     *	   Start of dictionary-related instructions.
     */

    {
	int opnd2, allocateDict, done, allocdict;
	size_t i;
	Tcl_Obj *dictPtr, *statePtr, *keyPtr, *listPtr, *varNamePtr, *keysPtr;
	Tcl_Obj *emptyPtr, **keyPtrPtr;
	Tcl_DictSearch *searchPtr;
	DictUpdateInfo *duiPtr;

    case INST_DICT_VERIFY: {
	size_t size;
	dictPtr = OBJ_AT_TOS;
	TRACE(("\"%.30s\" => ", O2S(dictPtr)));
	if (Tcl_DictObjSize(interp, dictPtr, &size) != TCL_OK) {
	    TRACE_APPEND(("ERROR verifying dictionary nature of \"%.30s\": %s\n",
		    O2S(dictPtr), O2S(Tcl_GetObjResult(interp))));
	    goto gotError;
	}







|






|







6702
6703
6704
6705
6706
6707
6708
6709
6710
6711
6712
6713
6714
6715
6716
6717
6718
6719
6720
6721
6722
6723
    /*
     * -----------------------------------------------------------------
     *	   Start of dictionary-related instructions.
     */

    {
	int opnd2, allocateDict, done, allocdict;
	Tcl_Size i;
	Tcl_Obj *dictPtr, *statePtr, *keyPtr, *listPtr, *varNamePtr, *keysPtr;
	Tcl_Obj *emptyPtr, **keyPtrPtr;
	Tcl_DictSearch *searchPtr;
	DictUpdateInfo *duiPtr;

    case INST_DICT_VERIFY: {
	Tcl_Size size;
	dictPtr = OBJ_AT_TOS;
	TRACE(("\"%.30s\" => ", O2S(dictPtr)));
	if (Tcl_DictObjSize(interp, dictPtr, &size) != TCL_OK) {
	    TRACE_APPEND(("ERROR verifying dictionary nature of \"%.30s\": %s\n",
		    O2S(dictPtr), O2S(Tcl_GetObjResult(interp))));
	    goto gotError;
	}
7065
7066
7067
7068
7069
7070
7071
7072
7073
7074
7075
7076
7077
7078
7079
	    PUSH_OBJECT(valuePtr);
	    PUSH_OBJECT(keyPtr);
	}
	TRACE_APPEND(("\"%.30s\" \"%.30s\" %d\n",
		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), done));

	/*
	 * The INST_DICT_FIRST and INST_DICT_NEXT instructsions are always
	 * followed by a conditional jump, so we can take advantage of this to
	 * do some peephole optimization (note that we're careful to not close
	 * out someone doing something else).
	 */

	JUMP_PEEPHOLE_F(done, 5, 0);








|







7128
7129
7130
7131
7132
7133
7134
7135
7136
7137
7138
7139
7140
7141
7142
	    PUSH_OBJECT(valuePtr);
	    PUSH_OBJECT(keyPtr);
	}
	TRACE_APPEND(("\"%.30s\" \"%.30s\" %d\n",
		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), done));

	/*
	 * The INST_DICT_FIRST and INST_DICT_NEXT instructions are always
	 * followed by a conditional jump, so we can take advantage of this to
	 * do some peephole optimization (note that we're careful to not close
	 * out someone doing something else).
	 */

	JUMP_PEEPHOLE_F(done, 5, 0);

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
	    while (cleanup--) {
		valuePtr = POP_OBJECT();
		TclDecrRefCount(valuePtr);
	    }
	    if (result == TCL_BREAK) {
		result = TCL_OK;
		pc = (codePtr->codeStart + rangePtr->breakOffset);
		TRACE_APPEND(("%s, range at %" TCL_Z_MODIFIER "u, new pc %" TCL_Z_MODIFIER "u\n",
			StringForResultCode(result),
			rangePtr->codeOffset, rangePtr->breakOffset));
		NEXT_INST_F(0, 0, 0);
	    }
	    if (rangePtr->continueOffset == TCL_INDEX_NONE) {
		TRACE_APPEND(("%s, loop w/o continue, checking for catch\n",
			StringForResultCode(result)));
		goto checkForCatch;
	    }
	    result = TCL_OK;
	    pc = (codePtr->codeStart + rangePtr->continueOffset);
	    TRACE_APPEND(("%s, range at %" TCL_Z_MODIFIER "u, new pc %" TCL_Z_MODIFIER "u\n",
		    StringForResultCode(result),
		    rangePtr->codeOffset, rangePtr->continueOffset));
	    NEXT_INST_F(0, 0, 0);
	}
#ifdef TCL_COMPILE_DEBUG
	if (traceInstructions) {
	    objPtr = Tcl_GetObjResult(interp);







|











|







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
	    while (cleanup--) {
		valuePtr = POP_OBJECT();
		TclDecrRefCount(valuePtr);
	    }
	    if (result == TCL_BREAK) {
		result = TCL_OK;
		pc = (codePtr->codeStart + rangePtr->breakOffset);
		TRACE_APPEND(("%s, range at %" TCL_SIZE_MODIFIER "d, new pc %" TCL_SIZE_MODIFIER "d\n",
			StringForResultCode(result),
			rangePtr->codeOffset, rangePtr->breakOffset));
		NEXT_INST_F(0, 0, 0);
	    }
	    if (rangePtr->continueOffset == TCL_INDEX_NONE) {
		TRACE_APPEND(("%s, loop w/o continue, checking for catch\n",
			StringForResultCode(result)));
		goto checkForCatch;
	    }
	    result = TCL_OK;
	    pc = (codePtr->codeStart + rangePtr->continueOffset);
	    TRACE_APPEND(("%s, range at %" TCL_SIZE_MODIFIER "d, new pc %" TCL_SIZE_MODIFIER "d\n",
		    StringForResultCode(result),
		    rangePtr->codeOffset, rangePtr->continueOffset));
	    NEXT_INST_F(0, 0, 0);
	}
#ifdef TCL_COMPILE_DEBUG
	if (traceInstructions) {
	    objPtr = Tcl_GetObjResult(interp);
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

    checkForCatch:
	if (iPtr->execEnvPtr->rewind) {
	    goto abnormalReturn;
	}
	if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
	    const unsigned char *pcBeg;
	    size_t xxx1length;

	    bytes = GetSrcInfoForPc(pc, codePtr, &xxx1length, &pcBeg, NULL);
	    DECACHE_STACK_INFO();
	    TclLogCommandInfo(interp, codePtr->source, bytes,
		    bytes ? xxx1length : 0, pcBeg, tosPtr);
	    CACHE_STACK_INFO();
	}
	iPtr->flags &= ~ERR_ALREADY_LOGGED;

	/*
	 * Clear all expansions that may have started after the last
	 * INST_BEGIN_CATCH.
	 */

	while (auxObjList) {
	    if ((catchTop != initCatchTop)
		    && (PTR2UINT(*catchTop) >
			PTR2UINT(auxObjList->internalRep.twoPtrValue.ptr2))) {
		break;
	    }
	    POP_TAUX_OBJ();
	}

	/*
	 * We must not catch if the script in progress has been canceled with







|
















|
|







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

    checkForCatch:
	if (iPtr->execEnvPtr->rewind) {
	    goto abnormalReturn;
	}
	if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
	    const unsigned char *pcBeg;
	    Tcl_Size xxx1length;

	    bytes = GetSrcInfoForPc(pc, codePtr, &xxx1length, &pcBeg, NULL);
	    DECACHE_STACK_INFO();
	    TclLogCommandInfo(interp, codePtr->source, bytes,
		    bytes ? xxx1length : 0, pcBeg, tosPtr);
	    CACHE_STACK_INFO();
	}
	iPtr->flags &= ~ERR_ALREADY_LOGGED;

	/*
	 * Clear all expansions that may have started after the last
	 * INST_BEGIN_CATCH.
	 */

	while (auxObjList) {
	    if ((catchTop != initCatchTop)
		    && (PTR2INT(*catchTop) >
			PTR2INT(auxObjList->internalRep.twoPtrValue.ptr2))) {
		break;
	    }
	    POP_TAUX_OBJ();
	}

	/*
	 * We must not catch if the script in progress has been canceled with
7562
7563
7564
7565
7566
7567
7568
7569
7570
7571
7572
7573
7574
7575
7576
7577
7578
7579
7580
7581
7582
7583
7584
7585
	 * "exception". It was found either by checkForCatch just above or by
	 * an instruction during break, continue, or error processing. Jump to
	 * its catchOffset after unwinding the operand stack to the depth it
	 * had when starting to execute the range's catch command.
	 */

    processCatch:
	while (CURR_DEPTH > PTR2UINT(*catchTop)) {
	    valuePtr = POP_OBJECT();
	    TclDecrRefCount(valuePtr);
	}
#ifdef TCL_COMPILE_DEBUG
	if (traceInstructions) {
	    fprintf(stdout, "  ... found catch at %" TCL_Z_MODIFIER "u, catchTop=%" TCL_Z_MODIFIER "u, "
		    "unwound to %" TCL_Z_MODIFIER "u, new pc %" TCL_Z_MODIFIER "u\n",
		    rangePtr->codeOffset, (size_t)(catchTop - initCatchTop - 1),
		    PTR2UINT(*catchTop), (size_t)rangePtr->catchOffset);
	}
#endif
	pc = (codePtr->codeStart + rangePtr->catchOffset);
	NEXT_INST_F(0, 0, 0);	/* Restart the execution loop at pc. */

	/*
	 * end of infinite loop dispatching on instructions.







|





|
|
|
|







7625
7626
7627
7628
7629
7630
7631
7632
7633
7634
7635
7636
7637
7638
7639
7640
7641
7642
7643
7644
7645
7646
7647
7648
	 * "exception". It was found either by checkForCatch just above or by
	 * an instruction during break, continue, or error processing. Jump to
	 * its catchOffset after unwinding the operand stack to the depth it
	 * had when starting to execute the range's catch command.
	 */

    processCatch:
	while (CURR_DEPTH > PTR2INT(*catchTop)) {
	    valuePtr = POP_OBJECT();
	    TclDecrRefCount(valuePtr);
	}
#ifdef TCL_COMPILE_DEBUG
	if (traceInstructions) {
	    fprintf(stdout, "  ... found catch at %" TCL_SIZE_MODIFIER "d, catchTop=%" TCL_T_MODIFIER "d, "
		    "unwound to %" TCL_T_MODIFIER "d, new pc %" TCL_SIZE_MODIFIER "d\n",
		    rangePtr->codeOffset, (catchTop - initCatchTop - 1),
		    PTR2INT(*catchTop), rangePtr->catchOffset);
	}
#endif
	pc = (codePtr->codeStart + rangePtr->catchOffset);
	NEXT_INST_F(0, 0, 0);	/* Restart the execution loop at pc. */

	/*
	 * end of infinite loop dispatching on instructions.
7607
7608
7609
7610
7611
7612
7613
7614
7615
7616
7617
7618
7619
7620
7621
7622
7623
	while (tosPtr > initTosPtr) {
	    objPtr = POP_OBJECT();
	    Tcl_DecrRefCount(objPtr);
	}

	if (tosPtr < initTosPtr) {
	    fprintf(stderr,
		    "\nTclNRExecuteByteCode: abnormal return at pc %" TCL_Z_MODIFIER "u: "
		    "stack top %" TCL_Z_MODIFIER "u < entry stack top %d\n",
		    (size_t)(pc - codePtr->codeStart),
		    CURR_DEPTH, 0);
	    Tcl_Panic("TclNRExecuteByteCode execution failure: end stack top < start stack top");
	}
	CLANG_ASSERT(bcFramePtr);
    }

    iPtr->cmdFramePtr = bcFramePtr->nextPtr;







|
|
|







7670
7671
7672
7673
7674
7675
7676
7677
7678
7679
7680
7681
7682
7683
7684
7685
7686
	while (tosPtr > initTosPtr) {
	    objPtr = POP_OBJECT();
	    Tcl_DecrRefCount(objPtr);
	}

	if (tosPtr < initTosPtr) {
	    fprintf(stderr,
		    "\nTclNRExecuteByteCode: abnormal return at pc %" TCL_T_MODIFIER "d: "
		    "stack top %" TCL_T_MODIFIER "d < entry stack top %d\n",
		    (pc - codePtr->codeStart),
		    CURR_DEPTH, 0);
	    Tcl_Panic("TclNRExecuteByteCode execution failure: end stack top < start stack top");
	}
	CLANG_ASSERT(bcFramePtr);
    }

    iPtr->cmdFramePtr = bcFramePtr->nextPtr;
7636
7637
7638
7639
7640
7641
7642
7643
7644
7645
7646
7647
7648
7649
7650

     * case INST_START_CMD:
     */

	instStartCmdFailed:
	{
	    const char *bytes;
	    size_t xxx1length;

	    xxx1length = 0;

	    if (TclInterpReady(interp) == TCL_ERROR) {
		goto gotError;
	    }








|







7699
7700
7701
7702
7703
7704
7705
7706
7707
7708
7709
7710
7711
7712
7713

     * case INST_START_CMD:
     */

	instStartCmdFailed:
	{
	    const char *bytes;
	    Tcl_Size xxx1length;

	    xxx1length = 0;

	    if (TclInterpReady(interp) == TCL_ERROR) {
		goto gotError;
	    }

8918
8919
8920
8921
8922
8923
8924
8925
8926
8927
8928
8929
8930
8931
8932
    if (opCode >= LAST_INST_OPCODE) {
	fprintf(stderr, "\nBad opcode %u at pc %" TCL_Z_MODIFIER "u in TclNRExecuteByteCode\n",
		opCode, relativePc);
	Tcl_Panic("TclNRExecuteByteCode execution failure: bad opcode");
    }
    if (checkStack &&
	    (stackTop > stackUpperBound)) {
	size_t numChars;
	const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars, NULL, NULL);

	fprintf(stderr, "\nBad stack top %" TCL_Z_MODIFIER "u at pc %" TCL_Z_MODIFIER "u in TclNRExecuteByteCode (min 0, max %" TCL_Z_MODIFIER "u)",
		stackTop, relativePc, stackUpperBound);
	if (cmd != NULL) {
	    Tcl_Obj *message;








|







8981
8982
8983
8984
8985
8986
8987
8988
8989
8990
8991
8992
8993
8994
8995
    if (opCode >= LAST_INST_OPCODE) {
	fprintf(stderr, "\nBad opcode %u at pc %" TCL_Z_MODIFIER "u in TclNRExecuteByteCode\n",
		opCode, relativePc);
	Tcl_Panic("TclNRExecuteByteCode execution failure: bad opcode");
    }
    if (checkStack &&
	    (stackTop > stackUpperBound)) {
	Tcl_Size numChars;
	const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars, NULL, NULL);

	fprintf(stderr, "\nBad stack top %" TCL_Z_MODIFIER "u at pc %" TCL_Z_MODIFIER "u in TclNRExecuteByteCode (min 0, max %" TCL_Z_MODIFIER "u)",
		stackTop, relativePc, stackUpperBound);
	if (cmd != NULL) {
	    Tcl_Obj *message;

9067
9068
9069
9070
9071
9072
9073
9074
9075
9076
9077
9078
9079
9080
9081
	/*
	 * We now have the command. We can get the srcOffset back and from
	 * there find the list of word locations for this command.
	 */

	ExtCmdLoc *eclPtr;
	ECL *locPtr = NULL;
	size_t srcOffset;
	int i;
	Interp *iPtr = (Interp *) *codePtr->interpHandle;
	Tcl_HashEntry *hePtr =
		Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr);

	if (!hePtr) {
	    return;







|







9130
9131
9132
9133
9134
9135
9136
9137
9138
9139
9140
9141
9142
9143
9144
	/*
	 * We now have the command. We can get the srcOffset back and from
	 * there find the list of word locations for this command.
	 */

	ExtCmdLoc *eclPtr;
	ECL *locPtr = NULL;
	Tcl_Size srcOffset;
	int i;
	Interp *iPtr = (Interp *) *codePtr->interpHandle;
	Tcl_HashEntry *hePtr =
		Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr);

	if (!hePtr) {
	    return;
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
GetSrcInfoForPc(
    const unsigned char *pc,	/* The program counter value for which to
				 * return the closest command's source info.
				 * This points within a bytecode instruction
				 * in codePtr's code. */
    ByteCode *codePtr,		/* The bytecode sequence in which to look up
				 * the command source for the pc. */
    size_t *lengthPtr,		/* If non-NULL, the location where the length
				 * of the command's source should be stored.
				 * If NULL, no length is stored. */
    const unsigned char **pcBeg,/* If non-NULL, the bytecode location
				 * where the current instruction starts.
				 * If NULL; no pointer is stored. */
    int *cmdIdxPtr)		/* If non-NULL, the location where the index
				 * of the command containing the pc should
				 * be stored. */
{
    size_t pcOffset = (size_t)(pc - codePtr->codeStart);
    size_t numCmds = codePtr->numCommands;
    unsigned char *codeDeltaNext, *codeLengthNext;
    unsigned char *srcDeltaNext, *srcLengthNext;
    size_t codeOffset, codeLen, codeEnd, srcOffset, srcLen, delta, i;
    int bestDist = INT_MAX;	/* Distance of pc to best cmd's start pc. */
    int bestSrcOffset = -1;	/* Initialized to avoid compiler warning. */
    int bestSrcLength = -1;	/* Initialized to avoid compiler warning. */
    int bestCmdIdx = -1;

    /* The pc must point within the bytecode */
    assert (pcOffset < codePtr->numCodeBytes);

    /*
     * Decode the code and source offset and length for each command. The
     * closest enclosing command is the last one whose code started before
     * pcOffset.
     */








|









|
|


|






|







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
GetSrcInfoForPc(
    const unsigned char *pc,	/* The program counter value for which to
				 * return the closest command's source info.
				 * This points within a bytecode instruction
				 * in codePtr's code. */
    ByteCode *codePtr,		/* The bytecode sequence in which to look up
				 * the command source for the pc. */
    Tcl_Size *lengthPtr,	/* If non-NULL, the location where the length
				 * of the command's source should be stored.
				 * If NULL, no length is stored. */
    const unsigned char **pcBeg,/* If non-NULL, the bytecode location
				 * where the current instruction starts.
				 * If NULL; no pointer is stored. */
    int *cmdIdxPtr)		/* If non-NULL, the location where the index
				 * of the command containing the pc should
				 * be stored. */
{
    Tcl_Size pcOffset = pc - codePtr->codeStart;
    Tcl_Size numCmds = codePtr->numCommands;
    unsigned char *codeDeltaNext, *codeLengthNext;
    unsigned char *srcDeltaNext, *srcLengthNext;
    Tcl_Size codeOffset, codeLen, codeEnd, srcOffset, srcLen, delta, i;
    int bestDist = INT_MAX;	/* Distance of pc to best cmd's start pc. */
    int bestSrcOffset = -1;	/* Initialized to avoid compiler warning. */
    int bestSrcLength = -1;	/* Initialized to avoid compiler warning. */
    int bestCmdIdx = -1;

    /* The pc must point within the bytecode */
    assert ((pcOffset >= 0) && (pcOffset < codePtr->numCodeBytes));

    /*
     * Decode the code and source offset and length for each command. The
     * closest enclosing command is the last one whose code started before
     * pcOffset.
     */

9458
9459
9460
9461
9462
9463
9464
9465


9466
9467
9468
9469
9470
9471
9472
    double totalCodeBytes, currentCodeBytes;
    double totalLiteralBytes, currentLiteralBytes;
    double objBytesIfUnshared, strBytesIfUnshared, sharingBytesSaved;
    double strBytesSharedMultX, strBytesSharedOnce;
    double numInstructions, currentHeaderBytes;
    size_t numCurrentByteCodes, numByteCodeLits;
    size_t refCountSum, literalMgmtBytes, sum, decadeHigh, length;
    size_t numSharedMultX, numSharedOnce, minSizeDecade, maxSizeDecade, i;


    char *litTableStats;
    LiteralEntry *entryPtr;
    Tcl_Obj *objPtr;

#define Percent(a,b) ((a) * 100.0 / (b))

    TclNewObj(objPtr);







|
>
>







9521
9522
9523
9524
9525
9526
9527
9528
9529
9530
9531
9532
9533
9534
9535
9536
9537
    double totalCodeBytes, currentCodeBytes;
    double totalLiteralBytes, currentLiteralBytes;
    double objBytesIfUnshared, strBytesIfUnshared, sharingBytesSaved;
    double strBytesSharedMultX, strBytesSharedOnce;
    double numInstructions, currentHeaderBytes;
    size_t numCurrentByteCodes, numByteCodeLits;
    size_t refCountSum, literalMgmtBytes, sum, decadeHigh, length;
    size_t numSharedMultX, numSharedOnce, minSizeDecade, maxSizeDecade;
    Tcl_Size i;
    size_t ui;
    char *litTableStats;
    LiteralEntry *entryPtr;
    Tcl_Obj *objPtr;

#define Percent(a,b) ((a) * 100.0 / (b))

    TclNewObj(objPtr);
9594
9595
9596
9597
9598
9599
9600
9601
9602
9603
9604
9605
9606
9607
9608
    refCountSum = 0;
    numSharedMultX = 0;
    numSharedOnce = 0;
    objBytesIfUnshared = 0.0;
    strBytesIfUnshared = 0.0;
    strBytesSharedMultX = 0.0;
    strBytesSharedOnce = 0.0;
    for (i = 0;  i < globalTablePtr->numBuckets;  i++) {
	for (entryPtr = globalTablePtr->buckets[i];  entryPtr != NULL;
		entryPtr = entryPtr->nextPtr) {
	    if (TclHasInternalRep(entryPtr->objPtr, &tclByteCodeType)) {
		numByteCodeLits++;
	    }
	    (void) Tcl_GetStringFromObj(entryPtr->objPtr, &length);
	    refCountSum += entryPtr->refCount;







|







9659
9660
9661
9662
9663
9664
9665
9666
9667
9668
9669
9670
9671
9672
9673
    refCountSum = 0;
    numSharedMultX = 0;
    numSharedOnce = 0;
    objBytesIfUnshared = 0.0;
    strBytesIfUnshared = 0.0;
    strBytesSharedMultX = 0.0;
    strBytesSharedOnce = 0.0;
    for (ui = 0;  ui < globalTablePtr->numBuckets;  ui++) {
	for (entryPtr = globalTablePtr->buckets[i];  entryPtr != NULL;
		entryPtr = entryPtr->nextPtr) {
	    if (TclHasInternalRep(entryPtr->objPtr, &tclByteCodeType)) {
		numByteCodeLits++;
	    }
	    (void) Tcl_GetStringFromObj(entryPtr->objPtr, &length);
	    refCountSum += entryPtr->refCount;
9623
9624
9625
9626
9627
9628
9629
9630
9631
9632
9633
9634
9635
9636
9637
    Tcl_AppendPrintfToObj(objPtr, "\nTotal objects (all interps)\t%" TCL_Z_MODIFIER "u\n",
	    tclObjsAlloced);
    Tcl_AppendPrintfToObj(objPtr, "Current objects\t\t\t%" TCL_Z_MODIFIER "u\n",
	    (tclObjsAlloced - tclObjsFreed));
    Tcl_AppendPrintfToObj(objPtr, "Total literal objects\t\t%" TCL_Z_MODIFIER "u\n",
	    statsPtr->numLiteralsCreated);

    Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal objects\t\t%" TCL_Z_MODIFIER "u (%0.1f%% of current objects)\n",
	    globalTablePtr->numEntries,
	    Percent(globalTablePtr->numEntries, tclObjsAlloced-tclObjsFreed));
    Tcl_AppendPrintfToObj(objPtr, "  ByteCode literals\t\t%" TCL_Z_MODIFIER "u (%0.1f%% of current literals)\n",
	    numByteCodeLits,
	    Percent(numByteCodeLits, globalTablePtr->numEntries));
    Tcl_AppendPrintfToObj(objPtr, "  Literals reused > 1x\t\t%" TCL_Z_MODIFIER "u\n",
	    numSharedMultX);







|







9688
9689
9690
9691
9692
9693
9694
9695
9696
9697
9698
9699
9700
9701
9702
    Tcl_AppendPrintfToObj(objPtr, "\nTotal objects (all interps)\t%" TCL_Z_MODIFIER "u\n",
	    tclObjsAlloced);
    Tcl_AppendPrintfToObj(objPtr, "Current objects\t\t\t%" TCL_Z_MODIFIER "u\n",
	    (tclObjsAlloced - tclObjsFreed));
    Tcl_AppendPrintfToObj(objPtr, "Total literal objects\t\t%" TCL_Z_MODIFIER "u\n",
	    statsPtr->numLiteralsCreated);

    Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal objects\t\t%" TCL_SIZE_MODIFIER "d (%0.1f%% of current objects)\n",
	    globalTablePtr->numEntries,
	    Percent(globalTablePtr->numEntries, tclObjsAlloced-tclObjsFreed));
    Tcl_AppendPrintfToObj(objPtr, "  ByteCode literals\t\t%" TCL_Z_MODIFIER "u (%0.1f%% of current literals)\n",
	    numByteCodeLits,
	    Percent(numByteCodeLits, globalTablePtr->numEntries));
    Tcl_AppendPrintfToObj(objPtr, "  Literals reused > 1x\t\t%" TCL_Z_MODIFIER "u\n",
	    numSharedMultX);
9715
9716
9717
9718
9719
9720
9721
9722
9723
9724
9725
9726
9727
9728
9729
	    break;
	}
    }
    sum = 0;
    for (i = 0;  i <= maxSizeDecade;  i++) {
	decadeHigh = (1 << (i+1)) - 1;
	sum += statsPtr->literalCount[i];
	Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_Z_MODIFIER "u\t\t%8.0f%%\n",
		decadeHigh, Percent(sum, statsPtr->numLiteralsCreated));
    }

    litTableStats = TclLiteralStats(globalTablePtr);
    Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal table statistics:\n%s\n",
	    litTableStats);
    Tcl_Free(litTableStats);







|







9780
9781
9782
9783
9784
9785
9786
9787
9788
9789
9790
9791
9792
9793
9794
	    break;
	}
    }
    sum = 0;
    for (i = 0;  i <= maxSizeDecade;  i++) {
	decadeHigh = (1 << (i+1)) - 1;
	sum += statsPtr->literalCount[i];
	Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_SIZE_MODIFIER "d\t\t%8.0f%%\n",
		decadeHigh, Percent(sum, statsPtr->numLiteralsCreated));
    }

    litTableStats = TclLiteralStats(globalTablePtr);
    Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal table statistics:\n%s\n",
	    litTableStats);
    Tcl_Free(litTableStats);
9748
9749
9750
9751
9752
9753
9754
9755
9756
9757
9758
9759
9760
9761
9762
	}
    }
    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++) {







|







9813
9814
9815
9816
9817
9818
9819
9820
9821
9822
9823
9824
9825
9826
9827
	}
    }
    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_SIZE_MODIFIER "d\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++) {
9772
9773
9774
9775
9776
9777
9778
9779
9780
9781
9782
9783
9784
9785
9786
	}
    }
    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++) {







|







9837
9838
9839
9840
9841
9842
9843
9844
9845
9846
9847
9848
9849
9850
9851
	}
    }
    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_SIZE_MODIFIER "d\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++) {

Changes to generic/tclFCmd.c.

217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Used for error reporting. */
    int objc,			/* Number of arguments */
    Tcl_Obj *const objv[])	/* Argument strings passed to Tcl_FileCmd. */
{
    Tcl_Obj *errfile = NULL;
    int result, i;
    size_t j, pobjc;
    Tcl_Obj *split = NULL;
    Tcl_Obj *target = NULL;
    Tcl_StatBuf statBuf;

    result = TCL_OK;
    for (i = 1; i < objc; i++) {
	if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) {







|







217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Used for error reporting. */
    int objc,			/* Number of arguments */
    Tcl_Obj *const objv[])	/* Argument strings passed to Tcl_FileCmd. */
{
    Tcl_Obj *errfile = NULL;
    int result, i;
    Tcl_Size j, pobjc;
    Tcl_Obj *split = NULL;
    Tcl_Obj *target = NULL;
    Tcl_StatBuf statBuf;

    result = TCL_OK;
    for (i = 1; i < objc; i++) {
	if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) {
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
	    result = TCL_ERROR;
	    break;
	}
    }
    if (result != TCL_OK) {
	if (errfile == NULL) {
	    /*
	     * We try to accomodate poor error results from our Tcl_FS calls.
	     */

	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "error deleting unknown file: %s",
		    Tcl_PosixError(interp)));
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(







|







422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
	    result = TCL_ERROR;
	    break;
	}
    }
    if (result != TCL_OK) {
	if (errfile == NULL) {
	    /*
	     * We try to accommodate poor error results from our Tcl_FS calls.
	     */

	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "error deleting unknown file: %s",
		    Tcl_PosixError(interp)));
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
 */

static Tcl_Obj *
FileBasename(
    TCL_UNUSED(Tcl_Interp *),	/* Interp, for error return. */
    Tcl_Obj *pathPtr)		/* Path whose basename to extract. */
{
    size_t objc;
    Tcl_Obj *splitPtr;
    Tcl_Obj *resultPtr = NULL;

    splitPtr = Tcl_FSSplitPath(pathPtr, &objc);
    Tcl_IncrRefCount(splitPtr);

    if (objc != 0) {







|







870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
 */

static Tcl_Obj *
FileBasename(
    TCL_UNUSED(Tcl_Interp *),	/* Interp, for error return. */
    Tcl_Obj *pathPtr)		/* Path whose basename to extract. */
{
    Tcl_Size objc;
    Tcl_Obj *splitPtr;
    Tcl_Obj *resultPtr = NULL;

    splitPtr = Tcl_FSSplitPath(pathPtr, &objc);
    Tcl_IncrRefCount(splitPtr);

    if (objc != 0) {
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
    int objc,			/* Number of command line arguments. */
    Tcl_Obj *const objv[])	/* The command line objects. */
{
    int result;
    const char *const *attributeStrings;
    const char **attributeStringsAllocated = NULL;
    Tcl_Obj *objStrings = NULL;
    size_t numObjStrings = TCL_INDEX_NONE;
    Tcl_Obj *filePtr;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name ?-option value ...?");
	return TCL_ERROR;
    }








|







943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
    int objc,			/* Number of command line arguments. */
    Tcl_Obj *const objv[])	/* The command line objects. */
{
    int result;
    const char *const *attributeStrings;
    const char **attributeStringsAllocated = NULL;
    Tcl_Obj *objStrings = NULL;
    Tcl_Size numObjStrings = TCL_INDEX_NONE;
    Tcl_Obj *filePtr;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name ?-option value ...?");
	return TCL_ERROR;
    }

967
968
969
970
971
972
973
974
975
976
977
978
979
980
981

    /*
     * Get the set of attribute names from the filesystem.
     */

    attributeStrings = Tcl_FSFileAttrStrings(filePtr, &objStrings);
    if (attributeStrings == NULL) {
	size_t index;
	Tcl_Obj *objPtr;

	if (objStrings == NULL) {
	    if (Tcl_GetErrno() != 0) {
		/*
		 * There was an error, probably that the filePtr is not
		 * accepted by any filesystem







|







967
968
969
970
971
972
973
974
975
976
977
978
979
980
981

    /*
     * Get the set of attribute names from the filesystem.
     */

    attributeStrings = Tcl_FSFileAttrStrings(filePtr, &objStrings);
    if (attributeStrings == NULL) {
	Tcl_Size index;
	Tcl_Obj *objPtr;

	if (objStrings == NULL) {
	    if (Tcl_GetErrno() != 0) {
		/*
		 * There was an error, probably that the filePtr is not
		 * accepted by any filesystem
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
	 * Create link from source to target.
	 */

	contents = Tcl_FSLink(objv[index], objv[index+1], linkAction);
	if (contents == NULL) {
	    /*
	     * We handle three common error cases specially, and for all other
	     * errors, we use the standard posix error message.
	     */

	    if (errno == EEXIST) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"could not create new link \"%s\": that path already"
			" exists", TclGetString(objv[index])));
		Tcl_PosixError(interp);







|







1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
	 * Create link from source to target.
	 */

	contents = Tcl_FSLink(objv[index], objv[index+1], linkAction);
	if (contents == NULL) {
	    /*
	     * We handle three common error cases specially, and for all other
	     * errors, we use the standard Posix error message.
	     */

	    if (errno == EEXIST) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"could not create new link \"%s\": that path already"
			" exists", TclGetString(objv[index])));
		Tcl_PosixError(interp);
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
    }

    if (objc > 1) {
	nameVarObj = objv[1];
	TclNewObj(nameObj);
    }
    if (objc > 2) {
	size_t length;
	Tcl_Obj *templateObj = objv[2];
	const char *string = Tcl_GetStringFromObj(templateObj, &length);

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








|







1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
    }

    if (objc > 1) {
	nameVarObj = objv[1];
	TclNewObj(nameObj);
    }
    if (objc > 2) {
	Tcl_Size length;
	Tcl_Obj *templateObj = objv[2];
	const char *string = Tcl_GetStringFromObj(templateObj, &length);

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

1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543

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

    if (objc > 1) {
	int length;
	Tcl_Obj *templateObj = objv[1];
	const char *string = Tcl_GetStringFromObj(templateObj, &length);
	const int onWindows = (tclPlatform == TCL_PLATFORM_WINDOWS);

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







|







1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543

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

    if (objc > 1) {
	Tcl_Size length;
	Tcl_Obj *templateObj = objv[1];
	const char *string = Tcl_GetStringFromObj(templateObj, &length);
	const int onWindows = (tclPlatform == TCL_PLATFORM_WINDOWS);

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

Changes to generic/tclFileName.c.

91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
 *
 *	Matches the root portion of a Windows path and appends it to the
 *	specified Tcl_DString.
 *
 * Results:
 *	Returns the position in the path immediately after the root including
 *	any trailing slashes. Appends a cleaned up version of the root to the
 *	Tcl_DString at the specified offest.
 *
 * Side effects:
 *	Modifies the specified Tcl_DString.
 *
 *----------------------------------------------------------------------
 */








|







91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
 *
 *	Matches the root portion of a Windows path and appends it to the
 *	specified Tcl_DString.
 *
 * Results:
 *	Returns the position in the path immediately after the root including
 *	any trailing slashes. Appends a cleaned up version of the root to the
 *	Tcl_DString at the specified offset.
 *
 * Side effects:
 *	Modifies the specified Tcl_DString.
 *
 *----------------------------------------------------------------------
 */

377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
 *
 *----------------------------------------------------------------------
 */

Tcl_PathType
TclpGetNativePathType(
    Tcl_Obj *pathPtr,		/* Native path of interest */
    size_t *driveNameLengthPtr,	/* Returns length of drive, if non-NULL and
				 * path was absolute */
    Tcl_Obj **driveNameRef)
{
    Tcl_PathType type = TCL_PATH_ABSOLUTE;
    const char *path = TclGetString(pathPtr);

    switch (tclPlatform) {
    case TCL_PLATFORM_UNIX: {







|
|







377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
 *
 *----------------------------------------------------------------------
 */

Tcl_PathType
TclpGetNativePathType(
    Tcl_Obj *pathPtr,		/* Native path of interest */
    Tcl_Size *driveNameLengthPtr, /* Returns length of drive, if non-NULL and
				   * path was absolute */
    Tcl_Obj **driveNameRef)
{
    Tcl_PathType type = TCL_PATH_ABSOLUTE;
    const char *path = TclGetString(pathPtr);

    switch (tclPlatform) {
    case TCL_PLATFORM_UNIX: {
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
        const char *rootEnd;

        Tcl_DStringInit(&ds);
        rootEnd = ExtractWinRoot(path, &ds, 0, &type);
        if ((rootEnd != path) && (driveNameLengthPtr != NULL)) {
            *driveNameLengthPtr = rootEnd - path;
            if (driveNameRef != NULL) {
                *driveNameRef = TclDStringToObj(&ds);
                Tcl_IncrRefCount(*driveNameRef);
            }
        }
        Tcl_DStringFree(&ds);
        break;
    }
    }







|







424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
        const char *rootEnd;

        Tcl_DStringInit(&ds);
        rootEnd = ExtractWinRoot(path, &ds, 0, &type);
        if ((rootEnd != path) && (driveNameLengthPtr != NULL)) {
            *driveNameLengthPtr = rootEnd - path;
            if (driveNameRef != NULL) {
                *driveNameRef = Tcl_DStringToObj(&ds);
                Tcl_IncrRefCount(*driveNameRef);
            }
        }
        Tcl_DStringFree(&ds);
        break;
    }
    }
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
TclpNativeSplitPath(
    Tcl_Obj *pathPtr,		/* Path to split. */
    size_t *lenPtr)		/* int to store number of path elements. */
{
    Tcl_Obj *resultPtr = NULL;	/* Needed only to prevent gcc warnings. */

    /*
     * Perform platform specific splitting.
     */








|







461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
TclpNativeSplitPath(
    Tcl_Obj *pathPtr,		/* Path to split. */
    Tcl_Size *lenPtr)		/* int to store number of path elements. */
{
    Tcl_Obj *resultPtr = NULL;	/* Needed only to prevent gcc warnings. */

    /*
     * Perform platform specific splitting.
     */

518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
 *----------------------------------------------------------------------
 */

#undef Tcl_SplitPath
void
Tcl_SplitPath(
    const char *path,		/* Pointer to string containing a path. */
    size_t *argcPtr,		/* Pointer to location to fill in with the
				 * number of elements in the path. */
    const char ***argvPtr)	/* Pointer to place to store pointer to array
				 * of pointers to path elements. */
{
    Tcl_Obj *resultPtr = NULL;	/* Needed only to prevent gcc warnings. */
    Tcl_Obj *tmpPtr, *eltPtr;
    size_t i, size, len;
    char *p;
    const char *str;

    /*
     * Perform the splitting, using objectified, vfs-aware code.
     */








|






|







518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
 *----------------------------------------------------------------------
 */

#undef Tcl_SplitPath
void
Tcl_SplitPath(
    const char *path,		/* Pointer to string containing a path. */
    Tcl_Size *argcPtr,		/* Pointer to location to fill in with the
				 * number of elements in the path. */
    const char ***argvPtr)	/* Pointer to place to store pointer to array
				 * of pointers to path elements. */
{
    Tcl_Obj *resultPtr = NULL;	/* Needed only to prevent gcc warnings. */
    Tcl_Obj *tmpPtr, *eltPtr;
    Tcl_Size i, size, len;
    char *p;
    const char *str;

    /*
     * Perform the splitting, using objectified, vfs-aware code.
     */

697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
    p = ExtractWinRoot(path, &buf, 0, &type);

    /*
     * Terminate the root portion, if we matched something.
     */

    if (p != path) {
	Tcl_ListObjAppendElement(NULL, result, TclDStringToObj(&buf));
    }
    Tcl_DStringFree(&buf);

    /*
     * Split on slashes.
     */








|







697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
    p = ExtractWinRoot(path, &buf, 0, &type);

    /*
     * Terminate the root portion, if we matched something.
     */

    if (p != path) {
	Tcl_ListObjAppendElement(NULL, result, Tcl_DStringToObj(&buf));
    }
    Tcl_DStringFree(&buf);

    /*
     * Split on slashes.
     */

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

Tcl_Obj *
Tcl_FSJoinToPath(
    Tcl_Obj *pathPtr,		/* Valid path or NULL. */
    size_t objc,			/* Number of array elements to join */
    Tcl_Obj *const objv[])	/* Path elements to join. */
{
    if (pathPtr == NULL) {
	return TclJoinPath(objc, objv, 0);
    }
    if (objc == 0) {
	return TclJoinPath(1, &pathPtr, 0);
    }
    if (objc == 1) {
	Tcl_Obj *pair[2];

	pair[0] = pathPtr;
	pair[1] = objv[0];
	return TclJoinPath(2, pair, 0);
    } else {
	size_t elemc = objc + 1;
	Tcl_Obj *ret, **elemv = (Tcl_Obj**)Tcl_Alloc(elemc*sizeof(Tcl_Obj *));

	elemv[0] = pathPtr;
	memcpy(elemv+1, objv, objc*sizeof(Tcl_Obj *));
	ret = TclJoinPath(elemc, elemv, 0);
	Tcl_Free(elemv);
	return ret;







|















|







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

Tcl_Obj *
Tcl_FSJoinToPath(
    Tcl_Obj *pathPtr,		/* Valid path or NULL. */
    Tcl_Size objc,		/* Number of array elements to join */
    Tcl_Obj *const objv[])	/* Path elements to join. */
{
    if (pathPtr == NULL) {
	return TclJoinPath(objc, objv, 0);
    }
    if (objc == 0) {
	return TclJoinPath(1, &pathPtr, 0);
    }
    if (objc == 1) {
	Tcl_Obj *pair[2];

	pair[0] = pathPtr;
	pair[1] = objv[0];
	return TclJoinPath(2, pair, 0);
    } else {
	Tcl_Size elemc = objc + 1;
	Tcl_Obj *ret, **elemv = (Tcl_Obj**)Tcl_Alloc(elemc*sizeof(Tcl_Obj *));

	elemv[0] = pathPtr;
	memcpy(elemv+1, objv, objc*sizeof(Tcl_Obj *));
	ret = TclJoinPath(elemc, elemv, 0);
	Tcl_Free(elemv);
	return ret;
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817

void
TclpNativeJoinPath(
    Tcl_Obj *prefix,
    const char *joining)
{
    int needsSep;
    size_t length;
    char *dest;
    const char *p;
    const char *start;

    start = Tcl_GetStringFromObj(prefix, &length);

    /*







|







803
804
805
806
807
808
809
810
811
812
813
814
815
816
817

void
TclpNativeJoinPath(
    Tcl_Obj *prefix,
    const char *joining)
{
    int needsSep;
    Tcl_Size length;
    char *dest;
    const char *p;
    const char *start;

    start = Tcl_GetStringFromObj(prefix, &length);

    /*
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
	}
	needsSep = 0;

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

	Tcl_SetObjLength(prefix, length + (int) strlen(p));

	dest = TclGetString(prefix) + length;
	for (; *p != '\0'; p++) {
	    if (*p == '/') {
		while (p[1] == '/') {
		    p++;
		}







|







844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
	}
	needsSep = 0;

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

	Tcl_SetObjLength(prefix, length + strlen(p));

	dest = TclGetString(prefix) + length;
	for (; *p != '\0'; p++) {
	    if (*p == '/') {
		while (p[1] == '/') {
		    p++;
		}
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
 *	Modifies the Tcl_DString.
 *
 *----------------------------------------------------------------------
 */

char *
Tcl_JoinPath(
    size_t argc,
    const char *const *argv,
    Tcl_DString *resultPtr)	/* Pointer to previously initialized DString */
{
    size_t i, len;
    Tcl_Obj *listObj;
    Tcl_Obj *resultObj;
    const char *resultStr;

    /*
     * Build the list of paths.
     */







|



|







923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
 *	Modifies the Tcl_DString.
 *
 *----------------------------------------------------------------------
 */

char *
Tcl_JoinPath(
    Tcl_Size argc,
    const char *const *argv,
    Tcl_DString *resultPtr)	/* Pointer to previously initialized DString */
{
    Tcl_Size i, len;
    Tcl_Obj *listObj;
    Tcl_Obj *resultObj;
    const char *resultStr;

    /*
     * Build the list of paths.
     */
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
Tcl_GlobObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int i, globFlags, join, dir, result;
    size_t length;
    char *string;
    const char *separators;
    Tcl_Obj *typePtr, *look;
    Tcl_Obj *pathOrDir = NULL;
    Tcl_DString prefix;
    static const char *const options[] = {
	"-directory", "-join", "-nocomplain", "-path", "-tails",







|







1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
Tcl_GlobObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int i, globFlags, join, dir, result;
    Tcl_Size length;
    char *string;
    const char *separators;
    Tcl_Obj *typePtr, *look;
    Tcl_Obj *pathOrDir = NULL;
    Tcl_DString prefix;
    static const char *const options[] = {
	"-directory", "-join", "-nocomplain", "-path", "-tails",
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
	break;
    case TCL_PLATFORM_WINDOWS:
	separators = "/\\:";
	break;
    }

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

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








|







1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
	break;
    case TCL_PLATFORM_WINDOWS:
	separators = "/\\:";
	break;
    }

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

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

1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
	globTypes = (Tcl_GlobTypeData *)TclStackAlloc(interp, sizeof(Tcl_GlobTypeData));
	globTypes->type = 0;
	globTypes->perm = 0;
	globTypes->macType = NULL;
	globTypes->macCreator = NULL;

	while (length-- > 0) {
	    size_t len;
	    const char *str;

	    Tcl_ListObjIndex(interp, typePtr, length, &look);
	    str = Tcl_GetStringFromObj(look, &len);
	    if (strcmp("readonly", str) == 0) {
		globTypes->perm |= TCL_GLOB_PERM_RONLY;
	    } else if (strcmp("hidden", str) == 0) {







|







1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
	globTypes = (Tcl_GlobTypeData *)TclStackAlloc(interp, sizeof(Tcl_GlobTypeData));
	globTypes->type = 0;
	globTypes->perm = 0;
	globTypes->macType = NULL;
	globTypes->macCreator = NULL;

	while (length-- > 0) {
	    Tcl_Size len;
	    const char *str;

	    Tcl_ListObjIndex(interp, typePtr, length, &look);
	    str = Tcl_GetStringFromObj(look, &len);
	    if (strcmp("readonly", str) == 0) {
		globTypes->perm |= TCL_GLOB_PERM_RONLY;
	    } else if (strcmp("hidden", str) == 0) {
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
		    goto badMacTypesArg;
		}
		globTypes->macType = look;
		Tcl_IncrRefCount(look);

	    } else {
		Tcl_Obj *item;
		size_t llen;

		if ((TclListObjLengthM(NULL, look, &llen) == TCL_OK)
			&& (llen == 3)) {
		    Tcl_ListObjIndex(interp, look, 0, &item);
		    if (!strcmp("macintosh", TclGetString(item))) {
			Tcl_ListObjIndex(interp, look, 1, &item);
			if (!strcmp("type", TclGetString(item))) {







|







1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
		    goto badMacTypesArg;
		}
		globTypes->macType = look;
		Tcl_IncrRefCount(look);

	    } else {
		Tcl_Obj *item;
		Tcl_Size llen;

		if ((TclListObjLengthM(NULL, look, &llen) == TCL_OK)
			&& (llen == 3)) {
		    Tcl_ListObjIndex(interp, look, 0, &item);
		    if (!strcmp("macintosh", TclGetString(item))) {
			Tcl_ListObjIndex(interp, look, 1, &item);
			if (!strcmp("type", TclGetString(item))) {
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
		}
		p++;
	    }
	    tail = p;
	    Tcl_IncrRefCount(pathPrefix);
	} else if (pathPrefix == NULL && (tail[0] == '/'
		|| (tail[0] == '\\' && tail[1] == '\\'))) {
	    size_t driveNameLen;
	    Tcl_Obj *driveName;
	    Tcl_Obj *temp = Tcl_NewStringObj(tail, -1);
	    Tcl_IncrRefCount(temp);

	    switch (TclGetPathType(temp, NULL, &driveNameLen, &driveName)) {
	    case TCL_PATH_VOLUME_RELATIVE: {
		/*







|







1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
		}
		p++;
	    }
	    tail = p;
	    Tcl_IncrRefCount(pathPrefix);
	} else if (pathPrefix == NULL && (tail[0] == '/'
		|| (tail[0] == '\\' && tail[1] == '\\'))) {
	    Tcl_Size driveNameLen;
	    Tcl_Obj *driveName;
	    Tcl_Obj *temp = Tcl_NewStringObj(tail, -1);
	    Tcl_IncrRefCount(temp);

	    switch (TclGetPathType(temp, NULL, &driveNameLen, &driveName)) {
	    case TCL_PATH_VOLUME_RELATIVE: {
		/*
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

    /*
     * Finally if we still haven't managed to generate a path prefix, check if
     * the path starts with a current volume.
     */

    if (pathPrefix == NULL) {
	size_t driveNameLen;
	Tcl_Obj *driveName;
	if (TclFSNonnativePathType(tail, strlen(tail), NULL,
		&driveNameLen, &driveName) == TCL_PATH_ABSOLUTE) {
	    pathPrefix = driveName;
	    tail += driveNameLen;
	}
    }

    /*
     * To process a [glob] invocation, this function may be called multiple
     * times. Each time, the previously discovered filenames are in the
     * interpreter result. We stash that away here so the result is free for
     * error messsages.
     */

    savedResultObj = Tcl_GetObjResult(interp);
    Tcl_IncrRefCount(savedResultObj);
    Tcl_ResetResult(interp);
    TclNewObj(filenamesObj);
    Tcl_IncrRefCount(filenamesObj);







|












|







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

    /*
     * Finally if we still haven't managed to generate a path prefix, check if
     * the path starts with a current volume.
     */

    if (pathPrefix == NULL) {
	Tcl_Size driveNameLen;
	Tcl_Obj *driveName;
	if (TclFSNonnativePathType(tail, strlen(tail), NULL,
		&driveNameLen, &driveName) == TCL_PATH_ABSOLUTE) {
	    pathPrefix = driveName;
	    tail += driveNameLen;
	}
    }

    /*
     * To process a [glob] invocation, this function may be called multiple
     * times. Each time, the previously discovered filenames are in the
     * interpreter result. We stash that away here so the result is free for
     * error messages.
     */

    savedResultObj = Tcl_GetObjResult(interp);
    Tcl_IncrRefCount(savedResultObj);
    Tcl_ResetResult(interp);
    TclNewObj(filenamesObj);
    Tcl_IncrRefCount(filenamesObj);
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
     * that would add a lot of complexity to the code. This way is a little
     * slower (when the -tails flag is given), but much simpler to code.
     *
     * We do it by rewriting the result list in-place.
     */

    if (globFlags & TCL_GLOBMODE_TAILS) {
	size_t objc, i;
	Tcl_Obj **objv;
	size_t prefixLen;
	const char *pre;

	/*
	 * If this length has never been set, set it here.
	 */

	if (pathPrefix == NULL) {







|

|







1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
     * that would add a lot of complexity to the code. This way is a little
     * slower (when the -tails flag is given), but much simpler to code.
     *
     * We do it by rewriting the result list in-place.
     */

    if (globFlags & TCL_GLOBMODE_TAILS) {
	Tcl_Size objc, i;
	Tcl_Obj **objv;
	Tcl_Size prefixLen;
	const char *pre;

	/*
	 * If this length has never been set, set it here.
	 */

	if (pathPrefix == NULL) {
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
		    || (pre[1] != ':')) {
		prefixLen++;
	    }
	}

	TclListObjGetElementsM(NULL, filenamesObj, &objc, &objv);
	for (i = 0; i< objc; i++) {
	    size_t len;
	    const char *oldStr = Tcl_GetStringFromObj(objv[i], &len);
	    Tcl_Obj *elem;

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







|







1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
		    || (pre[1] != ':')) {
		prefixLen++;
	    }
	}

	TclListObjGetElementsM(NULL, filenamesObj, &objc, &objv);
	for (i = 0; i< objc; i++) {
	    Tcl_Size 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, ".");
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
	*p = '\0';
	TclNewObj(subdirsPtr);
	Tcl_IncrRefCount(subdirsPtr);
	result = Tcl_FSMatchInDirectory(interp, subdirsPtr, pathPtr,
		pattern, &dirOnly);
	*p = save;
	if (result == TCL_OK) {
	    size_t i, subdirc, repair = TCL_INDEX_NONE;
	    Tcl_Obj **subdirv;

	    result = TclListObjGetElementsM(interp, subdirsPtr,
		    &subdirc, &subdirv);
	    for (i=0; result==TCL_OK && i<subdirc; i++) {
		Tcl_Obj *copy = NULL;

		result = DoGlob(interp, matchesObj, separators, subdirv[i],
			1, p+1, types);
		if (copy) {
		    size_t end;

		    Tcl_DecrRefCount(subdirv[i]);
		    subdirv[i] = copy;
		    TclListObjLengthM(NULL, matchesObj, &end);
		    while (repair + 1 <= end) {
			const char *bytes;
			size_t numBytes;
			Tcl_Obj *fixme, *newObj;

			Tcl_ListObjIndex(NULL, matchesObj, repair, &fixme);
			bytes = Tcl_GetStringFromObj(fixme, &numBytes);
			newObj = Tcl_NewStringObj(bytes+2, numBytes-2);
			Tcl_ListObjReplace(NULL, matchesObj, repair, 1,
				1, &newObj);







|










|




|

|







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
	*p = '\0';
	TclNewObj(subdirsPtr);
	Tcl_IncrRefCount(subdirsPtr);
	result = Tcl_FSMatchInDirectory(interp, subdirsPtr, pathPtr,
		pattern, &dirOnly);
	*p = save;
	if (result == TCL_OK) {
	    Tcl_Size i, subdirc, repair = -1;
	    Tcl_Obj **subdirv;

	    result = TclListObjGetElementsM(interp, subdirsPtr,
		    &subdirc, &subdirv);
	    for (i=0; result==TCL_OK && i<subdirc; i++) {
		Tcl_Obj *copy = NULL;

		result = DoGlob(interp, matchesObj, separators, subdirv[i],
			1, p+1, types);
		if (copy) {
		    Tcl_Size end;

		    Tcl_DecrRefCount(subdirv[i]);
		    subdirv[i] = copy;
		    TclListObjLengthM(NULL, matchesObj, &end);
		    while (repair < end) {
			const char *bytes;
			Tcl_Size numBytes;
			Tcl_Obj *fixme, *newObj;

			Tcl_ListObjIndex(NULL, matchesObj, repair, &fixme);
			bytes = Tcl_GetStringFromObj(fixme, &numBytes);
			newObj = Tcl_NewStringObj(bytes+2, numBytes-2);
			Tcl_ListObjReplace(NULL, matchesObj, repair, 1,
				1, &newObj);
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
    }

    /*
     * We reach here with no pattern char in current section
     */

    if (*p == '\0') {
	size_t length;
	Tcl_DString append;

	/*
	 * This is the code path reached by a command like 'glob foo'.
	 *
	 * There are no more wildcards in the pattern and no more unprocessed
	 * characters in the pattern, so now we can construct the path, and







|







2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
    }

    /*
     * We reach here with no pattern char in current section
     */

    if (*p == '\0') {
	Tcl_Size length;
	Tcl_DString append;

	/*
	 * This is the code path reached by a command like 'glob foo'.
	 *
	 * There are no more wildcards in the pattern and no more unprocessed
	 * characters in the pattern, so now we can construct the path, and
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
	}

	/*
	 * Common for all platforms.
	 */

	if (pathPtr == NULL) {
	    joinedPtr = TclDStringToObj(&append);
	} else if (flags) {
	    joinedPtr = TclNewFSPathObj(pathPtr, Tcl_DStringValue(&append),
		    Tcl_DStringLength(&append));
	} else {
	    joinedPtr = Tcl_DuplicateObj(pathPtr);
	    if (strchr(separators, Tcl_DStringValue(&append)[0]) == NULL) {
		/*
		 * The current prefix must end in a separator.
		 */

		size_t len;
		const char *joined = Tcl_GetStringFromObj(joinedPtr,&len);

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







|










|







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
	}

	/*
	 * Common for all platforms.
	 */

	if (pathPtr == NULL) {
	    joinedPtr = Tcl_DStringToObj(&append);
	} else if (flags) {
	    joinedPtr = TclNewFSPathObj(pathPtr, Tcl_DStringValue(&append),
		    Tcl_DStringLength(&append));
	} else {
	    joinedPtr = Tcl_DuplicateObj(pathPtr);
	    if (strchr(separators, Tcl_DStringValue(&append)[0]) == NULL) {
		/*
		 * The current prefix must end in a separator.
		 */

		Tcl_Size 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),
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
	     * The current prefix must end in a separator, unless this is a
	     * volume-relative path. In particular globbing in Windows shares,
	     * when not using -dir or -path, e.g. 'glob [file join
	     * //machine/share/subdir *]' requires adding a separator here.
	     * This behaviour is not currently tested for in the test suite.
	     */

	    size_t len;
	    const char *joined = Tcl_GetStringFromObj(joinedPtr,&len);

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







|







2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
	     * The current prefix must end in a separator, unless this is a
	     * 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.
	     */

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

Changes to generic/tclFileSystem.h.

44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
/*
 * Private shared functions for use by tclIOUtil.c, tclPathObj.c and
 * tclFileName.c, and any platform-specific filesystem code.
 */

MODULE_SCOPE Tcl_PathType TclFSGetPathType(Tcl_Obj *pathPtr,
			    const Tcl_Filesystem **filesystemPtrPtr,
			    size_t *driveNameLengthPtr);
MODULE_SCOPE Tcl_PathType TclFSNonnativePathType(const char *pathPtr,
			    size_t pathLen, const Tcl_Filesystem **filesystemPtrPtr,
			    size_t *driveNameLengthPtr, Tcl_Obj **driveNameRef);
MODULE_SCOPE Tcl_PathType TclGetPathType(Tcl_Obj *pathPtr,
			    const Tcl_Filesystem **filesystemPtrPtr,
			    size_t *driveNameLengthPtr, Tcl_Obj **driveNameRef);
MODULE_SCOPE int	TclFSEpochOk(size_t filesystemEpoch);
MODULE_SCOPE int	TclFSCwdIsNative(void);
MODULE_SCOPE Tcl_Obj *	TclWinVolumeRelativeNormalize(Tcl_Interp *interp,
			    const char *path, Tcl_Obj **useThisCwdPtr);

MODULE_SCOPE Tcl_FSPathInFilesystemProc TclNativePathInFilesystem;
MODULE_SCOPE Tcl_FSCreateInternalRepProc TclNativeCreateNativeRep;







|

|
|


|







44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
/*
 * Private shared functions for use by tclIOUtil.c, tclPathObj.c and
 * tclFileName.c, and any platform-specific filesystem code.
 */

MODULE_SCOPE Tcl_PathType TclFSGetPathType(Tcl_Obj *pathPtr,
			    const Tcl_Filesystem **filesystemPtrPtr,
			    Tcl_Size *driveNameLengthPtr);
MODULE_SCOPE Tcl_PathType TclFSNonnativePathType(const char *pathPtr,
			    Tcl_Size pathLen, const Tcl_Filesystem **filesystemPtrPtr,
			    Tcl_Size *driveNameLengthPtr, Tcl_Obj **driveNameRef);
MODULE_SCOPE Tcl_PathType TclGetPathType(Tcl_Obj *pathPtr,
			    const Tcl_Filesystem **filesystemPtrPtr,
			    Tcl_Size *driveNameLengthPtr, Tcl_Obj **driveNameRef);
MODULE_SCOPE int	TclFSEpochOk(size_t filesystemEpoch);
MODULE_SCOPE int	TclFSCwdIsNative(void);
MODULE_SCOPE Tcl_Obj *	TclWinVolumeRelativeNormalize(Tcl_Interp *interp,
			    const char *path, Tcl_Obj **useThisCwdPtr);

MODULE_SCOPE Tcl_FSPathInFilesystemProc TclNativePathInFilesystem;
MODULE_SCOPE Tcl_FSCreateInternalRepProc TclNativeCreateNativeRep;

Changes to generic/tclHash.c.

434
435
436
437
438
439
440
441
442
443
444
445
446
447
448

void
Tcl_DeleteHashTable(
    Tcl_HashTable *tablePtr)	/* Table to delete. */
{
    Tcl_HashEntry *hPtr, *nextPtr;
    const Tcl_HashKeyType *typePtr;
    size_t i;

    if (tablePtr->keyType == TCL_STRING_KEYS) {
	typePtr = &tclStringHashKeyType;
    } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
	typePtr = &tclOneWordHashKeyType;
    } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
	    || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {







|







434
435
436
437
438
439
440
441
442
443
444
445
446
447
448

void
Tcl_DeleteHashTable(
    Tcl_HashTable *tablePtr)	/* Table to delete. */
{
    Tcl_HashEntry *hPtr, *nextPtr;
    const Tcl_HashKeyType *typePtr;
    Tcl_Size i;

    if (tablePtr->keyType == TCL_STRING_KEYS) {
	typePtr = &tclStringHashKeyType;
    } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
	typePtr = &tclOneWordHashKeyType;
    } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
	    || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
 */

char *
Tcl_HashStats(
    Tcl_HashTable *tablePtr)	/* Table for which to produce stats. */
{
#define NUM_COUNTERS 10
    size_t i;
    TCL_HASH_TYPE count[NUM_COUNTERS], overflow, j;
    double average, tmp;
    Tcl_HashEntry *hPtr;
    char *result, *p;

    /*
     * Compute a histogram of bucket usage.







|







583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
 */

char *
Tcl_HashStats(
    Tcl_HashTable *tablePtr)	/* Table for which to produce stats. */
{
#define NUM_COUNTERS 10
    Tcl_Size i;
    TCL_HASH_TYPE count[NUM_COUNTERS], overflow, j;
    double average, tmp;
    Tcl_HashEntry *hPtr;
    char *result, *p;

    /*
     * Compute a histogram of bucket usage.
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
    }

    /*
     * Print out the histogram and a few other pieces of information.
     */

    result = (char *)Tcl_Alloc((NUM_COUNTERS * 60) + 300);
    sprintf(result, "%" TCL_Z_MODIFIER "u entries in table, %" TCL_Z_MODIFIER "u buckets\n",
	    tablePtr->numEntries, tablePtr->numBuckets);
    p = result + strlen(result);
    for (i = 0; i < NUM_COUNTERS; i++) {
	sprintf(p, "number of buckets with %" TCL_Z_MODIFIER "u entries: %" TCL_Z_MODIFIER "u\n",
		i, count[i]);
	p += strlen(p);
    }
    sprintf(p, "number of buckets with %d or more entries: %" TCL_Z_MODIFIER "u\n",
	    NUM_COUNTERS, overflow);
    p += strlen(p);
    sprintf(p, "average search distance for entry: %.1f", average);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * AllocArrayEntry --







|



|



|


|







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
    }

    /*
     * Print out the histogram and a few other pieces of information.
     */

    result = (char *)Tcl_Alloc((NUM_COUNTERS * 60) + 300);
    snprintf(result, 60, "%" TCL_Z_MODIFIER "u entries in table, %" TCL_Z_MODIFIER "u buckets\n",
	    tablePtr->numEntries, tablePtr->numBuckets);
    p = result + strlen(result);
    for (i = 0; i < NUM_COUNTERS; i++) {
	snprintf(p, 60, "number of buckets with %" TCL_Z_MODIFIER "u entries: %" TCL_Z_MODIFIER "u\n",
		i, count[i]);
	p += strlen(p);
    }
    snprintf(p, 60, "number of buckets with %d or more entries: %" TCL_Z_MODIFIER "u\n",
	    NUM_COUNTERS, overflow);
    p += strlen(p);
    snprintf(p, 60, "average search distance for entry: %.1f", average);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * AllocArrayEntry --

Changes to generic/tclIO.c.

98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
    struct Channel *writePtr;	/* Pointer to output channel. */
    int readFlags;		/* Original read channel flags. */
    int writeFlags;		/* Original write channel flags. */
    Tcl_WideInt toRead;		/* Number of bytes to copy, or -1. */
    Tcl_WideInt total;		/* Total bytes transferred (written). */
    Tcl_Interp *interp;		/* Interp that started the copy. */
    Tcl_Obj *cmdPtr;		/* Command to be invoked at completion. */
    size_t bufSize;		/* Size of appended buffer. */
    char buffer[TCLFLEXARRAY];		/* Copy buffer, this must be the last
                                 * field. */
} CopyState;

/*
 * All static variables used in this file are collected into a single instance
 * of the following structure. For multi-threaded implementations, there is







|







98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
    struct Channel *writePtr;	/* Pointer to output channel. */
    int readFlags;		/* Original read channel flags. */
    int writeFlags;		/* Original write channel flags. */
    Tcl_WideInt toRead;		/* Number of bytes to copy, or -1. */
    Tcl_WideInt total;		/* Total bytes transferred (written). */
    Tcl_Interp *interp;		/* Interp that started the copy. */
    Tcl_Obj *cmdPtr;		/* Command to be invoked at completion. */
    Tcl_Size bufSize;		/* Size of appended buffer. */
    char buffer[TCLFLEXARRAY];		/* Copy buffer, this must be the last
                                 * field. */
} CopyState;

/*
 * All static variables used in this file are collected into a single instance
 * of the following structure. For multi-threaded implementations, there is
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
    struct CloseCallback *nextPtr;	/* For chaining close callbacks. */
} CloseCallback;

/*
 * Static functions in this file:
 */

static ChannelBuffer *	AllocChannelBuffer(size_t length);
static void		PreserveChannelBuffer(ChannelBuffer *bufPtr);
static void		ReleaseChannelBuffer(ChannelBuffer *bufPtr);
static int		IsShared(ChannelBuffer *bufPtr);
static void		ChannelFree(Channel *chanPtr);
static void		ChannelTimerProc(void *clientData);
static int		ChanRead(Channel *chanPtr, char *dst, int dstSize);
static int		CheckChannelErrors(ChannelState *statePtr,
			    int direction);
static int		CheckForDeadChannel(Tcl_Interp *interp,
			    ChannelState *statePtr);
static void		CheckForStdChannelsBeingClosed(Tcl_Channel chan);
static void		CleanupChannelHandlers(Tcl_Interp *interp,
			    Channel *chanPtr);

static int		CloseChannel(Tcl_Interp *interp, Channel *chanPtr,
			    int errorCode);
static int		CloseChannelPart(Tcl_Interp *interp, Channel *chanPtr,
			    int errorCode, int flags);
static int		CloseWrite(Tcl_Interp *interp, Channel *chanPtr);
static void		CommonGetsCleanup(Channel *chanPtr);
static int		CopyData(CopyState *csPtr, int mask);



static int		MoveBytes(CopyState *csPtr);

static void		MBCallback(CopyState *csPtr, Tcl_Obj *errObj);
static void		MBError(CopyState *csPtr, int mask, int errorCode);
static int		MBRead(CopyState *csPtr);
static int		MBWrite(CopyState *csPtr);
static void		MBEvent(void *clientData, int mask);

static void		CopyEventProc(void *clientData, int mask);
static void		CreateScriptRecord(Tcl_Interp *interp,
			    Channel *chanPtr, int mask, Tcl_Obj *scriptPtr);
static void		DeleteChannelTable(void *clientData,
			    Tcl_Interp *interp);
static void		DeleteScriptRecord(Tcl_Interp *interp,
			    Channel *chanPtr, int mask);
static int		DetachChannel(Tcl_Interp *interp, Tcl_Channel chan);
static void		DiscardInputQueued(ChannelState *statePtr,
			    int discardSavedBuffers);
static void		DiscardOutputQueued(ChannelState *chanPtr);
static int		DoRead(Channel *chanPtr, char *dst, size_t bytesToRead,
			    int allowShortReads);
static int		DoReadChars(Channel *chan, Tcl_Obj *objPtr, size_t toRead,
			    int appendFlag);
static int		FilterInputBytes(Channel *chanPtr,
			    GetsState *statePtr);
static int		FlushChannel(Tcl_Interp *interp, Channel *chanPtr,
			    int calledFromAsyncFlush);
static int		TclGetsObjBinary(Tcl_Channel chan, Tcl_Obj *objPtr);
static Tcl_Encoding	GetBinaryEncoding(void);
static Tcl_ExitProc	FreeBinaryEncoding;
static Tcl_HashTable *	GetChannelTable(Tcl_Interp *interp);
static int		GetInput(Channel *chanPtr);
static void		PeekAhead(Channel *chanPtr, char **dstEndPtr,
			    GetsState *gsPtr);
static int		ReadBytes(ChannelState *statePtr, Tcl_Obj *objPtr,
			    int charsLeft);
static int		ReadChars(ChannelState *statePtr, Tcl_Obj *objPtr,
			    int charsLeft, int *factorPtr);
static void		RecycleBuffer(ChannelState *statePtr,
			    ChannelBuffer *bufPtr, int mustDiscard);
static int		StackSetBlockMode(Channel *chanPtr, int mode);
static int		SetBlockMode(Tcl_Interp *interp, Channel *chanPtr,
			    int mode);
static void		StopCopy(CopyState *csPtr);
static void		TranslateInputEOL(ChannelState *statePtr, char *dst,
			    const char *src, int *dstLenPtr, int *srcLenPtr);
static void		UpdateInterest(Channel *chanPtr);
static int		Write(Channel *chanPtr, const char *src,
			    int srcLen, Tcl_Encoding encoding);
static Tcl_Obj *	FixLevelCode(Tcl_Obj *msg);
static void		SpliceChannel(Tcl_Channel chan);
static void		CutChannel(Tcl_Channel chan);
static int              WillRead(Channel *chanPtr);

#define WriteChars(chanPtr, src, srcLen) \
			Write(chanPtr, src, srcLen, chanPtr->state->encoding)
#define WriteBytes(chanPtr, src, srcLen) \
			Write(chanPtr, src, srcLen, tclIdentityEncoding)

/*
 * Simplifying helper macros. All may use their argument(s) multiple times.
 * The ANSI C "prototypes" for the macros are listed below, together with a
 * short description of what the macro does.
 *
 * --------------------------------------------------------------------------
 * size_t BytesLeft(ChannelBuffer *bufPtr)
 *
 *	Returns the number of bytes of data remaining in the buffer.
 *
 * int SpaceLeft(ChannelBuffer *bufPtr)
 *
 *	Returns the number of bytes of space remaining at the end of the
 *	buffer.







|













>







>
>
>



















|

|
|






|

















|
|
















|







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
    struct CloseCallback *nextPtr;	/* For chaining close callbacks. */
} CloseCallback;

/*
 * Static functions in this file:
 */

static ChannelBuffer *	AllocChannelBuffer(Tcl_Size length);
static void		PreserveChannelBuffer(ChannelBuffer *bufPtr);
static void		ReleaseChannelBuffer(ChannelBuffer *bufPtr);
static int		IsShared(ChannelBuffer *bufPtr);
static void		ChannelFree(Channel *chanPtr);
static void		ChannelTimerProc(void *clientData);
static int		ChanRead(Channel *chanPtr, char *dst, int dstSize);
static int		CheckChannelErrors(ChannelState *statePtr,
			    int direction);
static int		CheckForDeadChannel(Tcl_Interp *interp,
			    ChannelState *statePtr);
static void		CheckForStdChannelsBeingClosed(Tcl_Channel chan);
static void		CleanupChannelHandlers(Tcl_Interp *interp,
			    Channel *chanPtr);
static void		CleanupTimerHandler(ChannelState *statePtr);
static int		CloseChannel(Tcl_Interp *interp, Channel *chanPtr,
			    int errorCode);
static int		CloseChannelPart(Tcl_Interp *interp, Channel *chanPtr,
			    int errorCode, int flags);
static int		CloseWrite(Tcl_Interp *interp, Channel *chanPtr);
static void		CommonGetsCleanup(Channel *chanPtr);
static int		CopyData(CopyState *csPtr, int mask);
static void		DeleteTimerHandler(ChannelState *statePtr);
int				Lossless(ChannelState *inStatePtr,
			    ChannelState *outStatePtr, long long toRead);
static int		MoveBytes(CopyState *csPtr);

static void		MBCallback(CopyState *csPtr, Tcl_Obj *errObj);
static void		MBError(CopyState *csPtr, int mask, int errorCode);
static int		MBRead(CopyState *csPtr);
static int		MBWrite(CopyState *csPtr);
static void		MBEvent(void *clientData, int mask);

static void		CopyEventProc(void *clientData, int mask);
static void		CreateScriptRecord(Tcl_Interp *interp,
			    Channel *chanPtr, int mask, Tcl_Obj *scriptPtr);
static void		DeleteChannelTable(void *clientData,
			    Tcl_Interp *interp);
static void		DeleteScriptRecord(Tcl_Interp *interp,
			    Channel *chanPtr, int mask);
static int		DetachChannel(Tcl_Interp *interp, Tcl_Channel chan);
static void		DiscardInputQueued(ChannelState *statePtr,
			    int discardSavedBuffers);
static void		DiscardOutputQueued(ChannelState *chanPtr);
static Tcl_Size		DoRead(Channel *chanPtr, char *dst, Tcl_Size bytesToRead,
			    int allowShortReads);
static Tcl_Size		DoReadChars(Channel *chan, Tcl_Obj *objPtr, Tcl_Size toRead,
			    int allowShortReads, int appendFlag);
static int		FilterInputBytes(Channel *chanPtr,
			    GetsState *statePtr);
static int		FlushChannel(Tcl_Interp *interp, Channel *chanPtr,
			    int calledFromAsyncFlush);
static int		TclGetsObjBinary(Tcl_Channel chan, Tcl_Obj *objPtr);
static Tcl_Encoding	GetBinaryEncoding(void);
static void		FreeBinaryEncoding(void);
static Tcl_HashTable *	GetChannelTable(Tcl_Interp *interp);
static int		GetInput(Channel *chanPtr);
static void		PeekAhead(Channel *chanPtr, char **dstEndPtr,
			    GetsState *gsPtr);
static int		ReadBytes(ChannelState *statePtr, Tcl_Obj *objPtr,
			    int charsLeft);
static int		ReadChars(ChannelState *statePtr, Tcl_Obj *objPtr,
			    int charsLeft, int *factorPtr);
static void		RecycleBuffer(ChannelState *statePtr,
			    ChannelBuffer *bufPtr, int mustDiscard);
static int		StackSetBlockMode(Channel *chanPtr, int mode);
static int		SetBlockMode(Tcl_Interp *interp, Channel *chanPtr,
			    int mode);
static void		StopCopy(CopyState *csPtr);
static void		TranslateInputEOL(ChannelState *statePtr, char *dst,
			    const char *src, int *dstLenPtr, int *srcLenPtr);
static void		UpdateInterest(Channel *chanPtr);
static Tcl_Size		Write(Channel *chanPtr, const char *src,
			    Tcl_Size srcLen, Tcl_Encoding encoding);
static Tcl_Obj *	FixLevelCode(Tcl_Obj *msg);
static void		SpliceChannel(Tcl_Channel chan);
static void		CutChannel(Tcl_Channel chan);
static int              WillRead(Channel *chanPtr);

#define WriteChars(chanPtr, src, srcLen) \
			Write(chanPtr, src, srcLen, chanPtr->state->encoding)
#define WriteBytes(chanPtr, src, srcLen) \
			Write(chanPtr, src, srcLen, tclIdentityEncoding)

/*
 * Simplifying helper macros. All may use their argument(s) multiple times.
 * The ANSI C "prototypes" for the macros are listed below, together with a
 * short description of what the macro does.
 *
 * --------------------------------------------------------------------------
 * Tcl_Size BytesLeft(ChannelBuffer *bufPtr)
 *
 *	Returns the number of bytes of data remaining in the buffer.
 *
 * int SpaceLeft(ChannelBuffer *bufPtr)
 *
 *	Returns the number of bytes of space remaining at the end of the
 *	buffer.
328
329
330
331
332
333
334
335

336
337



338
339
340
341
342
343
344
static void		FreeChannelInternalRep(Tcl_Obj *objPtr);

static const Tcl_ObjType chanObjType = {
    "channel",			/* name for this type */
    FreeChannelInternalRep,		/* freeIntRepProc */
    DupChannelInternalRep,		/* dupIntRepProc */
    NULL,			/* updateStringProc */
    NULL			/* setFromAnyProc */

};




#define ChanSetInternalRep(objPtr, resPtr)					\
    do {								\
	Tcl_ObjInternalRep ir;						\
	(resPtr)->refCount++;						\
	ir.twoPtrValue.ptr1 = (resPtr);					\
	ir.twoPtrValue.ptr2 = NULL;					\
	Tcl_StoreInternalRep((objPtr), &chanObjType, &ir);			\







|
>


>
>
>







332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
static void		FreeChannelInternalRep(Tcl_Obj *objPtr);

static const Tcl_ObjType chanObjType = {
    "channel",			/* name for this type */
    FreeChannelInternalRep,		/* freeIntRepProc */
    DupChannelInternalRep,		/* dupIntRepProc */
    NULL,			/* updateStringProc */
    NULL,			/* setFromAnyProc */
    TCL_OBJTYPE_V0
};

#define GetIso88591() \
    (binaryEncoding ? Tcl_GetEncoding(NULL, "iso8859-1") : binaryEncoding)

#define ChanSetInternalRep(objPtr, resPtr)					\
    do {								\
	Tcl_ObjInternalRep ir;						\
	(resPtr)->refCount++;						\
	ir.twoPtrValue.ptr1 = (resPtr);					\
	ir.twoPtrValue.ptr2 = NULL;					\
	Tcl_StoreInternalRep((objPtr), &chanObjType, &ir);			\
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
 * Results:
 *	The return value of the driver inputProc,
 *	  - number of bytes stored at dst, ot
 *	  - -1 on error, with a Posix error code available to the caller by
 *	    calling Tcl_GetErrno().
 *
 * Side effects:
 *	The CHANNEL_BLOCKED and CHANNEL_EOF flags of the channel state are set
 *	as appropriate.  On EOF, the inputEncodingFlags are set to perform
 *	ending operations on decoding.
 *
 *	TODO - Is this really the right place for that?
 *
 *---------------------------------------------------------------------------
 */
static int
ChanRead(







|
|
|







396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
 * Results:
 *	The return value of the driver inputProc,
 *	  - number of bytes stored at dst, ot
 *	  - -1 on error, with a Posix error code available to the caller by
 *	    calling Tcl_GetErrno().
 *
 * Side effects:
 *	The CHANNEL_ENCODING_ERROR, CHANNEL_BLOCKED and CHANNEL_EOF flags
 *	of the channel state are set as appropriate.  On EOF, the
 *	inputEncodingFlags are set to perform ending operations on decoding.
 *
 *	TODO - Is this really the right place for that?
 *
 *---------------------------------------------------------------------------
 */
static int
ChanRead(
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
    /*
     * Note that we prefer the wideSeekProc if that field is available in the
     * type and non-NULL.
     */

    if (Tcl_ChannelWideSeekProc(chanPtr->typePtr) == NULL) {
	*errnoPtr = EINVAL;
	return -1;
    }

	return Tcl_ChannelWideSeekProc(chanPtr->typePtr)(chanPtr->instanceData,
		offset, mode, errnoPtr);
}

static inline void







|







483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
    /*
     * Note that we prefer the wideSeekProc if that field is available in the
     * type and non-NULL.
     */

    if (Tcl_ChannelWideSeekProc(chanPtr->typePtr) == NULL) {
	*errnoPtr = EINVAL;
	return TCL_INDEX_NONE;
    }

	return Tcl_ChannelWideSeekProc(chanPtr->typePtr)(chanPtr->instanceData,
		offset, mode, errnoPtr);
}

static inline void
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
		 * Decrement the refcount which was earlier artificially
		 * bumped up to keep the channel from being closed.
		 */

		statePtr->refCount--;
	    }

	    if (statePtr->refCount + 1 <= 1) {
		/*
		 * Close it only if the refcount indicates that the channel is
		 * not referenced from any interpreter. If it is, that
		 * interpreter will close the channel when it gets destroyed.
		 */

		(void) Tcl_CloseEx(NULL, (Tcl_Channel) chanPtr, 0);







|







655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
		 * Decrement the refcount which was earlier artificially
		 * bumped up to keep the channel from being closed.
		 */

		statePtr->refCount--;
	    }

	    if (statePtr->refCount <= 0) {
		/*
		 * Close it only if the refcount indicates that the channel is
		 * not referenced from any interpreter. If it is, that
		 * interpreter will close the channel when it gets destroyed.
		 */

		(void) Tcl_CloseEx(NULL, (Tcl_Channel) chanPtr, 0);
683
684
685
686
687
688
689

690
691
692
693
694
695
696
		chanPtr->instanceData = NULL;
		SetFlag(statePtr, CHANNEL_DEAD);
	    }
	    TclChannelRelease((Tcl_Channel)chanPtr);
	}
    }


    TclpFinalizeSockets();
    TclpFinalizePipes();
}

/*
 *----------------------------------------------------------------------
 *







>







691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
		chanPtr->instanceData = NULL;
		SetFlag(statePtr, CHANNEL_DEAD);
	    }
	    TclChannelRelease((Tcl_Channel)chanPtr);
	}
    }

    FreeBinaryEncoding();
    TclpFinalizeSockets();
    TclpFinalizePipes();
}

/*
 *----------------------------------------------------------------------
 *
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
 *	an interpreter is deleted, via the AssocData cleanup mechanism.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Deletes the hash table of channels. May close channels. May flush
 *	output on closed channels. Removes any channeEvent handlers that were
 *	registered in this interpreter.
 *
 *----------------------------------------------------------------------
 */

static void
DeleteChannelTable(







|







966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
 *	an interpreter is deleted, via the AssocData cleanup mechanism.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Deletes the hash table of channels. May close channels. May flush
 *	output on closed channels. Removes any channelEvent handlers that were
 *	registered in this interpreter.
 *
 *----------------------------------------------------------------------
 */

static void
DeleteChannelTable(
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
    hTblPtr = (Tcl_HashTable *)clientData;
    for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch); hPtr != NULL;
	    hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch)) {
	chanPtr = (Channel *)Tcl_GetHashValue(hPtr);
	statePtr = chanPtr->state;

	/*
	 * Remove any fileevents registered in this interpreter.
	 */

	for (sPtr = statePtr->scriptRecordPtr, prevPtr = NULL;
		sPtr != NULL; sPtr = nextPtr) {
	    nextPtr = sPtr->nextPtr;
	    if (sPtr->interp == interp) {
		if (prevPtr == NULL) {







|







999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
    hTblPtr = (Tcl_HashTable *)clientData;
    for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch); hPtr != NULL;
	    hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch)) {
	chanPtr = (Channel *)Tcl_GetHashValue(hPtr);
	statePtr = chanPtr->state;

	/*
	 * Remove any file events registered in this interpreter.
	 */

	for (sPtr = statePtr->scriptRecordPtr, prevPtr = NULL;
		sPtr != NULL; sPtr = nextPtr) {
	    nextPtr = sPtr->nextPtr;
	    if (sPtr->interp == interp) {
		if (prevPtr == NULL) {
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
{
    ChannelState *statePtr = ((Channel *) chan)->state;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (tsdPtr->stdinInitialized == 1
	    && tsdPtr->stdinChannel != NULL
	    && statePtr == ((Channel *)tsdPtr->stdinChannel)->state) {
	if (statePtr->refCount + 1 < 3) {
	    statePtr->refCount = 0;
	    tsdPtr->stdinChannel = NULL;
	    return;
	}
    } else if (tsdPtr->stdoutInitialized == 1
	    && tsdPtr->stdoutChannel != NULL
	    && statePtr == ((Channel *)tsdPtr->stdoutChannel)->state) {
	if (statePtr->refCount + 1 < 3) {
	    statePtr->refCount = 0;
	    tsdPtr->stdoutChannel = NULL;
	    return;
	}
    } else if (tsdPtr->stderrInitialized == 1
	    && tsdPtr->stderrChannel != NULL
	    && statePtr == ((Channel *)tsdPtr->stderrChannel)->state) {
	if (statePtr->refCount + 1 < 3) {
	    statePtr->refCount = 0;
	    tsdPtr->stderrChannel = NULL;
	    return;
	}
    }
}








|







|







|







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
{
    ChannelState *statePtr = ((Channel *) chan)->state;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (tsdPtr->stdinInitialized == 1
	    && tsdPtr->stdinChannel != NULL
	    && statePtr == ((Channel *)tsdPtr->stdinChannel)->state) {
	if (statePtr->refCount < 2) {
	    statePtr->refCount = 0;
	    tsdPtr->stdinChannel = NULL;
	    return;
	}
    } else if (tsdPtr->stdoutInitialized == 1
	    && tsdPtr->stdoutChannel != NULL
	    && statePtr == ((Channel *)tsdPtr->stdoutChannel)->state) {
	if (statePtr->refCount < 2) {
	    statePtr->refCount = 0;
	    tsdPtr->stdoutChannel = NULL;
	    return;
	}
    } else if (tsdPtr->stderrInitialized == 1
	    && tsdPtr->stderrChannel != NULL
	    && statePtr == ((Channel *)tsdPtr->stderrChannel)->state) {
	if (statePtr->refCount < 2) {
	    statePtr->refCount = 0;
	    tsdPtr->stderrChannel = NULL;
	    return;
	}
    }
}

1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257

    CheckForStdChannelsBeingClosed(chan);

    /*
     * If the refCount reached zero, close the actual channel.
     */

    if (statePtr->refCount + 1 <= 1) {
	Tcl_Preserve(statePtr);
	if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
	    /*
	     * We don't want to re-enter Tcl_CloseEx().
	     */

	    if (!GotFlag(statePtr, CHANNEL_CLOSED)) {







|







1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266

    CheckForStdChannelsBeingClosed(chan);

    /*
     * If the refCount reached zero, close the actual channel.
     */

    if (statePtr->refCount <= 0) {
	Tcl_Preserve(statePtr);
	if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
	    /*
	     * We don't want to re-enter Tcl_CloseEx().
	     */

	    if (!GotFlag(statePtr, CHANNEL_CLOSED)) {
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423

Tcl_Channel
Tcl_GetChannel(
    Tcl_Interp *interp,		/* Interpreter in which to find or create the
				 * channel. */
    const char *chanName,	/* The name of the channel. */
    int *modePtr)		/* Where to store the mode in which the
				 * channel was opened? Will contain an ORed
				 * combination of TCL_READABLE and
				 * TCL_WRITABLE, if non-NULL. */
{
    Channel *chanPtr;		/* The actual channel. */
    Tcl_HashTable *hTblPtr;	/* Hash table of channels. */
    Tcl_HashEntry *hPtr;	/* Search variable. */
    const char *name;		/* Translated name. */







|







1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432

Tcl_Channel
Tcl_GetChannel(
    Tcl_Interp *interp,		/* Interpreter in which to find or create the
				 * channel. */
    const char *chanName,	/* The name of the channel. */
    int *modePtr)		/* Where to store the mode in which the
				 * channel was opened? Will contain an OR'ed
				 * combination of TCL_READABLE and
				 * TCL_WRITABLE, if non-NULL. */
{
    Channel *chanPtr;		/* The actual channel. */
    Tcl_HashTable *hTblPtr;	/* Hash table of channels. */
    Tcl_HashEntry *hPtr;	/* Search variable. */
    const char *name;		/* Translated name. */
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
int
TclGetChannelFromObj(
    Tcl_Interp *interp,		/* Interpreter in which to find or create the
				 * channel. */
    Tcl_Obj *objPtr,
    Tcl_Channel *channelPtr,
    int *modePtr,		/* Where to store the mode in which the
				 * channel was opened? Will contain an ORed
				 * combination of TCL_READABLE and
				 * TCL_WRITABLE, if non-NULL. */
    TCL_UNUSED(int) /*flags*/)
{
    ChannelState *statePtr;
    ResolvedChanName *resPtr = NULL;
    Tcl_Channel chan;







|







1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
int
TclGetChannelFromObj(
    Tcl_Interp *interp,		/* Interpreter in which to find or create the
				 * channel. */
    Tcl_Obj *objPtr,
    Tcl_Channel *channelPtr,
    int *modePtr,		/* Where to store the mode in which the
				 * channel was opened? Will contain an OR'ed
				 * combination of TCL_READABLE and
				 * TCL_WRITABLE, if non-NULL. */
    TCL_UNUSED(int) /*flags*/)
{
    ChannelState *statePtr;
    ResolvedChanName *resPtr = NULL;
    Tcl_Channel chan;
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676


1677
1678


1679
1680
1681
1682
1683
1684
1685
     * Note the strange bit of protection taking place here. If the system
     * encoding name is reported back as "binary", something weird is
     * happening. Tcl provides no "binary" encoding, so someone else has
     * provided one. We ignore it so as not to interfere with the "magic"
     * interpretation that Tcl_Channels give to the "-encoding binary" option.
     */

    statePtr->encoding = NULL;
    name = Tcl_GetEncodingName(NULL);
    if (strcmp(name, "binary") != 0) {
	statePtr->encoding = Tcl_GetEncoding(NULL, name);
    }
    statePtr->inputEncodingState  = NULL;
    statePtr->inputEncodingFlags  = TCL_ENCODING_START;


    statePtr->outputEncodingState = NULL;
    statePtr->outputEncodingFlags = TCL_ENCODING_START;



    /*
     * Set the channel up initially in AUTO input translation mode to accept
     * "\n", "\r" and "\r\n". Output translation mode is set to a platform
     * specific default value. The eofChar is set to 0 for both input and
     * output, so that Tcl does not look for an in-file EOF indicator (e.g.,
     * ^Z) and does not append an EOF indicator to files.







<

<
|
<


>
>


>
>







1672
1673
1674
1675
1676
1677
1678

1679

1680

1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
     * Note the strange bit of protection taking place here. If the system
     * encoding name is reported back as "binary", something weird is
     * happening. Tcl provides no "binary" encoding, so someone else has
     * provided one. We ignore it so as not to interfere with the "magic"
     * interpretation that Tcl_Channels give to the "-encoding binary" option.
     */


    name = Tcl_GetEncodingName(NULL);

    statePtr->encoding = Tcl_GetEncoding(NULL, name);

    statePtr->inputEncodingState  = NULL;
    statePtr->inputEncodingFlags  = TCL_ENCODING_START;
    ENCODING_PROFILE_SET(statePtr->inputEncodingFlags,
			     TCL_ENCODING_PROFILE_DEFAULT);
    statePtr->outputEncodingState = NULL;
    statePtr->outputEncodingFlags = TCL_ENCODING_START;
    ENCODING_PROFILE_SET(statePtr->outputEncodingFlags,
			     TCL_ENCODING_PROFILE_DEFAULT);

    /*
     * Set the channel up initially in AUTO input translation mode to accept
     * "\n", "\r" and "\r\n". Output translation mode is set to a platform
     * specific default value. The eofChar is set to 0 for both input and
     * output, so that Tcl does not look for an in-file EOF indicator (e.g.,
     * ^Z) and does not append an EOF indicator to files.
1699
1700
1701
1702
1703
1704
1705

1706
1707
1708
1709
1710
1711
1712
    statePtr->inQueueHead	= NULL;
    statePtr->inQueueTail	= NULL;
    statePtr->chPtr		= NULL;
    statePtr->interestMask	= 0;
    statePtr->scriptRecordPtr	= NULL;
    statePtr->bufSize		= CHANNELBUFFER_DEFAULT_SIZE;
    statePtr->timer		= NULL;

    statePtr->csPtrR		= NULL;
    statePtr->csPtrW		= NULL;
    statePtr->outputStage	= NULL;

    /*
     * As we are creating the channel, it is obviously the top for now.
     */







>







1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
    statePtr->inQueueHead	= NULL;
    statePtr->inQueueTail	= NULL;
    statePtr->chPtr		= NULL;
    statePtr->interestMask	= 0;
    statePtr->scriptRecordPtr	= NULL;
    statePtr->bufSize		= CHANNELBUFFER_DEFAULT_SIZE;
    statePtr->timer		= NULL;
    statePtr->timerChanPtr	= NULL;
    statePtr->csPtrR		= NULL;
    statePtr->csPtrW		= NULL;
    statePtr->outputStage	= NULL;

    /*
     * As we are creating the channel, it is obviously the top for now.
     */
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
     * are not only useless but actually distorts our view of the system.
     *
     * To preserve the information without having to read them again and to
     * avoid problems with the location in the channel (seeking might be
     * impossible) we move the buffers from the common state structure into
     * the channel itself. We use the buffers in the channel below the new
     * transformation to hold the data. In the future this allows us to write
     * transformations which pre-read data and push the unused part back when
     * they are going away.
     */

    if (((mask & TCL_READABLE) != 0) && (statePtr->inQueueHead != NULL)) {
	/*
	 * When statePtr->inQueueHead is not NULL, we know
	 * prevChanPtr->inQueueHead must be NULL.







|







1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
     * are not only useless but actually distorts our view of the system.
     *
     * To preserve the information without having to read them again and to
     * avoid problems with the location in the channel (seeking might be
     * impossible) we move the buffers from the common state structure into
     * the channel itself. We use the buffers in the channel below the new
     * transformation to hold the data. In the future this allows us to write
     * transformations which preread data and push the unused part back when
     * they are going away.
     */

    if (((mask & TCL_READABLE) != 0) && (statePtr->inQueueHead != NULL)) {
	/*
	 * When statePtr->inQueueHead is not NULL, we know
	 * prevChanPtr->inQueueHead must be NULL.
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
    }
}

static void
ChannelFree(
    Channel *chanPtr)
{
    if (!chanPtr->refCount) {
	Tcl_Free(chanPtr);
	return;
    }
    chanPtr->typePtr = NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UnstackChannel --
 *
 *	Unstacks an entry in the hash table for a Tcl_Channel record. This is
 *	the reverse to 'Tcl_StackChannel'.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	If TCL_ERROR is returned, the posix error code will be set with
 *	Tcl_SetErrno. May leave a message in interp result as well.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_UnstackChannel(







|


















|







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

static void
ChannelFree(
    Channel *chanPtr)
{
    if (chanPtr->refCount == 0) {
	Tcl_Free(chanPtr);
	return;
    }
    chanPtr->typePtr = NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UnstackChannel --
 *
 *	Unstacks an entry in the hash table for a Tcl_Channel record. This is
 *	the reverse to 'Tcl_StackChannel'.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	If TCL_ERROR is returned, the Posix error code will be set with
 *	Tcl_SetErrno. May leave a message in interp result as well.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_UnstackChannel(
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
     * This operation should occur at the top of a channel stack.
     */

    chanPtr = statePtr->topChanPtr;

    if (chanPtr->downChanPtr != NULL) {
	/*
	 * Instead of manipulating the per-thread / per-interp list/hashtable
	 * of registered channels we wind down the state of the
	 * transformation, and then restore the state of underlying channel
	 * into the old structure.
	 *
	 * TODO: Figure out how to handle the situation where the chan
	 * operations called below by this unstacking operation cause
	 * another unstacking recursively.  In that case the downChanPtr







|







2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
     * This operation should occur at the top of a channel stack.
     */

    chanPtr = statePtr->topChanPtr;

    if (chanPtr->downChanPtr != NULL) {
	/*
	 * Instead of manipulating the per-thread / per-interp list/hash table
	 * of registered channels we wind down the state of the
	 * transformation, and then restore the state of underlying channel
	 * into the old structure.
	 *
	 * TODO: Figure out how to handle the situation where the chan
	 * operations called below by this unstacking operation cause
	 * another unstacking recursively.  In that case the downChanPtr
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
	}
    } else {
	/*
	 * This channel does not cover another one. Simply do a close, if
	 * necessary.
	 */

	if (statePtr->refCount + 1 <= 1) {
	    if (Tcl_CloseEx(interp, chan, 0) != TCL_OK) {
		/*
		 * TIP #219, Tcl Channel Reflection API.
		 * "TclChanCaughtErrorBypass" is not required here, it was
		 * done already by "Tcl_Close".
		 */








|







2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
	}
    } else {
	/*
	 * This channel does not cover another one. Simply do a close, if
	 * necessary.
	 */

	if (statePtr->refCount <= 0) {
	    if (Tcl_CloseEx(interp, chan, 0) != TCL_OK) {
		/*
		 * TIP #219, Tcl Channel Reflection API.
		 * "TclChanCaughtErrorBypass" is not required here, it was
		 * done already by "Tcl_Close".
		 */

2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
 *	None.
 *
 *---------------------------------------------------------------------------
 */

static ChannelBuffer *
AllocChannelBuffer(
    size_t length)			/* Desired length of channel buffer. */
{
    ChannelBuffer *bufPtr;
    size_t n;

    n = length + CHANNELBUFFER_HEADER_SIZE + BUFFER_PADDING + BUFFER_PADDING;
    bufPtr = (ChannelBuffer *)Tcl_Alloc(n);
    bufPtr->nextAdded	= BUFFER_PADDING;
    bufPtr->nextRemoved	= BUFFER_PADDING;
    bufPtr->bufLength	= length + BUFFER_PADDING;
    bufPtr->nextPtr	= NULL;







|


|







2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
 *	None.
 *
 *---------------------------------------------------------------------------
 */

static ChannelBuffer *
AllocChannelBuffer(
    Tcl_Size length)			/* Desired length of channel buffer. */
{
    ChannelBuffer *bufPtr;
    Tcl_Size n;

    n = length + CHANNELBUFFER_HEADER_SIZE + BUFFER_PADDING + BUFFER_PADDING;
    bufPtr = (ChannelBuffer *)Tcl_Alloc(n);
    bufPtr->nextAdded	= BUFFER_PADDING;
    bufPtr->nextRemoved	= BUFFER_PADDING;
    bufPtr->bufLength	= length + BUFFER_PADDING;
    bufPtr->nextPtr	= NULL;
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
    Tcl_Free(bufPtr);
}

static int
IsShared(
    ChannelBuffer *bufPtr)
{
    return bufPtr->refCount + 1 > 2;
}

/*
 *----------------------------------------------------------------------
 *
 * RecycleBuffer --
 *







|







2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
    Tcl_Free(bufPtr);
}

static int
IsShared(
    ChannelBuffer *bufPtr)
{
    return bufPtr->refCount > 1;
}

/*
 *----------------------------------------------------------------------
 *
 * RecycleBuffer --
 *
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590

    if (mustDiscard) {
	ReleaseChannelBuffer(bufPtr);
	return;
    }

    /*
     * Only save buffers which have the requested buffersize for the channel.
     * This is to honor dynamic changes of the buffersize made by the user.
     */

    if ((bufPtr->bufLength) != statePtr->bufSize + BUFFER_PADDING) {
	ReleaseChannelBuffer(bufPtr);
	return;
    }








|
|







2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601

    if (mustDiscard) {
	ReleaseChannelBuffer(bufPtr);
	return;
    }

    /*
     * Only save buffers which have the requested buffer size for the channel.
     * This is to honor dynamic changes of the buffe rsize made by the user.
     */

    if ((bufPtr->bufLength) != statePtr->bufSize + BUFFER_PADDING) {
	ReleaseChannelBuffer(bufPtr);
	return;
    }

2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
    int wroteSome = 0;		/* Set to one if any data was written to the
				 * driver. */

    int bufExists;
    /*
     * Prevent writing on a dead channel -- a channel that has been closed but
     * not yet deallocated. This can occur if the exit handler for the channel
     * deallocation runs before all channels are deregistered in all
     * interpreters.
     */

    if (CheckForDeadChannel(interp, statePtr)) {
	return -1;
    }








|







2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
    int wroteSome = 0;		/* Set to one if any data was written to the
				 * driver. */

    int bufExists;
    /*
     * Prevent writing on a dead channel -- a channel that has been closed but
     * not yet deallocated. This can occur if the exit handler for the channel
     * deallocation runs before all channels are unregistered in all
     * interpreters.
     */

    if (CheckForDeadChannel(interp, statePtr)) {
	return -1;
    }

2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
	    /*
	     * Decide whether to report the error upwards or defer it.
	     */

	    if (calledFromAsyncFlush) {
		/*
		 * TIP #219, Tcl Channel Reflection API.
		 * When defering the error copy a message from the bypass into
		 * the unreported area. Or discard it if the new error is to
		 * be ignored in favor of an earlier defered error.
		 */

		Tcl_Obj *msg = statePtr->chanMsg;

		if (statePtr->unreportedError == 0) {
		    statePtr->unreportedError = errorCode;
		    statePtr->unreportedMsg = msg;







|

|







2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
	    /*
	     * Decide whether to report the error upwards or defer it.
	     */

	    if (calledFromAsyncFlush) {
		/*
		 * TIP #219, Tcl Channel Reflection API.
		 * When deferring the error copy a message from the bypass into
		 * the unreported area. Or discard it if the new error is to
		 * be ignored in favor of an earlier deferred error.
		 */

		Tcl_Obj *msg = statePtr->chanMsg;

		if (statePtr->unreportedError == 0) {
		    statePtr->unreportedError = errorCode;
		    statePtr->unreportedMsg = msg;
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995

    /*
     * If the channel is flagged as closed, delete it when the refCount drops
     * to zero, the output queue is empty and there is no output in the
     * current output buffer.
     */

    if (GotFlag(statePtr, CHANNEL_CLOSED) && (statePtr->refCount + 1 <= 1) &&
	    (statePtr->outQueueHead == NULL) &&
	    ((statePtr->curOutPtr == NULL) ||
	    IsBufferEmpty(statePtr->curOutPtr))) {
	errorCode = CloseChannel(interp, chanPtr, errorCode);
	goto done;
    }








|







2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006

    /*
     * If the channel is flagged as closed, delete it when the refCount drops
     * to zero, the output queue is empty and there is no output in the
     * current output buffer.
     */

    if (GotFlag(statePtr, CHANNEL_CLOSED) && (statePtr->refCount <= 0) &&
	    (statePtr->outQueueHead == NULL) &&
	    ((statePtr->curOutPtr == NULL) ||
	    IsBufferEmpty(statePtr->curOutPtr))) {
	errorCode = CloseChannel(interp, chanPtr, errorCode);
	goto done;
    }

3144
3145
3146
3147
3148
3149
3150

3151
3152
3153
3154
3155
3156
3157
3158
3159
	    Tcl_SetErrno(errorCode);
	}
    }

    /*
     * Cancel any outstanding timer.
     */


    Tcl_DeleteTimerHandler(statePtr->timer);

    /*
     * Mark the channel as deleted by clearing the type structure.
     */

    if (chanPtr->downChanPtr != NULL) {
	Channel *downChanPtr = chanPtr->downChanPtr;







>

<







3155
3156
3157
3158
3159
3160
3161
3162
3163

3164
3165
3166
3167
3168
3169
3170
	    Tcl_SetErrno(errorCode);
	}
    }

    /*
     * Cancel any outstanding timer.
     */
    DeleteTimerHandler(statePtr);



    /*
     * Mark the channel as deleted by clearing the type structure.
     */

    if (chanPtr->downChanPtr != NULL) {
	Channel *downChanPtr = chanPtr->downChanPtr;
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
 * Side effects:
 *	Resets the field 'nextCSPtr' of the specified channel state to NULL.
 *
 * NOTE:
 *	The channel to cut out of the list must not be referenced in any
 *	interpreter. This is something this procedure cannot check (despite
 *	the refcount) because the caller usually wants fiddle with the channel
 *	(like transfering it to a different thread) and thus keeps the
 *	refcount artifically high to prevent its destruction.
 *
 *----------------------------------------------------------------------
 */

static void
CutChannel(
    Tcl_Channel chan)		/* The channel being removed. Must not be







|
|







3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
 * Side effects:
 *	Resets the field 'nextCSPtr' of the specified channel state to NULL.
 *
 * NOTE:
 *	The channel to cut out of the list must not be referenced in any
 *	interpreter. This is something this procedure cannot check (despite
 *	the refcount) because the caller usually wants fiddle with the channel
 *	(like transferring it to a different thread) and thus keeps the
 *	refcount artificially high to prevent its destruction.
 *
 *----------------------------------------------------------------------
 */

static void
CutChannel(
    Tcl_Channel chan)		/* The channel being removed. Must not be
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
 *
 * Side effects:
 *	Nothing.
 *
 * NOTE:
 *	The channel to splice into the list must not be referenced in any
 *	interpreter. This is something this procedure cannot check (despite
 *	the refcount) because the caller usually wants figgle with the channel
 *	(like transfering it to a different thread) and thus keeps the
 *	refcount artifically high to prevent its destruction.
 *
 *----------------------------------------------------------------------
 */

static void
SpliceChannel(
    Tcl_Channel chan)		/* The channel being added. Must not be







|
|
|







3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
 *
 * Side effects:
 *	Nothing.
 *
 * NOTE:
 *	The channel to splice into the list must not be referenced in any
 *	interpreter. This is something this procedure cannot check (despite
 *	the refcount) because the caller usually wants fiddle with the channel
 *	(like transferring it to a different thread) and thus keeps the
 *	refcount artificially high to prevent its destruction.
 *
 *----------------------------------------------------------------------
 */

static void
SpliceChannel(
    Tcl_Channel chan)		/* The channel being added. Must not be
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
     * This operation should occur at the top of a channel stack.
     */

    chanPtr = (Channel *) chan;
    statePtr = chanPtr->state;
    chanPtr = statePtr->topChanPtr;

    if (statePtr->refCount + 1 > 1) {
	Tcl_Panic("called Tcl_Close on channel with refCount > 0");
    }

    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;
    }
    SetFlag(statePtr, CHANNEL_INCLOSE);

    /*
     * When the channel has an escape sequence driven encoding such as
     * iso2022, the terminated escape sequence must write to the buffer.
     */

    stickyError = 0;

    if (GotFlag(statePtr, TCL_WRITABLE) && (statePtr->encoding != NULL)

	    && !(statePtr->outputEncodingFlags & TCL_ENCODING_START)) {
	int code = CheckChannelErrors(statePtr, TCL_WRITABLE);

	if (code == 0) {
	    statePtr->outputEncodingFlags |= TCL_ENCODING_END;
	    code = WriteChars(chanPtr, "", 0);
	    statePtr->outputEncodingFlags &= ~TCL_ENCODING_END;







|




















|
>







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
     * This operation should occur at the top of a channel stack.
     */

    chanPtr = (Channel *) chan;
    statePtr = chanPtr->state;
    chanPtr = statePtr->topChanPtr;

    if (statePtr->refCount > 0) {
	Tcl_Panic("called Tcl_Close on channel with refCount > 0");
    }

    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;
    }
    SetFlag(statePtr, CHANNEL_INCLOSE);

    /*
     * When the channel has an escape sequence driven encoding such as
     * iso2022, the terminated escape sequence must write to the buffer.
     */

    stickyError = 0;

    if (GotFlag(statePtr, TCL_WRITABLE)
	    && (statePtr->encoding != GetBinaryEncoding())
	    && !(statePtr->outputEncodingFlags & TCL_ENCODING_START)) {
	int code = CheckChannelErrors(statePtr, TCL_WRITABLE);

	if (code == 0) {
	    statePtr->outputEncodingFlags |= TCL_ENCODING_END;
	    code = WriteChars(chanPtr, "", 0);
	    statePtr->outputEncodingFlags &= ~TCL_ENCODING_END;
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
    }

    Tcl_ClearChannelHandlers(chan);

    /*
     * Cancel any outstanding timer.
     */
    Tcl_DeleteTimerHandler(statePtr->timer);

    /*
     * Invoke the registered close callbacks and delete their records.
     */

    while (statePtr->closeCbPtr != NULL) {
	cbPtr = statePtr->closeCbPtr;







|







3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
    }

    Tcl_ClearChannelHandlers(chan);

    /*
     * Cancel any outstanding timer.
     */
    DeleteTimerHandler(statePtr);

    /*
     * Invoke the registered close callbacks and delete their records.
     */

    while (statePtr->closeCbPtr != NULL) {
	cbPtr = statePtr->closeCbPtr;
3725
3726
3727
3728
3729
3730
3731
3732
3733
3734
3735
3736
3737
3738
3739
 *	A standard Tcl result.
 *
 * Side effects:
 *	Closes the write side of the channel.
 *
 * NOTE:
 *	CloseWrite removes the channel as far as the user is concerned.
 *	However, the ooutput data structures may continue to exist for a while
 *	longer if it has a background flush scheduled. The device itself is
 *	eventually closed and the channel structures modified, in
 *	CloseChannelPart, below.
 *
 *----------------------------------------------------------------------
 */








|







3737
3738
3739
3740
3741
3742
3743
3744
3745
3746
3747
3748
3749
3750
3751
 *	A standard Tcl result.
 *
 * Side effects:
 *	Closes the write side of the channel.
 *
 * NOTE:
 *	CloseWrite removes the channel as far as the user is concerned.
 *	However, the output data structures may continue to exist for a while
 *	longer if it has a background flush scheduled. The device itself is
 *	eventually closed and the channel structures modified, in
 *	CloseChannelPart, below.
 *
 *----------------------------------------------------------------------
 */

3950
3951
3952
3953
3954
3955
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
    chanPtr = (Channel *) channel;
    statePtr = chanPtr->state;
    chanPtr = statePtr->topChanPtr;

    /*
     * Cancel any outstanding timer.
     */

    Tcl_DeleteTimerHandler(statePtr->timer);

    /*
     * Remove any references to channel handlers for this channel that may be
     * about to be invoked.
     */

    for (nhPtr = tsdPtr->nestedHandlerPtr; nhPtr != NULL;







<
|







3962
3963
3964
3965
3966
3967
3968

3969
3970
3971
3972
3973
3974
3975
3976
    chanPtr = (Channel *) channel;
    statePtr = chanPtr->state;
    chanPtr = statePtr->topChanPtr;

    /*
     * Cancel any outstanding timer.
     */

    DeleteTimerHandler(statePtr);

    /*
     * Remove any references to channel handlers for this channel that may be
     * about to be invoked.
     */

    for (nhPtr = tsdPtr->nestedHandlerPtr; nhPtr != NULL;
4028
4029
4030
4031
4032
4033
4034
4035
4036
4037
4038
4039
4040
4041
4042
4043
4044
4045
4046
 * Side effects:
 *	May buffer up output and may cause output to be produced on the
 *	channel.
 *
 *----------------------------------------------------------------------
 */

size_t
Tcl_Write(
    Tcl_Channel chan,		/* The channel to buffer output for. */
    const char *src,		/* Data to queue in output buffer. */
    size_t srcLen)			/* Length of data in bytes, or -1 for
				 * strlen(). */
{
    /*
     * Always use the topmost channel of the stack
     */

    Channel *chanPtr;







|



|







4039
4040
4041
4042
4043
4044
4045
4046
4047
4048
4049
4050
4051
4052
4053
4054
4055
4056
4057
 * Side effects:
 *	May buffer up output and may cause output to be produced on the
 *	channel.
 *
 *----------------------------------------------------------------------
 */

Tcl_Size
Tcl_Write(
    Tcl_Channel chan,		/* The channel to buffer output for. */
    const char *src,		/* Data to queue in output buffer. */
    Tcl_Size srcLen)			/* Length of data in bytes, or TCL_INDEX_NONE for
				 * strlen(). */
{
    /*
     * Always use the topmost channel of the stack
     */

    Channel *chanPtr;
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
 * Side effects:
 *	May buffer up output and may cause output to be produced on the
 *	channel.
 *
 *----------------------------------------------------------------------
 */

size_t
Tcl_WriteRaw(
    Tcl_Channel chan,		/* The channel to buffer output for. */
    const char *src,		/* Data to queue in output buffer. */
    size_t srcLen)		/* Length of data in bytes, or -1 for
				 * strlen(). */
{
    Channel *chanPtr = ((Channel *) chan);
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */
    int errorCode;
    size_t written;

    if (CheckChannelErrors(statePtr, TCL_WRITABLE | CHANNEL_RAW_MODE) != 0) {
	return TCL_INDEX_NONE;
    }

    if (srcLen == TCL_INDEX_NONE) {
	srcLen = strlen(src);







|



|






|







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
 * Side effects:
 *	May buffer up output and may cause output to be produced on the
 *	channel.
 *
 *----------------------------------------------------------------------
 */

Tcl_Size
Tcl_WriteRaw(
    Tcl_Channel chan,		/* The channel to buffer output for. */
    const char *src,		/* Data to queue in output buffer. */
    Tcl_Size srcLen)		/* Length of data in bytes, or TCL_INDEX_NONE for
				 * strlen(). */
{
    Channel *chanPtr = ((Channel *) chan);
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */
    int errorCode;
    Tcl_Size written;

    if (CheckChannelErrors(statePtr, TCL_WRITABLE | CHANNEL_RAW_MODE) != 0) {
	return TCL_INDEX_NONE;
    }

    if (srcLen == TCL_INDEX_NONE) {
	srcLen = strlen(src);
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
 * Side effects:
 *	May buffer up output and may cause output to be produced on the
 *	channel.
 *
 *----------------------------------------------------------------------
 */

size_t
Tcl_WriteChars(
    Tcl_Channel chan,		/* The channel to buffer output for. */
    const char *src,		/* UTF-8 characters to queue in output
				 * buffer. */
    size_t len)			/* Length of string in bytes, or -1 for
				 * strlen(). */
{
    Channel *chanPtr = (Channel *) chan;
    ChannelState *statePtr = chanPtr->state;	/* State info for channel */
    int result;
    Tcl_Obj *objPtr, *copy;

    if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
	return TCL_INDEX_NONE;
    }

    chanPtr = statePtr->topChanPtr;

    if (len == TCL_INDEX_NONE) {
	len = strlen(src);
    }
    if (statePtr->encoding) {
	return WriteChars(chanPtr, src, len);
    }

    /*
     * Inefficient way to convert UTF-8 to byte-array, but the code
     * parallels the way it is done for objects.  Special case for 1-byte
     * (used by eg [puts] for the \n) could be extended to more efficient
     * translation of the src string.
     */

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

    objPtr = Tcl_NewStringObj(src, len);
    copy = TclNarrowToBytes(objPtr);
    src = (char *) Tcl_GetByteArrayFromObj(copy, &len);

    TclDecrRefCount(objPtr);


    result = WriteBytes(chanPtr, src, len);

    TclDecrRefCount(copy);
    return result;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_WriteObj --
 *
 *	Takes the Tcl object and queues its contents for output. If the
 *	encoding of the channel is NULL, takes the byte-array representation
 *	of the object and queues those bytes for output. Otherwise, takes the
 *	characters in the UTF-8 (string) representation of the object and
 *	converts them for output using the channel's current encoding. May
 *	flush internal buffers to output if one becomes full or is ready for
 *	some other reason, e.g. if it contains a newline and the channel is in
 *	line buffering mode.
 *
 * Results:
 *	The number of bytes written or -1 in case of error. If -1,
 *	Tcl_GetErrno() will return the error code.
 *
 * Side effects:
 *	May buffer up output and may cause output to be produced on the
 *	channel.
 *
 *----------------------------------------------------------------------
 */

size_t
Tcl_WriteObj(
    Tcl_Channel chan,		/* The channel to buffer output for. */
    Tcl_Obj *objPtr)		/* The object to write. */
{
    /*
     * Always use the topmost channel of the stack
     */

    Channel *chanPtr;
    ChannelState *statePtr;	/* State info for channel */
    const char *src;
    size_t srcLen = 0;

    statePtr = ((Channel *) chan)->state;
    chanPtr = statePtr->topChanPtr;

    if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
	return TCL_INDEX_NONE;
    }
    if (statePtr->encoding == NULL) {
	int result;
	Tcl_Obj *copy = TclNarrowToBytes(objPtr);

	src = (char *) Tcl_GetByteArrayFromObj(copy, &srcLen);




	result = WriteBytes(chanPtr, src, srcLen);
	Tcl_DecrRefCount(copy);

	return result;
    } else {
	src = Tcl_GetStringFromObj(objPtr, &srcLen);
	return WriteChars(chanPtr, src, srcLen);
    }
}








|




|




|
|

















|








<
|
>
|
>
>
|
>
|


















|
|








|











|








|
<

|
>
>
>
>
|
<
>







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
 * Side effects:
 *	May buffer up output and may cause output to be produced on the
 *	channel.
 *
 *----------------------------------------------------------------------
 */

Tcl_Size
Tcl_WriteChars(
    Tcl_Channel chan,		/* The channel to buffer output for. */
    const char *src,		/* UTF-8 characters to queue in output
				 * buffer. */
    Tcl_Size len)			/* Length of string in bytes, or TCL_INDEX_NONE for
				 * strlen(). */
{
    Channel *chanPtr = (Channel *) chan;
    ChannelState *statePtr = chanPtr->state;	/* State info for channel */
    Tcl_Size result;
    Tcl_Obj *objPtr;

    if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
	return TCL_INDEX_NONE;
    }

    chanPtr = statePtr->topChanPtr;

    if (len == TCL_INDEX_NONE) {
	len = strlen(src);
    }
    if (statePtr->encoding) {
	return WriteChars(chanPtr, src, len);
    }

    /*
     * Inefficient way to convert UTF-8 to byte-array, but the code
     * parallels the way it is done for objects.  Special case for 1-byte
     * (used by e.g. [puts] for the \n) could be extended to more efficient
     * translation of the src string.
     */

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

    objPtr = Tcl_NewStringObj(src, len);

    src = (char *) Tcl_GetByteArrayFromObj(objPtr, &len);
    if (src == NULL) {
	Tcl_SetErrno(EILSEQ);
	result = TCL_INDEX_NONE;
    } else {
	result = WriteBytes(chanPtr, src, len);
    }
    TclDecrRefCount(objPtr);
    return result;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_WriteObj --
 *
 *	Takes the Tcl object and queues its contents for output. If the
 *	encoding of the channel is NULL, takes the byte-array representation
 *	of the object and queues those bytes for output. Otherwise, takes the
 *	characters in the UTF-8 (string) representation of the object and
 *	converts them for output using the channel's current encoding. May
 *	flush internal buffers to output if one becomes full or is ready for
 *	some other reason, e.g. if it contains a newline and the channel is in
 *	line buffering mode.
 *
 * Results:
 *	The number of bytes written or TCL_INDEX_NONE in case of error. If
 *	TCL_INDEX_NONE, Tcl_GetErrno() will return the error code.
 *
 * Side effects:
 *	May buffer up output and may cause output to be produced on the
 *	channel.
 *
 *----------------------------------------------------------------------
 */

Tcl_Size
Tcl_WriteObj(
    Tcl_Channel chan,		/* The channel to buffer output for. */
    Tcl_Obj *objPtr)		/* The object to write. */
{
    /*
     * Always use the topmost channel of the stack
     */

    Channel *chanPtr;
    ChannelState *statePtr;	/* State info for channel */
    const char *src;
    Tcl_Size srcLen = 0;

    statePtr = ((Channel *) chan)->state;
    chanPtr = statePtr->topChanPtr;

    if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
	return TCL_INDEX_NONE;
    }
    if (statePtr->encoding == NULL) {
	Tcl_Size result;


	src = (char *) Tcl_GetByteArrayFromObj(objPtr, &srcLen);
	if (src == NULL) {
	    Tcl_SetErrno(EILSEQ);
	    result = TCL_INDEX_NONE;
	} else {
	    result = WriteBytes(chanPtr, src, srcLen);

	}
	return result;
    } else {
	src = Tcl_GetStringFromObj(objPtr, &srcLen);
	return WriteChars(chanPtr, src, srcLen);
    }
}

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
 *
 *	Convert srcLen bytes starting at src according to encoding and write
 *	produced bytes into an output buffer, may queue the buffer for output
 *	if it gets full, and also remembers whether the current buffer is
 *	ready e.g. if it contains a newline and we are in line buffering mode.
 *
 * Results:
 *	The number of bytes written or -1 in case of error. If -1,
 *	Tcl_GetErrno will return the error code.
 *
 * Side effects:
 *	May buffer up output and may cause output to be produced on the
 *	channel.
 *
 *----------------------------------------------------------------------
 */

static int
Write(
    Channel *chanPtr,		/* The channel to buffer output for. */
    const char *src,		/* UTF-8 string to write. */
    int srcLen,			/* Length of UTF-8 string in bytes. */
    Tcl_Encoding encoding)
{
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */
    char *nextNewLine = NULL;

    int endEncoding, saved = 0, total = 0, flushed = 0, needNlFlush = 0;
    char safe[BUFFER_PADDING];
    int encodingError = 0;

    if (srcLen) {
        WillWrite(chanPtr);
    }

    /*
     * Transfer encoding nocomplain/strict option to the encoding flags
     */

    if (GotFlag(statePtr, CHANNEL_ENCODING_NOCOMPLAIN)) {
	statePtr->outputEncodingFlags |= TCL_ENCODING_NOCOMPLAIN;
    } else {
	statePtr->outputEncodingFlags &= ~TCL_ENCODING_NOCOMPLAIN;
    }
    if (GotFlag(statePtr, CHANNEL_ENCODING_STRICT)) {
	statePtr->outputEncodingFlags |= TCL_ENCODING_STRICT;
    } else {
	statePtr->outputEncodingFlags &= ~TCL_ENCODING_STRICT;
    }

    /*
     * Write the terminated escape sequence even if srcLen is 0.
     */

    endEncoding = ((statePtr->outputEncodingFlags & TCL_ENCODING_END) != 0);

    if (GotFlag(statePtr, CHANNEL_LINEBUFFERED)
	    || (statePtr->outputTranslation != TCL_TRANSLATE_LF)) {
	nextNewLine = (char *)memchr(src, '\n', srcLen);
    }

    while (srcLen + saved + endEncoding > 0 && !encodingError) {
	ChannelBuffer *bufPtr;
	char *dst;
	int result, srcRead, dstLen, dstWrote, srcLimit = srcLen;


	if (nextNewLine) {
	    srcLimit = nextNewLine - src;
	}

	/* Get space to write into */
	bufPtr = statePtr->curOutPtr;







|









|



|





>
|







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





<








|
>







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
 *
 *	Convert srcLen bytes starting at src according to encoding and write
 *	produced bytes into an output buffer, may queue the buffer for output
 *	if it gets full, and also remembers whether the current buffer is
 *	ready e.g. if it contains a newline and we are in line buffering mode.
 *
 * Results:
 *	The number of bytes written or TCL_INDEX_NONE in case of error. If TCL_INDEX_NONE,
 *	Tcl_GetErrno will return the error code.
 *
 * Side effects:
 *	May buffer up output and may cause output to be produced on the
 *	channel.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Size
Write(
    Channel *chanPtr,		/* The channel to buffer output for. */
    const char *src,		/* UTF-8 string to write. */
    Tcl_Size srcLen,            /* Length of UTF-8 string in bytes. */
    Tcl_Encoding encoding)
{
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */
    char *nextNewLine = NULL;
    int endEncoding, needNlFlush = 0;
    Tcl_Size saved = 0, total = 0, flushed = 0;
    char safe[BUFFER_PADDING];
    int encodingError = 0;

    if (srcLen) {
        WillWrite(chanPtr);
    }
















    /*
     * Write the terminated escape sequence even if srcLen is 0.
     */

    endEncoding = ((statePtr->outputEncodingFlags & TCL_ENCODING_END) != 0);

    if (GotFlag(statePtr, CHANNEL_LINEBUFFERED)
	    || (statePtr->outputTranslation != TCL_TRANSLATE_LF)) {
	nextNewLine = (char *)memchr(src, '\n', srcLen);
    }

    while (srcLen + saved + endEncoding > 0 && !encodingError) {
	ChannelBuffer *bufPtr;
	char *dst;
	int result, srcRead, dstLen, dstWrote;
	Tcl_Size srcLimit = srcLen;

	if (nextNewLine) {
	    srcLimit = nextNewLine - src;
	}

	/* Get space to write into */
	bufPtr = statePtr->curOutPtr;
4403
4404
4405
4406
4407
4408
4409

4410
4411
4412
4413
4414
4415
4416
4417
4418
4419

4420
4421
4422
4423
4424
4425
4426
	 * See io-75.2, TCL bug 6978c01b65.
	 * Check, if an encoding error occured and should be reported to the
	 * script level.
	 * This happens, if a written character may not be represented by the
	 * current output encoding and strict encoding is active.
	 */


	if (result == TCL_CONVERT_UNKNOWN) {
	    encodingError = 1;
	    result = TCL_OK;
	}

	if ((result != TCL_OK) && (srcRead + dstWrote == 0)) {
	    /*
	     * We're reading from invalid/incomplete UTF-8.
	     */


	    encodingError = 1;
	    result = TCL_OK;
	}

	bufPtr->nextAdded += dstWrote;
	src += srcRead;
	srcLen -= srcRead;







>
|
<
<
<
|
<



|
>







4406
4407
4408
4409
4410
4411
4412
4413
4414



4415

4416
4417
4418
4419
4420
4421
4422
4423
4424
4425
4426
4427
	 * See io-75.2, TCL bug 6978c01b65.
	 * Check, if an encoding error occured and should be reported to the
	 * script level.
	 * This happens, if a written character may not be represented by the
	 * current output encoding and strict encoding is active.
	 */

	if (
	    (result == TCL_CONVERT_UNKNOWN || result == TCL_CONVERT_SYNTAX)



	    ||

	    /*
	     * We're reading from invalid/incomplete UTF-8.
	     */
	    ((result != TCL_OK) && (srcRead + dstWrote == 0))
	) {
	    encodingError = 1;
	    result = TCL_OK;
	}

	bufPtr->nextAdded += dstWrote;
	src += srcRead;
	srcLen -= srcRead;
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
	     * When translating from UTF-8 to external encoding, we allowed
	     * the translation to produce a character that crossed the end of
	     * the output buffer, so that we would get a completely full
	     * buffer before flushing it. The extra bytes will be moved to the
	     * beginning of the next buffer.
	     */

	    saved = 1 + ~SpaceLeft(bufPtr);
	    memcpy(safe, dst + dstLen, saved);
	    bufPtr->nextAdded = bufPtr->bufLength;
	}

	if ((srcLen + saved == 0) && (result == TCL_OK)) {
	    endEncoding = 0;
	}

	if (IsBufferFull(bufPtr)) {
	    if (FlushChannel(NULL, chanPtr, 0) != 0) {
		return -1;
	    }
	    flushed += statePtr->bufSize;

	    /*
 	     * We just flushed.  So if we have needNlFlush set to record that
 	     * we need to flush because theres a (translated) newline in the
 	     * buffer, that's likely not true any more.  But there is a tricky
 	     * exception.  If we have saved bytes that did not really get
 	     * flushed and those bytes came from a translation of a newline as
 	     * the last thing taken from the src array, then needNlFlush needs
 	     * to remain set to flag that the next buffer still needs a
 	     * newline flush.
 	     */







|
















|







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
	     * When translating from UTF-8 to external encoding, we allowed
	     * the translation to produce a character that crossed the end of
	     * the output buffer, so that we would get a completely full
	     * buffer before flushing it. The extra bytes will be moved to the
	     * beginning of the next buffer.
	     */

	    saved = -SpaceLeft(bufPtr);
	    memcpy(safe, dst + dstLen, saved);
	    bufPtr->nextAdded = bufPtr->bufLength;
	}

	if ((srcLen + saved == 0) && (result == TCL_OK)) {
	    endEncoding = 0;
	}

	if (IsBufferFull(bufPtr)) {
	    if (FlushChannel(NULL, chanPtr, 0) != 0) {
		return -1;
	    }
	    flushed += statePtr->bufSize;

	    /*
 	     * We just flushed.  So if we have needNlFlush set to record that
 	     * we need to flush because there is a (translated) newline in the
 	     * buffer, that's likely not true any more.  But there is a tricky
 	     * exception.  If we have saved bytes that did not really get
 	     * flushed and those bytes came from a translation of a newline as
 	     * the last thing taken from the src array, then needNlFlush needs
 	     * to remain set to flag that the next buffer still needs a
 	     * newline flush.
 	     */
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
 *---------------------------------------------------------------------------
 *
 * Tcl_Gets --
 *
 *	Reads a complete line of input from the channel into a Tcl_DString.
 *
 * Results:
 *	Length of line read (in characters) or -1 if error, EOF, or blocked.
 *	If -1, use Tcl_GetErrno() to retrieve the POSIX error code for the
 *	error or condition that occurred.
 *
 * Side effects:
 *	May flush output on the channel. May cause input to be consumed from
 *	the channel.
 *
 *---------------------------------------------------------------------------
 */

size_t
Tcl_Gets(
    Tcl_Channel chan,		/* Channel from which to read. */
    Tcl_DString *lineRead)	/* The line read will be appended to this
				 * DString as UTF-8 characters. The caller
				 * must have initialized it and is responsible
				 * for managing the storage. */
{
    Tcl_Obj *objPtr;
    size_t charsStored;

    TclNewObj(objPtr);
    charsStored = Tcl_GetsObj(chan, objPtr);
    if (charsStored + 1 > 1) {
	TclDStringAppendObj(lineRead, objPtr);
    }
    TclDecrRefCount(objPtr);
    return charsStored;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_GetsObj --
 *
 *	Accumulate input from the input channel until end-of-line or
 *	end-of-file has been seen. Bytes read from the input channel are
 *	converted to UTF-8 using the encoding specified by the channel.
 *
 * Results:
 *	Number of characters accumulated in the object or -1 if error,
 *	blocked, or EOF. If -1, use Tcl_GetErrno() to retrieve the POSIX error
 *	code for the error or condition that occurred.
 *
 * Side effects:
 *	Consumes input from the channel.
 *
 *	On reading EOF, leave channel pointing at EOF char. On reading EOL,
 *	leave channel pointing after EOL, but don't return EOL in dst buffer.
 *
 *---------------------------------------------------------------------------
 */

size_t
Tcl_GetsObj(
    Tcl_Channel chan,		/* Channel from which to read. */
    Tcl_Obj *objPtr)		/* The line read will be appended to this
				 * object as UTF-8 characters. */
{
    GetsState gs;
    Channel *chanPtr = (Channel *) chan;
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */
    ChannelBuffer *bufPtr;
    int inEofChar, skip, copiedTotal, oldFlags, oldRemoved;
    size_t oldLength;
    Tcl_Encoding encoding;
    char *dst, *dstEnd, *eol, *eof;
    Tcl_EncodingState oldState;








    if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
	return TCL_INDEX_NONE;
    }

    /*
     * If we're sitting ready to read the eofchar, there's no need to







|
|









|








|



|
















|
|











|











|



>
>
>
>
>
>
>







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
 *---------------------------------------------------------------------------
 *
 * Tcl_Gets --
 *
 *	Reads a complete line of input from the channel into a Tcl_DString.
 *
 * Results:
 *	Length of line read (in characters) or TCL_INDEX_NONE if error, EOF, or blocked.
 *	If TCL_INDEX_NONE, use Tcl_GetErrno() to retrieve the POSIX error code for the
 *	error or condition that occurred.
 *
 * Side effects:
 *	May flush output on the channel. May cause input to be consumed from
 *	the channel.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Size
Tcl_Gets(
    Tcl_Channel chan,		/* Channel from which to read. */
    Tcl_DString *lineRead)	/* The line read will be appended to this
				 * DString as UTF-8 characters. The caller
				 * must have initialized it and is responsible
				 * for managing the storage. */
{
    Tcl_Obj *objPtr;
    Tcl_Size charsStored;

    TclNewObj(objPtr);
    charsStored = Tcl_GetsObj(chan, objPtr);
    if (charsStored > 0) {
	TclDStringAppendObj(lineRead, objPtr);
    }
    TclDecrRefCount(objPtr);
    return charsStored;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_GetsObj --
 *
 *	Accumulate input from the input channel until end-of-line or
 *	end-of-file has been seen. Bytes read from the input channel are
 *	converted to UTF-8 using the encoding specified by the channel.
 *
 * Results:
 *	Number of characters accumulated in the object or TCL_INDEX_NONE if error,
 *	blocked, or EOF. If TCL_INDEX_NONE, use Tcl_GetErrno() to retrieve the POSIX error
 *	code for the error or condition that occurred.
 *
 * Side effects:
 *	Consumes input from the channel.
 *
 *	On reading EOF, leave channel pointing at EOF char. On reading EOL,
 *	leave channel pointing after EOL, but don't return EOL in dst buffer.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Size
Tcl_GetsObj(
    Tcl_Channel chan,		/* Channel from which to read. */
    Tcl_Obj *objPtr)		/* The line read will be appended to this
				 * object as UTF-8 characters. */
{
    GetsState gs;
    Channel *chanPtr = (Channel *) chan;
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */
    ChannelBuffer *bufPtr;
    int inEofChar, skip, copiedTotal, oldFlags, oldRemoved;
    Tcl_Size oldLength;
    Tcl_Encoding encoding;
    char *dst, *dstEnd, *eol, *eof;
    Tcl_EncodingState oldState;

    if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR)) {
	UpdateInterest(chanPtr);
	ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_ENCODING_ERROR);
	Tcl_SetErrno(EILSEQ);
	return TCL_INDEX_NONE;
    }

    if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
	return TCL_INDEX_NONE;
    }

    /*
     * If we're sitting ready to read the eofchar, there's no need to
4623
4624
4625
4626
4627
4628
4629
4630
4631
4632
4633
4634
4635
4636
4637
4638
4639
4640

    /*
     * A binary version of Tcl_GetsObj. This could also handle encodings that
     * are ascii-7 pure (iso8859, utf-8, ...) with a final encoding conversion
     * done on objPtr.
     */

    if ((statePtr->encoding == NULL)
	    && ((statePtr->inputTranslation == TCL_TRANSLATE_LF)
		    || (statePtr->inputTranslation == TCL_TRANSLATE_CR))
	    && Tcl_GetBytesFromObj(NULL, objPtr, (size_t *)NULL) != NULL) {
	return TclGetsObjBinary(chan, objPtr);
    }

    /*
     * This operation should occur at the top of a channel stack.
     */








|


|







4631
4632
4633
4634
4635
4636
4637
4638
4639
4640
4641
4642
4643
4644
4645
4646
4647
4648

    /*
     * A binary version of Tcl_GetsObj. This could also handle encodings that
     * are ascii-7 pure (iso8859, utf-8, ...) with a final encoding conversion
     * done on objPtr.
     */

    if (statePtr->encoding == GetBinaryEncoding()
	    && ((statePtr->inputTranslation == TCL_TRANSLATE_LF)
		    || (statePtr->inputTranslation == TCL_TRANSLATE_CR))
	    && Tcl_GetByteArrayFromObj(objPtr, (Tcl_Size *)NULL) != NULL) {
	return TclGetsObjBinary(chan, objPtr);
    }

    /*
     * This operation should occur at the top of a channel stack.
     */

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
    oldFlags = statePtr->inputEncodingFlags;
    oldState = statePtr->inputEncodingState;
    oldRemoved = BUFFER_PADDING;
    if (bufPtr != NULL) {
	oldRemoved = bufPtr->nextRemoved;
    }

    /*
     * If there is no encoding, use "iso8859-1" -- Tcl_GetsObj() doesn't
     * produce ByteArray objects.
     */

    if (encoding == NULL) {
	encoding = GetBinaryEncoding();
    }

    /*
     * Transfer encoding nocomplain/strict option to the encoding flags
     */

    if (GotFlag(statePtr, CHANNEL_ENCODING_NOCOMPLAIN)) {
	statePtr->inputEncodingFlags |= TCL_ENCODING_NOCOMPLAIN;
    } else {
	statePtr->inputEncodingFlags &= ~TCL_ENCODING_NOCOMPLAIN;
    }
    if (GotFlag(statePtr, CHANNEL_ENCODING_STRICT)) {
	statePtr->inputEncodingFlags |= TCL_ENCODING_STRICT;
    } else {
	statePtr->inputEncodingFlags &= ~TCL_ENCODING_STRICT;
    }

    /*
     * Object used by FilterInputBytes to keep track of how much data has been
     * consumed from the channel buffers.
     */

    gs.objPtr		= objPtr;
    gs.dstPtr		= &dst;







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







4661
4662
4663
4664
4665
4666
4667
























4668
4669
4670
4671
4672
4673
4674
    oldFlags = statePtr->inputEncodingFlags;
    oldState = statePtr->inputEncodingState;
    oldRemoved = BUFFER_PADDING;
    if (bufPtr != NULL) {
	oldRemoved = bufPtr->nextRemoved;
    }

























    /*
     * Object used by FilterInputBytes to keep track of how much data has been
     * consumed from the channel buffers.
     */

    gs.objPtr		= objPtr;
    gs.dstPtr		= &dst;
4752
4753
4754
4755
4756
4757
4758
4759
4760
4761
4762
4763
4764
4765
4766
4767
4768
4769
4770
4771
	case TCL_TRANSLATE_CRLF:
	    for (eol = dst; eol < dstEnd; eol++) {
		if (*eol == '\r') {
		    eol++;

		    /*
		     * If a CR is at the end of the buffer, then check for a
		     * LF at the begining of the next buffer, unless EOF char
		     * was found already.
		     */

		    if (eol >= dstEnd) {
			size_t offset;

			if (eol != eof) {
			    offset = eol - objPtr->bytes;
			    dst = dstEnd;
			    if (FilterInputBytes(chanPtr, &gs) != 0) {
				goto restore;
			    }







|




|







4736
4737
4738
4739
4740
4741
4742
4743
4744
4745
4746
4747
4748
4749
4750
4751
4752
4753
4754
4755
	case TCL_TRANSLATE_CRLF:
	    for (eol = dst; eol < dstEnd; eol++) {
		if (*eol == '\r') {
		    eol++;

		    /*
		     * If a CR is at the end of the buffer, then check for a
		     * LF at the beginning of the next buffer, unless EOF char
		     * was found already.
		     */

		    if (eol >= dstEnd) {
			Tcl_Size offset;

			if (eol != eof) {
			    offset = eol - objPtr->bytes;
			    dst = dstEnd;
			    if (FilterInputBytes(chanPtr, &gs) != 0) {
				goto restore;
			    }
4870
4871
4872
4873
4874
4875
4876













4877
4878
4879
4880
4881
4882
4883
		Tcl_SetObjLength(objPtr, oldLength);
		CommonGetsCleanup(chanPtr);
		copiedTotal = -1;
		ResetFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR);
		goto done;
	    }
	    goto gotEOL;













	}
	dst = dstEnd;
    }

    /*
     * Found EOL or EOF, but the output buffer may now contain too many UTF-8
     * characters. We need to know how many raw bytes correspond to the number







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







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
		Tcl_SetObjLength(objPtr, oldLength);
		CommonGetsCleanup(chanPtr);
		copiedTotal = -1;
		ResetFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR);
		goto done;
	    }
	    goto gotEOL;
	} else if (gs.bytesWrote == 0
		&& GotFlag(statePtr, CHANNEL_ENCODING_ERROR)
		&& !GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
	    /* Set eol to the position that caused the encoding error, and then
	     * continue to gotEOL, which stores the data that was decoded
	     * without error to objPtr.  This allows the caller to do something
	     * useful with the data decoded so far, and also results in the
	     * position of the file being the first byte that was not
	     * successfully decoded, allowing further processing at exactly that
	     * point, if desired.
	     */
	    eol = dstEnd;
	    goto gotEOL;
	}
	dst = dstEnd;
    }

    /*
     * Found EOL or EOF, but the output buffer may now contain too many UTF-8
     * characters. We need to know how many raw bytes correspond to the number
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
     * Update the notifier state so we don't block while there is still data
     * in the buffers.
     */

  done:
    assert(!GotFlag(statePtr, CHANNEL_EOF)
	    || GotFlag(statePtr, CHANNEL_STICKY_EOF)

	    || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0);
    assert(!(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)
	    == (CHANNEL_EOF|CHANNEL_BLOCKED)));

    /*
     * Regenerate the top channel, in case it was changed due to
     * self-modifying reflected transforms.
     */

    if (chanPtr != statePtr->topChanPtr) {
	TclChannelRelease((Tcl_Channel)chanPtr);
	chanPtr = statePtr->topChanPtr;
	TclChannelPreserve((Tcl_Channel)chanPtr);
    }
    UpdateInterest(chanPtr);
    TclChannelRelease((Tcl_Channel)chanPtr);






    return copiedTotal;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclGetsObjBinary --
 *
 *	A variation of Tcl_GetsObj that works directly on the buffers until
 *	end-of-line or end-of-file has been seen. Bytes read from the input
 *	channel return as a ByteArray obj.
 *
 *	WARNING!  The notion of "binary" used here is different from notions
 *	of "binary" used in other places. In particular, this "binary" routine
 *	may be called when an -eofchar is set on the channel.
 *
 * Results:
 *	Number of characters accumulated in the object or -1 if error,
 *	blocked, or EOF. If -1, use Tcl_GetErrno() to retrieve the POSIX error
 *	code for the error or condition that occurred.
 *
 * Side effects:
 *	Consumes input from the channel.
 *
 *	On reading EOF, leave channel pointing at EOF char. On reading EOL,
 *	leave channel pointing after EOL, but don't return EOL in dst buffer.







>
















>
>
>
>
>
>

















|
|







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
     * Update the notifier state so we don't block while there is still data
     * in the buffers.
     */

  done:
    assert(!GotFlag(statePtr, CHANNEL_EOF)
	    || GotFlag(statePtr, CHANNEL_STICKY_EOF)
	    || GotFlag(statePtr, CHANNEL_ENCODING_ERROR)
	    || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0);
    assert(!(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)
	    == (CHANNEL_EOF|CHANNEL_BLOCKED)));

    /*
     * Regenerate the top channel, in case it was changed due to
     * self-modifying reflected transforms.
     */

    if (chanPtr != statePtr->topChanPtr) {
	TclChannelRelease((Tcl_Channel)chanPtr);
	chanPtr = statePtr->topChanPtr;
	TclChannelPreserve((Tcl_Channel)chanPtr);
    }
    UpdateInterest(chanPtr);
    TclChannelRelease((Tcl_Channel)chanPtr);
    if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR) && gs.bytesWrote == 0) {
	bufPtr->nextRemoved = oldRemoved;
	Tcl_SetErrno(EILSEQ);
	copiedTotal = -1;
    }
    ResetFlag(statePtr, CHANNEL_ENCODING_ERROR);
    return copiedTotal;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclGetsObjBinary --
 *
 *	A variation of Tcl_GetsObj that works directly on the buffers until
 *	end-of-line or end-of-file has been seen. Bytes read from the input
 *	channel return as a ByteArray obj.
 *
 *	WARNING!  The notion of "binary" used here is different from notions
 *	of "binary" used in other places. In particular, this "binary" routine
 *	may be called when an -eofchar is set on the channel.
 *
 * Results:
 *	Number of characters accumulated in the object or TCL_INDEX_NONE if error,
 *	blocked, or EOF. If TCL_INDEX_NONE, use Tcl_GetErrno() to retrieve the POSIX error
 *	code for the error or condition that occurred.
 *
 * Side effects:
 *	Consumes input from the channel.
 *
 *	On reading EOF, leave channel pointing at EOF char. On reading EOL,
 *	leave channel pointing after EOL, but don't return EOL in dst buffer.
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
				 * object as UTF-8 characters. */
{
    Channel *chanPtr = (Channel *) chan;
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */
    ChannelBuffer *bufPtr;
    int inEofChar, skip, copiedTotal, oldFlags, oldRemoved;
    size_t rawLen, byteLen = 0, oldLength;
    int eolChar;
    unsigned char *dst, *dstEnd, *eol, *eof, *byteArray;

    /*
     * This operation should occur at the top of a channel stack.
     */

    chanPtr = statePtr->topChanPtr;
    TclChannelPreserve((Tcl_Channel)chanPtr);

    bufPtr = statePtr->inQueueHead;

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

    byteArray = Tcl_GetByteArrayFromObj(objPtr, &byteLen);




    oldFlags = statePtr->inputEncodingFlags;
    oldRemoved = BUFFER_PADDING;
    oldLength = byteLen;
    if (bufPtr != NULL) {
	oldRemoved = bufPtr->nextRemoved;
    }








|


















>
>
>
>







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
				 * object as UTF-8 characters. */
{
    Channel *chanPtr = (Channel *) chan;
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */
    ChannelBuffer *bufPtr;
    int inEofChar, skip, copiedTotal, oldFlags, oldRemoved;
    Tcl_Size rawLen, byteLen = 0, oldLength;
    int eolChar;
    unsigned char *dst, *dstEnd, *eol, *eof, *byteArray;

    /*
     * This operation should occur at the top of a channel stack.
     */

    chanPtr = statePtr->topChanPtr;
    TclChannelPreserve((Tcl_Channel)chanPtr);

    bufPtr = statePtr->inQueueHead;

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

    byteArray = Tcl_GetByteArrayFromObj(objPtr, &byteLen);
    if (byteArray == NULL) {
	Tcl_SetErrno(EILSEQ);
	return -1;
    }
    oldFlags = statePtr->inputEncodingFlags;
    oldRemoved = BUFFER_PADDING;
    oldLength = byteLen;
    if (bufPtr != NULL) {
	oldRemoved = bufPtr->nextRemoved;
    }

5151
5152
5153
5154
5155
5156
5157
5158
5159
5160
5161
5162
5163
5164
5165
	}
	if (GotFlag(statePtr, CHANNEL_EOF)) {
	    skip = 0;
	    eol = dstEnd;
	    if ((dst == dstEnd) && (byteLen == oldLength)) {
		/*
		 * If we didn't append any bytes before encountering EOF,
		 * caller needs to see -1.
		 */

		byteArray = Tcl_SetByteArrayLength(objPtr, oldLength);
		CommonGetsCleanup(chanPtr);
		copiedTotal = -1;
		ResetFlag(statePtr, CHANNEL_BLOCKED);
		goto done;







|







5159
5160
5161
5162
5163
5164
5165
5166
5167
5168
5169
5170
5171
5172
5173
	}
	if (GotFlag(statePtr, CHANNEL_EOF)) {
	    skip = 0;
	    eol = dstEnd;
	    if ((dst == dstEnd) && (byteLen == oldLength)) {
		/*
		 * If we didn't append any bytes before encountering EOF,
		 * caller needs to see TCL_INDEX_NONE.
		 */

		byteArray = Tcl_SetByteArrayLength(objPtr, oldLength);
		CommonGetsCleanup(chanPtr);
		copiedTotal = -1;
		ResetFlag(statePtr, CHANNEL_BLOCKED);
		goto done;
5200
5201
5202
5203
5204
5205
5206
5207
5208
5209
5210
5211
5212
5213
5214
    bufPtr->nextRemoved += rawLen + skip;

    /*
     * Convert the buffer if there was an encoding.
     * XXX - unimplemented.
     */

    if (statePtr->encoding != NULL) {
    }

    /*
     * Recycle all the emptied buffers.
     */

    CommonGetsCleanup(chanPtr);







|







5208
5209
5210
5211
5212
5213
5214
5215
5216
5217
5218
5219
5220
5221
5222
    bufPtr->nextRemoved += rawLen + skip;

    /*
     * Convert the buffer if there was an encoding.
     * XXX - unimplemented.
     */

    if (statePtr->encoding != GetBinaryEncoding()) {
    }

    /*
     * Recycle all the emptied buffers.
     */

    CommonGetsCleanup(chanPtr);
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
 * Results:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

static void
FreeBinaryEncoding(
    TCL_UNUSED(void *))
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (tsdPtr->binaryEncoding != NULL) {
	Tcl_FreeEncoding(tsdPtr->binaryEncoding);
	tsdPtr->binaryEncoding = NULL;
    }
}

static Tcl_Encoding
GetBinaryEncoding()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (tsdPtr->binaryEncoding == NULL) {
	tsdPtr->binaryEncoding = Tcl_GetEncoding(NULL, "iso8859-1");
	Tcl_CreateThreadExitHandler(FreeBinaryEncoding, NULL);
    }
    if (tsdPtr->binaryEncoding == NULL) {
	Tcl_Panic("binary encoding is not available");
    }
    return tsdPtr->binaryEncoding;
}








|
<










|





<







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

static void
FreeBinaryEncoding(void)

{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (tsdPtr->binaryEncoding != NULL) {
	Tcl_FreeEncoding(tsdPtr->binaryEncoding);
	tsdPtr->binaryEncoding = NULL;
    }
}

static Tcl_Encoding
GetBinaryEncoding(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (tsdPtr->binaryEncoding == NULL) {
	tsdPtr->binaryEncoding = Tcl_GetEncoding(NULL, "iso8859-1");

    }
    if (tsdPtr->binaryEncoding == NULL) {
	Tcl_Panic("binary encoding is not available");
    }
    return tsdPtr->binaryEncoding;
}

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
	}
	spaceLeft = length - offset;
	dst = objPtr->bytes + offset;
	*gsPtr->dstPtr = dst;
    }
    gsPtr->state = statePtr->inputEncodingState;

    /*
     * Transfer encoding nocomplain/strict option to the encoding flags
     */

    if (GotFlag(statePtr, CHANNEL_ENCODING_NOCOMPLAIN)) {
	statePtr->inputEncodingFlags |= TCL_ENCODING_NOCOMPLAIN;
    } else {
	statePtr->inputEncodingFlags &= ~TCL_ENCODING_NOCOMPLAIN;
    }
    if (GotFlag(statePtr, CHANNEL_ENCODING_STRICT)) {
	statePtr->inputEncodingFlags |= TCL_ENCODING_STRICT;
    } else {
	statePtr->inputEncodingFlags &= ~TCL_ENCODING_STRICT;
    }

    result = Tcl_ExternalToUtf(NULL, gsPtr->encoding, raw, rawLen,
	    statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE,
	    &statePtr->inputEncodingState, dst, spaceLeft, &gsPtr->rawRead,
	    &gsPtr->bytesWrote, &gsPtr->charsWrote);








    /*
     * Make sure that if we go through 'gets', that we reset the
     * TCL_ENCODING_START flag still. [Bug #523988]
     */

    statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;







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




>
>
>
>
>
>
>







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
	}
	spaceLeft = length - offset;
	dst = objPtr->bytes + offset;
	*gsPtr->dstPtr = dst;
    }
    gsPtr->state = statePtr->inputEncodingState;
















    result = Tcl_ExternalToUtf(NULL, gsPtr->encoding, raw, rawLen,
	    statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE,
	    &statePtr->inputEncodingState, dst, spaceLeft, &gsPtr->rawRead,
	    &gsPtr->bytesWrote, &gsPtr->charsWrote);

	if (result == TCL_CONVERT_UNKNOWN || result == TCL_CONVERT_SYNTAX) {
	    SetFlag(statePtr, CHANNEL_ENCODING_ERROR);
	    ResetFlag(statePtr, CHANNEL_STICKY_EOF);
	    ResetFlag(statePtr, CHANNEL_EOF);
	    result = TCL_OK;
	}

    /*
     * Make sure that if we go through 'gets', that we reset the
     * TCL_ENCODING_START flag still. [Bug #523988]
     */

    statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;
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
 *	is done on the bytes being read, so the number of bytes consumed from
 *	the channel may not be equal to the number of bytes stored in the
 *	destination buffer.
 *
 *	No encoding conversions are applied to the bytes being read.
 *
 * Results:
 *	The number of bytes read, or -1 on error. Use Tcl_GetErrno() to
 *	retrieve the error code for the error that occurred.
 *
 * Side effects:
 *	May cause input to be buffered.
 *
 *----------------------------------------------------------------------
 */

size_t
Tcl_Read(
    Tcl_Channel chan,		/* The channel from which to read. */
    char *dst,			/* Where to store input read. */
    size_t bytesToRead)		/* Maximum number of bytes to read. */
{
    Channel *chanPtr = (Channel *) chan;
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */

    /*
     * This operation should occur at the top of a channel stack.







|








|



|







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
 *	is done on the bytes being read, so the number of bytes consumed from
 *	the channel may not be equal to the number of bytes stored in the
 *	destination buffer.
 *
 *	No encoding conversions are applied to the bytes being read.
 *
 * Results:
 *	The number of bytes read, or TCL_INDEX_NONE on error. Use Tcl_GetErrno() to
 *	retrieve the error code for the error that occurred.
 *
 * Side effects:
 *	May cause input to be buffered.
 *
 *----------------------------------------------------------------------
 */

Tcl_Size
Tcl_Read(
    Tcl_Channel chan,		/* The channel from which to read. */
    char *dst,			/* Where to store input read. */
    Tcl_Size bytesToRead)		/* Maximum number of bytes to read. */
{
    Channel *chanPtr = (Channel *) chan;
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */

    /*
     * This operation should occur at the top of a channel stack.
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
 *	is done on the bytes being read, so the number of bytes consumed from
 *	the channel may not be equal to the number of bytes stored in the
 *	destination buffer.
 *
 *	No encoding conversions are applied to the bytes being read.
 *
 * Results:
 *	The number of bytes read, or -1 on error. Use Tcl_GetErrno() to
 *	retrieve the error code for the error that occurred.
 *
 * Side effects:
 *	May cause input to be buffered.
 *
 *----------------------------------------------------------------------
 */

size_t
Tcl_ReadRaw(
    Tcl_Channel chan,		/* The channel from which to read. */
    char *readBuf,		/* Where to store input read. */
    size_t bytesToRead)		/* Maximum number of bytes to read. */
{
    Channel *chanPtr = (Channel *) chan;
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */
    int copied = 0;

    assert(bytesToRead > 0);







|








|



|







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
 *	is done on the bytes being read, so the number of bytes consumed from
 *	the channel may not be equal to the number of bytes stored in the
 *	destination buffer.
 *
 *	No encoding conversions are applied to the bytes being read.
 *
 * Results:
 *	The number of bytes read, or TCL_INDEX_NONE on error. Use Tcl_GetErrno() to
 *	retrieve the error code for the error that occurred.
 *
 * Side effects:
 *	May cause input to be buffered.
 *
 *----------------------------------------------------------------------
 */

Tcl_Size
Tcl_ReadRaw(
    Tcl_Channel chan,		/* The channel from which to read. */
    char *readBuf,		/* Where to store input read. */
    Tcl_Size bytesToRead)		/* Maximum number of bytes to read. */
{
    Channel *chanPtr = (Channel *) chan;
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */
    int copied = 0;

    assert(bytesToRead > 0);
5779
5780
5781
5782
5783
5784
5785
5786
5787
5788
5789
5790
5791
5792
5793
	    }
	    RecycleBuffer(chanPtr->state, bufPtr, 0);
	}
    }

    /*
     * Go to the driver only if we got nothing from pushback.  Have to do it
     * this way to avoid EOF mis-timings when we consider the ability that EOF
     * may not be a permanent condition in the driver, and in that case we
     * have to synchronize.
     */

    if (copied) {
	return copied;
    }







|







5777
5778
5779
5780
5781
5782
5783
5784
5785
5786
5787
5788
5789
5790
5791
	    }
	    RecycleBuffer(chanPtr->state, bufPtr, 0);
	}
    }

    /*
     * Go to the driver only if we got nothing from pushback.  Have to do it
     * this way to avoid EOF mistimings when we consider the ability that EOF
     * may not be a permanent condition in the driver, and in that case we
     * have to synchronize.
     */

    if (copied) {
	return copied;
    }
5811
5812
5813
5814
5815
5816
5817
5818
5819
5820
5821
5822
5823
5824
5825
5826
	     */

	    if (!GotFlag(statePtr, CHANNEL_BLOCKED) || copied == 0) {
		copied = -1;
	    }
	} else if (nread > 0) {
	    /*
             * Successful read (short is OK) - add to bytes copied.
             */

	    copied += nread;
	} else {
	    /*
	     * nread == 0.  Driver is at EOF. Let that state filter up.
	     */
	}







|
|







5809
5810
5811
5812
5813
5814
5815
5816
5817
5818
5819
5820
5821
5822
5823
5824
	     */

	    if (!GotFlag(statePtr, CHANNEL_BLOCKED) || copied == 0) {
		copied = -1;
	    }
	} else if (nread > 0) {
	    /*
	     * Successful read (short is OK) - add to bytes copied.
	     */

	    copied += nread;
	} else {
	    /*
	     * nread == 0.  Driver is at EOF. Let that state filter up.
	     */
	}
5837
5838
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
5865
 *	been seen, EOF is seen, or the channel would block. EOL and EOF
 *	translation is done. If reading binary data, the raw bytes are wrapped
 *	in a Tcl byte array object. Otherwise, the raw bytes are converted to
 *	UTF-8 using the channel's current encoding and stored in a Tcl string
 *	object.
 *
 * Results:
 *	The number of characters read, or -1 on error. Use Tcl_GetErrno() to
 *	retrieve the error code for the error that occurred.
 *
 * Side effects:
 *	May cause input to be buffered.
 *
 *---------------------------------------------------------------------------
 */

size_t
Tcl_ReadChars(
    Tcl_Channel chan,		/* The channel to read. */
    Tcl_Obj *objPtr,		/* Input data is stored in this object. */
    size_t toRead,		/* Maximum number of characters to store, or
				 * -1 to read all available data (up to EOF or
				 * when channel blocks). */
    int appendFlag)		/* If non-zero, data read from the channel
				 * will be appended to the object. Otherwise,
				 * the data will replace the existing contents
				 * of the object. */
{
    Channel *chanPtr = (Channel *) chan;







|








|



|
|







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
5861
5862
5863
 *	been seen, EOF is seen, or the channel would block. EOL and EOF
 *	translation is done. If reading binary data, the raw bytes are wrapped
 *	in a Tcl byte array object. Otherwise, the raw bytes are converted to
 *	UTF-8 using the channel's current encoding and stored in a Tcl string
 *	object.
 *
 * Results:
 *	The number of characters read, or TCL_INDEX_NONE on error. Use Tcl_GetErrno() to
 *	retrieve the error code for the error that occurred.
 *
 * Side effects:
 *	May cause input to be buffered.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Size
Tcl_ReadChars(
    Tcl_Channel chan,		/* The channel to read. */
    Tcl_Obj *objPtr,		/* Input data is stored in this object. */
    Tcl_Size toRead,		/* Maximum number of characters to store, or
				 * TCL_INDEX_NONE to read all available data (up to EOF or
				 * when channel blocks). */
    int appendFlag)		/* If non-zero, data read from the channel
				 * will be appended to the object. Otherwise,
				 * the data will replace the existing contents
				 * of the object. */
{
    Channel *chanPtr = (Channel *) chan;
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
    if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
	/*
	 * Update the notifier state so we don't block while there is still
	 * data in the buffers.
	 */

	UpdateInterest(chanPtr);
	return -1;
    }

    return DoReadChars(chanPtr, objPtr, toRead, appendFlag);
}
/*
 *---------------------------------------------------------------------------
 *
 * DoReadChars --
 *
 *	Reads from the channel until the requested number of characters have
 *	been seen, EOF is seen, or the channel would block. EOL and EOF
 *	translation is done. If reading binary data, the raw bytes are wrapped
 *	in a Tcl byte array object. Otherwise, the raw bytes are converted to
 *	UTF-8 using the channel's current encoding and stored in a Tcl string
 *	object.
 *
 * Results:
 *	The number of characters read, or -1 on error. Use Tcl_GetErrno() to
 *	retrieve the error code for the error that occurred.
 *
 * Side effects:
 *	May cause input to be buffered.
 *
 *---------------------------------------------------------------------------
 */

static int
DoReadChars(
    Channel *chanPtr,		/* The channel to read. */
    Tcl_Obj *objPtr,		/* Input data is stored in this object. */
    size_t toRead,			/* Maximum number of characters to store, or
				 * -1 to read all available data (up to EOF or
				 * when channel blocks). */

    int appendFlag)		/* If non-zero, data read from the channel
				 * will be appended to the object. Otherwise,
				 * the data will replace the existing contents
				 * of the object. */
{
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */
    ChannelBuffer *bufPtr;

    int copied, copiedNow, result;
    Tcl_Encoding encoding = statePtr->encoding;
    int binaryMode;
#define UTF_EXPANSION_FACTOR	1024
    int factor = UTF_EXPANSION_FACTOR;

    binaryMode = (encoding == NULL)
	    && (statePtr->inputTranslation == TCL_TRANSLATE_LF)
	    && (statePtr->inEofChar == '\0');

    if (appendFlag) {
	if (binaryMode && (NULL == Tcl_GetBytesFromObj(NULL, objPtr, (size_t *)NULL))) {
	    binaryMode = 0;
	}
    } else {
	if (binaryMode) {
	    Tcl_SetByteArrayLength(objPtr, 0);
	} else {
	    Tcl_SetObjLength(objPtr, 0);

	    /*
	     * We're going to access objPtr->bytes directly, so we must ensure
	     * that this is actually a string object (otherwise it might have
	     * been pure Unicode).
	     *
	     * Probably not needed anymore.
	     */

	    TclGetString(objPtr);
	}
    }

    /*
     * Early out when next read will see eofchar.
     *
     * NOTE: See DoRead for argument that it's a bug (one we're keeping) to
     * have this escape before the one for zero-char read request.
     */

    if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
	SetFlag(statePtr, CHANNEL_EOF);
	assert(statePtr->inputEncodingFlags & TCL_ENCODING_END);
	assert(!GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR));

	/* TODO: We don't need this call? */
	UpdateInterest(chanPtr);
	return 0;
    }

    /*
     * Special handling for zero-char read request.
     */
    if (toRead == 0) {
	if (GotFlag(statePtr, CHANNEL_EOF)) {
	    statePtr->inputEncodingFlags |= TCL_ENCODING_START;
	}
	ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF);
	statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
	/* TODO: We don't need this call? */
	UpdateInterest(chanPtr);
	return 0;
    }

    /*
     * This operation should occur at the top of a channel stack.
     */

    chanPtr = statePtr->topChanPtr;
    TclChannelPreserve((Tcl_Channel)chanPtr);

















    /*
     * Must clear the BLOCKED|EOF flags here since we check before reading.
     */

    if (GotFlag(statePtr, CHANNEL_EOF)) {
	statePtr->inputEncodingFlags |= TCL_ENCODING_START;
    }
    ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF);
    statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
    for (copied = 0; toRead > 0; ) {
	copiedNow = -1;
	if (statePtr->inQueueHead != NULL) {
	    if (binaryMode) {
		copiedNow = ReadBytes(statePtr, objPtr, toRead);
	    } else {
		copiedNow = ReadChars(statePtr, objPtr, toRead, &factor);
	    }

	    /*
	     * If the current buffer is empty recycle it.
	     */

	    bufPtr = statePtr->inQueueHead;
	    if (IsBufferEmpty(bufPtr)) {
		ChannelBuffer *nextPtr = bufPtr->nextPtr;

		RecycleBuffer(statePtr, bufPtr, 0);
		statePtr->inQueueHead = nextPtr;
		if (nextPtr == NULL) {
		    statePtr->inQueueTail = NULL;
		}
	    }













	}

	if (copiedNow < 0) {
	    if (GotFlag(statePtr, CHANNEL_EOF)) {
		break;
	    }
	    if (GotFlag(statePtr, CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)
		    == (CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)) {
		break;
	    }
	    result = GetInput(chanPtr);
	    if (chanPtr != statePtr->topChanPtr) {
		TclChannelRelease((Tcl_Channel)chanPtr);
		chanPtr = statePtr->topChanPtr;
		TclChannelPreserve((Tcl_Channel)chanPtr);
	    }
	    if (result != 0) {
		if (!GotFlag(statePtr, CHANNEL_BLOCKED)) {
		    copied = -1;
		}
		break;
	    }
	} else {
	    copied += copiedNow;

	    toRead -= copiedNow;

	}
    }


    /*
     * Failure to fill a channel buffer may have left channel reporting a
     * "blocked" state, but so long as we fulfilled the request here, the
     * caller does not consider us blocked.
     */

    if (toRead == 0) {
	ResetFlag(statePtr, CHANNEL_BLOCKED);
    }

    /*
     * Regenerate the top channel, in case it was changed due to
     * self-modifying reflected transforms.
     */

    if (chanPtr != statePtr->topChanPtr) {
	TclChannelRelease((Tcl_Channel)chanPtr);
	chanPtr = statePtr->topChanPtr;
	TclChannelPreserve((Tcl_Channel)chanPtr);
    }

    /*
     * Update the notifier state so we don't block while there is still data
     * in the buffers.
     */

    assert(!GotFlag(statePtr, CHANNEL_EOF)
	    || GotFlag(statePtr, CHANNEL_STICKY_EOF)

	    || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0);
    assert(!(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)
            == (CHANNEL_EOF|CHANNEL_BLOCKED)));
    UpdateInterest(chanPtr);












    TclChannelRelease((Tcl_Channel)chanPtr);
    return copied;
}

/*
 *---------------------------------------------------------------------------
 *
 * ReadBytes --
 *
 *	Reads from the channel until the requested number of bytes have been
 *	seen, EOF is seen, or the channel would block. Bytes from the channel
 *	are stored in objPtr as a ByteArray object. EOL and EOF translation
 *	are done.
 *
 *	'bytesToRead' can safely be a very large number because space is only
 *	allocated to hold data read from the channel as needed.
 *
 * Results:
 *	The return value is the number of bytes appended to the object, or
 *	-1 to indicate that zero bytes were read due to an EOF.
 *
 * Side effects:
 *	The storage of bytes in objPtr can cause (re-)allocation of memory.
 *
 *---------------------------------------------------------------------------
 */








|


|














|








|



|
|

>








>
|





<
|
|
|
<
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
|
|
|
<
<












|













|










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










|
|








|












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






|
|
















>
|
>



>











|
















>




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



















|







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
    if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
	/*
	 * Update the notifier state so we don't block while there is still
	 * data in the buffers.
	 */

	UpdateInterest(chanPtr);
	return TCL_INDEX_NONE;
    }

    return DoReadChars(chanPtr, objPtr, toRead, 0, appendFlag);
}
/*
 *---------------------------------------------------------------------------
 *
 * DoReadChars --
 *
 *	Reads from the channel until the requested number of characters have
 *	been seen, EOF is seen, or the channel would block. EOL and EOF
 *	translation is done. If reading binary data, the raw bytes are wrapped
 *	in a Tcl byte array object. Otherwise, the raw bytes are converted to
 *	UTF-8 using the channel's current encoding and stored in a Tcl string
 *	object.
 *
 * Results:
 *	The number of characters read, or TCL_INDEX_NONE on error. Use Tcl_GetErrno() to
 *	retrieve the error code for the error that occurred.
 *
 * Side effects:
 *	May cause input to be buffered.
 *
 *---------------------------------------------------------------------------
 */

static Tcl_Size
DoReadChars(
    Channel *chanPtr,		/* The channel to read. */
    Tcl_Obj *objPtr,		/* Input data is stored in this object. */
    Tcl_Size toRead,		/* Maximum number of characters to store, or
				 * TCL_INDEX_NONE to read all available data (up to EOF or
				 * when channel blocks). */
    int allowShortReads,	/* Allow half-blocking (pipes,sockets) */
    int appendFlag)		/* If non-zero, data read from the channel
				 * will be appended to the object. Otherwise,
				 * the data will replace the existing contents
				 * of the object. */
{
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */
    ChannelBuffer *bufPtr;
    Tcl_Size copied;
    int result;
    Tcl_Encoding encoding = statePtr->encoding;
    int binaryMode;
#define UTF_EXPANSION_FACTOR	1024
    int factor = UTF_EXPANSION_FACTOR;


    if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR)) {
	ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_ENCODING_ERROR);
	/* TODO: UpdateInterest not needed here? */









	UpdateInterest(chanPtr);







	Tcl_SetErrno(EILSEQ);
	return -1;
    }


    /*
     * Early out when next read will see eofchar.
     *
     * NOTE: See DoRead for argument that it's a bug (one we're keeping) to
     * have this escape before the one for zero-char read request.
     */

    if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
	SetFlag(statePtr, CHANNEL_EOF);
	assert(statePtr->inputEncodingFlags & TCL_ENCODING_END);
	assert(!GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR));

	/* TODO: UpdateInterest not needed here? */
	UpdateInterest(chanPtr);
	return 0;
    }

    /*
     * Special handling for zero-char read request.
     */
    if (toRead == 0) {
	if (GotFlag(statePtr, CHANNEL_EOF)) {
	    statePtr->inputEncodingFlags |= TCL_ENCODING_START;
	}
	ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF);
	statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
	/* TODO: UpdateInterest not needed here? */
	UpdateInterest(chanPtr);
	return 0;
    }

    /*
     * This operation should occur at the top of a channel stack.
     */

    chanPtr = statePtr->topChanPtr;
    TclChannelPreserve((Tcl_Channel)chanPtr);

    binaryMode = (encoding == GetBinaryEncoding())
	    && (statePtr->inputTranslation == TCL_TRANSLATE_LF)
	    && (statePtr->inEofChar == '\0');

    if (appendFlag) {
	if (binaryMode && (NULL == Tcl_GetByteArrayFromObj(objPtr, (Tcl_Size *)NULL))) {
	    binaryMode = 0;
	}
    } else {
	if (binaryMode) {
	    Tcl_SetByteArrayLength(objPtr, 0);
	} else {
	    Tcl_SetObjLength(objPtr, 0);
	}
    }

    /*
     * Must clear the BLOCKED|EOF flags here since we check before reading.
     */

    if (GotFlag(statePtr, CHANNEL_EOF)) {
	statePtr->inputEncodingFlags |= TCL_ENCODING_START;
    }
    ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF);
    statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
    for (copied = 0; toRead != 0 ; ) {
	int copiedNow = -1;
	if (statePtr->inQueueHead != NULL) {
	    if (binaryMode) {
		copiedNow = ReadBytes(statePtr, objPtr, toRead);
	    } else {
		copiedNow = ReadChars(statePtr, objPtr, toRead, &factor);
	    }

	    /*
	     * Recycle current buffer if empty.
	     */

	    bufPtr = statePtr->inQueueHead;
	    if (IsBufferEmpty(bufPtr)) {
		ChannelBuffer *nextPtr = bufPtr->nextPtr;

		RecycleBuffer(statePtr, bufPtr, 0);
		statePtr->inQueueHead = nextPtr;
		if (nextPtr == NULL) {
		    statePtr->inQueueTail = NULL;
		}
	    }

	    /*
	     * If CHANNEL_ENCODING_ERROR and CHANNEL_STICKY_EOF are both set,
	     * then CHANNEL_ENCODING_ERROR was caused by data that occurred
	     * after the EOF character was encountered, so it doesn't count as
	     * a real error.
	     */

	    if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR)
		    && !GotFlag(statePtr, CHANNEL_STICKY_EOF)
		    && (!GotFlag(statePtr, CHANNEL_NONBLOCKING))) {
		goto finish;
	    }
	}

	if (copiedNow < 0) {
	    if (GotFlag(statePtr, CHANNEL_EOF)) {
		break;
	    }
	    if ((GotFlag(statePtr, CHANNEL_NONBLOCKING) || allowShortReads)
		    && GotFlag(statePtr, CHANNEL_BLOCKED)) {
		break;
	    }
	    result = GetInput(chanPtr);
	    if (chanPtr != statePtr->topChanPtr) {
		TclChannelRelease((Tcl_Channel)chanPtr);
		chanPtr = statePtr->topChanPtr;
		TclChannelPreserve((Tcl_Channel)chanPtr);
	    }
	    if (result != 0) {
		if (!GotFlag(statePtr, CHANNEL_BLOCKED)) {
		    copied = -1;
		}
		break;
	    }
	} else {
	    copied += copiedNow;
	    if (toRead != TCL_INDEX_NONE) {
		toRead -= copiedNow; /* Only decr if not reading whole file */
	    }
	}
    }

finish:
    /*
     * Failure to fill a channel buffer may have left channel reporting a
     * "blocked" state, but so long as we fulfilled the request here, the
     * caller does not consider us blocked.
     */

    if (toRead == 0) {
	ResetFlag(statePtr, CHANNEL_BLOCKED);
    }

    /*
     * Regenerate chanPtr in case it was changed due to
     * self-modifying reflected transforms.
     */

    if (chanPtr != statePtr->topChanPtr) {
	TclChannelRelease((Tcl_Channel)chanPtr);
	chanPtr = statePtr->topChanPtr;
	TclChannelPreserve((Tcl_Channel)chanPtr);
    }

    /*
     * Update the notifier state so we don't block while there is still data
     * in the buffers.
     */

    assert(!GotFlag(statePtr, CHANNEL_EOF)
	    || GotFlag(statePtr, CHANNEL_STICKY_EOF)
	    || GotFlag(statePtr, CHANNEL_ENCODING_ERROR)
	    || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0);
    assert(!(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)
            == (CHANNEL_EOF|CHANNEL_BLOCKED)));
    UpdateInterest(chanPtr);

    /* This must comes after UpdateInterest(), which may set errno */
    if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR)
	    && (!copied || !GotFlag(statePtr, CHANNEL_NONBLOCKING))) {
	/* Channel either is blocking or is nonblocking with no data
	 * succesfully red before the error.  Return an error so that callers
	 * like [read] can also return an error.
	*/
	ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_ENCODING_ERROR);
	Tcl_SetErrno(EILSEQ);
	copied = -1;
    }
    TclChannelRelease((Tcl_Channel)chanPtr);
    return copied;
}

/*
 *---------------------------------------------------------------------------
 *
 * ReadBytes --
 *
 *	Reads from the channel until the requested number of bytes have been
 *	seen, EOF is seen, or the channel would block. Bytes from the channel
 *	are stored in objPtr as a ByteArray object. EOL and EOF translation
 *	are done.
 *
 *	'bytesToRead' can safely be a very large number because space is only
 *	allocated to hold data read from the channel as needed.
 *
 * Results:
 *	The return value is the number of bytes appended to the object, or
 *	TCL_INDEX_NONE to indicate that zero bytes were read due to an EOF.
 *
 * Side effects:
 *	The storage of bytes in objPtr can cause (re-)allocation of memory.
 *
 *---------------------------------------------------------------------------
 */

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
ReadChars(
    ChannelState *statePtr,	/* State of channel to read. */
    Tcl_Obj *objPtr,		/* Input data is appended to this object.
				 * objPtr->length is how much space has been
				 * allocated to hold data, not how many bytes
				 * of data have been stored in the object. */
    int charsToRead,		/* Maximum number of characters to store, or
				 * -1 to get all available characters.
				 * Characters are obtained from the first
				 * buffer in the queue -- even if this number
				 * is larger than the number of characters
				 * available in the first buffer, only the
				 * characters from the first buffer are
				 * returned. The execption is when there is
				 * not any complete character in the first
				 * buffer.  In that case, a recursive call
				 * effectively obtains chars from the
				 * second buffer. */
    int *factorPtr)		/* On input, contains a guess of how many
				 * bytes need to be allocated to hold the
				 * result of converting N source bytes to
				 * UTF-8. On output, contains another guess
				 * based on the data seen so far. */
{
    Tcl_Encoding encoding = statePtr->encoding? statePtr->encoding
	    : GetBinaryEncoding();
    Tcl_EncodingState savedState = statePtr->inputEncodingState;
    ChannelBuffer *bufPtr = statePtr->inQueueHead;
    int savedIEFlags = statePtr->inputEncodingFlags;
    int savedFlags = statePtr->flags;
    char *dst, *src = RemovePoint(bufPtr);
    size_t numBytes;
    int srcLen = BytesLeft(bufPtr);

    /*
     * One src byte can yield at most one character.  So when the number of
     * src bytes we plan to read is less than the limit on character count to
     * be read, clearly we will remain within that limit, and we can use the
     * value of "srcLen" as a tighter limit for sizing receiving buffers.







|





|










|
<





|







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
6227
6228
6229
6230
ReadChars(
    ChannelState *statePtr,	/* State of channel to read. */
    Tcl_Obj *objPtr,		/* Input data is appended to this object.
				 * objPtr->length is how much space has been
				 * allocated to hold data, not how many bytes
				 * of data have been stored in the object. */
    int charsToRead,		/* Maximum number of characters to store, or
				 * TCL_INDEX_NONE to get all available characters.
				 * Characters are obtained from the first
				 * buffer in the queue -- even if this number
				 * is larger than the number of characters
				 * available in the first buffer, only the
				 * characters from the first buffer are
				 * returned. The exception is when there is
				 * not any complete character in the first
				 * buffer.  In that case, a recursive call
				 * effectively obtains chars from the
				 * second buffer. */
    int *factorPtr)		/* On input, contains a guess of how many
				 * bytes need to be allocated to hold the
				 * result of converting N source bytes to
				 * UTF-8. On output, contains another guess
				 * based on the data seen so far. */
{
    Tcl_Encoding encoding = statePtr->encoding;

    Tcl_EncodingState savedState = statePtr->inputEncodingState;
    ChannelBuffer *bufPtr = statePtr->inQueueHead;
    int savedIEFlags = statePtr->inputEncodingFlags;
    int savedFlags = statePtr->flags;
    char *dst, *src = RemovePoint(bufPtr);
    Tcl_Size numBytes;
    int srcLen = BytesLeft(bufPtr);

    /*
     * One src byte can yield at most one character.  So when the number of
     * src bytes we plan to read is less than the limit on character count to
     * be read, clearly we will remain within that limit, and we can use the
     * value of "srcLen" as a tighter limit for sizing receiving buffers.
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
6251

    int factor = *factorPtr;
    int dstLimit = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR;

    (void) Tcl_GetStringFromObj(objPtr, &numBytes);
    Tcl_AppendToObj(objPtr, NULL, dstLimit);
    if (toRead == srcLen) {
	size_t size;

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

    /*
     * Transfer encoding nocomplain/strict option to the encoding flags
     */

    if (GotFlag(statePtr, CHANNEL_ENCODING_NOCOMPLAIN)) {
	statePtr->inputEncodingFlags |= TCL_ENCODING_NOCOMPLAIN;
    } else {
	statePtr->inputEncodingFlags &= ~TCL_ENCODING_NOCOMPLAIN;
    }
    if (GotFlag(statePtr, CHANNEL_ENCODING_STRICT)) {
	statePtr->inputEncodingFlags |= TCL_ENCODING_STRICT;
    } else {
	statePtr->inputEncodingFlags &= ~TCL_ENCODING_STRICT;
    }

    /*
     * This routine is burdened with satisfying several constraints. It cannot
     * append more than 'charsToRead` chars onto objPtr. This is measured
     * after encoding and translation transformations are completed. There is
     * no precise number of src bytes that can be associated with the limit.
     * Yet, when we are done, we must know precisely the number of src bytes
     * that were consumed to produce the appended chars, so that all







|


|




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







6240
6241
6242
6243
6244
6245
6246
6247
6248
6249
6250
6251
6252
6253
6254















6255
6256
6257
6258
6259
6260
6261

    int factor = *factorPtr;
    int dstLimit = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR;

    (void) Tcl_GetStringFromObj(objPtr, &numBytes);
    Tcl_AppendToObj(objPtr, NULL, dstLimit);
    if (toRead == srcLen) {
	Tcl_Size size;

	dst = TclGetStringStorage(objPtr, &size) + numBytes;
	dstLimit = (size - numBytes) > INT_MAX ? INT_MAX : (size - numBytes);
    } else {
	dst = TclGetString(objPtr) + numBytes;
    }
















    /*
     * This routine is burdened with satisfying several constraints. It cannot
     * append more than 'charsToRead` chars onto objPtr. This is measured
     * after encoding and translation transformations are completed. There is
     * no precise number of src bytes that can be associated with the limit.
     * Yet, when we are done, we must know precisely the number of src bytes
     * that were consumed to produce the appended chars, so that all
6282
6283
6284
6285
6286
6287
6288










6289
6290
6291
6292
6293
6294
6295

	assert(bufPtr->nextPtr == NULL || BytesLeft(bufPtr->nextPtr) == 0
		|| (statePtr->inputEncodingFlags & TCL_ENCODING_END) == 0);

	code = Tcl_ExternalToUtf(NULL, encoding, src, srcLen,
		flags, &statePtr->inputEncodingState,
		dst, dstLimit, &srcRead, &dstDecoded, &numChars);











	/*
	 * Perform the translation transformation in place.  Read no more than
	 * the dstDecoded bytes the encoding transformation actually produced.
	 * Capture the number of bytes written in dstWrote. Capture the number
	 * of bytes actually consumed in dstRead.
	 */







>
>
>
>
>
>
>
>
>
>







6292
6293
6294
6295
6296
6297
6298
6299
6300
6301
6302
6303
6304
6305
6306
6307
6308
6309
6310
6311
6312
6313
6314
6315

	assert(bufPtr->nextPtr == NULL || BytesLeft(bufPtr->nextPtr) == 0
		|| (statePtr->inputEncodingFlags & TCL_ENCODING_END) == 0);

	code = Tcl_ExternalToUtf(NULL, encoding, src, srcLen,
		flags, &statePtr->inputEncodingState,
		dst, dstLimit, &srcRead, &dstDecoded, &numChars);

	if (code == TCL_CONVERT_UNKNOWN || code == TCL_CONVERT_SYNTAX
	    || (
		code == TCL_CONVERT_MULTIBYTE
		&& GotFlag(statePtr, CHANNEL_EOF
	    ))
	) {
	    SetFlag(statePtr, CHANNEL_ENCODING_ERROR);
	    code = TCL_OK;
	}

	/*
	 * Perform the translation transformation in place.  Read no more than
	 * the dstDecoded bytes the encoding transformation actually produced.
	 * Capture the number of bytes written in dstWrote. Capture the number
	 * of bytes actually consumed in dstRead.
	 */
6310
6311
6312
6313
6314
6315
6316
6317
6318
6319
6320
6321
6322
6323
6324
6325
6326
6327
6328
6329
		 *    we saw it and stopped translating at that point.
		 *
		 * NOTE the bizarre spec of TranslateInputEOL in this case.
		 * Clearly the eof char had to be read in order to account for
		 * the stopping, but the value of dstRead does not include it.
		 *
		 * Also rather bizarre, our caller can only notice an EOF
		 * condition if we return the value -1 as the number of chars
		 * read.  This forces us to perform a 2-call dance where the
		 * first call can read all the chars up to the eof char, and
		 * the second call is solely for consuming the encoded eof
		 * char then pointed at by src so that we can return that
		 * magic -1 value.  This seems really wasteful, especially
		 * since the first decoding pass of each call is likely to
		 * decode many bytes beyond that eof char that's all we care
		 * about.
		 */

		if (dstRead == 0) {
		    /*







|




|







6330
6331
6332
6333
6334
6335
6336
6337
6338
6339
6340
6341
6342
6343
6344
6345
6346
6347
6348
6349
		 *    we saw it and stopped translating at that point.
		 *
		 * NOTE the bizarre spec of TranslateInputEOL in this case.
		 * Clearly the eof char had to be read in order to account for
		 * the stopping, but the value of dstRead does not include it.
		 *
		 * Also rather bizarre, our caller can only notice an EOF
		 * condition if we return the value TCL_INDEX_NONE as the number of chars
		 * read.  This forces us to perform a 2-call dance where the
		 * first call can read all the chars up to the eof char, and
		 * the second call is solely for consuming the encoded eof
		 * char then pointed at by src so that we can return that
		 * magic TCL_INDEX_NONE value.  This seems really wasteful, especially
		 * since the first decoding pass of each call is likely to
		 * decode many bytes beyond that eof char that's all we care
		 * about.
		 */

		if (dstRead == 0) {
		    /*
6521
6522
6523
6524
6525
6526
6527
6528
6529
6530
6531
6532
6533
6534
6535
	     *
	     * Note that the BUFFER_PADDING (See AllocChannelBuffer) is used
	     * to prevent exactly this situation. I.e. it should never happen.
	     * Therefore it is ok to panic should it happen despite the
	     * precautions.
	     */

	    if (nextPtr->nextRemoved < (size_t)srcLen) {
		Tcl_Panic("Buffer Underflow, BUFFER_PADDING not enough");
	    }

	    nextPtr->nextRemoved -= srcLen;
	    memcpy(RemovePoint(nextPtr), src, srcLen);
	    RecycleBuffer(statePtr, bufPtr, 0);
	    statePtr->inQueueHead = nextPtr;







|







6541
6542
6543
6544
6545
6546
6547
6548
6549
6550
6551
6552
6553
6554
6555
	     *
	     * Note that the BUFFER_PADDING (See AllocChannelBuffer) is used
	     * to prevent exactly this situation. I.e. it should never happen.
	     * Therefore it is ok to panic should it happen despite the
	     * precautions.
	     */

	    if (nextPtr->nextRemoved < srcLen) {
		Tcl_Panic("Buffer Underflow, BUFFER_PADDING not enough");
	    }

	    nextPtr->nextRemoved -= srcLen;
	    memcpy(RemovePoint(nextPtr), src, srcLen);
	    RecycleBuffer(statePtr, bufPtr, 0);
	    statePtr->inQueueHead = nextPtr;
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
    *srcLenPtr = srcLen;

    if (srcStart + srcLen == eof) {
	/*
	 * EOF character was seen in EOL translated range. Leave current file
	 * position pointing at the EOF character, but don't store the EOF
	 * character in the output string.



	 */

	SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);
	statePtr->inputEncodingFlags |= TCL_ENCODING_END;
	ResetFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Ungets --
 *
 *	Causes the supplied string to be added to the input queue of the
 *	channel, at either the head or tail of the queue.
 *
 * Results:
 *	The number of bytes stored in the channel, or TCL_INDEX_NONE on error.
 *
 * Side effects:
 *	Adds input to the input queue of a channel.
 *
 *----------------------------------------------------------------------
 */

size_t
Tcl_Ungets(
    Tcl_Channel chan,		/* The channel for which to add the input. */
    const char *str,		/* The input itself. */
    size_t len,			/* The length of the input. */
    int atEnd)			/* If non-zero, add at end of queue; otherwise
				 * add at head of queue. */
{
    Channel *chanPtr;		/* The real IO channel. */
    ChannelState *statePtr;	/* State of actual channel. */
    ChannelBuffer *bufPtr;	/* Buffer to contain the data. */
    int flags;







>
>
>




|




















|



|







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
    *srcLenPtr = srcLen;

    if (srcStart + srcLen == eof) {
	/*
	 * EOF character was seen in EOL translated range. Leave current file
	 * position pointing at the EOF character, but don't store the EOF
	 * character in the output string.
	 *
	 * If CHANNEL_ENCODING_ERROR is set, it can only be because of data
	 * encountered after the EOF character, so it is nonsense.  Unset it.
	 */

	SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);
	statePtr->inputEncodingFlags |= TCL_ENCODING_END;
	ResetFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR|CHANNEL_ENCODING_ERROR);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Ungets --
 *
 *	Causes the supplied string to be added to the input queue of the
 *	channel, at either the head or tail of the queue.
 *
 * Results:
 *	The number of bytes stored in the channel, or TCL_INDEX_NONE on error.
 *
 * Side effects:
 *	Adds input to the input queue of a channel.
 *
 *----------------------------------------------------------------------
 */

Tcl_Size
Tcl_Ungets(
    Tcl_Channel chan,		/* The channel for which to add the input. */
    const char *str,		/* The input itself. */
    Tcl_Size len,			/* The length of the input. */
    int atEnd)			/* If non-zero, add at end of queue; otherwise
				 * add at head of queue. */
{
    Channel *chanPtr;		/* The real IO channel. */
    ChannelState *statePtr;	/* State of actual channel. */
    ChannelBuffer *bufPtr;	/* Buffer to contain the data. */
    int flags;
7026
7027
7028
7029
7030
7031
7032
7033
7034
7035
7036
7037
7038
7039
7040

	if (bufPtr == NULL) {
	    bufPtr = AllocChannelBuffer(statePtr->bufSize);
	}
	bufPtr->nextPtr = NULL;

	toRead = SpaceLeft(bufPtr);
	assert((size_t)toRead == statePtr->bufSize);

	if (statePtr->inQueueTail == NULL) {
	    statePtr->inQueueHead = bufPtr;
	} else {
	    statePtr->inQueueTail->nextPtr = bufPtr;
	}
	statePtr->inQueueTail = bufPtr;







|







7049
7050
7051
7052
7053
7054
7055
7056
7057
7058
7059
7060
7061
7062
7063

	if (bufPtr == NULL) {
	    bufPtr = AllocChannelBuffer(statePtr->bufSize);
	}
	bufPtr->nextPtr = NULL;

	toRead = SpaceLeft(bufPtr);
	assert((Tcl_Size)toRead == statePtr->bufSize);

	if (statePtr->inQueueTail == NULL) {
	    statePtr->inQueueHead = bufPtr;
	} else {
	    statePtr->inQueueTail->nextPtr = bufPtr;
	}
	statePtr->inQueueTail = bufPtr;
7363
7364
7365
7366
7367
7368
7369
7370
7371
7372
7373
7374
7375
7376
7377

	Tcl_SetErrno(EINVAL);
	return TCL_ERROR;
    }

    /*
     * Seek first to force a total flush of all pending buffers and ditch any
     * pre-read input data.
     */

    WillWrite(chanPtr);

    if (WillRead(chanPtr) == -1) {
        return TCL_ERROR;
    }







|







7386
7387
7388
7389
7390
7391
7392
7393
7394
7395
7396
7397
7398
7399
7400

	Tcl_SetErrno(EINVAL);
	return TCL_ERROR;
    }

    /*
     * Seek first to force a total flush of all pending buffers and ditch any
     * preread input data.
     */

    WillWrite(chanPtr);

    if (WillRead(chanPtr) == -1) {
        return TCL_ERROR;
    }
7423
7424
7425
7426
7427
7428
7429
7430
7431
7432
7433
7434
7435
7436
7437

    if (statePtr->unreportedError != 0) {
	Tcl_SetErrno(statePtr->unreportedError);
	statePtr->unreportedError = 0;

	/*
	 * TIP #219, Tcl Channel Reflection API.
	 * Move a defered error message back into the channel bypass.
	 */

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







|







7446
7447
7448
7449
7450
7451
7452
7453
7454
7455
7456
7457
7458
7459
7460

    if (statePtr->unreportedError != 0) {
	Tcl_SetErrno(statePtr->unreportedError);
	statePtr->unreportedError = 0;

	/*
	 * TIP #219, Tcl Channel Reflection API.
	 * Move a deferred error message back into the channel bypass.
	 */

	if (statePtr->chanMsg != NULL) {
	    TclDecrRefCount(statePtr->chanMsg);
	}
	statePtr->chanMsg = statePtr->unreportedMsg;
	statePtr->unreportedMsg = NULL;
7496
7497
7498
7499
7500
7501
7502



7503
7504
7505
7506
7507
7508
7509
int
Tcl_Eof(
    Tcl_Channel chan)		/* Does this channel have EOF? */
{
    ChannelState *statePtr = ((Channel *) chan)->state;
				/* State of real channel structure. */




    return GotFlag(statePtr, CHANNEL_EOF) ? 1 : 0;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_InputBlocked --







>
>
>







7519
7520
7521
7522
7523
7524
7525
7526
7527
7528
7529
7530
7531
7532
7533
7534
7535
int
Tcl_Eof(
    Tcl_Channel chan)		/* Does this channel have EOF? */
{
    ChannelState *statePtr = ((Channel *) chan)->state;
				/* State of real channel structure. */

    if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR)) {
	return 0;
    }
    return GotFlag(statePtr, CHANNEL_EOF) ? 1 : 0;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_InputBlocked --
7558
7559
7560
7561
7562
7563
7564
7565
7566
7567
7568
7569
7570
7571
7572

    for (bytesBuffered = 0, bufPtr = statePtr->inQueueHead; bufPtr != NULL;
	    bufPtr = bufPtr->nextPtr) {
	bytesBuffered += BytesLeft(bufPtr);
    }

    /*
     * Don't forget the bytes in the topmost pushback area.
     */

    for (bufPtr = statePtr->topChanPtr->inQueueHead; bufPtr != NULL;
	    bufPtr = bufPtr->nextPtr) {
	bytesBuffered += BytesLeft(bufPtr);
    }








|







7584
7585
7586
7587
7588
7589
7590
7591
7592
7593
7594
7595
7596
7597
7598

    for (bytesBuffered = 0, bufPtr = statePtr->inQueueHead; bufPtr != NULL;
	    bufPtr = bufPtr->nextPtr) {
	bytesBuffered += BytesLeft(bufPtr);
    }

    /*
     * Remember the bytes in the topmost pushback area.
     */

    for (bufPtr = statePtr->topChanPtr->inQueueHead; bufPtr != NULL;
	    bufPtr = bufPtr->nextPtr) {
	bytesBuffered += BytesLeft(bufPtr);
    }

7666
7667
7668
7669
7670
7671
7672
7673
7674
7675
7676
7677
7678
7679
7680
7681
7682
7683
7684
7685
7686
7687
7688
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetChannelBufferSize(
    Tcl_Channel chan,		/* The channel whose buffer size to set. */
    size_t sz)			/* The size to set. */
{
    ChannelState *statePtr;	/* State of real channel structure. */

    /*
     * Clip the buffer size to force it into the [1,1M] range
     */

    if (sz < 1 || sz > (TCL_INDEX_NONE>>1)) {
	sz = 1;
    } else if (sz > MAX_CHANNEL_BUFFER_SIZE) {
	sz = MAX_CHANNEL_BUFFER_SIZE;
    }

    statePtr = ((Channel *) chan)->state;








|







|







7692
7693
7694
7695
7696
7697
7698
7699
7700
7701
7702
7703
7704
7705
7706
7707
7708
7709
7710
7711
7712
7713
7714
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetChannelBufferSize(
    Tcl_Channel chan,		/* The channel whose buffer size to set. */
    Tcl_Size sz)			/* The size to set. */
{
    ChannelState *statePtr;	/* State of real channel structure. */

    /*
     * Clip the buffer size to force it into the [1,1M] range
     */

    if (sz < 1) {
	sz = 1;
    } else if (sz > MAX_CHANNEL_BUFFER_SIZE) {
	sz = MAX_CHANNEL_BUFFER_SIZE;
    }

    statePtr = ((Channel *) chan)->state;

7720
7721
7722
7723
7724
7725
7726
7727
7728
7729
7730
7731
7732
7733
7734
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
Tcl_GetChannelBufferSize(
    Tcl_Channel chan)		/* The channel for which to find the buffer
				 * size. */
{
    ChannelState *statePtr = ((Channel *) chan)->state;
				/* State of real channel structure. */








|







7746
7747
7748
7749
7750
7751
7752
7753
7754
7755
7756
7757
7758
7759
7760
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Size
Tcl_GetChannelBufferSize(
    Tcl_Channel chan)		/* The channel for which to find the buffer
				 * size. */
{
    ChannelState *statePtr = ((Channel *) chan)->state;
				/* State of real channel structure. */

7748
7749
7750
7751
7752
7753
7754
7755
7756
7757
7758
7759
7760
7761
7762
 *
 * Results:
 *	TCL_ERROR.
 *
 * Side effects:

 *	An error message is generated in interp's result object to indicate
 *	that a command was invoked with the a bad option. The message has the
 *	form:
 *		bad option "blah": should be one of
 *		<...generic options...>+<...specific options...>
 *	"blah" is the optionName argument and "<specific options>" is a space
 *	separated list of specific option words. The function takes good care
 *	of inserting minus signs before each option, commas after, and an "or"
 *	before the last option.







|







7774
7775
7776
7777
7778
7779
7780
7781
7782
7783
7784
7785
7786
7787
7788
 *
 * Results:
 *	TCL_ERROR.
 *
 * Side effects:

 *	An error message is generated in interp's result object to indicate
 *	that a command was invoked with a bad option. The message has the
 *	form:
 *		bad option "blah": should be one of
 *		<...generic options...>+<...specific options...>
 *	"blah" is the optionName argument and "<specific options>" is a space
 *	separated list of specific option words. The function takes good care
 *	of inserting minus signs before each option, commas after, and an "or"
 *	before the last option.
7770
7771
7772
7773
7774
7775
7776
7777
7778
7779
7780
7781
7782
7783
7784
7785
7786
    const char *optionName,	/* 'bad option' name */
    const char *optionList)	/* Specific options list to append to the
				 * standard generic options. Can be NULL for
				 * generic options only. */
{
    if (interp != NULL) {
	const char *genericopt =
		"blocking buffering buffersize encoding eofchar translation";
	const char **argv;
	size_t argc, i;
	Tcl_DString ds;
        Tcl_Obj *errObj;

	Tcl_DStringInit(&ds);
	Tcl_DStringAppend(&ds, genericopt, -1);
	if (optionList && (*optionList)) {
	    TclDStringAppendLiteral(&ds, " ");







|

|







7796
7797
7798
7799
7800
7801
7802
7803
7804
7805
7806
7807
7808
7809
7810
7811
7812
    const char *optionName,	/* 'bad option' name */
    const char *optionList)	/* Specific options list to append to the
				 * standard generic options. Can be NULL for
				 * generic options only. */
{
    if (interp != NULL) {
	const char *genericopt =
		"blocking buffering buffersize encoding eofchar profile translation";
	const char **argv;
	Tcl_Size argc, i;
	Tcl_DString ds;
        Tcl_Obj *errObj;

	Tcl_DStringInit(&ds);
	Tcl_DStringAppend(&ds, genericopt, -1);
	if (optionList && (*optionList)) {
	    TclDStringAppendLiteral(&ds, " ");
7830
7831
7832
7833
7834
7835
7836
7837
7838
7839
7840
7841
7842
7843
7844
Tcl_GetChannelOption(
    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
    Tcl_Channel chan,		/* Channel on which to get option. */
    const char *optionName,	/* Option to get. */
    Tcl_DString *dsPtr)		/* Where to store value(s). */
{
    size_t len;			/* Length of optionName string. */
    char optionVal[128];	/* Buffer for sprintf. */
    Channel *chanPtr = (Channel *) chan;
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */
    int flags;

    /*
     * Disallow options on dead channels -- channels that have been closed but







|







7856
7857
7858
7859
7860
7861
7862
7863
7864
7865
7866
7867
7868
7869
7870
Tcl_GetChannelOption(
    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
    Tcl_Channel chan,		/* Channel on which to get option. */
    const char *optionName,	/* Option to get. */
    Tcl_DString *dsPtr)		/* Where to store value(s). */
{
    size_t len;			/* Length of optionName string. */
    char optionVal[128];	/* Buffer for snprintf. */
    Channel *chanPtr = (Channel *) chan;
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */
    int flags;

    /*
     * Disallow options on dead channels -- channels that have been closed but
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
	    return TCL_OK;
	}
    }
    if (len == 0 || HaveOpt(2, "-encoding")) {
	if (len == 0) {
	    Tcl_DStringAppendElement(dsPtr, "-encoding");
	}
	if (statePtr->encoding == NULL) {
	    Tcl_DStringAppendElement(dsPtr, "binary");
	} else {
	    Tcl_DStringAppendElement(dsPtr,
		    Tcl_GetEncodingName(statePtr->encoding));
	}
	if (len > 0) {
	    return TCL_OK;
	}
    }
    if (len == 0 || HaveOpt(2, "-eofchar")) {
	char buf[4] = "";
	if (len == 0) {
	    Tcl_DStringAppendElement(dsPtr, "-eofchar");
	}
	if ((flags & TCL_READABLE) && (statePtr->inEofChar != 0)) {
	    sprintf(buf, "%c", statePtr->inEofChar);
	}
	if (len > 0) {
		Tcl_DStringAppend(dsPtr, buf, TCL_INDEX_NONE);
	    return TCL_OK;
	}
	Tcl_DStringAppendElement(dsPtr, buf);
    }
    if (len == 0 || HaveOpt(1, "-nocomplainencoding")) {


	if (len == 0) {
	    Tcl_DStringAppendElement(dsPtr, "-nocomplainencoding");
	}
	Tcl_DStringAppendElement(dsPtr,

		(flags & CHANNEL_ENCODING_NOCOMPLAIN) ? "1" : "0");

	if (len > 0) {
	    return TCL_OK;
	}
    }
    if (len == 0 || HaveOpt(1, "-strictencoding")) {
	if (len == 0) {
	    Tcl_DStringAppendElement(dsPtr, "-strictencoding");
	}
	Tcl_DStringAppendElement(dsPtr,
		(flags & CHANNEL_ENCODING_STRICT) ? "1" : "0");
	if (len > 0) {
	    return TCL_OK;
	}
    }
    if (len == 0 || HaveOpt(1, "-translation")) {
	if (len == 0) {
	    Tcl_DStringAppendElement(dsPtr, "-translation");







<
<
<
|
|
<










|


|




|
>
>

|

<
>
|
>
|
|

<
<
<
|
<
<
<







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
	    return TCL_OK;
	}
    }
    if (len == 0 || HaveOpt(2, "-encoding")) {
	if (len == 0) {
	    Tcl_DStringAppendElement(dsPtr, "-encoding");
	}



	Tcl_DStringAppendElement(dsPtr,
	    Tcl_GetEncodingName(statePtr->encoding));

	if (len > 0) {
	    return TCL_OK;
	}
    }
    if (len == 0 || HaveOpt(2, "-eofchar")) {
	char buf[4] = "";
	if (len == 0) {
	    Tcl_DStringAppendElement(dsPtr, "-eofchar");
	}
	if ((flags & TCL_READABLE) && (statePtr->inEofChar != 0)) {
	    snprintf(buf, sizeof(buf), "%c", statePtr->inEofChar);
	}
	if (len > 0) {
		Tcl_DStringAppend(dsPtr, buf, -1);
	    return TCL_OK;
	}
	Tcl_DStringAppendElement(dsPtr, buf);
    }
    if (len == 0 || HaveOpt(1, "-profile")) {
	int profile;
	const char *profileName;
	if (len == 0) {
	    Tcl_DStringAppendElement(dsPtr, "-profile");
	}

	/* Note currently input and output profiles are same */
	profile = ENCODING_PROFILE_GET(statePtr->inputEncodingFlags);
	profileName = TclEncodingProfileIdToName(interp, profile);
	if (profileName == NULL) {
	    return TCL_ERROR;
	}



	Tcl_DStringAppendElement(dsPtr, profileName);



	if (len > 0) {
	    return TCL_OK;
	}
    }
    if (len == 0 || HaveOpt(1, "-translation")) {
	if (len == 0) {
	    Tcl_DStringAppendElement(dsPtr, "-translation");
8054
8055
8056
8057
8058
8059
8060
8061
8062
8063
8064
8065
8066
8067
8068
    const char *newValue)	/* New value for option. */
{
    Channel *chanPtr = (Channel *) chan;
				/* The real IO channel. */
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */
    size_t len;			/* Length of optionName string. */
    size_t argc;
    const char **argv = NULL;

    /*
     * If the channel is in the middle of a background copy, fail.
     */

    if (statePtr->csPtrR || statePtr->csPtrW) {







|







8073
8074
8075
8076
8077
8078
8079
8080
8081
8082
8083
8084
8085
8086
8087
    const char *newValue)	/* New value for option. */
{
    Channel *chanPtr = (Channel *) chan;
				/* The real IO channel. */
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */
    size_t len;			/* Length of optionName string. */
    Tcl_Size argc;
    const char **argv = NULL;

    /*
     * If the channel is in the middle of a background copy, fail.
     */

    if (statePtr->csPtrR || statePtr->csPtrW) {
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
	if (code == TCL_ERROR) {
	    return TCL_ERROR;
	}
	Tcl_SetChannelBufferSize(chan, newBufferSize);
	return TCL_OK;
    } else if (HaveOpt(2, "-encoding")) {
	Tcl_Encoding encoding;


	if ((newValue[0] == '\0') || (strcmp(newValue, "binary") == 0)) {
	    encoding = NULL;






	} else {
	    encoding = Tcl_GetEncoding(interp, newValue);
	    if (encoding == NULL) {
		return TCL_ERROR;
	    }
	}

	/*
	 * When the channel has an escape sequence driven encoding such as
	 * iso2022, the terminated escape sequence must write to the buffer.
	 */

	if ((statePtr->encoding != NULL)
		&& !(statePtr->outputEncodingFlags & TCL_ENCODING_START)
		&& (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) {
	    statePtr->outputEncodingFlags |= TCL_ENCODING_END;
	    WriteChars(chanPtr, "", 0);
	}
	Tcl_FreeEncoding(statePtr->encoding);
	statePtr->encoding = encoding;
	statePtr->inputEncodingState = NULL;

	statePtr->inputEncodingFlags = TCL_ENCODING_START;

	statePtr->outputEncodingState = NULL;
	statePtr->outputEncodingFlags = TCL_ENCODING_START;

	ResetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
	UpdateInterest(chanPtr);
	return TCL_OK;
    } else if (HaveOpt(2, "-eofchar")) {
	if (!newValue[0] || (!(newValue[0] & 0x80) && (!newValue[1]
#ifndef TCL_NO_DEPRECATED
		|| !strcmp(newValue+1, " {}")
#endif
		))) {
	    if (GotFlag(statePtr, TCL_READABLE)) {
		statePtr->inEofChar = newValue[0];
	    }
	} else {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"bad value for -eofchar: must be non-NUL ASCII"
			" character", -1));
	    }
	    Tcl_Free((void *)argv);
	    return TCL_ERROR;
	}
	if (argv != NULL) {
	    Tcl_Free((void *)argv);
	}

	/*
	 * [Bug 930851] Reset EOF and BLOCKED flags. Changing the character
	 * which signals eof can transform a current eof condition into a 'go
	 * ahead'. Ditto for blocked.
	 */

	if (GotFlag(statePtr, CHANNEL_EOF)) {
	    statePtr->inputEncodingFlags |= TCL_ENCODING_START;
	}
	ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_STICKY_EOF|CHANNEL_BLOCKED);
	statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
	return TCL_OK;
    } else if (HaveOpt(1, "-nocomplainencoding")) {
	int newMode;

	if (Tcl_GetBoolean(interp, newValue, &newMode) == TCL_ERROR) {
	    return TCL_ERROR;
	}
	if (newMode) {
	    ResetFlag(statePtr, CHANNEL_ENCODING_STRICT);
	    SetFlag(statePtr, CHANNEL_ENCODING_NOCOMPLAIN);
	} else {
	    ResetFlag(statePtr, CHANNEL_ENCODING_NOCOMPLAIN);
	}
	return TCL_OK;
    } else if (HaveOpt(1, "-strictencoding")) {
	int newMode;

	if (Tcl_GetBoolean(interp, newValue, &newMode) == TCL_ERROR) {
	    return TCL_ERROR;
	}
	if (newMode) {
	    ResetFlag(statePtr, CHANNEL_ENCODING_NOCOMPLAIN);
	    SetFlag(statePtr, CHANNEL_ENCODING_STRICT);
	} else {
	    ResetFlag(statePtr, CHANNEL_ENCODING_STRICT);
	}
	return TCL_OK;
    } else if (HaveOpt(1, "-translation")) {
	const char *readMode, *writeMode;

	if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {
	    return TCL_ERROR;
	}







>


|
>
>
>
>
>
>












|








>

>


>
|















|




















|
|
|
<


<
|
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
|
<







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
	if (code == TCL_ERROR) {
	    return TCL_ERROR;
	}
	Tcl_SetChannelBufferSize(chan, newBufferSize);
	return TCL_OK;
    } else if (HaveOpt(2, "-encoding")) {
	Tcl_Encoding encoding;
	int profile;

	if ((newValue[0] == '\0') || (strcmp(newValue, "binary") == 0)) {
	    encoding = Tcl_GetEncoding(NULL, "iso8859-1");
	    ENCODING_PROFILE_SET(statePtr->inputEncodingFlags
		    ,ENCODING_PROFILE_GET(statePtr->inputEncodingFlags)
			|TCL_ENCODING_PROFILE_STRICT);
	    ENCODING_PROFILE_SET(statePtr->outputEncodingFlags
		    ,ENCODING_PROFILE_GET(statePtr->outputEncodingFlags)
			|TCL_ENCODING_PROFILE_STRICT);
	} else {
	    encoding = Tcl_GetEncoding(interp, newValue);
	    if (encoding == NULL) {
		return TCL_ERROR;
	    }
	}

	/*
	 * When the channel has an escape sequence driven encoding such as
	 * iso2022, the terminated escape sequence must write to the buffer.
	 */

	if ((statePtr->encoding != GetBinaryEncoding())
		&& !(statePtr->outputEncodingFlags & TCL_ENCODING_START)
		&& (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) {
	    statePtr->outputEncodingFlags |= TCL_ENCODING_END;
	    WriteChars(chanPtr, "", 0);
	}
	Tcl_FreeEncoding(statePtr->encoding);
	statePtr->encoding = encoding;
	statePtr->inputEncodingState = NULL;
	profile = ENCODING_PROFILE_GET(statePtr->inputEncodingFlags);
	statePtr->inputEncodingFlags = TCL_ENCODING_START;
	ENCODING_PROFILE_SET(statePtr->inputEncodingFlags, profile);
	statePtr->outputEncodingState = NULL;
	statePtr->outputEncodingFlags = TCL_ENCODING_START;
	ENCODING_PROFILE_SET(statePtr->outputEncodingFlags, profile); /* Same as input */
	ResetFlag(statePtr, CHANNEL_NEED_MORE_DATA|CHANNEL_ENCODING_ERROR);
	UpdateInterest(chanPtr);
	return TCL_OK;
    } else if (HaveOpt(2, "-eofchar")) {
	if (!newValue[0] || (!(newValue[0] & 0x80) && (!newValue[1]
#ifndef TCL_NO_DEPRECATED
		|| !strcmp(newValue+1, " {}")
#endif
		))) {
	    if (GotFlag(statePtr, TCL_READABLE)) {
		statePtr->inEofChar = newValue[0];
	    }
	} else {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"bad value for -eofchar: must be non-NUL ASCII"
			" character", TCL_INDEX_NONE));
	    }
	    Tcl_Free((void *)argv);
	    return TCL_ERROR;
	}
	if (argv != NULL) {
	    Tcl_Free((void *)argv);
	}

	/*
	 * [Bug 930851] Reset EOF and BLOCKED flags. Changing the character
	 * which signals eof can transform a current eof condition into a 'go
	 * ahead'. Ditto for blocked.
	 */

	if (GotFlag(statePtr, CHANNEL_EOF)) {
	    statePtr->inputEncodingFlags |= TCL_ENCODING_START;
	}
	ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_STICKY_EOF|CHANNEL_BLOCKED);
	statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
	return TCL_OK;
    } else if (HaveOpt(1, "-profile")) {
	int profile;
	if (TclEncodingProfileNameToId(interp, newValue, &profile) != TCL_OK) {

	    return TCL_ERROR;
	}

	ENCODING_PROFILE_SET(statePtr->inputEncodingFlags, profile);







	ENCODING_PROFILE_SET(statePtr->outputEncodingFlags, profile);







	ResetFlag(statePtr, CHANNEL_NEED_MORE_DATA|CHANNEL_ENCODING_ERROR);

	return TCL_OK;
    } else if (HaveOpt(1, "-translation")) {
	const char *readMode, *writeMode;

	if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {
	    return TCL_ERROR;
	}
8264
8265
8266
8267
8268
8269
8270
8271






8272
8273
8274
8275
8276
8277
8278
		translation = statePtr->inputTranslation;
	    } else if (strcmp(readMode, "auto") == 0) {
		translation = TCL_TRANSLATE_AUTO;
	    } else if (strcmp(readMode, "binary") == 0) {
		translation = TCL_TRANSLATE_LF;
		statePtr->inEofChar = 0;
		Tcl_FreeEncoding(statePtr->encoding);
		statePtr->encoding = NULL;






	    } else if (strcmp(readMode, "lf") == 0) {
		translation = TCL_TRANSLATE_LF;
	    } else if (strcmp(readMode, "cr") == 0) {
		translation = TCL_TRANSLATE_CR;
	    } else if (strcmp(readMode, "crlf") == 0) {
		translation = TCL_TRANSLATE_CRLF;
	    } else if (strcmp(readMode, "platform") == 0) {







|
>
>
>
>
>
>







8276
8277
8278
8279
8280
8281
8282
8283
8284
8285
8286
8287
8288
8289
8290
8291
8292
8293
8294
8295
8296
		translation = statePtr->inputTranslation;
	    } else if (strcmp(readMode, "auto") == 0) {
		translation = TCL_TRANSLATE_AUTO;
	    } else if (strcmp(readMode, "binary") == 0) {
		translation = TCL_TRANSLATE_LF;
		statePtr->inEofChar = 0;
		Tcl_FreeEncoding(statePtr->encoding);
		statePtr->encoding = Tcl_GetEncoding(NULL, "iso8859-1");
		ENCODING_PROFILE_SET(statePtr->inputEncodingFlags
			,ENCODING_PROFILE_GET(statePtr->inputEncodingFlags)
			    |TCL_ENCODING_PROFILE_STRICT);
		ENCODING_PROFILE_SET(statePtr->outputEncodingFlags
			,ENCODING_PROFILE_GET(statePtr->outputEncodingFlags)
			    |TCL_ENCODING_PROFILE_STRICT);
	    } else if (strcmp(readMode, "lf") == 0) {
		translation = TCL_TRANSLATE_LF;
	    } else if (strcmp(readMode, "cr") == 0) {
		translation = TCL_TRANSLATE_CR;
	    } else if (strcmp(readMode, "crlf") == 0) {
		translation = TCL_TRANSLATE_CRLF;
	    } else if (strcmp(readMode, "platform") == 0) {
8313
8314
8315
8316
8317
8318
8319
8320






8321
8322
8323
8324
8325
8326
8327
		    statePtr->outputTranslation = TCL_TRANSLATE_CRLF;
		} else {
		    statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
		}
	    } else if (strcmp(writeMode, "binary") == 0) {
		statePtr->outputTranslation = TCL_TRANSLATE_LF;
		Tcl_FreeEncoding(statePtr->encoding);
		statePtr->encoding = NULL;






	    } else if (strcmp(writeMode, "lf") == 0) {
		statePtr->outputTranslation = TCL_TRANSLATE_LF;
	    } else if (strcmp(writeMode, "cr") == 0) {
		statePtr->outputTranslation = TCL_TRANSLATE_CR;
	    } else if (strcmp(writeMode, "crlf") == 0) {
		statePtr->outputTranslation = TCL_TRANSLATE_CRLF;
	    } else if (strcmp(writeMode, "platform") == 0) {







|
>
>
>
>
>
>







8331
8332
8333
8334
8335
8336
8337
8338
8339
8340
8341
8342
8343
8344
8345
8346
8347
8348
8349
8350
8351
		    statePtr->outputTranslation = TCL_TRANSLATE_CRLF;
		} else {
		    statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
		}
	    } else if (strcmp(writeMode, "binary") == 0) {
		statePtr->outputTranslation = TCL_TRANSLATE_LF;
		Tcl_FreeEncoding(statePtr->encoding);
		statePtr->encoding = Tcl_GetEncoding(NULL, "iso8859-1");
		ENCODING_PROFILE_SET(statePtr->inputEncodingFlags
			,ENCODING_PROFILE_GET(statePtr->inputEncodingFlags)
			    |TCL_ENCODING_PROFILE_STRICT);
		ENCODING_PROFILE_SET(statePtr->outputEncodingFlags
			,ENCODING_PROFILE_GET(statePtr->outputEncodingFlags)
			    |TCL_ENCODING_PROFILE_STRICT);
	    } else if (strcmp(writeMode, "lf") == 0) {
		statePtr->outputTranslation = TCL_TRANSLATE_LF;
	    } else if (strcmp(writeMode, "cr") == 0) {
		statePtr->outputTranslation = TCL_TRANSLATE_CR;
	    } else if (strcmp(writeMode, "crlf") == 0) {
		statePtr->outputTranslation = TCL_TRANSLATE_CRLF;
	    } else if (strcmp(writeMode, "platform") == 0) {
8649
8650
8651
8652
8653
8654
8655


8656
8657
8658
8659
8660
8661
8662
8663
8664
8665


8666
8667
8668
8669
8670
8671
8672
	     * events too. This compiles on all platforms, and also passes the
	     * testsuite on all of them.
	     */

	    mask &= ~TCL_EXCEPTION;

	    if (!statePtr->timer) {


		statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
                        ChannelTimerProc, chanPtr);
	    }
	}
    }

    if (!statePtr->timer
	&& mask & TCL_WRITABLE
	&& GotFlag(statePtr, CHANNEL_NONBLOCKING)) {



	statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
	    ChannelTimerProc,chanPtr);
    }


    ChanWatch(chanPtr, mask);
}







>
>

|








>
>







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
	     * events too. This compiles on all platforms, and also passes the
	     * testsuite on all of them.
	     */

	    mask &= ~TCL_EXCEPTION;

	    if (!statePtr->timer) {
		TclChannelPreserve((Tcl_Channel)chanPtr);
		statePtr->timerChanPtr = chanPtr;
		statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
		    ChannelTimerProc, chanPtr);
	    }
	}
    }

    if (!statePtr->timer
	&& mask & TCL_WRITABLE
	&& GotFlag(statePtr, CHANNEL_NONBLOCKING)) {

	TclChannelPreserve((Tcl_Channel)chanPtr);
	statePtr->timerChanPtr = chanPtr;
	statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
	    ChannelTimerProc,chanPtr);
    }


    ChanWatch(chanPtr, mask);
}
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
 */

static void
ChannelTimerProc(
    void *clientData)
{
    Channel *chanPtr = (Channel *)clientData;

    /* State info for channel */
    ChannelState *statePtr = chanPtr->state;



	/* Preserve chanPtr to guard against deallocation in Tcl_NotifyChannel. */


    TclChannelPreserve((Tcl_Channel)chanPtr);



    Tcl_Preserve(statePtr);
    statePtr->timer = NULL;
    if (statePtr->interestMask & TCL_WRITABLE
	&& GotFlag(statePtr, CHANNEL_NONBLOCKING)
	&& !GotFlag(statePtr, BG_FLUSH_SCHEDULED)
	) {
	/*
	 * Restart the timer in case a channel handler reenters the event loop
	 * before UpdateInterest gets called by Tcl_NotifyChannel.
	 */
	statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
                ChannelTimerProc,chanPtr);
	Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_WRITABLE);
    }

    /* The channel may have just been closed from within Tcl_NotifyChannel */
    if (!GotFlag(statePtr, CHANNEL_INCLOSE)) {
	if (!GotFlag(statePtr, CHANNEL_NEED_MORE_DATA)
		&& (statePtr->interestMask & TCL_READABLE)
		&& (statePtr->inQueueHead != NULL)
		&& IsBufferReady(statePtr->inQueueHead)) {
	    /*
	     * Restart the timer in case a channel handler reenters the event loop
	     * before UpdateInterest gets called by Tcl_NotifyChannel.
	     */

	    statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
		    ChannelTimerProc,chanPtr);
	    Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_READABLE);
	} else {

	    UpdateInterest(chanPtr);
	}


    }

    Tcl_Release(statePtr);

















    TclChannelRelease((Tcl_Channel)chanPtr);


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







<



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

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







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

static void
ChannelTimerProc(
    void *clientData)
{
    Channel *chanPtr = (Channel *)clientData;

    /* State info for channel */
    ChannelState *statePtr = chanPtr->state;

    /* TclChannelPreserve() must be called before the current function was
     * scheduled, is already in effect.  In this function it guards against
     * deallocation in Tcl_NotifyChannel and also keps the channel preserved
     * until ChannelTimerProc is later called again.
     */

    if (chanPtr->typePtr == NULL) {
	CleanupTimerHandler(statePtr);
    } else {
	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);

	} else {
	    /* The channel may have just been closed from within Tcl_NotifyChannel */
	    if (!GotFlag(statePtr, CHANNEL_INCLOSE)) {
		if (!GotFlag(statePtr, CHANNEL_NEED_MORE_DATA)
		    && (statePtr->interestMask & TCL_READABLE)
		    && (statePtr->inQueueHead != NULL)
		    && IsBufferReady(statePtr->inQueueHead)) {
		    /*
		     * Restart the timer in case a channel handler reenters the event loop
		     * before UpdateInterest gets called by Tcl_NotifyChannel.
		     */

		    statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
			ChannelTimerProc,chanPtr);
		    Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_READABLE);
		} else {
		    CleanupTimerHandler(statePtr);
		    UpdateInterest(chanPtr);
		}
	    } else {
		CleanupTimerHandler(statePtr);
	    }
	}
	Tcl_Release(statePtr);
    }
}

static void
DeleteTimerHandler(
    ChannelState *statePtr
)
{
    if (statePtr->timer != NULL) {
	Tcl_DeleteTimerHandler(statePtr->timer);
	CleanupTimerHandler(statePtr);
    }
}
static void
CleanupTimerHandler(
    ChannelState *statePtr
){
    TclChannelRelease((Tcl_Channel)statePtr->timerChanPtr);
    statePtr->timer = NULL;
    statePtr->timerChanPtr = NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateChannelHandler --
 *
9298
9299
9300
9301
9302
9303
9304
9305
9306
9307
9308
9309
9310
9311
9312
9313
9314
9315
9316
9317
9318
9319
9320
9321
    /*
     * Make sure the output side is unbuffered.
     */

    ResetFlag(outStatePtr, CHANNEL_LINEBUFFERED);
    SetFlag(outStatePtr, CHANNEL_UNBUFFERED);

    /*
     * Test for conditions where we know we can just move bytes from input
     * channel to output channel with no transformation or even examination
     * of the bytes themselves.
     */

    moveBytes = inStatePtr->inEofChar == '\0'	/* No eofChar to stop input */
	    && inStatePtr->inputTranslation == TCL_TRANSLATE_LF
	    && outStatePtr->outputTranslation == TCL_TRANSLATE_LF
	    && inStatePtr->encoding == outStatePtr->encoding;

    /*
     * Allocate a new CopyState to maintain info about the current copy in
     * progress. This structure will be deallocated when the copy is
     * completed.
     */








<
<
<
<
<
|
<
<
<
<







9353
9354
9355
9356
9357
9358
9359





9360




9361
9362
9363
9364
9365
9366
9367
    /*
     * Make sure the output side is unbuffered.
     */

    ResetFlag(outStatePtr, CHANNEL_LINEBUFFERED);
    SetFlag(outStatePtr, CHANNEL_UNBUFFERED);






    moveBytes = Lossless(inStatePtr, outStatePtr, toRead);





    /*
     * Allocate a new CopyState to maintain info about the current copy in
     * progress. This structure will be deallocated when the copy is
     * completed.
     */

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
    CopyState *csPtr,		/* State of copy operation. */
    int mask)			/* Current channel event flags. */
{
    Tcl_Interp *interp;
    Tcl_Obj *cmdPtr, *errObj = NULL, *bufObj = NULL, *msg = NULL;
    Tcl_Channel inChan, outChan;
    ChannelState *inStatePtr, *outStatePtr;
    int result = TCL_OK, size;
    size_t sizeb;
    Tcl_WideInt total;

    const char *buffer;
    int inBinary, outBinary, sameEncoding;
				/* Encoding control */
    int underflow;		/* Input underflow */

    inChan	= (Tcl_Channel) csPtr->readPtr;
    outChan	= (Tcl_Channel) csPtr->writePtr;
    inStatePtr	= csPtr->readPtr->state;
    outStatePtr	= csPtr->writePtr->state;
    interp	= csPtr->interp;
    cmdPtr	= csPtr->cmdPtr;

    /*
     * Copy the data the slow way, using the translation mechanism.
     *
     * Note: We have make sure that we use the topmost channel in a stack for
     * the copying. The caller uses Tcl_GetChannel to access it, and thus gets
     * the bottom of the stack.
     */

    inBinary = (inStatePtr->encoding == NULL);
    outBinary = (outStatePtr->encoding == NULL);
    sameEncoding = (inStatePtr->encoding == outStatePtr->encoding);

    if (!(inBinary || sameEncoding)) {
	TclNewObj(bufObj);
	Tcl_IncrRefCount(bufObj);
    }

    while (csPtr->toRead != (Tcl_WideInt) 0) {
	/*
	 * Check for unreported background errors.
	 */

	Tcl_GetChannelError(inChan, &msg);
	if ((inStatePtr->unreportedError != 0) || (msg != NULL)) {
	    Tcl_SetErrno(inStatePtr->unreportedError);
	    inStatePtr->unreportedError = 0;
	    goto readError;




	}
	Tcl_GetChannelError(outChan, &msg);
	if ((outStatePtr->unreportedError != 0) || (msg != NULL)) {
	    Tcl_SetErrno(outStatePtr->unreportedError);
	    outStatePtr->unreportedError = 0;




	    goto writeError;
	}

	if (cmdPtr && (mask == 0)) {
	    /*
	     * In async mode, we skip reading synchronously and fake an
	     * underflow instead to prime the readable fileevent.
	     */

	    size = 0;
	    underflow = 1;
	} else {
	    /*
	     * Read up to bufSize bytes.
	     */

	    if ((csPtr->toRead == (Tcl_WideInt) -1)
                    || (csPtr->toRead > (Tcl_WideInt) csPtr->bufSize)) {
		sizeb = csPtr->bufSize;
	    } else {
		sizeb = csPtr->toRead;
	    }

	    if (inBinary || sameEncoding) {
		size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb,
                              !GotFlag(inStatePtr, CHANNEL_NONBLOCKING));
	    } else {
		size = DoReadChars(inStatePtr->topChanPtr, bufObj, sizeb,

			0 /* No append */);
	    }
	    underflow = (size >= 0) && ((size_t)size < sizeb);	/* Input underflow */
	}

	if (size < 0) {
	readError:
	    if (interp) {
		TclNewObj(errObj);
		Tcl_AppendStringsToObj(errObj, "error reading \"",







|
|

>

|
<

















|
<
<

|














>
>
>
>





>
>
>
>













|









|




>
|

|







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
    CopyState *csPtr,		/* State of copy operation. */
    int mask)			/* Current channel event flags. */
{
    Tcl_Interp *interp;
    Tcl_Obj *cmdPtr, *errObj = NULL, *bufObj = NULL, *msg = NULL;
    Tcl_Channel inChan, outChan;
    ChannelState *inStatePtr, *outStatePtr;
    int result = TCL_OK;
    Tcl_Size sizeb;
    Tcl_WideInt total;
    Tcl_WideInt size;
    const char *buffer;
    int moveBytes;

    int underflow;		/* Input underflow */

    inChan	= (Tcl_Channel) csPtr->readPtr;
    outChan	= (Tcl_Channel) csPtr->writePtr;
    inStatePtr	= csPtr->readPtr->state;
    outStatePtr	= csPtr->writePtr->state;
    interp	= csPtr->interp;
    cmdPtr	= csPtr->cmdPtr;

    /*
     * Copy the data the slow way, using the translation mechanism.
     *
     * Note: We have make sure that we use the topmost channel in a stack for
     * the copying. The caller uses Tcl_GetChannel to access it, and thus gets
     * the bottom of the stack.
     */

    moveBytes = Lossless(inStatePtr, outStatePtr, csPtr->toRead);



    if (!moveBytes) {
	TclNewObj(bufObj);
	Tcl_IncrRefCount(bufObj);
    }

    while (csPtr->toRead != (Tcl_WideInt) 0) {
	/*
	 * Check for unreported background errors.
	 */

	Tcl_GetChannelError(inChan, &msg);
	if ((inStatePtr->unreportedError != 0) || (msg != NULL)) {
	    Tcl_SetErrno(inStatePtr->unreportedError);
	    inStatePtr->unreportedError = 0;
	    goto readError;
	} else if (inStatePtr->flags & CHANNEL_ENCODING_ERROR) {
	    Tcl_SetErrno(EILSEQ);
	    inStatePtr->flags &= ~CHANNEL_ENCODING_ERROR;
	    goto readError;
	}
	Tcl_GetChannelError(outChan, &msg);
	if ((outStatePtr->unreportedError != 0) || (msg != NULL)) {
	    Tcl_SetErrno(outStatePtr->unreportedError);
	    outStatePtr->unreportedError = 0;
	    goto writeError;
	} else if (outStatePtr->flags & CHANNEL_ENCODING_ERROR) {
	    Tcl_SetErrno(EILSEQ);
	    outStatePtr->flags &= ~CHANNEL_ENCODING_ERROR;
	    goto writeError;
	}

	if (cmdPtr && (mask == 0)) {
	    /*
	     * In async mode, we skip reading synchronously and fake an
	     * underflow instead to prime the readable fileevent.
	     */

	    size = 0;
	    underflow = 1;
	} else {
	    /*
	     * Read up to bufSize characters.
	     */

	    if ((csPtr->toRead == (Tcl_WideInt) -1)
                    || (csPtr->toRead > (Tcl_WideInt) csPtr->bufSize)) {
		sizeb = csPtr->bufSize;
	    } else {
		sizeb = csPtr->toRead;
	    }

	    if (moveBytes) {
		size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb,
                              !GotFlag(inStatePtr, CHANNEL_NONBLOCKING));
	    } else {
		size = DoReadChars(inStatePtr->topChanPtr, bufObj, sizeb,
			!GotFlag(inStatePtr, CHANNEL_NONBLOCKING)
			,0 /* No append */);
	    }
	    underflow = (size >= 0) && (size < sizeb);	/* Input underflow */
	}

	if (size < 0) {
	readError:
	    if (interp) {
		TclNewObj(errObj);
		Tcl_AppendStringsToObj(errObj, "error reading \"",
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
	    }
	}

	/*
	 * Now write the buffer out.
	 */

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

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

	/*
	 * [Bug 2895565]. At this point 'size' still contains the number of
	 * bytes or characters which have been read. We keep this to later to
	 * update the totals and toRead information, see marker (UP) below. We
	 * must not overwrite it with 'sizeb', which is the number of written
	 * bytes or characters, and both EOL translation and encoding
	 * conversion may have changed this number unpredictably in relation
	 * to 'size' (It can be smaller or larger, in the latter case able to
	 * drive toRead below -1, causing infinite looping). Completely
	 * unsuitable for updating totals and toRead.
	 */

	if (sizeb == TCL_INDEX_NONE) {
	writeError:
	    if (interp) {
		TclNewObj(errObj);
		Tcl_AppendStringsToObj(errObj, "error writing \"",
			Tcl_GetChannelName(outChan), "\": ", NULL);
		if (msg != NULL) {
		    Tcl_AppendObjToObj(errObj, msg);
		} else {
		    Tcl_AppendStringsToObj(errObj, Tcl_PosixError(interp),
			    NULL);
		}
	    }
	    if (msg != NULL) {
		Tcl_DecrRefCount(msg);
	    }
	    break;
	}

	/*
	 * Update the current byte count. Do it now so the count is valid
	 * before a return or break takes us out of the loop. The invariant at
	 * the top of the loop should be that csPtr->toRead holds the number
	 * of bytes left to copy.
	 */

	if (csPtr->toRead != -1) {
	    csPtr->toRead -= size;
	}
	csPtr->total += size;








|

|


<
<
<
<
<





|


|






|



















|


|







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

	/*
	 * Now write the buffer out.
	 */

	if (moveBytes) {
	    buffer = csPtr->buffer;
	    sizeb = WriteBytes(outStatePtr->topChanPtr, buffer, size);
	} else {
	    buffer = Tcl_GetStringFromObj(bufObj, &sizeb);





	    sizeb = WriteChars(outStatePtr->topChanPtr, buffer, sizeb);
	}

	/*
	 * [Bug 2895565]. At this point 'size' still contains the number of
	 * characters which have been read. We keep this to later to
	 * update the totals and toRead information, see marker (UP) below. We
	 * must not overwrite it with 'sizeb', which is the number of written
	 * characters, and both EOL translation and encoding
	 * conversion may have changed this number unpredictably in relation
	 * to 'size' (It can be smaller or larger, in the latter case able to
	 * drive toRead below -1, causing infinite looping). Completely
	 * unsuitable for updating totals and toRead.
	 */

	if (sizeb < 0) {
	writeError:
	    if (interp) {
		TclNewObj(errObj);
		Tcl_AppendStringsToObj(errObj, "error writing \"",
			Tcl_GetChannelName(outChan), "\": ", NULL);
		if (msg != NULL) {
		    Tcl_AppendObjToObj(errObj, msg);
		} else {
		    Tcl_AppendStringsToObj(errObj, Tcl_PosixError(interp),
			    NULL);
		}
	    }
	    if (msg != NULL) {
		Tcl_DecrRefCount(msg);
	    }
	    break;
	}

	/*
	 * Update the current character count. Do it now so the count is valid
	 * before a return or break takes us out of the loop. The invariant at
	 * the top of the loop should be that csPtr->toRead holds the number
	 * of characters left to copy.
	 */

	if (csPtr->toRead != -1) {
	    csPtr->toRead -= size;
	}
	csPtr->total += size;

9860
9861
9862
9863
9864
9865
9866
9867
9868
9869
9870
9871
9872
9873
9874
9875

    if (bufObj != NULL) {
	TclDecrRefCount(bufObj);
	bufObj = NULL;
    }

    /*
     * Make the callback or return the number of bytes transferred. The local
     * total is used because StopCopy frees csPtr.
     */

    total = csPtr->total;
    if (cmdPtr && interp) {
	int code;

	/*







|
|







9908
9909
9910
9911
9912
9913
9914
9915
9916
9917
9918
9919
9920
9921
9922
9923

    if (bufObj != NULL) {
	TclDecrRefCount(bufObj);
	bufObj = NULL;
    }

    /*
     * Make the callback or return the number of characters transferred. The
     * local total is used because StopCopy frees csPtr.
     */

    total = csPtr->total;
    if (cmdPtr && interp) {
	int code;

	/*
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
 *	Stores up to "bytesToRead" bytes in memory pointed to by "dst".
 *	These bytes come from reading the channel "chanPtr" and
 *	performing the configured translations.  No encoding conversions
 *	are applied to the bytes being read.
 *
 * Results:
 *	The number of bytes actually stored (<= bytesToRead),
 * 	or -1 if there is an error in reading the channel.  Use
 * 	Tcl_GetErrno() to retrieve the error code for the error
 *	that occurred.
 *
 *	The number of bytes stored can be less than the number
 * 	requested when
 *	  - EOF is reached on the channel; or
 *	  - the channel is non-blocking, and we've read all we can
 *	    without blocking.
 *	  - a channel reading error occurs (and we return -1)
 *
 * Side effects:
 *	May cause input to be buffered.
 *
 *----------------------------------------------------------------------
 */

static int
DoRead(
    Channel *chanPtr,		/* The channel from which to read. */
    char *dst,			/* Where to store input read. */
    size_t bytesToRead,		/* Maximum number of bytes to read. */
    int allowShortReads)	/* Allow half-blocking (pipes,sockets) */
{
    ChannelState *statePtr = chanPtr->state;
    char *p = dst;

    /*
     * Early out when we know a read will get the eofchar.
     *
     * NOTE: This seems to be a bug.  The special handling for
     * a zero-char read request ought to come first.  As coded
     * the EOF due to eofchar has distinguishing behavior from
     * the EOF due to reported EOF on the underlying device, and
     * that seems undesirable.  However recent history indicates
     * that new inconsistent behavior in a patchlevel has problems
     * too.  Keep on keeping on for now.
     */






    if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
	SetFlag(statePtr, CHANNEL_EOF);
	assert(statePtr->inputEncodingFlags & TCL_ENCODING_END);
	assert(!GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR));

	/* TODO: Don't need this call */
	UpdateInterest(chanPtr);







|








|







|



|

















>
>
>
>
>







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
 *	Stores up to "bytesToRead" bytes in memory pointed to by "dst".
 *	These bytes come from reading the channel "chanPtr" and
 *	performing the configured translations.  No encoding conversions
 *	are applied to the bytes being read.
 *
 * Results:
 *	The number of bytes actually stored (<= bytesToRead),
 * 	or TCL_INDEX_NONE if there is an error in reading the channel.  Use
 * 	Tcl_GetErrno() to retrieve the error code for the error
 *	that occurred.
 *
 *	The number of bytes stored can be less than the number
 * 	requested when
 *	  - EOF is reached on the channel; or
 *	  - the channel is non-blocking, and we've read all we can
 *	    without blocking.
 *	  - a channel reading error occurs (and we return TCL_INDEX_NONE)
 *
 * Side effects:
 *	May cause input to be buffered.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Size
DoRead(
    Channel *chanPtr,		/* The channel from which to read. */
    char *dst,			/* Where to store input read. */
    Tcl_Size bytesToRead,		/* Maximum number of bytes to read. */
    int allowShortReads)	/* Allow half-blocking (pipes,sockets) */
{
    ChannelState *statePtr = chanPtr->state;
    char *p = dst;

    /*
     * Early out when we know a read will get the eofchar.
     *
     * NOTE: This seems to be a bug.  The special handling for
     * a zero-char read request ought to come first.  As coded
     * the EOF due to eofchar has distinguishing behavior from
     * the EOF due to reported EOF on the underlying device, and
     * that seems undesirable.  However recent history indicates
     * that new inconsistent behavior in a patchlevel has problems
     * too.  Keep on keeping on for now.
     */

    if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR)) {
	UpdateInterest(chanPtr);
	Tcl_SetErrno(EILSEQ);
	return -1;
    }
    if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
	SetFlag(statePtr, CHANNEL_EOF);
	assert(statePtr->inputEncodingFlags & TCL_ENCODING_END);
	assert(!GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR));

	/* TODO: Don't need this call */
	UpdateInterest(chanPtr);
9997
9998
9999
10000
10001
10002
10003
10004
10005
10006
10007
10008
10009
10010
10011

	/*
	 * Don't read more data if we have what we need.
	 */

	while (!bufPtr ||			/* We got no buffer!   OR */
		(!IsBufferFull(bufPtr) && 	/* Our buffer has room AND */
		((size_t)BytesLeft(bufPtr) < bytesToRead))) {
						/* Not enough bytes in it yet
						 * to fill the dst */
	    int code;

	moreData:
	    code = GetInput(chanPtr);
	    bufPtr = statePtr->inQueueHead;







|







10050
10051
10052
10053
10054
10055
10056
10057
10058
10059
10060
10061
10062
10063
10064

	/*
	 * Don't read more data if we have what we need.
	 */

	while (!bufPtr ||			/* We got no buffer!   OR */
		(!IsBufferFull(bufPtr) && 	/* Our buffer has room AND */
		((Tcl_Size) BytesLeft(bufPtr) < bytesToRead))) {
						/* Not enough bytes in it yet
						 * to fill the dst */
	    int code;

	moreData:
	    code = GetInput(chanPtr);
	    bufPtr = statePtr->inQueueHead;
10053
10054
10055
10056
10057
10058
10059
10060
10061
10062
10063
10064
10065
10066
10067
10068
10069
10070
	     */

	    if (bytesToRead == 0) {
		break;
	    }

	    /*
	     * 1) We're @EOF because we saw eof char.
	     */

	    if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
		break;
	    }

	    /*
	     * 2) The buffer holds a \r while in CRLF translation, followed by
	     *    the end of the buffer.
	     */







|


|







10106
10107
10108
10109
10110
10111
10112
10113
10114
10115
10116
10117
10118
10119
10120
10121
10122
10123
	     */

	    if (bytesToRead == 0) {
		break;
	    }

	    /*
	     * 1) We're @EOF because we saw eof char, or there was an encoding error.
	     */

	    if (GotFlag(statePtr, CHANNEL_STICKY_EOF|CHANNEL_ENCODING_ERROR)) {
		break;
	    }

	    /*
	     * 2) The buffer holds a \r while in CRLF translation, followed by
	     *    the end of the buffer.
	     */
10141
10142
10143
10144
10145
10146
10147

10148
10149
10150
10151
10152
10153
10154
10155
10156
10157
10158
10159
10160
    }
    if (bytesToRead == 0) {
	ResetFlag(statePtr, CHANNEL_BLOCKED);
    }

    assert(!GotFlag(statePtr, CHANNEL_EOF)
	    || GotFlag(statePtr, CHANNEL_STICKY_EOF)

	    || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0);
    assert(!(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)
	    == (CHANNEL_EOF|CHANNEL_BLOCKED)));
    UpdateInterest(chanPtr);
    TclChannelRelease((Tcl_Channel)chanPtr);
    return (int)(p - dst);
}

/*
 *----------------------------------------------------------------------
 *
 * CopyEventProc --
 *







>





|







10194
10195
10196
10197
10198
10199
10200
10201
10202
10203
10204
10205
10206
10207
10208
10209
10210
10211
10212
10213
10214
    }
    if (bytesToRead == 0) {
	ResetFlag(statePtr, CHANNEL_BLOCKED);
    }

    assert(!GotFlag(statePtr, CHANNEL_EOF)
	    || GotFlag(statePtr, CHANNEL_STICKY_EOF)
	    || GotFlag(statePtr, CHANNEL_ENCODING_ERROR)
	    || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0);
    assert(!(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)
	    == (CHANNEL_EOF|CHANNEL_BLOCKED)));
    UpdateInterest(chanPtr);
    TclChannelRelease((Tcl_Channel)chanPtr);
    return (Tcl_Size)(p - dst);
}

/*
 *----------------------------------------------------------------------
 *
 * CopyEventProc --
 *
10174
10175
10176
10177
10178
10179
10180








































10181
10182
10183
10184
10185
10186
10187
static void
CopyEventProc(
    void *clientData,
    int mask)
{
    (void) CopyData((CopyState *)clientData, mask);
}









































/*
 *----------------------------------------------------------------------
 *
 * StopCopy --
 *
 *	This routine halts a copy that is in progress.







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







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
static void
CopyEventProc(
    void *clientData,
    int mask)
{
    (void) CopyData((CopyState *)clientData, mask);
}

/*
 *----------------------------------------------------------------------
 *
 * Lossless --
 *
 *	Determines whether copying characters between two channel states would
 *	be lossless, i.e. whether one byte corresponds to one character, every
 *	character appears in the Unicode character set, there are no
 *	translations to be performed, and no inline signals to respond to.
 *
 * Result:
 *	True if copying would be lossless.
 *
 *----------------------------------------------------------------------
 */
int
Lossless(
    ChannelState *inStatePtr,
    ChannelState *outStatePtr,
    long long toRead)
{
    return inStatePtr->inEofChar == '\0'	/* No eofChar to stop input */
	&& inStatePtr->inputTranslation == TCL_TRANSLATE_LF
	&& outStatePtr->outputTranslation == TCL_TRANSLATE_LF
	&& (
	    (
		inStatePtr->encoding == GetBinaryEncoding()
		&&
		outStatePtr->encoding == GetBinaryEncoding()
	    )
	    ||
	    (
		toRead == -1
		&& inStatePtr->encoding == outStatePtr->encoding
		&& ENCODING_PROFILE_GET(inStatePtr->inputEncodingFlags) == TCL_ENCODING_PROFILE_TCL8
		&& ENCODING_PROFILE_GET(outStatePtr->inputEncodingFlags) == TCL_ENCODING_PROFILE_TCL8
	    )
	);
}

/*
 *----------------------------------------------------------------------
 *
 * StopCopy --
 *
 *	This routine halts a copy that is in progress.
10543
10544
10545
10546
10547
10548
10549
10550
10551
10552
10553
10554
10555
10556
10557
int
Tcl_IsChannelShared(
    Tcl_Channel chan)		/* The channel to query */
{
    ChannelState *statePtr = ((Channel *) chan)->state;
				/* State of real channel structure. */

    return ((statePtr->refCount + 1 > 2) ? 1 : 0);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_IsChannelExisting --
 *







|







10637
10638
10639
10640
10641
10642
10643
10644
10645
10646
10647
10648
10649
10650
10651
int
Tcl_IsChannelShared(
    Tcl_Channel chan)		/* The channel to query */
{
    ChannelState *statePtr = ((Channel *) chan)->state;
				/* State of real channel structure. */

    return ((statePtr->refCount > 1) ? 1 : 0);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_IsChannelExisting --
 *
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
 */

static Tcl_Obj *
FixLevelCode(
    Tcl_Obj *msg)
{
    int explicitResult, numOptions, lcn;
    size_t lc;
    Tcl_Obj **lv, **lvn;
    int res, i, j, val, lignore, cignore;
    int newlevel = -1, newcode = -1;

    /* ASSERT msg != NULL */

    /*
     * Process the caught message.
     *
     * Syntax = (option value)... ?message?
     *
     * Bad message syntax causes a panic, because the other side uses
     * Tcl_GetReturnOptions and list construction functions to marshall the
     * information. Hence an error means that we've got serious breakage.
     */

    res = TclListObjGetElementsM(NULL, msg, &lc, &lv);
    if (res != TCL_OK) {
	Tcl_Panic("Tcl_SetChannelError: bad syntax of message");
    }







|












|







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

static Tcl_Obj *
FixLevelCode(
    Tcl_Obj *msg)
{
    int explicitResult, numOptions, lcn;
    Tcl_Size lc;
    Tcl_Obj **lv, **lvn;
    int res, i, j, val, lignore, cignore;
    int newlevel = -1, newcode = -1;

    /* ASSERT msg != NULL */

    /*
     * Process the caught message.
     *
     * Syntax = (option value)... ?message?
     *
     * Bad message syntax causes a panic, because the other side uses
     * Tcl_GetReturnOptions and list construction functions to marshal the
     * information. Hence an error means that we've got serious breakage.
     */

    res = TclListObjGetElementsM(NULL, msg, &lc, &lv);
    if (res != TCL_OK) {
	Tcl_Panic("Tcl_SetChannelError: bad syntax of message");
    }
11112
11113
11114
11115
11116
11117
11118
11119
11120
11121
11122
11123
11124
11125
11126
11127
    if (newcode >= 0) {
	lcn += 2;
    }

    lvn = (Tcl_Obj **)Tcl_Alloc(lcn * sizeof(Tcl_Obj *));

    /*
     * New level/code information is spliced into the first occurence of
     * -level, -code, further occurences are ignored. The options cannot be
     * not present, we would not come here. Options which are ok are simply
     * copied over.
     */

    lignore = cignore = 0;
    for (i=0, j=0; i<numOptions; i+=2) {
	if (0 == strcmp(TclGetString(lv[i]), "-level")) {







|
|







11206
11207
11208
11209
11210
11211
11212
11213
11214
11215
11216
11217
11218
11219
11220
11221
    if (newcode >= 0) {
	lcn += 2;
    }

    lvn = (Tcl_Obj **)Tcl_Alloc(lcn * sizeof(Tcl_Obj *));

    /*
     * New level/code information is spliced into the first occurrence of
     * -level, -code, further occurrences are ignored. The options cannot be
     * not present, we would not come here. Options which are ok are simply
     * copied over.
     */

    lignore = cignore = 0;
    for (i=0, j=0; i<numOptions; i+=2) {
	if (0 == strcmp(TclGetString(lv[i]), "-level")) {
11321
11322
11323
11324
11325
11326
11327
11328
11329

11330
11331
11332
11333
11334
11335
11336
11337
11338
11339
11340
11341

11342
11343
11344
11345
11346
11347
11348
 */

static int
DumpFlags(
    char *str,
    int flags)
{
    char buf[20];
    int i = 0;


#define ChanFlag(chr, bit)      (buf[i++] = ((flags & (bit)) ? (chr) : '_'))

    ChanFlag('r', TCL_READABLE);
    ChanFlag('w', TCL_WRITABLE);
    ChanFlag('n', CHANNEL_NONBLOCKING);
    ChanFlag('l', CHANNEL_LINEBUFFERED);
    ChanFlag('u', CHANNEL_UNBUFFERED);
    ChanFlag('F', BG_FLUSH_SCHEDULED);
    ChanFlag('c', CHANNEL_CLOSED);
    ChanFlag('E', CHANNEL_EOF);
    ChanFlag('S', CHANNEL_STICKY_EOF);

    ChanFlag('B', CHANNEL_BLOCKED);
    ChanFlag('/', INPUT_SAW_CR);
    ChanFlag('D', CHANNEL_DEAD);
    ChanFlag('R', CHANNEL_RAW_MODE);
    ChanFlag('x', CHANNEL_INCLOSE);

    buf[i] ='\0';







<

>












>







11415
11416
11417
11418
11419
11420
11421

11422
11423
11424
11425
11426
11427
11428
11429
11430
11431
11432
11433
11434
11435
11436
11437
11438
11439
11440
11441
11442
11443
 */

static int
DumpFlags(
    char *str,
    int flags)
{

    int i = 0;
    char buf[24];

#define ChanFlag(chr, bit)      (buf[i++] = ((flags & (bit)) ? (chr) : '_'))

    ChanFlag('r', TCL_READABLE);
    ChanFlag('w', TCL_WRITABLE);
    ChanFlag('n', CHANNEL_NONBLOCKING);
    ChanFlag('l', CHANNEL_LINEBUFFERED);
    ChanFlag('u', CHANNEL_UNBUFFERED);
    ChanFlag('F', BG_FLUSH_SCHEDULED);
    ChanFlag('c', CHANNEL_CLOSED);
    ChanFlag('E', CHANNEL_EOF);
    ChanFlag('S', CHANNEL_STICKY_EOF);
    ChanFlag('U', CHANNEL_ENCODING_ERROR);
    ChanFlag('B', CHANNEL_BLOCKED);
    ChanFlag('/', INPUT_SAW_CR);
    ChanFlag('D', CHANNEL_DEAD);
    ChanFlag('R', CHANNEL_RAW_MODE);
    ChanFlag('x', CHANNEL_INCLOSE);

    buf[i] ='\0';

Changes to generic/tclIO.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
/*
 * struct ChannelBuffer:
 *
 * Buffers data being sent to or from a channel.
 */

typedef struct ChannelBuffer {
    size_t refCount;		/* Current uses count */
    size_t nextAdded;		/* The next position into which a character
				 * will be put in the buffer. */
    size_t nextRemoved;		/* Position of next byte to be removed from
				 * the buffer. */
    size_t bufLength;		/* How big is the buffer? */
    struct ChannelBuffer *nextPtr;
    				/* Next buffer in chain. */
    char buf[TCLFLEXARRAY];		/* Placeholder for real buffer. The real
				 * buffer occuppies this space + bufSize-1
				 * bytes. This must be the last field in the
				 * structure. */
} ChannelBuffer;

#define CHANNELBUFFER_HEADER_SIZE	offsetof(ChannelBuffer, buf)

/*







|
|

|

|



|







32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
/*
 * struct ChannelBuffer:
 *
 * Buffers data being sent to or from a channel.
 */

typedef struct ChannelBuffer {
    Tcl_Size refCount;		/* Current uses count */
    Tcl_Size nextAdded;		/* The next position into which a character
				 * will be put in the buffer. */
    Tcl_Size nextRemoved;		/* Position of next byte to be removed from
				 * the buffer. */
    Tcl_Size bufLength;		/* How big is the buffer? */
    struct ChannelBuffer *nextPtr;
    				/* Next buffer in chain. */
    char buf[TCLFLEXARRAY];		/* Placeholder for real buffer. The real
				 * buffer occupies this space + bufSize-1
				 * bytes. This must be the last field in the
				 * structure. */
} ChannelBuffer;

#define CHANNELBUFFER_HEADER_SIZE	offsetof(ChannelBuffer, buf)

/*
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
     * Intermediate buffers to hold pre-read data for consumption by a newly
     * stacked transformation. See 'Tcl_StackChannel'.
     */

    ChannelBuffer *inQueueHead;	/* Points at first buffer in input queue. */
    ChannelBuffer *inQueueTail;	/* Points at last buffer in input queue. */

    size_t refCount;
} Channel;

/*
 * struct ChannelState:
 *
 * One of these structures is allocated for each open channel. It contains
 * data specific to the channel but which belongs to the generic part of the
 * Tcl channel mechanism, and it points at an instance specific (and type
 * specific) instance data, and at a channel type structure.
 */

typedef struct ChannelState {
    char *channelName;		/* The name of the channel instance in Tcl
				 * commands. Storage is owned by the generic
				 * IO code, is dynamically allocated. */
    int	flags;			/* ORed combination of the flags defined
				 * below. */
    Tcl_Encoding encoding;	/* Encoding to apply when reading or writing
				 * data on this channel. NULL means no
				 * encoding is applied to data. */
    Tcl_EncodingState inputEncodingState;
				/* Current encoding state, used when
				 * converting input data bytes to UTF-8. */







|















|







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
     * Intermediate buffers to hold pre-read data for consumption by a newly
     * stacked transformation. See 'Tcl_StackChannel'.
     */

    ChannelBuffer *inQueueHead;	/* Points at first buffer in input queue. */
    ChannelBuffer *inQueueTail;	/* Points at last buffer in input queue. */

    Tcl_Size refCount;
} Channel;

/*
 * struct ChannelState:
 *
 * One of these structures is allocated for each open channel. It contains
 * data specific to the channel but which belongs to the generic part of the
 * Tcl channel mechanism, and it points at an instance specific (and type
 * specific) instance data, and at a channel type structure.
 */

typedef struct ChannelState {
    char *channelName;		/* The name of the channel instance in Tcl
				 * commands. Storage is owned by the generic
				 * IO code, is dynamically allocated. */
    int	flags;			/* OR'ed combination of the flags defined
				 * below. */
    Tcl_Encoding encoding;	/* Encoding to apply when reading or writing
				 * data on this channel. NULL means no
				 * encoding is applied to data. */
    Tcl_EncodingState inputEncodingState;
				/* Current encoding state, used when
				 * converting input data bytes to UTF-8. */
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
#if TCL_MAJOR_VERSION < 9
    int outEofChar;		/* If nonzero, append this to the channel when
				 * it is closed if it is open for writing. For Tcl 8.x only */
#endif
    int unreportedError;	/* Non-zero if an error report was deferred
				 * because it happened in the background. The
				 * value is the POSIX error code. */
    size_t refCount;		/* How many interpreters hold references to
				 * this IO channel? */
    struct CloseCallback *closeCbPtr;
				/* Callbacks registered to be called when the
				 * channel is closed. */
    char *outputStage;		/* Temporary staging buffer used when
				 * translating EOL before converting from
				 * UTF-8 to external form. */







|







161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
#if TCL_MAJOR_VERSION < 9
    int outEofChar;		/* If nonzero, append this to the channel when
				 * it is closed if it is open for writing. For Tcl 8.x only */
#endif
    int unreportedError;	/* Non-zero if an error report was deferred
				 * because it happened in the background. The
				 * value is the POSIX error code. */
    Tcl_Size refCount;		/* How many interpreters hold references to
				 * this IO channel? */
    struct CloseCallback *closeCbPtr;
				/* Callbacks registered to be called when the
				 * channel is closed. */
    char *outputStage;		/* Temporary staging buffer used when
				 * translating EOL before converting from
				 * UTF-8 to external form. */
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
    struct ChannelHandler *chPtr;/* List of channel handlers registered for
				  * this channel. */
    int interestMask;		/* Mask of all events this channel has
				 * handlers for. */
    EventScriptRecord *scriptRecordPtr;
				/* Chain of all scripts registered for event
				 * handlers ("fileevent") on this channel. */
    size_t bufSize;		/* What size buffers to allocate? */
    Tcl_TimerToken timer;	/* Handle to wakeup timer for this channel. */



    struct CopyState *csPtrR;	/* State of background copy for which channel
				 * is input, or NULL. */
    struct CopyState *csPtrW;	/* State of background copy for which channel
				 * is output, or NULL. */
    Channel *topChanPtr;	/* Refers to topmost channel in a stack. Never
				 * NULL. */
    Channel *bottomChanPtr;	/* Refers to bottommost channel in a stack.
				 * This channel can be relied on to live as
				 * long as the channel state. Never NULL. */
    struct ChannelState *nextCSPtr;
				/* Next in list of channels currently open. */
    Tcl_ThreadId managingThread;/* TIP #10: Id of the thread managing this
				 * stack of channels. */

    /*
     * TIP #219 ... Info for the I/O system ...
     * Error message set by channel drivers, for the propagation of arbitrary
     * Tcl errors. This information, if present (chanMsg not NULL), takes
     * precedence over a posix error code returned by a channel operation.
     */

    Tcl_Obj* chanMsg;
    Tcl_Obj* unreportedMsg;     /* Non-NULL if an error report was deferred
				 * because it happened in the background. The
				 * value is the chanMg, if any. #219's
				 * companion to 'unreportedError'. */
    size_t epoch;		/* Used to test validity of stored channelname
				 * lookup results. */
    int maxPerms;		/* TIP #220: Max access privileges
				 * the channel was created with. */
} ChannelState;

/*
 * Values for the flags field in Channel. Any ORed combination of the
 * following flags can be stored in the field. These flags record various
 * options and state bits about the channel. In addition to the flags below,
 * the channel can also have TCL_READABLE (1<<1) and TCL_WRITABLE (1<<2) set.
 */

#define CHANNEL_NONBLOCKING	(1<<3)	/* Channel is currently in nonblocking
					 * mode. */







|

>
>
>


















|














|







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
    struct ChannelHandler *chPtr;/* List of channel handlers registered for
				  * this channel. */
    int interestMask;		/* Mask of all events this channel has
				 * handlers for. */
    EventScriptRecord *scriptRecordPtr;
				/* Chain of all scripts registered for event
				 * handlers ("fileevent") on this channel. */
    Tcl_Size bufSize;		/* What size buffers to allocate? */
    Tcl_TimerToken timer;	/* Handle to wakeup timer for this channel. */
    Channel *timerChanPtr;	/* Needed in order to decrement the refCount of
				   the right channel when the timer is
				   deleted. */
    struct CopyState *csPtrR;	/* State of background copy for which channel
				 * is input, or NULL. */
    struct CopyState *csPtrW;	/* State of background copy for which channel
				 * is output, or NULL. */
    Channel *topChanPtr;	/* Refers to topmost channel in a stack. Never
				 * NULL. */
    Channel *bottomChanPtr;	/* Refers to bottommost channel in a stack.
				 * This channel can be relied on to live as
				 * long as the channel state. Never NULL. */
    struct ChannelState *nextCSPtr;
				/* Next in list of channels currently open. */
    Tcl_ThreadId managingThread;/* TIP #10: Id of the thread managing this
				 * stack of channels. */

    /*
     * TIP #219 ... Info for the I/O system ...
     * Error message set by channel drivers, for the propagation of arbitrary
     * Tcl errors. This information, if present (chanMsg not NULL), takes
     * precedence over a Posix error code returned by a channel operation.
     */

    Tcl_Obj* chanMsg;
    Tcl_Obj* unreportedMsg;     /* Non-NULL if an error report was deferred
				 * because it happened in the background. The
				 * value is the chanMg, if any. #219's
				 * companion to 'unreportedError'. */
    size_t epoch;		/* Used to test validity of stored channelname
				 * lookup results. */
    int maxPerms;		/* TIP #220: Max access privileges
				 * the channel was created with. */
} ChannelState;

/*
 * Values for the flags field in Channel. Any OR'ed combination of the
 * following flags can be stored in the field. These flags record various
 * options and state bits about the channel. In addition to the flags below,
 * the channel can also have TCL_READABLE (1<<1) and TCL_WRITABLE (1<<2) set.
 */

#define CHANNEL_NONBLOCKING	(1<<3)	/* Channel is currently in nonblocking
					 * mode. */
269
270
271
272
273
274
275


276
277
278
279
280
281
282
283
284
285
286
287
288
					 * flag is set when gets fails to get
					 * a complete line or when read fails
					 * to get a complete character. When
					 * set, file events will not be
					 * delivered for buffered data until
					 * the state of the channel
					 * changes. */


#define CHANNEL_RAW_MODE	(1<<16)	/* When set, notes that the Raw API is
					 * being used. */
#define CHANNEL_ENCODING_NOCOMPLAIN	(1<<17)	/* set if option
					 * -nocomplainencoding is set to 1 */
#define CHANNEL_ENCODING_STRICT	(1<<18)	/* set if option
					 * -strictencoding is set to 1 */
#define CHANNEL_INCLOSE		(1<<19)	/* Channel is currently being closed.
					 * Its structures are still live and
					 * usable, but it may not be closed
					 * again from within the close
					 * handler. */
#define CHANNEL_CLOSEDWRITE	(1<<21)	/* Channel write side has been closed.
					 * No further Tcl-level write IO on







>
>


<
<
<
<







272
273
274
275
276
277
278
279
280
281
282




283
284
285
286
287
288
289
					 * flag is set when gets fails to get
					 * a complete line or when read fails
					 * to get a complete character. When
					 * set, file events will not be
					 * delivered for buffered data until
					 * the state of the channel
					 * changes. */
#define CHANNEL_ENCODING_ERROR	(1<<15)	/* set if channel
					 * encountered an encoding error */
#define CHANNEL_RAW_MODE	(1<<16)	/* When set, notes that the Raw API is
					 * being used. */




#define CHANNEL_INCLOSE		(1<<19)	/* Channel is currently being closed.
					 * Its structures are still live and
					 * usable, but it may not be closed
					 * again from within the close
					 * handler. */
#define CHANNEL_CLOSEDWRITE	(1<<21)	/* Channel write side has been closed.
					 * No further Tcl-level write IO on

Changes to generic/tclIOCmd.c.

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

13
14
15
16
17
18
19
/*
 * tclIOCmd.c --
 *
 *	Contains the definitions of most of the Tcl commands relating to IO.
 *
 * Copyright © 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"


/*
 * Callback structure for accept callback in a TCP server.
 */

typedef struct {
    Tcl_Obj *script;		/* Script to invoke. */












>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/*
 * tclIOCmd.c --
 *
 *	Contains the definitions of most of the Tcl commands relating to IO.
 *
 * Copyright © 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

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

/*
 * Callback structure for accept callback in a TCP server.
 */

typedef struct {
    Tcl_Obj *script;		/* Script to invoke. */
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
static Tcl_TcpAcceptProc 	AcceptCallbackProc;
static Tcl_ObjCmdProc		ChanPendingObjCmd;
static Tcl_ObjCmdProc		ChanTruncateObjCmd;
static void			RegisterTcpServerInterpCleanup(
				    Tcl_Interp *interp,
				    AcceptCallback *acceptCallbackPtr);
static Tcl_InterpDeleteProc	TcpAcceptCallbacksDeleteProc;
static void		TcpServerCloseProc(ClientData callbackData);
static void		UnregisterTcpServerInterpCleanupProc(
			    Tcl_Interp *interp,
			    AcceptCallback *acceptCallbackPtr);

/*
 *----------------------------------------------------------------------
 *







|







41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
static Tcl_TcpAcceptProc 	AcceptCallbackProc;
static Tcl_ObjCmdProc		ChanPendingObjCmd;
static Tcl_ObjCmdProc		ChanTruncateObjCmd;
static void			RegisterTcpServerInterpCleanup(
				    Tcl_Interp *interp,
				    AcceptCallback *acceptCallbackPtr);
static Tcl_InterpDeleteProc	TcpAcceptCallbacksDeleteProc;
static void		TcpServerCloseProc(void *callbackData);
static void		UnregisterTcpServerInterpCleanupProc(
			    Tcl_Interp *interp,
			    AcceptCallback *acceptCallbackPtr);

/*
 *----------------------------------------------------------------------
 *
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Channel chan;		/* The channel to puts on. */
    Tcl_Obj *string;		/* String to write. */
    Tcl_Obj *chanObjPtr = NULL;	/* channel object. */
    int newline;		/* Add a newline at end? */
    int result;			/* Result of puts operation. */
    int mode;			/* Mode in which channel is opened. */

    switch (objc) {
    case 2:			/* [puts $x] */
	string = objv[1];
	newline = 1;
	break;







|







103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Channel chan;		/* The channel to puts on. */
    Tcl_Obj *string;		/* String to write. */
    Tcl_Obj *chanObjPtr = NULL;	/* channel object. */
    int newline;		/* Add a newline at end? */
    Tcl_Size result;		/* Result of puts operation. */
    int mode;			/* Mode in which channel is opened. */

    switch (objc) {
    case 2:			/* [puts $x] */
	string = objv[1];
	newline = 1;
	break;
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
		"channel \"%s\" wasn't opened for writing",
		TclGetString(chanObjPtr)));
	return TCL_ERROR;
    }

    TclChannelPreserve(chan);
    result = Tcl_WriteObj(chan, string);
    if (result == -1) {
	goto error;
    }
    if (newline != 0) {
	result = Tcl_WriteChars(chan, "\n", 1);
	if (result == -1) {
	    goto error;
	}
    }
    TclChannelRelease(chan);
    return TCL_OK;

    /*







|




|







160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
		"channel \"%s\" wasn't opened for writing",
		TclGetString(chanObjPtr)));
	return TCL_ERROR;
    }

    TclChannelPreserve(chan);
    result = Tcl_WriteObj(chan, string);
    if (result == TCL_INDEX_NONE) {
	goto error;
    }
    if (newline != 0) {
	result = Tcl_WriteChars(chan, "\n", 1);
	if (result == TCL_INDEX_NONE) {
	    goto error;
	}
    }
    TclChannelRelease(chan);
    return TCL_OK;

    /*
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
Tcl_GetsObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Channel chan;		/* The channel to read from. */
    size_t lineLen;		/* Length of line just read. */
    int mode;			/* Mode in which channel is opened. */
    Tcl_Obj *linePtr, *chanObjPtr;
    int code = TCL_OK;

    if ((objc != 2) && (objc != 3)) {
	Tcl_WrongNumArgs(interp, 1, objv, "channelId ?varName?");
	return TCL_ERROR;







|







277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
Tcl_GetsObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Channel chan;		/* The channel to read from. */
    Tcl_Size lineLen;		/* Length of line just read. */
    int mode;			/* Mode in which channel is opened. */
    Tcl_Obj *linePtr, *chanObjPtr;
    int code = TCL_OK;

    if ((objc != 2) && (objc != 3)) {
	Tcl_WrongNumArgs(interp, 1, objv, "channelId ?varName?");
	return TCL_ERROR;
326
327
328
329
330
331
332


333
334
335
336
337
338
339
340
    }
    if (objc == 3) {
	if (Tcl_ObjSetVar2(interp, objv[2], NULL, linePtr,
		TCL_LEAVE_ERR_MSG) == NULL) {
	    code = TCL_ERROR;
	    goto done;
	}


	Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)((Tcl_WideUInt)(lineLen + 1U)) - 1));
    } else {
	Tcl_SetObjResult(interp, linePtr);
    }
  done:
    TclChannelRelease(chan);
    return code;
}







>
>
|







327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
    }
    if (objc == 3) {
	if (Tcl_ObjSetVar2(interp, objv[2], NULL, linePtr,
		TCL_LEAVE_ERR_MSG) == NULL) {
	    code = TCL_ERROR;
	    goto done;
	}
	Tcl_Obj *lineLenObj;
	TclNewIndexObj(lineLenObj, lineLen);
	Tcl_SetObjResult(interp, lineLenObj);
    } else {
	Tcl_SetObjResult(interp, linePtr);
    }
  done:
    TclChannelRelease(chan);
    return code;
}
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Channel chan;		/* The channel to read from. */
    int newline, i;		/* Discard newline at end? */
    Tcl_WideInt toRead;			/* How many bytes to read? */
    size_t charactersRead;		/* How many characters were read? */
    int mode;			/* Mode in which channel is opened. */
    Tcl_Obj *resultPtr, *chanObjPtr;

    if ((objc != 2) && (objc != 3)) {
	Interp *iPtr;

    argerror:







|







365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Channel chan;		/* The channel to read from. */
    int newline, i;		/* Discard newline at end? */
    Tcl_WideInt toRead;			/* How many bytes to read? */
    Tcl_Size charactersRead;		/* How many characters were read? */
    int mode;			/* Mode in which channel is opened. */
    Tcl_Obj *resultPtr, *chanObjPtr;

    if ((objc != 2) && (objc != 3)) {
	Interp *iPtr;

    argerror:
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
			TclGetString(objv[i])));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL);
		return TCL_ERROR;
	}
    }

    TclNewObj(resultPtr);
    Tcl_IncrRefCount(resultPtr);
    TclChannelPreserve(chan);
    charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0);
    if (charactersRead == TCL_IO_FAILURE) {

	/*
	 * TIP #219.
	 * Capture error messages put by the driver into the bypass area and
	 * put them into the regular interpreter result. Fall back to the
	 * regular message if nothing was found in the bypass.
	 */

	if (!TclChanCaughtErrorBypass(interp, chan)) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "error reading \"%s\": %s",
		    TclGetString(chanObjPtr), Tcl_PosixError(interp)));
	}
	TclChannelRelease(chan);
	Tcl_DecrRefCount(resultPtr);
	return TCL_ERROR;
    }

    /*
     * If requested, remove the last newline in the channel if at EOF.
     */

    if ((charactersRead > 0) && (newline != 0)) {
	const char *result;
	size_t length;

	result = Tcl_GetStringFromObj(resultPtr, &length);
	if (result[length - 1] == '\n') {
	    Tcl_SetObjLength(resultPtr, length - 1);
	}
    }
    Tcl_SetObjResult(interp, resultPtr);
    TclChannelRelease(chan);
    Tcl_DecrRefCount(resultPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SeekObjCmd --







<



>













<









|








<







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
			TclGetString(objv[i])));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL);
		return TCL_ERROR;
	}
    }

    TclNewObj(resultPtr);

    TclChannelPreserve(chan);
    charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0);
    if (charactersRead == TCL_IO_FAILURE) {
	Tcl_DecrRefCount(resultPtr);
	/*
	 * TIP #219.
	 * Capture error messages put by the driver into the bypass area and
	 * put them into the regular interpreter result. Fall back to the
	 * regular message if nothing was found in the bypass.
	 */

	if (!TclChanCaughtErrorBypass(interp, chan)) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "error reading \"%s\": %s",
		    TclGetString(chanObjPtr), Tcl_PosixError(interp)));
	}
	TclChannelRelease(chan);

	return TCL_ERROR;
    }

    /*
     * If requested, remove the last newline in the channel if at EOF.
     */

    if ((charactersRead > 0) && (newline != 0)) {
	const char *result;
	Tcl_Size length;

	result = Tcl_GetStringFromObj(resultPtr, &length);
	if (result[length - 1] == '\n') {
	    Tcl_SetObjLength(resultPtr, length - 1);
	}
    }
    Tcl_SetObjResult(interp, resultPtr);
    TclChannelRelease(chan);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SeekObjCmd --
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
	 * messages produced by drivers during the closing of a channel,
	 * because the Tcl convention is that such error messages do not have
	 * a terminating newline.
	 */

	Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
	const char *string;
	size_t len;

	if (Tcl_IsShared(resultPtr)) {
	    resultPtr = Tcl_DuplicateObj(resultPtr);
	    Tcl_SetObjResult(interp, resultPtr);
	}
	string = Tcl_GetStringFromObj(resultPtr, &len);
	if ((len > 0) && (string[len - 1] == '\n')) {







|







694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
	 * messages produced by drivers during the closing of a channel,
	 * because the Tcl convention is that such error messages do not have
	 * a terminating newline.
	 */

	Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
	const char *string;
	Tcl_Size len;

	if (Tcl_IsShared(resultPtr)) {
	    resultPtr = Tcl_DuplicateObj(resultPtr);
	    Tcl_SetObjResult(interp, resultPtr);
	}
	string = Tcl_GetStringFromObj(resultPtr, &len);
	if ((len > 0) && (string[len - 1] == '\n')) {
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
{
    Tcl_Obj *resultPtr;
    const char **argv;		/* An array for the string arguments. Stored
				 * on the _Tcl_ stack. */
    const char *string;
    Tcl_Channel chan;
    int argc, background, i, index, keepNewline, result, skip, ignoreStderr;
    size_t length;
    static const char *const options[] = {
	"-ignorestderr", "-keepnewline", "--", NULL
    };
    enum execOptionsEnum {
	EXEC_IGNORESTDERR, EXEC_KEEPNEWLINE, EXEC_LAST
    };








|







854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
{
    Tcl_Obj *resultPtr;
    const char **argv;		/* An array for the string arguments. Stored
				 * on the _Tcl_ stack. */
    const char *string;
    Tcl_Channel chan;
    int argc, background, i, index, keepNewline, result, skip, ignoreStderr;
    Tcl_Size length;
    static const char *const options[] = {
	"-ignorestderr", "-keepnewline", "--", NULL
    };
    enum execOptionsEnum {
	EXEC_IGNORESTDERR, EXEC_KEEPNEWLINE, EXEC_LAST
    };

1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
 *	the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Sets interp's result to boolean true or false depending on whether the
 *	preceeding input operation on the channel would have blocked.
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_FblockedObjCmd(
    TCL_UNUSED(void *),







|







1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
 *	the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Sets interp's result to boolean true or false depending on whether the
 *	preceding input operation on the channel would have blocked.
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_FblockedObjCmd(
    TCL_UNUSED(void *),
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
     * Open the file or create a process pipeline.
     */

    if (!pipeline) {
	chan = Tcl_FSOpenFileChannel(interp, objv[1], modeString, prot);
    } else {
	int mode, seekFlag, binary;
	size_t cmdObjc;
	const char **cmdArgv;

	if (Tcl_SplitList(interp, what+1, &cmdObjc, &cmdArgv) != TCL_OK) {
	    return TCL_ERROR;
	}

	mode = TclGetOpenModeEx(interp, modeString, &seekFlag, &binary);







|







1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
     * Open the file or create a process pipeline.
     */

    if (!pipeline) {
	chan = Tcl_FSOpenFileChannel(interp, objv[1], modeString, prot);
    } else {
	int mode, seekFlag, binary;
	Tcl_Size cmdObjc;
	const char **cmdArgv;

	if (Tcl_SplitList(interp, what+1, &cmdObjc, &cmdArgv) != TCL_OK) {
	    return TCL_ERROR;
	}

	mode = TclGetOpenModeEx(interp, modeString, &seekFlag, &binary);
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
 *	subsequently to eval accept scripts.
 *
 *----------------------------------------------------------------------
 */

static void
TcpAcceptCallbacksDeleteProc(
    ClientData clientData,	/* Data which was passed when the assocdata
				 * was registered. */
    TCL_UNUSED(Tcl_Interp *))
{
    Tcl_HashTable *hTblPtr = (Tcl_HashTable *)clientData;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch hSearch;








|







1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
 *	subsequently to eval accept scripts.
 *
 *----------------------------------------------------------------------
 */

static void
TcpAcceptCallbacksDeleteProc(
    void *clientData,	/* Data which was passed when the assocdata
				 * was registered. */
    TCL_UNUSED(Tcl_Interp *))
{
    Tcl_HashTable *hTblPtr = (Tcl_HashTable *)clientData;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch hSearch;

1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
 *	Whatever the script does.
 *
 *----------------------------------------------------------------------
 */

static void
AcceptCallbackProc(
    ClientData callbackData,	/* The data stored when the callback was
				 * created in the call to
				 * Tcl_OpenTcpServer. */
    Tcl_Channel chan,		/* Channel for the newly accepted
				 * connection. */
    char *address,		/* Address of client that was accepted. */
    int port)			/* Port of client that was accepted. */
{







|







1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
 *	Whatever the script does.
 *
 *----------------------------------------------------------------------
 */

static void
AcceptCallbackProc(
    void *callbackData,	/* The data stored when the callback was
				 * created in the call to
				 * Tcl_OpenTcpServer. */
    Tcl_Channel chan,		/* Channel for the newly accepted
				 * connection. */
    char *address,		/* Address of client that was accepted. */
    int port)			/* Port of client that was accepted. */
{
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
 *	longer be informed.
 *
 *----------------------------------------------------------------------
 */

static void
TcpServerCloseProc(
    ClientData callbackData)	/* The data passed in the call to
				 * Tcl_CreateCloseHandler. */
{
    AcceptCallback *acceptCallbackPtr = (AcceptCallback *)callbackData;
				/* The actual data. */

    if (acceptCallbackPtr->interp != NULL) {
	UnregisterTcpServerInterpCleanupProc(acceptCallbackPtr->interp,







|







1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
 *	longer be informed.
 *
 *----------------------------------------------------------------------
 */

static void
TcpServerCloseProc(
    void *callbackData)	/* The data passed in the call to
				 * Tcl_CreateCloseHandler. */
{
    AcceptCallback *acceptCallbackPtr = (AcceptCallback *)callbackData;
				/* The actual data. */

    if (acceptCallbackPtr->interp != NULL) {
	UnregisterTcpServerInterpCleanupProc(acceptCallbackPtr->interp,
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
    int a, server = 0, myport = 0, async = 0, reusep = -1,
	reusea = -1, backlog = -1;
    unsigned int flags = 0;
    const char *host, *port, *myaddr = NULL;
    Tcl_Obj *script = NULL;
    Tcl_Channel chan;

    if (TclpHasSockets(interp) != TCL_OK) {
	return TCL_ERROR;
    }

    for (a = 1; a < objc; a++) {
	const char *arg = TclGetString(objv[a]);

	if (arg[0] != '-') {
	    break;
	}







|
<
<







1452
1453
1454
1455
1456
1457
1458
1459


1460
1461
1462
1463
1464
1465
1466
    int a, server = 0, myport = 0, async = 0, reusep = -1,
	reusea = -1, backlog = -1;
    unsigned int flags = 0;
    const char *host, *port, *myaddr = NULL;
    Tcl_Obj *script = NULL;
    Tcl_Channel chan;

    TclInitSockets();



    for (a = 1; a < objc; a++) {
	const char *arg = TclGetString(objv[a]);

	if (arg[0] != '-') {
	    break;
	}
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794

1795
1796
1797
1798
1799
1800
1801
ChanPendingObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Channel chan;
    int mode;
    static const char *const options[] = {"input", "output", NULL};
    enum pendingOptionsEnum {PENDING_INPUT, PENDING_OUTPUT} index;


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

    if (Tcl_GetIndexFromObj(interp, objv[1], options, "mode", 0,







<


>







1784
1785
1786
1787
1788
1789
1790

1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
ChanPendingObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Channel chan;

    static const char *const options[] = {"input", "output", NULL};
    enum pendingOptionsEnum {PENDING_INPUT, PENDING_OUTPUT} index;
    int mode;

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

    if (Tcl_GetIndexFromObj(interp, objv[1], options, "mode", 0,

Changes to generic/tclIOGT.c.

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
#include "tclIO.h"

/*
 * Forward declarations of internal procedures. First the driver procedures of
 * the transformation.
 */

static int		TransformBlockModeProc(ClientData instanceData,
			    int mode);
static int		TransformCloseProc(ClientData instanceData,
			    Tcl_Interp *interp, int flags);
static int		TransformInputProc(ClientData instanceData, char *buf,
			    int toRead, int *errorCodePtr);
static int		TransformOutputProc(ClientData instanceData,
			    const char *buf, int toWrite, int *errorCodePtr);
static int		TransformSetOptionProc(ClientData instanceData,
			    Tcl_Interp *interp, const char *optionName,
			    const char *value);
static int		TransformGetOptionProc(ClientData instanceData,
			    Tcl_Interp *interp, const char *optionName,
			    Tcl_DString *dsPtr);
static void		TransformWatchProc(ClientData instanceData, int mask);
static int		TransformGetFileHandleProc(ClientData instanceData,
			    int direction, ClientData *handlePtr);
static int		TransformNotifyProc(ClientData instanceData, int mask);
static long long	TransformWideSeekProc(ClientData instanceData,
			    long long offset, int mode, int *errorCodePtr);

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

static void		TransformChannelHandlerTimer(ClientData clientData);

/*
 * Forward declarations of internal procedures. Third, helper procedures
 * encapsulating essential tasks.
 */

typedef struct TransformChannelData TransformChannelData;







|

|

|

|

|


|


|
|
|
|
|







|







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
#include "tclIO.h"

/*
 * Forward declarations of internal procedures. First the driver procedures of
 * the transformation.
 */

static int		TransformBlockModeProc(void *instanceData,
			    int mode);
static int		TransformCloseProc(void *instanceData,
			    Tcl_Interp *interp, int flags);
static int		TransformInputProc(void *instanceData, char *buf,
			    int toRead, int *errorCodePtr);
static int		TransformOutputProc(void *instanceData,
			    const char *buf, int toWrite, int *errorCodePtr);
static int		TransformSetOptionProc(void *instanceData,
			    Tcl_Interp *interp, const char *optionName,
			    const char *value);
static int		TransformGetOptionProc(void *instanceData,
			    Tcl_Interp *interp, const char *optionName,
			    Tcl_DString *dsPtr);
static void		TransformWatchProc(void *instanceData, int mask);
static int		TransformGetFileHandleProc(void *instanceData,
			    int direction, void **handlePtr);
static int		TransformNotifyProc(void *instanceData, int mask);
static long long	TransformWideSeekProc(void *instanceData,
			    long long offset, int mode, int *errorCodePtr);

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

static void		TransformChannelHandlerTimer(void *clientData);

/*
 * Forward declarations of internal procedures. Third, helper procedures
 * encapsulating essential tasks.
 */

typedef struct TransformChannelData TransformChannelData;
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
    Tcl_Interp *interp,		/* Interpreter for result. */
    Tcl_Channel chan,		/* Channel to transform. */
    Tcl_Obj *cmdObjPtr)		/* Script to use for transform. */
{
    Channel *chanPtr;		/* The actual channel. */
    ChannelState *statePtr;	/* State info for channel. */
    int mode;			/* Read/write mode of the channel. */
    size_t objc;
    TransformChannelData *dataPtr;
    Tcl_DString ds;

    if (chan == NULL) {
	return TCL_ERROR;
    }








|







254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
    Tcl_Interp *interp,		/* Interpreter for result. */
    Tcl_Channel chan,		/* Channel to transform. */
    Tcl_Obj *cmdObjPtr)		/* Script to use for transform. */
{
    Channel *chanPtr;		/* The actual channel. */
    ChannelState *statePtr;	/* State info for channel. */
    int mode;			/* Read/write mode of the channel. */
    Tcl_Size objc;
    TransformChannelData *dataPtr;
    Tcl_DString ds;

    if (chan == NULL) {
	return TCL_ERROR;
    }

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
				 * callback is sent to the underlying channel
				 * or not. */
    int preserve)		/* Flag. If true the procedure will preserve
				 * the result state of all accessed
				 * interpreters. */
{
    Tcl_Obj *resObj;		/* See below, switch (transmit). */
    size_t resLen = 0;
    unsigned char *resBuf;
    Tcl_InterpState state = NULL;
    int res = TCL_OK;
    Tcl_Obj *command = TclListObjCopy(NULL, dataPtr->command);




    Tcl_Interp *eval = dataPtr->interp;

    Tcl_Preserve(eval);

    /*
     * Step 1, create the complete command to execute. Do this by appending
     * operation and buffer to operate upon to a copy of the callback
     * definition. We *cannot* create a list containing 3 objects and then use
     * 'Tcl_EvalObjv', because the command may contain additional prefixed
     * arguments. Feather's curried commands would come in handy here.
     */

    if (preserve == P_PRESERVE) {
	state = Tcl_SaveInterpState(eval, res);
    }

    Tcl_IncrRefCount(command);
    Tcl_ListObjAppendElement(NULL, command, Tcl_NewStringObj((char *) op, -1));






    /*
     * Use a byte-array to prevent the misinterpretation of binary data coming
     * through as UTF while at the tcl level.
     */

    Tcl_ListObjAppendElement(NULL, command, Tcl_NewByteArrayObj(buf, bufLen));

    /*
     * Step 2, execute the command at the global level of the interpreter used
     * to create the transformation. Destroy the command afterward. If an
     * error occured and the current interpreter is defined and not equal to
     * the interpreter for the callback, then copy the error message into
     * current interpreter. Don't copy if in preservation mode.
     */

    res = Tcl_EvalObjEx(eval, command, TCL_EVAL_GLOBAL);
    Tcl_DecrRefCount(command);
    command = NULL;







|



|
>
>
>
>

















|
>
>
>
>
>



|







|







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
				 * callback is sent to the underlying channel
				 * or not. */
    int preserve)		/* Flag. If true the procedure will preserve
				 * the result state of all accessed
				 * interpreters. */
{
    Tcl_Obj *resObj;		/* See below, switch (transmit). */
    Tcl_Size resLen = 0;
    unsigned char *resBuf;
    Tcl_InterpState state = NULL;
    int res = TCL_OK;
    Tcl_Obj *command = TclDuplicatePureObj(
	interp, dataPtr->command, &tclListType);
    if (!command) {
	return TCL_ERROR;
    }
    Tcl_Interp *eval = dataPtr->interp;

    Tcl_Preserve(eval);

    /*
     * Step 1, create the complete command to execute. Do this by appending
     * operation and buffer to operate upon to a copy of the callback
     * definition. We *cannot* create a list containing 3 objects and then use
     * 'Tcl_EvalObjv', because the command may contain additional prefixed
     * arguments. Feather's curried commands would come in handy here.
     */

    if (preserve == P_PRESERVE) {
	state = Tcl_SaveInterpState(eval, res);
    }

    Tcl_IncrRefCount(command);
    res = Tcl_ListObjAppendElement(NULL, command, Tcl_NewStringObj((char *) op, -1));
    if (res != TCL_OK) {
	Tcl_DecrRefCount(command);
	Tcl_Release(eval);
	return res;
    }

    /*
     * Use a byte-array to prevent the misinterpretation of binary data coming
     * through as Utf while at the tcl level.
     */

    Tcl_ListObjAppendElement(NULL, command, Tcl_NewByteArrayObj(buf, bufLen));

    /*
     * Step 2, execute the command at the global level of the interpreter used
     * to create the transformation. Destroy the command afterward. If an
     * error occurred and the current interpreter is defined and not equal to
     * the interpreter for the callback, then copy the error message into
     * current interpreter. Don't copy if in preservation mode.
     */

    res = Tcl_EvalObjEx(eval, command, TCL_EVAL_GLOBAL);
    Tcl_DecrRefCount(command);
    command = NULL;
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
 *	0 if successful, errno when failed.
 *
 *----------------------------------------------------------------------
 */

static int
TransformBlockModeProc(
    ClientData instanceData,	/* State of transformation. */
    int mode)			/* New blocking mode. */
{
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;

    if (mode == TCL_MODE_NONBLOCKING) {
	dataPtr->flags |= CHANNEL_ASYNC;
    } else {







|







515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
 *	0 if successful, errno when failed.
 *
 *----------------------------------------------------------------------
 */

static int
TransformBlockModeProc(
    void *instanceData,	/* State of transformation. */
    int mode)			/* New blocking mode. */
{
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;

    if (mode == TCL_MODE_NONBLOCKING) {
	dataPtr->flags |= CHANNEL_ASYNC;
    } else {
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TransformCloseProc(
    ClientData instanceData,
    Tcl_Interp *interp,
	int flags)
{
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;

    if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) {
	return EINVAL;







|







547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TransformCloseProc(
    void *instanceData,
    Tcl_Interp *interp,
	int flags)
{
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;

    if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) {
	return EINVAL;
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
	dataPtr->timer = NULL;
    }

    /*
     * Now flush data waiting in internal buffers to output and input. The
     * input must be done despite the fact that there is no real receiver for
     * it anymore. But the scripts might have sideeffects other parts of the
     * system rely on (f.e. signaling the close to interested parties).
     */

    PreserveData(dataPtr);
    if (dataPtr->mode & TCL_WRITABLE) {
	ExecuteCallback(dataPtr, interp, A_FLUSH_WRITE, NULL, 0,
		TRANSMIT_DOWN, P_PRESERVE);
    }







|







578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
	dataPtr->timer = NULL;
    }

    /*
     * Now flush data waiting in internal buffers to output and input. The
     * input must be done despite the fact that there is no real receiver for
     * it anymore. But the scripts might have sideeffects other parts of the
     * system rely on (f.e. signalling the close to interested parties).
     */

    PreserveData(dataPtr);
    if (dataPtr->mode & TCL_WRITABLE) {
	ExecuteCallback(dataPtr, interp, A_FLUSH_WRITE, NULL, 0,
		TRANSMIT_DOWN, P_PRESERVE);
    }
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
 *	A transformed buffer.
 *
 *----------------------------------------------------------------------
 */

static int
TransformInputProc(
    ClientData instanceData,
    char *buf,
    int toRead,
    int *errorCodePtr)
{
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
    int gotBytes, read, copied;
    Tcl_Channel downChan;







|







631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
 *	A transformed buffer.
 *
 *----------------------------------------------------------------------
 */

static int
TransformInputProc(
    void *instanceData,
    char *buf,
    int toRead,
    int *errorCodePtr)
{
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
    int gotBytes, read, copied;
    Tcl_Channel downChan;
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
 *	A transformed buffer.
 *
 *----------------------------------------------------------------------
 */

static int
TransformOutputProc(
    ClientData instanceData,
    const char *buf,
    int toWrite,
    int *errorCodePtr)
{
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;

    /*







|







798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
 *	A transformed buffer.
 *
 *----------------------------------------------------------------------
 */

static int
TransformOutputProc(
    void *instanceData,
    const char *buf,
    int toWrite,
    int *errorCodePtr)
{
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;

    /*
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
 *	contains the POSIX error code if an error occurred, or zero.
 *
 *----------------------------------------------------------------------
 */

static long long
TransformWideSeekProc(
    ClientData instanceData,	/* The channel to manipulate. */
    long long offset,		/* Size of movement. */
    int mode,			/* How to move. */
    int *errorCodePtr)		/* Location of error flag. */
{
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
    Tcl_Channel parent = Tcl_GetStackedChannel(dataPtr->self);
    const Tcl_ChannelType *parentType	= Tcl_GetChannelType(parent);







|







850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
 *	contains the POSIX error code if an error occurred, or zero.
 *
 *----------------------------------------------------------------------
 */

static long long
TransformWideSeekProc(
    void *instanceData,	/* The channel to manipulate. */
    long long offset,		/* Size of movement. */
    int mode,			/* How to move. */
    int *errorCodePtr)		/* Location of error flag. */
{
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
    Tcl_Channel parent = Tcl_GetStackedChannel(dataPtr->self);
    const Tcl_ChannelType *parentType	= Tcl_GetChannelType(parent);
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
 *	A standard TCL error code.
 *
 *----------------------------------------------------------------------
 */

static int
TransformSetOptionProc(
    ClientData instanceData,
    Tcl_Interp *interp,
    const char *optionName,
    const char *value)
{
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
    Tcl_Channel downChan = Tcl_GetStackedChannel(dataPtr->self);
    Tcl_DriverSetOptionProc *setOptionProc;







|







928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
 *	A standard TCL error code.
 *
 *----------------------------------------------------------------------
 */

static int
TransformSetOptionProc(
    void *instanceData,
    Tcl_Interp *interp,
    const char *optionName,
    const char *value)
{
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
    Tcl_Channel downChan = Tcl_GetStackedChannel(dataPtr->self);
    Tcl_DriverSetOptionProc *setOptionProc;
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
 *	A standard TCL error code.
 *
 *----------------------------------------------------------------------
 */

static int
TransformGetOptionProc(
    ClientData instanceData,
    Tcl_Interp *interp,
    const char *optionName,
    Tcl_DString *dsPtr)
{
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
    Tcl_Channel downChan = Tcl_GetStackedChannel(dataPtr->self);
    Tcl_DriverGetOptionProc *getOptionProc;







|







966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
 *	A standard TCL error code.
 *
 *----------------------------------------------------------------------
 */

static int
TransformGetOptionProc(
    void *instanceData,
    Tcl_Interp *interp,
    const char *optionName,
    Tcl_DString *dsPtr)
{
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
    Tcl_Channel downChan = Tcl_GetStackedChannel(dataPtr->self);
    Tcl_DriverGetOptionProc *getOptionProc;
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
TransformWatchProc(
    ClientData instanceData,	/* Channel to watch. */
    int mask)			/* Events of interest. */
{
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
    Tcl_Channel downChan;

    /*
     * The caller expressed interest in events occuring for this channel. We
     * are forwarding the call to the underlying channel now.
     */

    dataPtr->watchMask = mask;

    /*
     * No channel handlers any more. We will be notified automatically about







|






|







1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
TransformWatchProc(
    void *instanceData,	/* Channel to watch. */
    int mask)			/* Events of interest. */
{
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
    Tcl_Channel downChan;

    /*
     * The caller expressed interest in events occurring for this channel. We
     * are forwarding the call to the underlying channel now.
     */

    dataPtr->watchMask = mask;

    /*
     * No channel handlers any more. We will be notified automatically about
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
 *	The appropriate Tcl_File or NULL if not present.
 *
 *----------------------------------------------------------------------
 */

static int
TransformGetFileHandleProc(
    ClientData instanceData,	/* Channel to query. */
    int direction,		/* Direction of interest. */
    ClientData *handlePtr)	/* Place to store the handle into. */
{
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;

    /*
     * Return the handle belonging to parent channel. IOW, pass the request
     * down and the result up.
     */







|

|







1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
 *	The appropriate Tcl_File or NULL if not present.
 *
 *----------------------------------------------------------------------
 */

static int
TransformGetFileHandleProc(
    void *instanceData,	/* Channel to query. */
    int direction,		/* Direction of interest. */
    void **handlePtr)	/* Place to store the handle into. */
{
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;

    /*
     * Return the handle belonging to parent channel. IOW, pass the request
     * down and the result up.
     */
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TransformNotifyProc(
    ClientData clientData,	/* The state of the notified
				 * transformation. */
    int mask)			/* The mask of occuring events. */
{
    TransformChannelData *dataPtr = (TransformChannelData *)clientData;

    /*
     * An event occured in the underlying channel. This transformation doesn't
     * process such events thus returns the incoming mask unchanged.
     */

    if (dataPtr->timer != NULL) {
	/*
	 * Delete an existing timer. It was not fired, yet we are here, so the
	 * channel below generated such an event and we don't have to. The







|

|




|







1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TransformNotifyProc(
    void *clientData,	/* The state of the notified
				 * transformation. */
    int mask)			/* The mask of occurring events. */
{
    TransformChannelData *dataPtr = (TransformChannelData *)clientData;

    /*
     * An event occurred in the underlying channel. This transformation doesn't
     * process such events thus returns the incoming mask unchanged.
     */

    if (dataPtr->timer != NULL) {
	/*
	 * Delete an existing timer. It was not fired, yet we are here, so the
	 * channel below generated such an event and we don't have to. The
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
TransformChannelHandlerTimer(
    ClientData clientData)	/* Transformation to query. */
{
    TransformChannelData *dataPtr = (TransformChannelData *)clientData;

    dataPtr->timer = NULL;
    if (!(dataPtr->watchMask&TCL_READABLE) || ResultEmpty(&dataPtr->result)) {
	/*
	 * The timer fired, but either is there no (more) interest in the







|







1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
TransformChannelHandlerTimer(
    void *clientData)	/* Transformation to query. */
{
    TransformChannelData *dataPtr = (TransformChannelData *)clientData;

    dataPtr->timer = NULL;
    if (!(dataPtr->watchMask&TCL_READABLE) || ResultEmpty(&dataPtr->result)) {
	/*
	 * The timer fired, but either is there no (more) interest in the
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227

/*
 *----------------------------------------------------------------------
 *
 * ResultInit --
 *
 *	Initializes the specified buffer structure. The structure will contain
 *	valid information for an emtpy buffer.
 *
 * Side effects:
 *	See above.
 *
 * Result:
 *	None.
 *







|







1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236

/*
 *----------------------------------------------------------------------
 *
 * ResultInit --
 *
 *	Initializes the specified buffer structure. The structure will contain
 *	valid information for an empty buffer.
 *
 * Side effects:
 *	See above.
 *
 * Result:
 *	None.
 *

Changes to generic/tclIORChan.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/*
 * tclIORChan.c --
 *
 *	This file contains the implementation of Tcl's generic channel
 *	reflection code, which allows the implementation of Tcl channels in
 *	Tcl code.
 *
 *	Parts of this file are based on code contributed by Jean-Claude
 *	Wippler.
 *
 *	See TIP #219 for the specification of this functionality.
 *
 * Copyright © 2004-2005 ActiveState, a divison of Sophos
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclIO.h"












|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/*
 * tclIORChan.c --
 *
 *	This file contains the implementation of Tcl's generic channel
 *	reflection code, which allows the implementation of Tcl channels in
 *	Tcl code.
 *
 *	Parts of this file are based on code contributed by Jean-Claude
 *	Wippler.
 *
 *	See TIP #219 for the specification of this functionality.
 *
 * Copyright © 2004-2005 ActiveState, a division 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"
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
    /*
     * Note regarding the usage of timers.
     *
     * Most channel implementations need a timer in the C level to ensure that
     * data in buffers is flushed out through the generation of fake file
     * events.
     *
     * See 'rechan', 'memchan', etc.
     *
     * A timer is used here as well in order to ensure at least on pass through
     * the event loop when a channel becomes ready. See issues 67a5eabbd3d1 and
     * ef28eb1f1516.
     */
} ReflectedChannel;

/*
 * Structure of the table maping from channel handles to reflected
 * channels. Each interpreter which has the handler command for one or more
 * reflected channels records them in such a table, so that 'chan postevent'
 * is able to find them even if the actual channel was moved to a different
 * interpreter and/or thread.
 *
 * The table is reachable via the standard interpreter AssocData, the key is
 * defined below.







|








|







127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
    /*
     * Note regarding the usage of timers.
     *
     * Most channel implementations need a timer in the C level to ensure that
     * data in buffers is flushed out through the generation of fake file
     * events.
     *
     * See 'refchan', 'memchan', etc.
     *
     * A timer is used here as well in order to ensure at least on pass through
     * the event loop when a channel becomes ready. See issues 67a5eabbd3d1 and
     * ef28eb1f1516.
     */
} ReflectedChannel;

/*
 * Structure of the table mapping from channel handles to reflected
 * channels. Each interpreter which has the handler command for one or more
 * reflected channels records them in such a table, so that 'chan postevent'
 * is able to find them even if the actual channel was moved to a different
 * interpreter and/or thread.
 *
 * The table is reachable via the standard interpreter AssocData, the key is
 * defined below.
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
 * ForwardParamBase. Where an operation does not need any special types, it
 * has no "subtype" and just uses ForwardParamBase, as listed above.)
 */

struct ForwardParamInput {
    ForwardParamBase base;	/* "Supertype". MUST COME FIRST. */
    char *buf;			/* O: Where to store the read bytes */
    size_t toRead;			/* I: #bytes to read,
				 * O: #bytes actually read */
};
struct ForwardParamOutput {
    ForwardParamBase base;	/* "Supertype". MUST COME FIRST. */
    const char *buf;		/* I: Where the bytes to write come from */
    int toWrite;		/* I: #bytes to write,
				 * O: #bytes actually written */
};
struct ForwardParamSeek {
    ForwardParamBase base;	/* "Supertype". MUST COME FIRST. */
    int seekMode;		/* I: How to seek */
    Tcl_WideInt offset;		/* I: Where to seek,
				 * O: New location */







|





|







262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
 * ForwardParamBase. Where an operation does not need any special types, it
 * has no "subtype" and just uses ForwardParamBase, as listed above.)
 */

struct ForwardParamInput {
    ForwardParamBase base;	/* "Supertype". MUST COME FIRST. */
    char *buf;			/* O: Where to store the read bytes */
    Tcl_Size toRead;			/* I: #bytes to read,
				 * O: #bytes actually read */
};
struct ForwardParamOutput {
    ForwardParamBase base;	/* "Supertype". MUST COME FIRST. */
    const char *buf;		/* I: Where the bytes to write come from */
    Tcl_Size toWrite;		/* I: #bytes to write,
				 * O: #bytes actually written */
};
struct ForwardParamSeek {
    ForwardParamBase base;	/* "Supertype". MUST COME FIRST. */
    int seekMode;		/* I: How to seek */
    Tcl_WideInt offset;		/* I: Where to seek,
				 * O: New location */
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
    Tcl_Obj *rcId;		/* Handle of the new channel */
    int mode;			/* R/W mode of new channel. Has to match
				 * abilities of handler commands */
    Tcl_Obj *cmdObj;		/* Command prefix, list of words */
    Tcl_Obj *cmdNameObj;	/* Command name */
    Tcl_Channel chan;		/* Token for the new channel */
    Tcl_Obj *modeObj;		/* mode in obj form for method call */
    size_t listc;			/* Result of 'initialize', and of */
    Tcl_Obj **listv;		/* its sublist in the 2nd element */
    int methIndex;		/* Encoded method name */
    int result;			/* Result code for 'initialize' */
    Tcl_Obj *resObj;		/* Result data for 'initialize' */
    int methods;		/* Bitmask for supported methods. */
    Channel *chanPtr;		/* 'chan' resolved to internal struct. */
    Tcl_Obj *err;		/* Error message */







|







509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
    Tcl_Obj *rcId;		/* Handle of the new channel */
    int mode;			/* R/W mode of new channel. Has to match
				 * abilities of handler commands */
    Tcl_Obj *cmdObj;		/* Command prefix, list of words */
    Tcl_Obj *cmdNameObj;	/* Command name */
    Tcl_Channel chan;		/* Token for the new channel */
    Tcl_Obj *modeObj;		/* mode in obj form for method call */
    Tcl_Size listc;			/* Result of 'initialize', and of */
    Tcl_Obj **listv;		/* its sublist in the 2nd element */
    int methIndex;		/* Encoded method name */
    int result;			/* Result code for 'initialize' */
    Tcl_Obj *resObj;		/* Result data for 'initialize' */
    int methods;		/* Bitmask for supported methods. */
    Channel *chanPtr;		/* 'chan' resolved to internal struct. */
    Tcl_Obj *err;		/* Error message */
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "mode cmdprefix");
	return TCL_ERROR;
    }

    /*
     * First argument is a list of modes. Allowed entries are "read", "write".
     * Expect at least one list element. Abbreviations are ok.
     */

    modeObj = objv[MODE];
    if (EncodeEventMask(interp, "mode", objv[MODE], &mode) != TCL_OK) {
	return TCL_ERROR;
    }








|







545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "mode cmdprefix");
	return TCL_ERROR;
    }

    /*
     * First argument is a list of modes. Allowed entries are "read", "write".
     * Empty list is uncommon, but allowed. Abbreviations are ok.
     */

    modeObj = objv[MODE];
    if (EncodeEventMask(interp, "mode", objv[MODE], &mode) != TCL_OK) {
	return TCL_ERROR;
    }

576
577
578
579
580
581
582



583
584
585
586
587
588
589

    /*
     * Now create the channel.
     */

    rcId = NextHandle();
    rcPtr = NewReflectedChannel(interp, cmdObj, mode, rcId);




    /*
     * Invoke 'initialize' and validate that the handler is present and ok.
     * Squash the channel if not.
     *
     * Note: The conversion of 'mode' back into a Tcl_Obj ensures that
     * 'initialize' is invoked with canonical mode names, and no







>
>
>







576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592

    /*
     * Now create the channel.
     */

    rcId = NextHandle();
    rcPtr = NewReflectedChannel(interp, cmdObj, mode, rcId);
    if (!rcPtr) {
	return TCL_ERROR;
    }

    /*
     * Invoke 'initialize' and validate that the handler is present and ok.
     * Squash the channel if not.
     *
     * Note: The conversion of 'mode' back into a Tcl_Obj ensures that
     * 'initialize' is invoked with canonical mode names, and no
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
     * (2) Is the post event issued from the interpreter holding the handler
     *     of the reflected channel?
     *
     * A successful search answers yes to both. Because the map holds only
     * handles of reflected channels, and only of such whose handler is
     * defined in this interpreter.
     *
     * We keep the old checks for both, for paranioa, but abort now instead of
     * throwing errors, as failure now means that our internal datastructures
     * have gone seriously haywire.
     */

    chan = (Tcl_Channel)Tcl_GetHashValue(hPtr);
    chanTypePtr = Tcl_GetChannelType(chan);

    /*







|
|







886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
     * (2) Is the post event issued from the interpreter holding the handler
     *     of the reflected channel?
     *
     * A successful search answers yes to both. Because the map holds only
     * handles of reflected channels, and only of such whose handler is
     * defined in this interpreter.
     *
     * We keep the old checks for both, for paranoia, but abort now instead of
     * throwing errors, as failure now means that our internal data structures
     * have gone seriously haywire.
     */

    chan = (Tcl_Channel)Tcl_GetHashValue(hPtr);
    chanTypePtr = Tcl_GetChannelType(chan);

    /*
917
918
919
920
921
922
923





924
925
926
927
928
929
930
    /*
     * Second argument is a list of events. Allowed entries are "read",
     * "write". Expect at least one list element. Abbreviations are ok.
     */

    if (EncodeEventMask(interp, "event", objv[EVENT], &events) != TCL_OK) {
	return TCL_ERROR;





    }

    /*
     * Check that the channel is actually interested in the provided events.
     */

    if (events & ~rcPtr->interest) {







>
>
>
>
>







920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
    /*
     * Second argument is a list of events. Allowed entries are "read",
     * "write". Expect at least one list element. Abbreviations are ok.
     */

    if (EncodeEventMask(interp, "event", objv[EVENT], &events) != TCL_OK) {
	return TCL_ERROR;
    }
    if (events == 0) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("bad event list: is empty", -1));
	return TCL_ERROR;
    }

    /*
     * Check that the channel is actually interested in the provided events.
     */

    if (events & ~rcPtr->interest) {
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
}

static void
UnmarshallErrorResult(
    Tcl_Interp *interp,
    Tcl_Obj *msgObj)
{
    size_t lc;
    Tcl_Obj **lv;
    int explicitResult;
    size_t numOptions;

    /*
     * Process the caught message.
     *
     * Syntax = (option value)... ?message?
     *
     * Bad syntax causes a panic. This is OK because the other side uses
     * Tcl_GetReturnOptions and list construction functions to marshall the
     * information; if we panic here, something has gone badly wrong already.
     */

    if (TclListObjGetElementsM(interp, msgObj, &lc, &lv) != TCL_OK) {
	Tcl_Panic("TclChanCaughtErrorBypass: Bad syntax of caught result");
    }
    if (interp == NULL) {







|


|







|







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
}

static void
UnmarshallErrorResult(
    Tcl_Interp *interp,
    Tcl_Obj *msgObj)
{
    Tcl_Size lc;
    Tcl_Obj **lv;
    int explicitResult;
    Tcl_Size numOptions;

    /*
     * Process the caught message.
     *
     * Syntax = (option value)... ?message?
     *
     * Bad syntax causes a panic. This is OK because the other side uses
     * Tcl_GetReturnOptions and list construction functions to marshal the
     * information; if we panic here, something has gone badly wrong already.
     */

    if (TclListObjGetElementsM(interp, msgObj, &lc, &lv) != TCL_OK) {
	Tcl_Panic("TclChanCaughtErrorBypass: Bad syntax of caught result");
    }
    if (interp == NULL) {
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
 *
 * ReflectClose --
 *
 *	This function is invoked when the channel is closed, to delete the
 *	driver-specific instance data.
 *
 * Results:
 *	A posix error.
 *
 * Side effects:
 *	Releases memory. Arbitrary, as it calls upon a script.
 *
 *----------------------------------------------------------------------
 */








|







1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
 *
 * ReflectClose --
 *
 *	This function is invoked when the channel is closed, to delete the
 *	driver-specific instance data.
 *
 * Results:
 *	A Posix error.
 *
 * Side effects:
 *	Releases memory. Arbitrary, as it calls upon a script.
 *
 *----------------------------------------------------------------------
 */

1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
    void *clientData,
    char *buf,
    int toRead,
    int *errorCodePtr)
{
    ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
    Tcl_Obj *toReadObj;
    size_t bytec = 0;		/* Number of returned bytes */
    unsigned char *bytev;	/* Array of returned bytes */
    Tcl_Obj *resObj;		/* Result data for 'read' */

    /*
     * Are we in the correct thread?
     */








|







1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
    void *clientData,
    char *buf,
    int toRead,
    int *errorCodePtr)
{
    ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
    Tcl_Obj *toReadObj;
    Tcl_Size bytec = 0;		/* Number of returned bytes */
    unsigned char *bytev;	/* Array of returned bytes */
    Tcl_Obj *resObj;		/* Result data for 'read' */

    /*
     * Are we in the correct thread?
     */

1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
        goto invalid;
    }

    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);

    if (bytev == NULL) {
	SetChannelErrorStr(rcPtr->chan, msg_read_nonbyte);
        goto invalid;
    } else if ((size_t)toRead < bytec) {
	SetChannelErrorStr(rcPtr->chan, msg_read_toomuch);
	goto invalid;
    }

    *errorCodePtr = EOK;

    if (bytec + 1 > 1) {
	memcpy(buf, bytev, bytec);
    }

 stop:
    Tcl_DecrRefCount(toReadObj);
    Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */
    Tcl_Release(rcPtr);







|
|






|







1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
        goto invalid;
    }

    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);

    if (bytev == NULL) {
	SetChannelErrorStr(rcPtr->chan, msg_read_nonbyte);
	goto invalid;
    } else if (toRead < bytec) {
	SetChannelErrorStr(rcPtr->chan, msg_read_toomuch);
	goto invalid;
    }

    *errorCodePtr = EOK;

    if (bytec > 0) {
	memcpy(buf, bytev, bytec);
    }

 stop:
    Tcl_DecrRefCount(toReadObj);
    Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */
    Tcl_Release(rcPtr);
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
 *
 * ReflectBlock --
 *
 *	This function is invoked to tell the channel which blocking behaviour
 *	is required of it.
 *
 * Results:
 *	A posix error number.
 *
 * Side effects:
 *	Allocates memory. Arbitrary, as it calls upon a script.
 *
 *----------------------------------------------------------------------
 */








|







1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
 *
 * ReflectBlock --
 *
 *	This function is invoked to tell the channel which blocking behaviour
 *	is required of it.
 *
 * Results:
 *	A Posix error number.
 *
 * Side effects:
 *	Allocates memory. Arbitrary, as it calls upon a script.
 *
 *----------------------------------------------------------------------
 */

1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
     * This code is special. It has regular passing of Tcl result, and errors.
     * The bypass functions are not required.
     */

    ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
    Tcl_Obj *optionObj;
    Tcl_Obj *resObj;		/* Result data for 'configure' */
    size_t listc;
    int result = TCL_OK;
    Tcl_Obj **listv;
    MethodName method;

    /*
     * Are we in the correct thread?
     */







|







1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
     * This code is special. It has regular passing of Tcl result, and errors.
     * The bypass functions are not required.
     */

    ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
    Tcl_Obj *optionObj;
    Tcl_Obj *resObj;		/* Result data for 'configure' */
    Tcl_Size listc;
    int result = TCL_OK;
    Tcl_Obj **listv;
    MethodName method;

    /*
     * Are we in the correct thread?
     */
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
	/*
	 * Odd number of elements is wrong.
	 */

	Tcl_ResetResult(interp);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"Expected list with even number of "
		"elements, got %" TCL_Z_MODIFIER "u element%s instead", listc,
		(listc == 1 ? "" : "s")));
        goto error;
    } else {
	size_t len;
	const char *str = Tcl_GetStringFromObj(resObj, &len);

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







|



|







2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
	/*
	 * Odd number of elements is wrong.
	 */

	Tcl_ResetResult(interp);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"Expected list with even number of "
		"elements, got %" TCL_SIZE_MODIFIER "u element%s instead", listc,
		(listc == 1 ? "" : "s")));
        goto error;
    } else {
	Tcl_Size len;
	const char *str = Tcl_GetStringFromObj(resObj, &len);

	if (len) {
	    TclDStringAppendLiteral(dsPtr, " ");
	    Tcl_DStringAppend(dsPtr, str, len);
	}
        goto ok;
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

/*
 *----------------------------------------------------------------------
 *
 * EncodeEventMask --
 *
 *	This function takes a list of event items and constructs the
 *	equivalent internal bitmask. The list must contain at least one
 *	element. Elements are "read", "write", or any unique abbreviation of
 *	them. Note that the bitmask is not changed if problems are
 *	encountered.
 *
 * Results:
 *	A standard Tcl error code. A bitmask where TCL_READABLE and/or
 *	TCL_WRITABLE can be set.
 *
 * Side effects:
 *	May shimmer 'obj' to a list representation. May place an error message
 *	into the interp result.
 *
 *----------------------------------------------------------------------
 */

static int
EncodeEventMask(
    Tcl_Interp *interp,
    const char *objName,
    Tcl_Obj *obj,
    int *mask)
{
    int events;			/* Mask of events to post */
    size_t listc;			/* #elements in eventspec list */
    Tcl_Obj **listv;		/* Elements of eventspec list */
    int evIndex;		/* Id of event for an element of the eventspec
				 * list. */

    if (TclListObjGetElementsM(interp, obj, &listc, &listv) != TCL_OK) {
	return TCL_ERROR;
    }

    if (listc < 1) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "bad %s list: is empty", objName));
	return TCL_ERROR;
    }

    events = 0;
    while (listc > 0) {
	if (Tcl_GetIndexFromObj(interp, listv[listc-1], eventOptions,
		objName, 0, &evIndex) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (evIndex) {







|
|
|
|




















|








<
<
<
<
<
<







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

/*
 *----------------------------------------------------------------------
 *
 * EncodeEventMask --
 *
 *	This function takes a list of event items and constructs the
 *	equivalent internal bitmask. The list may be empty but will usually
 *	contain at least one element. Valid elements are "read", "write", or
 *	any unique abbreviation of them. Note that the bitmask is not changed
 *	if problems are encountered.
 *
 * Results:
 *	A standard Tcl error code. A bitmask where TCL_READABLE and/or
 *	TCL_WRITABLE can be set.
 *
 * Side effects:
 *	May shimmer 'obj' to a list representation. May place an error message
 *	into the interp result.
 *
 *----------------------------------------------------------------------
 */

static int
EncodeEventMask(
    Tcl_Interp *interp,
    const char *objName,
    Tcl_Obj *obj,
    int *mask)
{
    int events;			/* Mask of events to post */
    Tcl_Size listc;			/* #elements in eventspec list */
    Tcl_Obj **listv;		/* Elements of eventspec list */
    int evIndex;		/* Id of event for an element of the eventspec
				 * list. */

    if (TclListObjGetElementsM(interp, obj, &listc, &listv) != TCL_OK) {
	return TCL_ERROR;
    }







    events = 0;
    while (listc > 0) {
	if (Tcl_GetIndexFromObj(interp, listv[listc-1], eventOptions,
		objName, 0, &evIndex) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (evIndex) {
2255
2256
2257
2258
2259
2260
2261
2262
2263


2264
2265
2266
2267
2268
2269
2270
    rcPtr->writeTimer = 0;
#if TCL_THREADS
    rcPtr->thread = Tcl_GetCurrentThread();
#endif
    rcPtr->mode = mode;
    rcPtr->interest = 0;		/* Initially no interest registered */

    /* ASSERT: cmdpfxObj is a Tcl List */
    rcPtr->cmd = TclListObjCopy(NULL, cmdpfxObj);


    Tcl_IncrRefCount(rcPtr->cmd);
    rcPtr->methods = Tcl_NewListObj(METH_WRITE + 1, NULL);
    while (mn <= (int)METH_WRITE) {
	Tcl_ListObjAppendElement(NULL, rcPtr->methods,
		Tcl_NewStringObj(methodNames[mn++], -1));
    }
    Tcl_IncrRefCount(rcPtr->methods);







|
|
>
>







2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
    rcPtr->writeTimer = 0;
#if TCL_THREADS
    rcPtr->thread = Tcl_GetCurrentThread();
#endif
    rcPtr->mode = mode;
    rcPtr->interest = 0;		/* Initially no interest registered */

    rcPtr->cmd = TclDuplicatePureObj(interp, cmdpfxObj, &tclListType);
    if (!rcPtr->cmd) {
	return NULL;
    }
    Tcl_IncrRefCount(rcPtr->cmd);
    rcPtr->methods = Tcl_NewListObj(METH_WRITE + 1, NULL);
    while (mn <= (int)METH_WRITE) {
	Tcl_ListObjAppendElement(NULL, rcPtr->methods,
		Tcl_NewStringObj(methodNames[mn++], -1));
    }
    Tcl_IncrRefCount(rcPtr->methods);
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
 *	reflected channel.
 *
 * Results:
 *	A Tcl_Obj containing the string of the new channel handle. The
 *	refcount of the returned object is -- zero --.
 *
 * Side effects:
 *	May allocate memory. Mutex protected critical section locks out other
 *	threads for a short time.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Obj *
NextHandle(void)







|







2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
 *	reflected channel.
 *
 * Results:
 *	A Tcl_Obj containing the string of the new channel handle. The
 *	refcount of the returned object is -- zero --.
 *
 * Side effects:
 *	May allocate memory. Mutex-protected critical section locks out other
 *	threads for a short time.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Obj *
NextHandle(void)
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350

/*
 *----------------------------------------------------------------------
 *
 * InvokeTclMethod --
 *
 *	This function is used to invoke the Tcl level of a reflected channel.
 *	It handles all the command assembly, invokation, and generic state and
 *	result mgmt. It does *not* handle thread redirection; that is the
 *	responsibility of clients of this function.
 *
 * Results:
 *	Result code and data as returned by the method.
 *
 * Side effects:







|







2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354

/*
 *----------------------------------------------------------------------
 *
 * InvokeTclMethod --
 *
 *	This function is used to invoke the Tcl level of a reflected channel.
 *	It handles all the command assembly, invocation, and generic state and
 *	result mgmt. It does *not* handle thread redirection; that is the
 *	responsibility of clients of this function.
 *
 * Results:
 *	Result code and data as returned by the method.
 *
 * Side effects:
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
    MethodName method,
    Tcl_Obj *argOneObj,		/* NULL'able */
    Tcl_Obj *argTwoObj,		/* NULL'able */
    Tcl_Obj **resultObjPtr)	/* NULL'able */
{
    Tcl_Obj *methObj = NULL;	/* Method name in object form */
    Tcl_InterpState sr;		/* State of handler interp */
    int result;			/* Result code of method invokation */
    Tcl_Obj *resObj = NULL;	/* Result of method invokation. */
    Tcl_Obj *cmd;

    if (rcPtr->dead) {
	/*
	 * The channel is marked as dead. Bail out immediately, with an
	 * appropriate error.
	 */







|
|







2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
    MethodName method,
    Tcl_Obj *argOneObj,		/* NULL'able */
    Tcl_Obj *argTwoObj,		/* NULL'able */
    Tcl_Obj **resultObjPtr)	/* NULL'able */
{
    Tcl_Obj *methObj = NULL;	/* Method name in object form */
    Tcl_InterpState sr;		/* State of handler interp */
    int result;			/* Result code of method invocation */
    Tcl_Obj *resObj = NULL;	/* Result of method invocation. */
    Tcl_Obj *cmd;

    if (rcPtr->dead) {
	/*
	 * The channel is marked as dead. Bail out immediately, with an
	 * appropriate error.
	 */
2393
2394
2395
2396
2397
2398
2399
2400


2401
2402
2403
2404
2405
2406
2407
2408
    }

    /*
     * Insert method into the callback command, after the command prefix,
     * before the channel id.
     */

    cmd = TclListObjCopy(NULL, rcPtr->cmd);



    Tcl_ListObjIndex(NULL, rcPtr->methods, method, &methObj);
    Tcl_ListObjAppendElement(NULL, cmd, methObj);
    Tcl_ListObjAppendElement(NULL, cmd, rcPtr->name);

    /*
     * Append the additional argument containing method specific details
     * behind the channel id. If specified.







|
>
>
|







2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
    }

    /*
     * Insert method into the callback command, after the command prefix,
     * before the channel id.
     */

    cmd = TclDuplicatePureObj(NULL, rcPtr->cmd, &tclListType);
    if (!cmd) {
	return TCL_ERROR;
    }
    Tcl_ListObjIndex(NULL, rcPtr->methods, method, &methObj);
    Tcl_ListObjAppendElement(NULL, cmd, methObj);
    Tcl_ListObjAppendElement(NULL, cmd, rcPtr->name);

    /*
     * Append the additional argument containing method specific details
     * behind the channel id. If specified.
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
	     * the full state of the result, including additional options.
	     *
	     * This is complex and ugly, and would be completely unnecessary
	     * if we only added support for a TCL_FORBID_EXCEPTIONS flag.
	     */

	    if (result != TCL_ERROR) {
		size_t cmdLen;
		const char *cmdString = Tcl_GetStringFromObj(cmd, &cmdLen);

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







|







2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
	     * the full state of the result, including additional options.
	     *
	     * 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_Size 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,
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
 *	an interpreter is deleted, via the AssocData cleanup mechanism.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Deletes the hash table of channels. May close channels. May flush
 *	output on closed channels. Removes any channeEvent handlers that were
 *	registered in this interpreter.
 *
 *----------------------------------------------------------------------
 */

static void
MarkDead(







|







2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
 *	an interpreter is deleted, via the AssocData cleanup mechanism.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Deletes the hash table of channels. May close channels. May flush
 *	output on closed channels. Removes any channelEvent handlers that were
 *	registered in this interpreter.
 *
 *----------------------------------------------------------------------
 */

static void
MarkDead(
2800
2801
2802
2803
2804
2805
2806

2807
2808
2809
2810
2811
2812
2813
    TCL_UNUSED(void *))
{
    Tcl_HashSearch hSearch;	 /* Search variable. */
    Tcl_HashEntry *hPtr;	 /* Search variable. */
    Tcl_ThreadId self = Tcl_GetCurrentThread();
    ReflectedChannelMap *rcmPtr; /* The map */
    ForwardingResult *resultPtr;


    /*
     * The origin thread for one or more reflected channels is gone.
     * NOTE: If this function is called due to a thread getting killed the
     *       per-interp DeleteReflectedChannelMap is apparently not called.
     */








>







2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
    TCL_UNUSED(void *))
{
    Tcl_HashSearch hSearch;	 /* Search variable. */
    Tcl_HashEntry *hPtr;	 /* Search variable. */
    Tcl_ThreadId self = Tcl_GetCurrentThread();
    ReflectedChannelMap *rcmPtr; /* The map */
    ForwardingResult *resultPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    /*
     * The origin thread for one or more reflected channels is gone.
     * NOTE: If this function is called due to a thread getting killed the
     *       per-interp DeleteReflectedChannelMap is apparently not called.
     */

2879
2880
2881
2882
2883
2884
2885

2886
2887
2888
2889
2890
2891
2892
    /*
     * Get the map of all channels handled by the current thread. This is a
     * ReflectedChannelMap, but on a per-thread basis, not per-interp. Go
     * through the channels, remove all, mark them as dead.
     */

    rcmPtr = GetThreadReflectedChannelMap();

    for (hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch);
	    hPtr != NULL;
	    hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch)) {
	Tcl_Channel chan = (Tcl_Channel)Tcl_GetHashValue(hPtr);
	ReflectedChannel *rcPtr = (ReflectedChannel *)Tcl_GetChannelInstanceData(chan);

	MarkDead(rcPtr);







>







2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
    /*
     * Get the map of all channels handled by the current thread. This is a
     * ReflectedChannelMap, but on a per-thread basis, not per-interp. Go
     * through the channels, remove all, mark them as dead.
     */

    rcmPtr = GetThreadReflectedChannelMap();
    tsdPtr->rcmPtr = NULL;
    for (hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch);
	    hPtr != NULL;
	    hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch)) {
	Tcl_Channel chan = (Tcl_Channel)Tcl_GetHashValue(hPtr);
	ReflectedChannel *rcPtr = (ReflectedChannel *)Tcl_GetChannelInstanceData(chan);

	MarkDead(rcPtr);
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
	    }
	    paramPtr->input.toRead = TCL_IO_FAILURE;
	} else {
	    /*
	     * Process a regular result.
	     */

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

	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);

	    if (bytev == NULL) {
		ForwardSetStaticError(paramPtr, msg_read_nonbyte);
		paramPtr->input.toRead = -1;
	    } else 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);
		}
		paramPtr->input.toRead = bytec;
	    }
	}
        Tcl_Release(rcPtr);
        Tcl_DecrRefCount(toReadObj);







|











|







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
	    }
	    paramPtr->input.toRead = TCL_IO_FAILURE;
	} else {
	    /*
	     * Process a regular result.
	     */

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

	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);

	    if (bytev == NULL) {
		ForwardSetStaticError(paramPtr, msg_read_nonbyte);
		paramPtr->input.toRead = -1;
	    } else if (paramPtr->input.toRead < bytec) {
		ForwardSetStaticError(paramPtr, msg_read_toomuch);
		paramPtr->input.toRead = TCL_IO_FAILURE;
	    } else {
		if (bytec > 0) {
		    memcpy(paramPtr->input.buf, bytev, bytec);
		}
		paramPtr->input.toRead = bytec;
	    }
	}
        Tcl_Release(rcPtr);
        Tcl_DecrRefCount(toReadObj);
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
	    ForwardSetObjError(paramPtr, resObj);
	} else {
	    /*
	     * Extract list, validate that it is a list, and #elements. See
	     * NOTE (4) as well.
	     */

	    size_t listc;
	    Tcl_Obj **listv;

	    if (TclListObjGetElementsM(interp, resObj, &listc,
                    &listv) != TCL_OK) {
		Tcl_DecrRefCount(resObj);
		resObj = MarshallError(interp);
		ForwardSetObjError(paramPtr, resObj);
	    } else if ((listc % 2) == 1) {
		/*
		 * Odd number of elements is wrong. [x].
		 */

		char *buf = (char *)Tcl_Alloc(200);
		sprintf(buf,
			"{Expected list with even number of elements, got %" TCL_Z_MODIFIER "u %s instead}",
			listc, (listc == 1 ? "element" : "elements"));

		ForwardSetDynamicError(paramPtr, buf);
	    } else {
		size_t len;
		const char *str = Tcl_GetStringFromObj(resObj, &len);

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







|













|
|




|







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
	    ForwardSetObjError(paramPtr, resObj);
	} else {
	    /*
	     * Extract list, validate that it is a list, and #elements. See
	     * NOTE (4) as well.
	     */

	    Tcl_Size listc;
	    Tcl_Obj **listv;

	    if (TclListObjGetElementsM(interp, resObj, &listc,
                    &listv) != TCL_OK) {
		Tcl_DecrRefCount(resObj);
		resObj = MarshallError(interp);
		ForwardSetObjError(paramPtr, resObj);
	    } else if ((listc % 2) == 1) {
		/*
		 * Odd number of elements is wrong. [x].
		 */

		char *buf = (char *)Tcl_Alloc(200);
		snprintf(buf, 200,
			"{Expected list with even number of elements, got %" TCL_SIZE_MODIFIER "u %s instead}",
			listc, (listc == 1 ? "element" : "elements"));

		ForwardSetDynamicError(paramPtr, buf);
	    } else {
		Tcl_Size len;
		const char *str = Tcl_GetStringFromObj(resObj, &len);

		if (len) {
		    TclDStringAppendLiteral(paramPtr->getOpt.value, " ");
		    Tcl_DStringAppend(paramPtr->getOpt.value, str, len);
		}
	    }
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
}

static void
ForwardSetObjError(
    ForwardParam *paramPtr,
    Tcl_Obj *obj)
{
    size_t len;
    const char *msgStr = Tcl_GetStringFromObj(obj, &len);

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







|







3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
}

static void
ForwardSetObjError(
    ForwardParam *paramPtr,
    Tcl_Obj *obj)
{
    Tcl_Size 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.

260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
 * has no "subtype" and just uses ForwardParamBase, as listed above.)
 */

struct ForwardParamTransform {
    ForwardParamBase base;	/* "Supertype". MUST COME FIRST. */
    char *buf;			/* I: Bytes to transform,
				 * O: Bytes in transform result */
    size_t size;		/* I: #bytes to transform,
				 * O: #bytes in the transform result */
};
struct ForwardParamLimit {
    ForwardParamBase base;	/* "Supertype". MUST COME FIRST. */
    int max;			/* O: Character read limit */
};








|







260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
 * has no "subtype" and just uses ForwardParamBase, as listed above.)
 */

struct ForwardParamTransform {
    ForwardParamBase base;	/* "Supertype". MUST COME FIRST. */
    char *buf;			/* I: Bytes to transform,
				 * O: Bytes in transform result */
    Tcl_Size size;		/* I: #bytes to transform,
				 * O: #bytes in the transform result */
};
struct ForwardParamLimit {
    ForwardParamBase base;	/* "Supertype". MUST COME FIRST. */
    int max;			/* O: Character read limit */
};

507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
    int mode;			/* R/W mode of parent, later the new channel.
				 * Has to match the abilities of the handler
				 * commands */
    Tcl_Obj *cmdObj;		/* Command prefix, list of words */
    Tcl_Obj *cmdNameObj;	/* Command name */
    Tcl_Obj *rtId;		/* Handle of the new transform (channel) */
    Tcl_Obj *modeObj;		/* mode in obj form for method call */
    size_t listc;			/* Result of 'initialize', and of */
    Tcl_Obj **listv;		/* its sublist in the 2nd element */
    int methIndex;		/* Encoded method name */
    int result;			/* Result code for 'initialize' */
    Tcl_Obj *resObj;		/* Result data for 'initialize' */
    int methods;		/* Bitmask for supported methods. */
    ReflectedTransformMap *rtmPtr;
				/* Map of reflected transforms with handlers







|







507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
    int mode;			/* R/W mode of parent, later the new channel.
				 * Has to match the abilities of the handler
				 * commands */
    Tcl_Obj *cmdObj;		/* Command prefix, list of words */
    Tcl_Obj *cmdNameObj;	/* Command name */
    Tcl_Obj *rtId;		/* Handle of the new transform (channel) */
    Tcl_Obj *modeObj;		/* mode in obj form for method call */
    Tcl_Size listc;			/* Result of 'initialize', and of */
    Tcl_Obj **listv;		/* its sublist in the 2nd element */
    int methIndex;		/* Encoded method name */
    int result;			/* Result code for 'initialize' */
    Tcl_Obj *resObj;		/* Result data for 'initialize' */
    int methods;		/* Bitmask for supported methods. */
    ReflectedTransformMap *rtmPtr;
				/* Map of reflected transforms with handlers
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
                TclGetString(cmdObj)));
	goto error;
    }

    /*
     * Mode tell us what the parent channel supports. The methods tell us what
     * the handler supports. We remove the non-supported bits from the mode
     * and check that the channel is not completely inacessible. Afterward the
     * mode tells us which methods are still required, and these methods will
     * also be supported by the handler, by design of the check.
     */

    if (!HAS(methods, METH_READ)) {
	mode &= ~TCL_READABLE;
    }







|







630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
                TclGetString(cmdObj)));
	goto error;
    }

    /*
     * Mode tell us what the parent channel supports. The methods tell us what
     * the handler supports. We remove the non-supported bits from the mode
     * and check that the channel is not completely inaccessible. Afterward the
     * mode tells us which methods are still required, and these methods will
     * also be supported by the handler, by design of the check.
     */

    if (!HAS(methods, METH_READ)) {
	mode &= ~TCL_READABLE;
    }
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
}

static void
UnmarshallErrorResult(
    Tcl_Interp *interp,
    Tcl_Obj *msgObj)
{
    size_t lc;
    Tcl_Obj **lv;
    int explicitResult;
    size_t numOptions;

    /*
     * Process the caught message.
     *
     * Syntax = (option value)... ?message?
     *
     * Bad syntax causes a panic. This is OK because the other side uses







|


|







816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
}

static void
UnmarshallErrorResult(
    Tcl_Interp *interp,
    Tcl_Obj *msgObj)
{
    Tcl_Size lc;
    Tcl_Obj **lv;
    int explicitResult;
    Tcl_Size numOptions;

    /*
     * Process the caught message.
     *
     * Syntax = (option value)... ?message?
     *
     * Bad syntax causes a panic. This is OK because the other side uses
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
 *
 * ReflectClose --
 *
 *	This function is invoked when the channel is closed, to delete the
 *	driver specific instance data.
 *
 * Results:
 *	A posix error.
 *
 * Side effects:
 *	Releases memory. Arbitrary, as it calls upon a script.
 *
 *----------------------------------------------------------------------
 */








|







862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
 *
 * ReflectClose --
 *
 *	This function is invoked when the channel is closed, to delete the
 *	driver specific instance data.
 *
 * Results:
 *	A Posix error.
 *
 * Side effects:
 *	Releases memory. Arbitrary, as it calls upon a script.
 *
 *----------------------------------------------------------------------
 */

981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
	    return EINVAL;
	}
	return EOK;
    }
#endif /* TCL_THREADS */

    /*
     * Do the actual invokation of "finalize" now; we're in the right thread.
     */

    result = InvokeTclMethod(rtPtr, "finalize", NULL, NULL, &resObj);
    if ((result != TCL_OK) && (interp != NULL)) {
	Tcl_SetChannelErrorInterp(interp, resObj);
    }








|







981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
	    return EINVAL;
	}
	return EOK;
    }
#endif /* TCL_THREADS */

    /*
     * Do the actual invocation of "finalize" now; we're in the right thread.
     */

    result = InvokeTclMethod(rtPtr, "finalize", NULL, NULL, &resObj);
    if ((result != TCL_OK) && (interp != NULL)) {
	Tcl_SetChannelErrorInterp(interp, resObj);
    }

1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
 *
 * ReflectBlock --
 *
 *	This function is invoked to tell the channel which blocking behaviour
 *	is required of it.
 *
 * Results:
 *	A posix error number.
 *
 * Side effects:
 *	Allocates memory. Arbitrary, as it calls upon a script.
 *
 *----------------------------------------------------------------------
 */








|







1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
 *
 * ReflectBlock --
 *
 *	This function is invoked to tell the channel which blocking behaviour
 *	is required of it.
 *
 * Results:
 *	A Posix error number.
 *
 * Side effects:
 *	Allocates memory. Arbitrary, as it calls upon a script.
 *
 *----------------------------------------------------------------------
 */

1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
 *----------------------------------------------------------------------
 */

static int
ReflectGetOption(
    void *clientData,	/* Channel to query */
    Tcl_Interp *interp,		/* Interpreter to leave error messages in */
    const char *optionName,	/* Name of reuqested option */
    Tcl_DString *dsPtr)		/* String to place the result into */
{
    ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;

    /*
     * Transformations have no options. Thus the call is passed down unchanged
     * to the parent channel for processing. Its results are passed back







|







1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
 *----------------------------------------------------------------------
 */

static int
ReflectGetOption(
    void *clientData,	/* Channel to query */
    Tcl_Interp *interp,		/* Interpreter to leave error messages in */
    const char *optionName,	/* Name of requested option */
    Tcl_DString *dsPtr)		/* String to place the result into */
{
    ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;

    /*
     * Transformations have no options. Thus the call is passed down unchanged
     * to the parent channel for processing. Its results are passed back
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
    int direction,
    void **handlePtr)
{
    ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;

    /*
     * Transformations have no handle of their own. As such we simply query
     * the parent channel for it. This way the qery will ripple down through
     * all transformations until reaches the base channel. Which then returns
     * its handle, or fails. The former will then ripple up the stack.
     *
     * This all happens in the thread we are in. As the Tcl level is not
     * involved no forwarding is required.
     */








|







1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
    int direction,
    void **handlePtr)
{
    ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;

    /*
     * Transformations have no handle of their own. As such we simply query
     * the parent channel for it. This way the query will ripple down through
     * all transformations until reaches the base channel. Which then returns
     * its handle, or fails. The former will then ripple up the stack.
     *
     * This all happens in the thread we are in. As the Tcl level is not
     * involved no forwarding is required.
     */

1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
ReflectNotify(
    void *clientData,
    int mask)
{
    ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;

    /*
     * An event occured in the underlying channel.
     *
     * We delete our timer. It was not fired, yet we are here, so the channel
     * below generated such an event and we don't have to. The renewal of the
     * interest after the execution of channel handlers will eventually cause
     * us to recreate the timer (in ReflectWatch).
     */








|







1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
ReflectNotify(
    void *clientData,
    int mask)
{
    ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;

    /*
     * An event occurred in the underlying channel.
     *
     * We delete our timer. It was not fired, yet we are here, so the channel
     * below generated such an event and we don't have to. The renewal of the
     * interest after the execution of channel handlers will eventually cause
     * us to recreate the timer (in ReflectWatch).
     */

1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
    Tcl_Interp *interp,
    Tcl_Obj *cmdpfxObj,
    TCL_UNUSED(int) /*mode*/,
    Tcl_Obj *handleObj,
    Tcl_Channel parentChan)
{
    ReflectedTransform *rtPtr;
    size_t i, listc;
    Tcl_Obj **listv;

    rtPtr = (ReflectedTransform *)Tcl_Alloc(sizeof(ReflectedTransform));

    /* rtPtr->chan: Assigned by caller. Dummy data here. */
    /* rtPtr->methods: Assigned by caller. Dummy data here. */








|







1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
    Tcl_Interp *interp,
    Tcl_Obj *cmdpfxObj,
    TCL_UNUSED(int) /*mode*/,
    Tcl_Obj *handleObj,
    Tcl_Channel parentChan)
{
    ReflectedTransform *rtPtr;
    Tcl_Size i, listc;
    Tcl_Obj **listv;

    rtPtr = (ReflectedTransform *)Tcl_Alloc(sizeof(ReflectedTransform));

    /* rtPtr->chan: Assigned by caller. Dummy data here. */
    /* rtPtr->methods: Assigned by caller. Dummy data here. */

1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897

/*
 *----------------------------------------------------------------------
 *
 * InvokeTclMethod --
 *
 *	This function is used to invoke the Tcl level of a reflected channel.
 *	It handles all the command assembly, invokation, and generic state and
 *	result mgmt. It does *not* handle thread redirection; that is the
 *	responsibility of clients of this function.
 *
 * Results:
 *	Result code and data as returned by the method.
 *
 * Side effects:







|







1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897

/*
 *----------------------------------------------------------------------
 *
 * InvokeTclMethod --
 *
 *	This function is used to invoke the Tcl level of a reflected channel.
 *	It handles all the command assembly, invocation, and generic state and
 *	result mgmt. It does *not* handle thread redirection; that is the
 *	responsibility of clients of this function.
 *
 * Results:
 *	Result code and data as returned by the method.
 *
 * Side effects:
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
    Tcl_Obj *argOneObj,		/* NULL'able */
    Tcl_Obj *argTwoObj,		/* NULL'able */
    Tcl_Obj **resultObjPtr)	/* NULL'able */
{
    int cmdc;			/* #words in constructed command */
    Tcl_Obj *methObj = NULL;	/* Method name in object form */
    Tcl_InterpState sr;		/* State of handler interp */
    int result;			/* Result code of method invokation */
    Tcl_Obj *resObj = NULL;	/* Result of method invokation. */

    if (rtPtr->dead) {
	/*
	 * The transform is marked as dead. Bail out immediately, with an
	 * appropriate error.
	 */








|
|







1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
    Tcl_Obj *argOneObj,		/* NULL'able */
    Tcl_Obj *argTwoObj,		/* NULL'able */
    Tcl_Obj **resultObjPtr)	/* NULL'able */
{
    int cmdc;			/* #words in constructed command */
    Tcl_Obj *methObj = NULL;	/* Method name in object form */
    Tcl_InterpState sr;		/* State of handler interp */
    int result;			/* Result code of method invocation */
    Tcl_Obj *resObj = NULL;	/* Result of method invocation. */

    if (rtPtr->dead) {
	/*
	 * The transform is marked as dead. Bail out immediately, with an
	 * appropriate error.
	 */

1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
     * NOTE (5): Decide impl. issue: Cache objects with method names?
     * Requires TSD data as reflections can be created in many different
     * threads.
     * NO: Caching of command resolutions means storage per channel.
     */

    /*
     * Insert method into the pre-allocated area, after the command prefix,
     * before the channel id.
     */

    methObj = Tcl_NewStringObj(method, -1);
    Tcl_IncrRefCount(methObj);
    rtPtr->argv[rtPtr->argc - 2] = methObj;








|







1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
     * NOTE (5): Decide impl. issue: Cache objects with method names?
     * Requires TSD data as reflections can be created in many different
     * threads.
     * NO: Caching of command resolutions means storage per channel.
     */

    /*
     * Insert method into the preallocated area, after the command prefix,
     * before the channel id.
     */

    methObj = Tcl_NewStringObj(method, -1);
    Tcl_IncrRefCount(methObj);
    rtPtr->argv[rtPtr->argc - 2] = methObj;

1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
	if (argTwoObj) {
	    rtPtr->argv[cmdc] = argTwoObj;
	    cmdc++;
	}
    }

    /*
     * And run the handler... This is done in auch a manner which leaves any
     * existing state intact.
     */

    sr = Tcl_SaveInterpState(rtPtr->interp, 0 /* Dummy */);
    Tcl_Preserve(rtPtr);
    Tcl_Preserve(rtPtr->interp);
    result = Tcl_EvalObjv(rtPtr->interp, cmdc, rtPtr->argv, TCL_EVAL_GLOBAL);







|







1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
	if (argTwoObj) {
	    rtPtr->argv[cmdc] = argTwoObj;
	    cmdc++;
	}
    }

    /*
     * And run the handler... This is done in a manner which leaves any
     * existing state intact.
     */

    sr = Tcl_SaveInterpState(rtPtr->interp, 0 /* Dummy */);
    Tcl_Preserve(rtPtr);
    Tcl_Preserve(rtPtr->interp);
    result = Tcl_EvalObjv(rtPtr->interp, cmdc, rtPtr->argv, TCL_EVAL_GLOBAL);
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
	     * the full state of the result, including additional options.
	     *
	     * This is complex and ugly, and would be completely unnecessary
	     * if we only added support for a TCL_FORBID_EXCEPTIONS flag.
	     */
	    if (result != TCL_ERROR) {
		Tcl_Obj *cmd = Tcl_NewListObj(cmdc, rtPtr->argv);
		size_t cmdLen;
		const char *cmdString = Tcl_GetStringFromObj(cmd, &cmdLen);

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







|







2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
	     * the full state of the result, including additional options.
	     *
	     * 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);
		Tcl_Size 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);
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
	    paramPtr->transform.size = TCL_INDEX_NONE;
	} else {
	    /*
	     * Process a regular return. Contains the transformation result.
	     * Sent it back to the request originator.
	     */

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

	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);

	    paramPtr->transform.size = bytec;








|







2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
	    paramPtr->transform.size = TCL_INDEX_NONE;
	} else {
	    /*
	     * Process a regular return. Contains the transformation result.
	     * Sent it back to the request originator.
	     */

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

	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);

	    paramPtr->transform.size = bytec;

2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
	    paramPtr->transform.size = TCL_INDEX_NONE;
	} else {
	    /*
	     * Process a regular return. Contains the transformation result.
	     * Sent it back to the request originator.
	     */

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

	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);

	    paramPtr->transform.size = bytec;








|







2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
	    paramPtr->transform.size = TCL_INDEX_NONE;
	} else {
	    /*
	     * Process a regular return. Contains the transformation result.
	     * Sent it back to the request originator.
	     */

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

	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);

	    paramPtr->transform.size = bytec;

2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
	    paramPtr->transform.size = TCL_INDEX_NONE;
	} else {
	    /*
	     * Process a regular return. Contains the transformation result.
	     * Sent it back to the request originator.
	     */

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

	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);

	    paramPtr->transform.size = bytec;

	    if (bytec > 0) {







|







2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
	    paramPtr->transform.size = TCL_INDEX_NONE;
	} else {
	    /*
	     * Process a regular return. Contains the transformation result.
	     * Sent it back to the request originator.
	     */

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

	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);

	    paramPtr->transform.size = bytec;

	    if (bytec > 0) {
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
	    paramPtr->transform.size = TCL_INDEX_NONE;
	} else {
	    /*
	     * Process a regular return. Contains the transformation result.
	     * Sent it back to the request originator.
	     */

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

	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);

	    paramPtr->transform.size = bytec;








|







2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
	    paramPtr->transform.size = TCL_INDEX_NONE;
	} else {
	    /*
	     * Process a regular return. Contains the transformation result.
	     * Sent it back to the request originator.
	     */

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

	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);

	    paramPtr->transform.size = bytec;

2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
}

static void
ForwardSetObjError(
    ForwardParam *paramPtr,
    Tcl_Obj *obj)
{
    size_t len;
    const char *msgStr = Tcl_GetStringFromObj(obj, &len);

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







|







2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
}

static void
ForwardSetObjError(
    ForwardParam *paramPtr,
    Tcl_Obj *obj)
{
    Tcl_Size len;
    const char *msgStr = Tcl_GetStringFromObj(obj, &len);

    len++;
    ForwardSetDynamicError(paramPtr, Tcl_Alloc(len));
    memcpy(paramPtr->base.msgStr, msgStr, len);
}
#endif /* TCL_THREADS */
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883

/*
 *----------------------------------------------------------------------
 *
 * ResultInit --
 *
 *	Initializes the specified buffer structure. The structure will contain
 *	valid information for an emtpy buffer.
 *
 * Side effects:
 *	See above.
 *
 * Result:
 *	None.
 *







|







2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883

/*
 *----------------------------------------------------------------------
 *
 * ResultInit --
 *
 *	Initializes the specified buffer structure. The structure will contain
 *	valid information for an empty buffer.
 *
 * Side effects:
 *	See above.
 *
 * Result:
 *	None.
 *
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
static int
TransformRead(
    ReflectedTransform *rtPtr,
    int *errorCodePtr,
    Tcl_Obj *bufObj)
{
    Tcl_Obj *resObj;
    size_t bytec = 0;		/* Number of returned bytes */
    unsigned char *bytev;	/* Array of returned bytes */

    /*
     * Are we in the correct thread?
     */

#if TCL_THREADS







|







3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
static int
TransformRead(
    ReflectedTransform *rtPtr,
    int *errorCodePtr,
    Tcl_Obj *bufObj)
{
    Tcl_Obj *resObj;
    Tcl_Size bytec = 0;		/* Number of returned bytes */
    unsigned char *bytev;	/* Array of returned bytes */

    /*
     * Are we in the correct thread?
     */

#if TCL_THREADS
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
    ReflectedTransform *rtPtr,
    int *errorCodePtr,
    unsigned char *buf,
    int toWrite)
{
    Tcl_Obj *bufObj;
    Tcl_Obj *resObj;
    size_t bytec = 0;		/* Number of returned bytes */
    unsigned char *bytev;	/* Array of returned bytes */
    int res;

    /*
     * Are we in the correct thread?
     */








|







3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
    ReflectedTransform *rtPtr,
    int *errorCodePtr,
    unsigned char *buf,
    int toWrite)
{
    Tcl_Obj *bufObj;
    Tcl_Obj *resObj;
    Tcl_Size bytec = 0;		/* Number of returned bytes */
    unsigned char *bytev;	/* Array of returned bytes */
    int res;

    /*
     * Are we in the correct thread?
     */

3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177

static int
TransformDrain(
    ReflectedTransform *rtPtr,
    int *errorCodePtr)
{
    Tcl_Obj *resObj;
    size_t bytec = 0;		/* Number of returned bytes */
    unsigned char *bytev;	/* Array of returned bytes */

    /*
     * Are we in the correct thread?
     */

#if TCL_THREADS







|







3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177

static int
TransformDrain(
    ReflectedTransform *rtPtr,
    int *errorCodePtr)
{
    Tcl_Obj *resObj;
    Tcl_Size bytec = 0;		/* Number of returned bytes */
    unsigned char *bytev;	/* Array of returned bytes */

    /*
     * Are we in the correct thread?
     */

#if TCL_THREADS
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
static int
TransformFlush(
    ReflectedTransform *rtPtr,
    int *errorCodePtr,
    int op)
{
    Tcl_Obj *resObj;
    size_t bytec = 0;		/* Number of returned bytes */
    unsigned char *bytev;	/* Array of returned bytes */
    int res;

    /*
     * Are we in the correct thread?
     */








|







3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
static int
TransformFlush(
    ReflectedTransform *rtPtr,
    int *errorCodePtr,
    int op)
{
    Tcl_Obj *resObj;
    Tcl_Size bytec = 0;		/* Number of returned bytes */
    unsigned char *bytev;	/* Array of returned bytes */
    int res;

    /*
     * Are we in the correct thread?
     */

Changes to generic/tclIOSock.c.

113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
#if !defined(_WIN32) && !defined(__CYGWIN__)
#   define SOCKET int
#endif

int
TclSockMinimumBuffers(
    void *sock,			/* Socket file descriptor */
    size_t size1)			/* Minimum buffer size */
{
    int current;
    socklen_t len;
    int size = size1;

    if ((size_t)size != size1) {
	return TCL_ERROR;
    }
    len = sizeof(int);
    getsockopt((SOCKET)(size_t) sock, SOL_SOCKET, SO_SNDBUF,
	    (char *) &current, &len);
    if (current < size) {
	len = sizeof(int);







|





|







113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
#if !defined(_WIN32) && !defined(__CYGWIN__)
#   define SOCKET int
#endif

int
TclSockMinimumBuffers(
    void *sock,			/* Socket file descriptor */
    Tcl_Size size1)		/* Minimum buffer size */
{
    int current;
    socklen_t len;
    int size = size1;

    if (size != size1) {
	return TCL_ERROR;
    }
    len = sizeof(int);
    getsockopt((SOCKET)(size_t) sock, SOL_SOCKET, SO_SNDBUF,
	    (char *) &current, &len);
    if (current < size) {
	len = sizeof(int);
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327

Tcl_Channel
Tcl_OpenTcpServer(
    Tcl_Interp *interp,
    int port,
    const char *host,
    Tcl_TcpAcceptProc *acceptProc,
    ClientData callbackData)
{
    char portbuf[TCL_INTEGER_SPACE];

    TclFormatInt(portbuf, port);
    return Tcl_OpenTcpServerEx(interp, portbuf, host, -1,
	    TCL_TCPSERVER_REUSEADDR, acceptProc, callbackData);
}







|







313
314
315
316
317
318
319
320
321
322
323
324
325
326
327

Tcl_Channel
Tcl_OpenTcpServer(
    Tcl_Interp *interp,
    int port,
    const char *host,
    Tcl_TcpAcceptProc *acceptProc,
    void *callbackData)
{
    char portbuf[TCL_INTEGER_SPACE];

    TclFormatInt(portbuf, port);
    return Tcl_OpenTcpServerEx(interp, portbuf, host, -1,
	    TCL_TCPSERVER_REUSEADDR, acceptProc, callbackData);
}

Changes to generic/tclIOUtil.c.

174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
    (Tcl_FSGetCwdProc *) TclpGetNativeCwd,
    TclpObjChdir
};

/*
 * An initial record in the linked list for the native filesystem.  Remains at
 * the tail of the list and is never freed.  Currently the native filesystem is
 * hard-coded.  It may make sense to modify this to accomodate unconventional
 * uses of Tcl that provide no native filesystem.
 */

static FilesystemRecord nativeFilesystemRecord = {
    NULL,
    &tclNativeFilesystem,
    NULL,







|







174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
    (Tcl_FSGetCwdProc *) TclpGetNativeCwd,
    TclpObjChdir
};

/*
 * An initial record in the linked list for the native filesystem.  Remains at
 * the tail of the list and is never freed.  Currently the native filesystem is
 * hard-coded.  It may make sense to modify this to accommodate unconventional
 * uses of Tcl that provide no native filesystem.
 */

static FilesystemRecord nativeFilesystemRecord = {
    NULL,
    &tclNativeFilesystem,
    NULL,
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
	}

#   undef OUT_OF_RANGE
#   undef OUT_OF_URANGE
#endif /* !TCL_WIDE_INT_IS_LONG */

	/*
	 * Copy across all supported fields, with possible type coercions on
	 * those fields that change between the normal and lf64 versions of
	 * the stat structure (on Solaris at least). This is slow when the
	 * structure sizes coincide, but that's what you get for using an
	 * obsolete interface.
	 */

	oldStyleBuf->st_mode	= buf.st_mode;







|







289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
	}

#   undef OUT_OF_RANGE
#   undef OUT_OF_URANGE
#endif /* !TCL_WIDE_INT_IS_LONG */

	/*
	 * Copy across all supported fields, with possible type coercion on
	 * those fields that change between the normal and lf64 versions of
	 * the stat structure (on Solaris at least). This is slow when the
	 * structure sizes coincide, but that's what you get for using an
	 * obsolete interface.
	 */

	oldStyleBuf->st_mode	= buf.st_mode;
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
    if (pathPtrPtr == NULL) {
	return (tsdPtr->cwdPathPtr == NULL);
    }

    if (tsdPtr->cwdPathPtr == *pathPtrPtr) {
	return 1;
    } else {
	size_t len1, len2;
	const char *str1, *str2;

	str1 = Tcl_GetStringFromObj(tsdPtr->cwdPathPtr, &len1);
	str2 = Tcl_GetStringFromObj(*pathPtrPtr, &len2);
	if ((len1 == len2) && !memcmp(str1, str2, len1)) {
	    /*
	     * The values are equal but the objects are different.  Cache the







|







517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
    if (pathPtrPtr == NULL) {
	return (tsdPtr->cwdPathPtr == NULL);
    }

    if (tsdPtr->cwdPathPtr == *pathPtrPtr) {
	return 1;
    } else {
	Tcl_Size len1, len2;
	const char *str1, *str2;

	str1 = Tcl_GetStringFromObj(tsdPtr->cwdPathPtr, &len1);
	str2 = Tcl_GetStringFromObj(*pathPtrPtr, &len2);
	if ((len1 == len2) && !memcmp(str1, str2, len1)) {
	    /*
	     * The values are equal but the objects are different.  Cache the
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
 */

static void
FsUpdateCwd(
    Tcl_Obj *cwdObj,
    void *clientData)
{
    size_t len = 0;
    const char *str = NULL;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);

    if (cwdObj != NULL) {
	str = Tcl_GetStringFromObj(cwdObj, &len);
    }








|







659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
 */

static void
FsUpdateCwd(
    Tcl_Obj *cwdObj,
    void *clientData)
{
    Tcl_Size len = 0;
    const char *str = NULL;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);

    if (cwdObj != NULL) {
	str = Tcl_GetStringFromObj(cwdObj, &len);
    }

985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
				 * of the correct type. */
    Tcl_GlobTypeData *types)	/* Specifies acceptable types.
				 * May be NULL. The directory flag is
				 * particularly significant. */
{
    const Tcl_Filesystem *fsPtr;
    Tcl_Obj *cwd, *tmpResultPtr, **elemsPtr;
    size_t resLength, i;
    int ret = -1;

    if (types != NULL && (types->type & TCL_GLOB_TYPE_MOUNT)) {
	/*
	 * Currently external callers may not query mounts, which would be a
	 * valuable future step. This is the only routine that knows about
	 * mounts, so we're being called recursively by ourself. Return no







|







985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
				 * of the correct type. */
    Tcl_GlobTypeData *types)	/* Specifies acceptable types.
				 * May be NULL. The directory flag is
				 * particularly significant. */
{
    const Tcl_Filesystem *fsPtr;
    Tcl_Obj *cwd, *tmpResultPtr, **elemsPtr;
    Tcl_Size resLength, i;
    int ret = -1;

    if (types != NULL && (types->type & TCL_GLOB_TYPE_MOUNT)) {
	/*
	 * Currently external callers may not query mounts, which would be a
	 * valuable future step. This is the only routine that knows about
	 * mounts, so we're being called recursively by ourself. Return no
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
				 * not be shared. */
    Tcl_Obj *pathPtr,		/* The directory that was searched. */
    const char *pattern,	/* Pattern to match mounts against. */
    Tcl_GlobTypeData *types)	/* Acceptable types.  May be NULL. The
				 * directory flag is particularly significant.
				 */
{
    size_t mLength, gLength, i;
    int dir = (types == NULL || (types->type & TCL_GLOB_TYPE_DIR));
    Tcl_Obj *mounts = FsListMounts(pathPtr, pattern);

    if (mounts == NULL) {
	return;
    }

    if (TclListObjLengthM(NULL, mounts, &mLength) != TCL_OK || mLength == 0) {
	goto endOfMounts;
    }
    if (TclListObjLengthM(NULL, resultPtr, &gLength) != TCL_OK) {
	goto endOfMounts;
    }
    for (i=0 ; i<mLength ; i++) {
	Tcl_Obj *mElt;
	size_t j;
	int found = 0;

	Tcl_ListObjIndex(NULL, mounts, i, &mElt);

	for (j=0 ; j<gLength ; j++) {
	    Tcl_Obj *gElt;








|















|







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
				 * not be shared. */
    Tcl_Obj *pathPtr,		/* The directory that was searched. */
    const char *pattern,	/* Pattern to match mounts against. */
    Tcl_GlobTypeData *types)	/* Acceptable types.  May be NULL. The
				 * directory flag is particularly significant.
				 */
{
    Tcl_Size mLength, gLength, i;
    int dir = (types == NULL || (types->type & TCL_GLOB_TYPE_DIR));
    Tcl_Obj *mounts = FsListMounts(pathPtr, pattern);

    if (mounts == NULL) {
	return;
    }

    if (TclListObjLengthM(NULL, mounts, &mLength) != TCL_OK || mLength == 0) {
	goto endOfMounts;
    }
    if (TclListObjLengthM(NULL, resultPtr, &gLength) != TCL_OK) {
	goto endOfMounts;
    }
    for (i=0 ; i<mLength ; i++) {
	Tcl_Obj *mElt;
	Tcl_Size j;
	int found = 0;

	Tcl_ListObjIndex(NULL, mounts, i, &mElt);

	for (j=0 ; j<gLength ; j++) {
	    Tcl_Obj *gElt;

1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
		    gLength--;
		}
		break;		/* Break out of for loop. */
	    }
	}
	if (!found && dir) {
	    Tcl_Obj *norm;
	    size_t len, mlen;

	    /*
	     * mElt is normalized and lies inside pathPtr so
	     * add to the result the right representation of mElt,
	     * i.e. the representation relative to pathPtr.
	     */








|







1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
		    gLength--;
		}
		break;		/* Break out of for loop. */
	    }
	}
	if (!found && dir) {
	    Tcl_Obj *norm;
	    Tcl_Size len, mlen;

	    /*
	     * mElt is normalized and lies inside pathPtr so
	     * add to the result the right representation of mElt,
	     * i.e. the representation relative to pathPtr.
	     */

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
 *	Stores the resulting pathname in pathPtr and returns the offset of the
 *	last byte processed in pathPtr.
 *
 * Side effects:
 *	None (beyond the memory allocation for the result).
 *
 * Special notes:
 *	If the filesystem-specific normalizePathProcs can re-introduce ../, ./
 *	components into the pathname, this function does not return the correct
 *	result. This may be possible with symbolic links on unix.
 *
 *
 *---------------------------------------------------------------------------
 */

int
TclFSNormalizeToUniquePath(
    Tcl_Interp *interp,		/* Used for error messages. */
    Tcl_Obj *pathPtr,		/* An Pathname to normalize in-place.  Must be
				 * unshared. */
    int startAt)		/* Offset the string of pathPtr to start at.
				 * Must either be 0 or offset of a directory
				 * separator at the end of a pathname part that
				 * is already normalized, I.e. not the index of
				 * the byte just after the separator.  */
{
    FilesystemRecord *fsRecPtr, *firstFsRecPtr;

    size_t i;
    int isVfsPath = 0;
    const char *path;

    /*
     * Pathnames starting with a UNC prefix and ending with a colon character
     * 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







|




















|







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
 *	Stores the resulting pathname in pathPtr and returns the offset of the
 *	last byte processed in pathPtr.
 *
 * Side effects:
 *	None (beyond the memory allocation for the result).
 *
 * Special notes:
 *	If the filesystem-specific normalizePathProcs can reintroduce ../, ./
 *	components into the pathname, this function does not return the correct
 *	result. This may be possible with symbolic links on unix.
 *
 *
 *---------------------------------------------------------------------------
 */

int
TclFSNormalizeToUniquePath(
    Tcl_Interp *interp,		/* Used for error messages. */
    Tcl_Obj *pathPtr,		/* An Pathname to normalize in-place.  Must be
				 * unshared. */
    int startAt)		/* Offset the string of pathPtr to start at.
				 * Must either be 0 or offset of a directory
				 * separator at the end of a pathname part that
				 * is already normalized, I.e. not the index of
				 * the byte just after the separator.  */
{
    FilesystemRecord *fsRecPtr, *firstFsRecPtr;

    Tcl_Size i;
    int isVfsPath = 0;
    const char *path;

    /*
     * Pathnames starting with a UNC prefix and ending with a colon character
     * 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
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
    int *seekFlagPtr,		/* Sets this to 1 to tell the the caller to seek to
				 * EOF after opening the file, and 0 otherwise. */
    int *binaryPtr)		/* Sets this to 1 to tell the caller to
				 * configure the channel for binary
				 * operations after opening the file. */
{
    int mode, c, gotRW;
    size_t modeArgc, i;
    const char **modeArgv, *flag;
#define RW_MODES (O_RDONLY|O_WRONLY|O_RDWR)

    /*
     * Check for the simpler fopen-like access modes like "r" which are
     * distinguished from the POSIX access modes by the presence of a
     * lower-case first letter.







|







1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
    int *seekFlagPtr,		/* Sets this to 1 to tell the the caller to seek to
				 * EOF after opening the file, and 0 otherwise. */
    int *binaryPtr)		/* Sets this to 1 to tell the caller to
				 * configure the channel for binary
				 * operations after opening the file. */
{
    int mode, c, gotRW;
    Tcl_Size modeArgc, i;
    const char **modeArgv, *flag;
#define RW_MODES (O_RDONLY|O_WRONLY|O_RDWR)

    /*
     * Check for the simpler fopen-like access modes like "r" which are
     * distinguished from the POSIX access modes by the presence of a
     * lower-case first letter.
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
    Tcl_Interp *interp,		/* Interpreter that evaluates the script. */
    Tcl_Obj *pathPtr,		/* Pathname of the file to process.
				 * Tilde-substitution is performed on this
				 * pathname. */
    const char *encodingName)	/* Either the name of an encoding or NULL to
				   use the utf-8 encoding. */
{
    size_t length;
	int result = TCL_ERROR;
    Tcl_StatBuf statBuf;
    Tcl_Obj *oldScriptFile;
    Interp *iPtr;
    const char *string;
    Tcl_Channel chan;
    Tcl_Obj *objPtr;








|
|







1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
    Tcl_Interp *interp,		/* Interpreter that evaluates the script. */
    Tcl_Obj *pathPtr,		/* Pathname of the file to process.
				 * Tilde-substitution is performed on this
				 * pathname. */
    const char *encodingName)	/* Either the name of an encoding or NULL to
				   use the utf-8 encoding. */
{
    Tcl_Size length;
    int result = TCL_ERROR;
    Tcl_StatBuf statBuf;
    Tcl_Obj *oldScriptFile;
    Interp *iPtr;
    const char *string;
    Tcl_Channel chan;
    Tcl_Obj *objPtr;

1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
    string = TclGetString(objPtr);

    /*
     * If first character is not a BOM, append the remaining characters.
     * Otherwise, replace them. [Bug 3466099]
     */

    if (Tcl_ReadChars(chan, objPtr, -1,
	    memcmp(string, "\xEF\xBB\xBF", 3)) == TCL_IO_FAILURE) {
	Tcl_CloseEx(interp, chan, 0);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't read file \"%s\": %s",
		TclGetString(pathPtr), Tcl_PosixError(interp)));
	goto end;
    }







|







1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
    string = TclGetString(objPtr);

    /*
     * If first character is not a BOM, append the remaining characters.
     * Otherwise, replace them. [Bug 3466099]
     */

    if (Tcl_ReadChars(chan, objPtr, TCL_INDEX_NONE,
	    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;
    }
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
    } else if (result == TCL_ERROR) {
	/*
	 * Record information about where the error occurred.
	 */

	const char *pathString = Tcl_GetStringFromObj(pathPtr, &length);
	unsigned limit = 150;
	int overflow = (length > limit);

	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (file \"%.*s%s\" line %d)",
		(overflow ? limit : (unsigned)length), pathString,
		(overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
    }








|







1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
    } else if (result == TCL_ERROR) {
	/*
	 * Record information about where the error occurred.
	 */

	const char *pathString = Tcl_GetStringFromObj(pathPtr, &length);
	unsigned limit = 150;
	int overflow = ((unsigned)length > limit);

	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (file \"%.*s%s\" line %d)",
		(overflow ? limit : (unsigned)length), pathString,
		(overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
    }

1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
    string = TclGetString(objPtr);

    /*
     * If first character is not a BOM, append the remaining characters.
     * Otherwise, replace them. [Bug 3466099]
     */

    if (Tcl_ReadChars(chan, objPtr, -1,
	    memcmp(string, "\xEF\xBB\xBF", 3)) == TCL_IO_FAILURE) {
	Tcl_CloseEx(interp, chan, 0);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't read file \"%s\": %s",
		TclGetString(pathPtr), Tcl_PosixError(interp)));
	Tcl_DecrRefCount(objPtr);
	return TCL_ERROR;







|







1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
    string = TclGetString(objPtr);

    /*
     * If first character is not a BOM, append the remaining characters.
     * Otherwise, replace them. [Bug 3466099]
     */

    if (Tcl_ReadChars(chan, objPtr, TCL_INDEX_NONE,
	    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;
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
    if (result == TCL_RETURN) {
	result = TclUpdateReturnInfo(iPtr);
    } else if (result == TCL_ERROR) {
	/*
	 * Record information about where the error occurred.
	 */

	size_t length;
	const char *pathString = Tcl_GetStringFromObj(pathPtr, &length);
	const unsigned int limit = 150;
	int overflow = (length > limit);

	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (file \"%.*s%s\" line %d)",
		(overflow ? limit : (unsigned int)length), pathString,
		(overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
    }

    Tcl_DecrRefCount(objPtr);
    return result;
}








|

|
|



|







1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
    if (result == TCL_RETURN) {
	result = TclUpdateReturnInfo(iPtr);
    } else if (result == TCL_ERROR) {
	/*
	 * Record information about where the error occurred.
	 */

	Tcl_Size length;
	const char *pathString = Tcl_GetStringFromObj(pathPtr, &length);
	const unsigned limit = 150;
	int overflow = ((unsigned)length > limit);

	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (file \"%.*s%s\" line %d)",
		(overflow ? limit : (unsigned)length), pathString,
		(overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
    }

    Tcl_DecrRefCount(objPtr);
    return result;
}

2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSStat --
 *	Calls 'statProc' of the filesystem corresponding to pathPtr.
 *
 *	Replaces the standard library routines stat.
 *
 *
 * Results:
 *	See stat documentation.
 *
 * Side effects:
 *	See stat documentation.
 *







|
<







2059
2060
2061
2062
2063
2064
2065
2066

2067
2068
2069
2070
2071
2072
2073

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSStat --
 *	Calls 'statProc' of the filesystem corresponding to pathPtr.
 *
 *	Replaces the standard library "stat" routine.

 *
 * Results:
 *	See stat documentation.
 *
 * Side effects:
 *	See stat documentation.
 *
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
	}
	return result;
    } else if (listObj != NULL) {
	/*
	 * It's a non-constant attribute list, so do a literal search.
	 */

	size_t i, objc;
	Tcl_Obj **objv;

	if (TclListObjGetElementsM(NULL, listObj, &objc, &objv) != TCL_OK) {
	    TclDecrRefCount(listObj);
	    return TCL_ERROR;
	}
	for (i=0 ; i<objc ; i++) {







|







2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
	}
	return result;
    } else if (listObj != NULL) {
	/*
	 * It's a non-constant attribute list, so do a literal search.
	 */

	Tcl_Size i, objc;
	Tcl_Obj **objv;

	if (TclListObjGetElementsM(NULL, listObj, &objc, &objv) != TCL_OK) {
	    TclDecrRefCount(listObj);
	    return TCL_ERROR;
	}
	for (i=0 ; i<objc ; i++) {
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
	     * Determine whether the filesystem's answer is the same as the
	     * cached local value.  Since both 'norm' and 'tsdPtr->cwdPathPtr'
	     * are normalized pathnames, do something more efficient than
	     * calling 'Tcl_FSEqualPaths', and in addition avoid a nasty
	     * infinite loop bug when trying to normalize tsdPtr->cwdPathPtr.
	     */

	    size_t len1, len2;
	    const char *str1, *str2;

	    str1 = Tcl_GetStringFromObj(tsdPtr->cwdPathPtr, &len1);
	    str2 = Tcl_GetStringFromObj(norm, &len2);
	    if ((len1 == len2) && (strcmp(str1, str2) == 0)) {
		/*
		 * The pathname values are equal so retain the old pathname







|







2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
	     * Determine whether the filesystem's answer is the same as the
	     * cached local value.  Since both 'norm' and 'tsdPtr->cwdPathPtr'
	     * are normalized pathnames, do something more efficient than
	     * calling 'Tcl_FSEqualPaths', and in addition avoid a nasty
	     * infinite loop bug when trying to normalize tsdPtr->cwdPathPtr.
	     */

	    Tcl_Size len1, len2;
	    const char *str1, *str2;

	    str1 = Tcl_GetStringFromObj(tsdPtr->cwdPathPtr, &len1);
	    str2 = Tcl_GetStringFromObj(norm, &len2);
	    if ((len1 == len2) && (strcmp(str1, str2) == 0)) {
		/*
		 * The pathname values are equal so retain the old pathname
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
 *---------------------------------------------------------------------------
 */

#undef Tcl_FSSplitPath
Tcl_Obj *
Tcl_FSSplitPath(
    Tcl_Obj *pathPtr,		/* The pathname to split. */
    size_t *lenPtr)		/* A place to hold the number of pathname
				 * elements. */
{
    Tcl_Obj *result = NULL;	/* Just to squelch gcc warnings. */
    const Tcl_Filesystem *fsPtr;
    char separator = '/';
    size_t driveNameLength;
    const char *p;

    /*
     * Perform platform-specific splitting.
     */

    if (TclFSGetPathType(pathPtr, &fsPtr,







|





|







3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
 *---------------------------------------------------------------------------
 */

#undef Tcl_FSSplitPath
Tcl_Obj *
Tcl_FSSplitPath(
    Tcl_Obj *pathPtr,		/* The pathname to split. */
    Tcl_Size *lenPtr)		/* A place to hold the number of pathname
				 * elements. */
{
    Tcl_Obj *result = NULL;	/* Just to squelch gcc warnings. */
    const Tcl_Filesystem *fsPtr;
    char separator = '/';
    Tcl_Size driveNameLength;
    const char *p;

    /*
     * Perform platform-specific splitting.
     */

    if (TclFSGetPathType(pathPtr, &fsPtr,
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938

    /*
     * Add the remaining pathname elements to the list.
     */

    for (;;) {
	const char *elementStart = p;
	size_t length;

	while ((*p != '\0') && (*p != separator)) {
	    p++;
	}
	length = p - elementStart;
	if (length > 0) {
	    Tcl_Obj *nextElt;







|







3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937

    /*
     * Add the remaining pathname elements to the list.
     */

    for (;;) {
	const char *elementStart = p;
	Tcl_Size length;

	while ((*p != '\0') && (*p != separator)) {
	    p++;
	}
	length = p - elementStart;
	if (length > 0) {
	    Tcl_Obj *nextElt;
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
Tcl_PathType
TclGetPathType(
    Tcl_Obj *pathPtr,		/* Pathname to determine type of. */
    const Tcl_Filesystem **filesystemPtrPtr,
				/* If not NULL, a place in which to store a
				 * pointer to the filesystem for this pathname
				 * if it is absolute. */
    size_t *driveNameLengthPtr,	/* If not NULL, a place in which to store the
				 * length of the volume name. */
    Tcl_Obj **driveNameRef)	/* If not NULL, for an absolute pathname, a
				 * place to store a pointer to an object with a
				 * refCount of 1, and whose value is the name
				 * of the volume. */
{
    size_t pathLen;
    const char *path = Tcl_GetStringFromObj(pathPtr, &pathLen);
    Tcl_PathType type;

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

    if (type != TCL_PATH_ABSOLUTE) {







|






|







3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
Tcl_PathType
TclGetPathType(
    Tcl_Obj *pathPtr,		/* Pathname to determine type of. */
    const Tcl_Filesystem **filesystemPtrPtr,
				/* If not NULL, a place in which to store a
				 * pointer to the filesystem for this pathname
				 * if it is absolute. */
    Tcl_Size *driveNameLengthPtr,	/* If not NULL, a place in which to store the
				 * 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. */
{
    Tcl_Size pathLen;
    const char *path = Tcl_GetStringFromObj(pathPtr, &pathLen);
    Tcl_PathType type;

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

    if (type != TCL_PATH_ABSOLUTE) {
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
4029
4030
4031
4032
4033
4034
4035
4036
4037
 *
 *----------------------------------------------------------------------
 */

Tcl_PathType
TclFSNonnativePathType(
    const char *path,		/* Pathname to determine the type of. */
    size_t pathLen,		/* Length of the pathname. */
    const Tcl_Filesystem **filesystemPtrPtr,
				/* If not NULL, a  place to store a pointer to
				 * the filesystem for this pathname when it is
				 * an absolute pathname. */
    size_t *driveNameLengthPtr,	/* If not NULL, a place to store the length of
				 * the volume name if the pathname is absolute.
				 */
    Tcl_Obj **driveNameRef)	/* If not NULL, a place to store a pointer to
				 * an object having its its refCount already
				 * incremented, and contining the name of the
				 * volume if the pathname is absolute. */
{







|




|







4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
4029
4030
4031
4032
4033
4034
4035
4036
 *
 *----------------------------------------------------------------------
 */

Tcl_PathType
TclFSNonnativePathType(
    const char *path,		/* Pathname to determine the type of. */
    Tcl_Size pathLen,		/* Length of the pathname. */
    const Tcl_Filesystem **filesystemPtrPtr,
				/* If not NULL, a  place to store a pointer to
				 * the filesystem for this pathname when it is
				 * an absolute pathname. */
    Tcl_Size *driveNameLengthPtr,/* If not NULL, a place to store the length of
				 * the volume name if the pathname is absolute.
				 */
    Tcl_Obj **driveNameRef)	/* If not NULL, a place to store a pointer to
				 * an object having its its refCount already
				 * incremented, and contining the name of the
				 * volume if the pathname is absolute. */
{
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
	 * no reason to waste time doing that in this frequently-called
	 * function.  It is better to save the overhead of the native
	 * filesystem continuously returning a list of volumes.
	 */

	if ((fsRecPtr->fsPtr != &tclNativeFilesystem)
		&& (fsRecPtr->fsPtr->listVolumesProc != NULL)) {
	    size_t numVolumes;
	    Tcl_Obj *thisFsVolumes = fsRecPtr->fsPtr->listVolumesProc();

	    if (thisFsVolumes != NULL) {
		if (TclListObjLengthM(NULL, thisFsVolumes, &numVolumes)
			!= TCL_OK) {
		    /*
		     * This is VERY bad; the listVolumesProc didn't return a
		     * valid list. Set numVolumes to -1 to skip the loop below
		     * and just return with the current value of 'type'.
		     *
		     * It would be better to signal an error here, but
		     * Tcl_Panic seems a bit excessive.
		     */

		    numVolumes = TCL_INDEX_NONE;
		}
		while (numVolumes + 1 > 1) {
		    Tcl_Obj *vol;
		    size_t len;
		    const char *strVol;

		    numVolumes--;
		    Tcl_ListObjIndex(NULL, thisFsVolumes, numVolumes, &vol);
		    strVol = Tcl_GetStringFromObj(vol,&len);
		    if (pathLen < len) {
			continue;







|
















|

|







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
	 * no reason to waste time doing that in this frequently-called
	 * function.  It is better to save the overhead of the native
	 * filesystem continuously returning a list of volumes.
	 */

	if ((fsRecPtr->fsPtr != &tclNativeFilesystem)
		&& (fsRecPtr->fsPtr->listVolumesProc != NULL)) {
	    Tcl_Size numVolumes;
	    Tcl_Obj *thisFsVolumes = fsRecPtr->fsPtr->listVolumesProc();

	    if (thisFsVolumes != NULL) {
		if (TclListObjLengthM(NULL, thisFsVolumes, &numVolumes)
			!= TCL_OK) {
		    /*
		     * This is VERY bad; the listVolumesProc didn't return a
		     * valid list. Set numVolumes to -1 to skip the loop below
		     * and just return with the current value of 'type'.
		     *
		     * It would be better to signal an error here, but
		     * Tcl_Panic seems a bit excessive.
		     */

		    numVolumes = TCL_INDEX_NONE;
		}
		while (numVolumes > 0) {
		    Tcl_Obj *vol;
		    Tcl_Size len;
		    const char *strVol;

		    numVolumes--;
		    Tcl_ListObjIndex(NULL, thisFsVolumes, numVolumes, &vol);
		    strVol = Tcl_GetStringFromObj(vol,&len);
		    if (pathLen < len) {
			continue;
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
	return -1;
    }

    if (recursive) {
	Tcl_Obj *cwdPtr = Tcl_FSGetCwd(NULL);
	if (cwdPtr != NULL) {
	    const char *cwdStr, *normPathStr;
	    size_t cwdLen, normLen;
	    Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathPtr);

	    if (normPath != NULL) {
		normPathStr = Tcl_GetStringFromObj(normPath, &normLen);
		cwdStr = Tcl_GetStringFromObj(cwdPtr, &cwdLen);
		if ((cwdLen >= normLen) && (strncmp(normPathStr, cwdStr,
			normLen) == 0)) {







|







4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
	return -1;
    }

    if (recursive) {
	Tcl_Obj *cwdPtr = Tcl_FSGetCwd(NULL);
	if (cwdPtr != NULL) {
	    const char *cwdStr, *normPathStr;
	    Tcl_Size cwdLen, normLen;
	    Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathPtr);

	    if (normPath != NULL) {
		normPathStr = Tcl_GetStringFromObj(normPath, &normLen);
		cwdStr = Tcl_GetStringFromObj(cwdPtr, &cwdLen);
		if ((cwdLen >= normLen) && (strncmp(normPathStr, cwdStr,
			normLen) == 0)) {

Changes to generic/tclIndexObj.c.

10
11
12
13
14
15
16

17
18
19
20
21
22
23
 * 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"


/*
 * Prototypes for functions defined later in this file:
 */

static int		GetIndexFromObjList(Tcl_Interp *interp,
			    Tcl_Obj *objPtr, Tcl_Obj *tableObjPtr,







>







10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
 * 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"
#include <assert.h>

/*
 * Prototypes for functions defined later in this file:
 */

static int		GetIndexFromObjList(Tcl_Interp *interp,
			    Tcl_Obj *objPtr, Tcl_Obj *tableObjPtr,
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
 */

static const Tcl_ObjType indexType = {
    "index",			/* name */
    FreeIndex,			/* freeIntRepProc */
    DupIndex,			/* dupIntRepProc */
    UpdateStringOfIndex,	/* updateStringProc */
    NULL			/* setFromAnyProc */

};

/*
 * The definition of the internal representation of the "index" object; The
 * internalRep.twoPtrValue.ptr1 field of an object of "index" type will be a
 * pointer to one of these structures.
 *
 * Keep this structure declaration in sync with tclTestObj.c
 */

typedef struct {
    void *tablePtr;		/* Pointer to the table of strings */
    size_t offset;			/* Offset between table entries */
    size_t index;			/* Selected index into table. */
} IndexRep;

/*
 * The following macros greatly simplify moving through a table...
 */

#define STRING_AT(table, offset) \







|
>












|
|







38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
 */

static const Tcl_ObjType indexType = {
    "index",			/* name */
    FreeIndex,			/* freeIntRepProc */
    DupIndex,			/* dupIntRepProc */
    UpdateStringOfIndex,	/* updateStringProc */
    NULL,			/* setFromAnyProc */
    TCL_OBJTYPE_V0
};

/*
 * The definition of the internal representation of the "index" object; The
 * internalRep.twoPtrValue.ptr1 field of an object of "index" type will be a
 * pointer to one of these structures.
 *
 * Keep this structure declaration in sync with tclTestObj.c
 */

typedef struct {
    void *tablePtr;		/* Pointer to the table of strings */
    Tcl_Size offset;			/* Offset between table entries */
    Tcl_Size index;			/* Selected index into table. */
} IndexRep;

/*
 * The following macros greatly simplify moving through a table...
 */

#define STRING_AT(table, offset) \
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
				 * value of objPtr. */
    const char *msg,		/* Identifying word to use in error
				 * messages. */
    int flags,			/* 0 or TCL_EXACT */
    int *indexPtr)		/* Place to store resulting integer index. */
{

    size_t objc, t;
    int result;
    Tcl_Obj **objv;
    const char **tablePtr;

    /*
     * Use Tcl_GetIndexFromObjStruct to do the work to avoid duplicating most
     * of the code there. This is a bit ineffiecient but simpler.
     */

    result = TclListObjGetElementsM(interp, tableObjPtr, &objc, &objv);
    if (result != TCL_OK) {
	return result;
    }




    /*
     * Build a string table from the list.
     */

    tablePtr = (const char **)Tcl_Alloc((objc + 1) * sizeof(char *));
    for (t = 0; t < objc; t++) {
	if (objv[t] == objPtr) {
	    /*
	     * An exact match is always chosen, so we can stop here.
	     */

	    Tcl_Free((void *)tablePtr);
	    *indexPtr = t;
	    return TCL_OK;
	}

	tablePtr[t] = TclGetString(objv[t]);
    }
    tablePtr[objc] = NULL;








|






|






>
>
>













|







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
				 * value of objPtr. */
    const char *msg,		/* Identifying word to use in error
				 * messages. */
    int flags,			/* 0 or TCL_EXACT */
    int *indexPtr)		/* Place to store resulting integer index. */
{

    Tcl_Size objc, t;
    int result;
    Tcl_Obj **objv;
    const char **tablePtr;

    /*
     * Use Tcl_GetIndexFromObjStruct to do the work to avoid duplicating most
     * of the code there. This is a bit inefficient but simpler.
     */

    result = TclListObjGetElementsM(interp, tableObjPtr, &objc, &objv);
    if (result != TCL_OK) {
	return result;
    }

    /* Return type is int* so caller should not be passing larger table */
    assert(objc <= INT_MAX);

    /*
     * Build a string table from the list.
     */

    tablePtr = (const char **)Tcl_Alloc((objc + 1) * sizeof(char *));
    for (t = 0; t < objc; t++) {
	if (objv[t] == objPtr) {
	    /*
	     * An exact match is always chosen, so we can stop here.
	     */

	    Tcl_Free((void *)tablePtr);
	    *indexPtr = (int) t;
	    return TCL_OK;
	}

	tablePtr[t] = TclGetString(objv[t]);
    }
    tablePtr[objc] = NULL;

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
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr,		/* Object containing the string to lookup. */
    const void *tablePtr,	/* The first string in the table. The second
				 * string will be at this address plus the
				 * offset, the third plus the offset again,
				 * etc. The last entry must be NULL and there
				 * must not be duplicate entries. */
    size_t offset,			/* The number of bytes between entries */
    const char *msg,		/* Identifying word to use in error
				 * messages. */
    int flags,			/* 0, TCL_EXACT, TCL_NULL_OK or TCL_INDEX_TEMP_TABLE */
    void *indexPtr)		/* Place to store resulting index. */
{
    size_t index, idx, numAbbrev;
    const char *key, *p1;
    const char *p2;
    const char *const *entryPtr;
    Tcl_Obj *resultPtr;
    IndexRep *indexRep;
    const Tcl_ObjInternalRep *irPtr;

    /* Protect against invalid values, like TCL_INDEX_NONE or 0. */
    if (offset+1 <= sizeof(char *)) {
	offset = sizeof(char *);
    }
    /*
     * See if there is a valid cached result from a previous lookup.
     */

    if (objPtr && !(flags & TCL_INDEX_TEMP_TABLE)) {
    irPtr = TclFetchInternalRep(objPtr, &indexType);







|





|







<
|
|







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
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr,		/* Object containing the string to lookup. */
    const void *tablePtr,	/* The first string in the table. The second
				 * string will be at this address plus the
				 * offset, the third plus the offset again,
				 * etc. The last entry must be NULL and there
				 * must not be duplicate entries. */
    Tcl_Size offset,		/* The number of bytes between entries */
    const char *msg,		/* Identifying word to use in error
				 * messages. */
    int flags,			/* 0, TCL_EXACT, TCL_NULL_OK or TCL_INDEX_TEMP_TABLE */
    void *indexPtr)		/* Place to store resulting index. */
{
    Tcl_Size index, idx, numAbbrev;
    const char *key, *p1;
    const char *p2;
    const char *const *entryPtr;
    Tcl_Obj *resultPtr;
    IndexRep *indexRep;
    const Tcl_ObjInternalRep *irPtr;


    if (offset < (Tcl_Size) sizeof(char *)) {
	return TclIndexInvalidError(interp, "struct offset", offset);
    }
    /*
     * See if there is a valid cached result from a previous lookup.
     */

    if (objPtr && !(flags & TCL_INDEX_TEMP_TABLE)) {
    irPtr = TclFetchInternalRep(objPtr, &indexType);
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
PrefixMatchObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int flags = 0, result, dummy, i;
    size_t dummyLength, errorLength;
    Tcl_Obj *errorPtr = NULL;
    const char *message = "option";
    Tcl_Obj *tablePtr, *objPtr, *resultPtr;
    static const char *const matchOptions[] = {
	"-error", "-exact", "-message", NULL
    };
    enum matchOptionsEnum {







|







504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
PrefixMatchObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int flags = 0, result, dummy, i;
    Tcl_Size dummyLength, errorLength;
    Tcl_Obj *errorPtr = NULL;
    const char *message = "option";
    Tcl_Obj *tablePtr, *objPtr, *resultPtr;
    static const char *const matchOptions[] = {
	"-error", "-exact", "-message", NULL
    };
    enum matchOptionsEnum {
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
PrefixAllObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int result;
    size_t length, elemLength, tableObjc, t;
    const char *string, *elemString;
    Tcl_Obj **tableObjv, *resultPtr;

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







|







628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
PrefixAllObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int result;
    Tcl_Size length, elemLength, tableObjc, t;
    const char *string, *elemString;
    Tcl_Obj **tableObjv, *resultPtr;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "table string");
	return TCL_ERROR;
    }
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
PrefixLongestObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int result;
    size_t i, length, elemLength, resultLength, tableObjc, t;
    const char *string, *elemString, *resultString;
    Tcl_Obj **tableObjv;

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







|







686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
PrefixLongestObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int result;
    Tcl_Size i, length, elemLength, resultLength, tableObjc, t;
    const char *string, *elemString, *resultString;
    Tcl_Obj **tableObjv;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "table string");
	return TCL_ERROR;
    }
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
 *
 *----------------------------------------------------------------------
 */

void
Tcl_WrongNumArgs(
    Tcl_Interp *interp,		/* Current interpreter. */
    size_t objc,			/* Number of arguments to print from objv. */
    Tcl_Obj *const objv[],	/* Initial argument objects, which should be
				 * included in the error message. */
    const char *message)	/* Error message to print after the leading
				 * objects in objv. The message may be
				 * NULL. */
{
    Tcl_Obj *objPtr;
    size_t i, len, elemLen;
    char flags;
    Interp *iPtr = (Interp *)interp;
    const char *elementStr;

    TclNewObj(objPtr);
    if (iPtr->flags & INTERP_ALTERNATE_WRONG_ARGS) {
	iPtr->flags &= ~INTERP_ALTERNATE_WRONG_ARGS;
	Tcl_AppendObjToObj(objPtr, Tcl_GetObjResult(interp));
	Tcl_AppendToObj(objPtr, " or \"", -1);
    } else {
	Tcl_AppendToObj(objPtr, "wrong # args: should be \"", -1);
    }

    /*
     * If processing an an ensemble implementation, rewrite the results in
     * terms of how the ensemble was invoked.
     */

    if (iPtr->ensembleRewrite.sourceObjs != NULL) {
	size_t toSkip = iPtr->ensembleRewrite.numInsertedObjs;
	size_t toPrint = iPtr->ensembleRewrite.numRemovedObjs;
	Tcl_Obj *const *origObjv = TclEnsembleGetRewriteValues(interp);

	/*
	 * Only do rewrite the command if all the replaced objects are
	 * actually arguments (in objv) to this function. Otherwise it just
	 * gets too complicated and it's to just give a slightly
	 * confusing error message...







|







|



















|
|







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

void
Tcl_WrongNumArgs(
    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Size objc,		/* Number of arguments to print from objv. */
    Tcl_Obj *const objv[],	/* Initial argument objects, which should be
				 * included in the error message. */
    const char *message)	/* Error message to print after the leading
				 * objects in objv. The message may be
				 * NULL. */
{
    Tcl_Obj *objPtr;
    Tcl_Size i, len, elemLen;
    char flags;
    Interp *iPtr = (Interp *)interp;
    const char *elementStr;

    TclNewObj(objPtr);
    if (iPtr->flags & INTERP_ALTERNATE_WRONG_ARGS) {
	iPtr->flags &= ~INTERP_ALTERNATE_WRONG_ARGS;
	Tcl_AppendObjToObj(objPtr, Tcl_GetObjResult(interp));
	Tcl_AppendToObj(objPtr, " or \"", -1);
    } else {
	Tcl_AppendToObj(objPtr, "wrong # args: should be \"", -1);
    }

    /*
     * If processing an an ensemble implementation, rewrite the results in
     * terms of how the ensemble was invoked.
     */

    if (iPtr->ensembleRewrite.sourceObjs != NULL) {
	Tcl_Size toSkip = iPtr->ensembleRewrite.numInsertedObjs;
	Tcl_Size toPrint = iPtr->ensembleRewrite.numRemovedObjs;
	Tcl_Obj *const *origObjv = TclEnsembleGetRewriteValues(interp);

	/*
	 * Only do rewrite the command if all the replaced objects are
	 * actually arguments (in objv) to this function. Otherwise it just
	 * gets too complicated and it's to just give a slightly
	 * confusing error message...
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
	    }

	    /*
	     * Add a space if the word is not the last one (which has a
	     * moderately complex condition here).
	     */

	    if (i+1<toPrint || objc!=0 || message!=NULL) {
		Tcl_AppendStringsToObj(objPtr, " ", NULL);
	    }
	}
    }

    /*
     * Now add the arguments (other than those rewritten) that the caller took







|







888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
	    }

	    /*
	     * Add a space if the word is not the last one (which has a
	     * moderately complex condition here).
	     */

	    if (i<toPrint-1 || objc!=0 || message!=NULL) {
		Tcl_AppendStringsToObj(objPtr, " ", NULL);
	    }
	}
    }

    /*
     * Now add the arguments (other than those rewritten) that the caller took
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

#undef Tcl_ParseArgsObjv
int
Tcl_ParseArgsObjv(
    Tcl_Interp *interp,		/* Place to store error message. */
    const Tcl_ArgvInfo *argTable,
				/* Array of option descriptions. */
    size_t *objcPtr,		/* Number of arguments in objv. Modified to
				 * hold # args left in objv at end. */
    Tcl_Obj *const *objv,	/* Array of arguments to be parsed. */
    Tcl_Obj ***remObjv)		/* Pointer to array of arguments that were not
				 * processed here. Should be NULL if no return
				 * of arguments is desired. */
{
    Tcl_Obj **leftovers;	/* Array to write back to remObjv on
				 * successful exit. Will include the name of
				 * the command. */
    size_t nrem;			/* Size of leftovers.*/
    const Tcl_ArgvInfo *infoPtr;
				/* Pointer to the current entry in the table
				 * of argument descriptions. */
    const Tcl_ArgvInfo *matchPtr;
				/* Descriptor that matches current argument */
    Tcl_Obj *curArg;		/* Current argument */
    const char *str = NULL;
    char c;		/* Second character of current arg (used for
				 * quick check for matching; use 2nd char.
				 * because first char. will almost always be
				 * '-'). */
    size_t srcIndex;		/* Location from which to read next argument
				 * from objv. */
    size_t dstIndex;		/* Used to keep track of current arguments
				 * being processed, primarily for error
				 * reporting. */
    size_t objc;			/* # arguments in objv still to process. */
    size_t length;			/* Number of characters in current argument */

    if (remObjv != NULL) {
	/*
	 * Then we should copy the name of the command (0th argument). The
	 * upper bound on the number of elements is known, and (undocumented,
	 * but historically true) there should be a NULL argument after the
	 * last result. [Bug 3413857]







|









|











|

|


|
|







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

#undef Tcl_ParseArgsObjv
int
Tcl_ParseArgsObjv(
    Tcl_Interp *interp,		/* Place to store error message. */
    const Tcl_ArgvInfo *argTable,
				/* Array of option descriptions. */
    Tcl_Size *objcPtr,		/* Number of arguments in objv. Modified to
				 * hold # args left in objv at end. */
    Tcl_Obj *const *objv,	/* Array of arguments to be parsed. */
    Tcl_Obj ***remObjv)		/* Pointer to array of arguments that were not
				 * processed here. Should be NULL if no return
				 * of arguments is desired. */
{
    Tcl_Obj **leftovers;	/* Array to write back to remObjv on
				 * successful exit. Will include the name of
				 * the command. */
    Tcl_Size nrem;		/* Size of leftovers.*/
    const Tcl_ArgvInfo *infoPtr;
				/* Pointer to the current entry in the table
				 * of argument descriptions. */
    const Tcl_ArgvInfo *matchPtr;
				/* Descriptor that matches current argument */
    Tcl_Obj *curArg;		/* Current argument */
    const char *str = NULL;
    char c;		/* Second character of current arg (used for
				 * quick check for matching; use 2nd char.
				 * because first char. will almost always be
				 * '-'). */
    Tcl_Size srcIndex;		/* Location from which to read next argument
				 * from objv. */
    Tcl_Size dstIndex;		/* Used to keep track of current arguments
				 * being processed, primarily for error
				 * reporting. */
    Tcl_Size objc;			/* # arguments in objv still to process. */
    Tcl_Size length;			/* Number of characters in current argument */

    if (remObjv != NULL) {
	/*
	 * Then we should copy the name of the command (0th argument). The
	 * upper bound on the number of elements is known, and (undocumented,
	 * but historically true) there should be a NULL argument after the
	 * last result. [Bug 3413857]
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
	    if (handlerProc(infoPtr->clientData, argObj, infoPtr->dstPtr)) {
		srcIndex++;
		objc--;
	    }
	    break;
	}
	case TCL_ARGV_GENFUNC: {
	    int i = (int)objc;

	    if (objc > INT_MAX) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"too many (%" TCL_Z_MODIFIER "u) arguments for TCL_ARGV_GENFUNC", objc));
		goto error;
	    }
	    Tcl_ArgvGenFuncProc *handlerProc = (Tcl_ArgvGenFuncProc *)
		    infoPtr->srcPtr;

	    i = handlerProc(infoPtr->clientData, interp, i,
		    &objv[srcIndex], infoPtr->dstPtr);
	    if (i < 0) {
		goto error;
	    }
	    objc = i;
	    break;
	}







<



|





|







1167
1168
1169
1170
1171
1172
1173

1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
	    if (handlerProc(infoPtr->clientData, argObj, infoPtr->dstPtr)) {
		srcIndex++;
		objc--;
	    }
	    break;
	}
	case TCL_ARGV_GENFUNC: {


	    if (objc > INT_MAX) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"too many (%" TCL_SIZE_MODIFIER "d) arguments for TCL_ARGV_GENFUNC", objc));
		goto error;
	    }
	    Tcl_ArgvGenFuncProc *handlerProc = (Tcl_ArgvGenFuncProc *)
		    infoPtr->srcPtr;

	    int i = handlerProc(infoPtr->clientData, interp, (int) objc,
		    &objv[srcIndex], infoPtr->dstPtr);
	    if (i < 0) {
		goto error;
	    }
	    objc = i;
	    break;
	}
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
    /*
     * First, compute the width of the widest option key, so that we can make
     * everything line up.
     */

    width = 4;
    for (infoPtr = argTable; infoPtr->type != TCL_ARGV_END; infoPtr++) {
	size_t length;

	if (infoPtr->keyStr == NULL) {
	    continue;
	}
	length = strlen(infoPtr->keyStr);
	if (length > (size_t)width) {
	    width = length;
	}
    }

    /*
     * Now add the option information, with pretty-printing.
     */







|





|







1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
    /*
     * First, compute the width of the widest option key, so that we can make
     * everything line up.
     */

    width = 4;
    for (infoPtr = argTable; infoPtr->type != TCL_ARGV_END; infoPtr++) {
	Tcl_Size length;

	if (infoPtr->keyStr == NULL) {
	    continue;
	}
	length = strlen(infoPtr->keyStr);
	if (length > width) {
	    width = length;
	}
    }

    /*
     * Now add the option information, with pretty-printing.
     */

Changes to generic/tclInt.decls.

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
    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)
#}
declare 138 {
    const char *TclGetEnv(const char *name, Tcl_DString *valuePtr)
}
# This is used by TclX, but should otherwise be considered private
declare 141 {
    const char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr)
}
declare 142 {
    int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    CompileHookProc *hookProc, void *clientData)
}

declare 143 {
    Tcl_Size TclAddLiteralObj(struct CompileEnv *envPtr, Tcl_Obj *objPtr,
	    LiteralEntry **litPtrPtr)
}
declare 144 {
    void TclHideLiteral(Tcl_Interp *interp, struct CompileEnv *envPtr,
	    int index)
}
declare 145 {







>
|
|
<
>















>

|







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
    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)
}
# Removed in 9.0:
#declare 132 {
#    int TclpHasSockets(Tcl_Interp *interp)

#}
# Removed in 9.0:
#declare 133 {
#    struct tm *TclpGetDate(const time_t *time, int useGMT)
#}
declare 138 {
    const char *TclGetEnv(const char *name, Tcl_DString *valuePtr)
}
# This is used by TclX, but should otherwise be considered private
declare 141 {
    const char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr)
}
declare 142 {
    int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    CompileHookProc *hookProc, void *clientData)
}
# Do NOT change width of the size. TclEmitPush cannot handle it
declare 143 {
    int TclAddLiteralObj(struct CompileEnv *envPtr, Tcl_Obj *objPtr,
	    LiteralEntry **litPtrPtr)
}
declare 144 {
    void TclHideLiteral(Tcl_Interp *interp, struct CompileEnv *envPtr,
	    int index)
}
declare 145 {
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
declare 213 {
    Tcl_Obj *TclGetObjNameOfExecutable(void)
}
declare 214 {
    void TclSetObjNameOfExecutable(Tcl_Obj *name, Tcl_Encoding encoding)
}
declare 215 {
    void *TclStackAlloc(Tcl_Interp *interp, Tcl_Size numBytes)
}
declare 216 {
    void TclStackFree(Tcl_Interp *interp, void *freePtr)
}
declare 217 {
    int TclPushStackFrame(Tcl_Interp *interp, Tcl_CallFrame **framePtrPtr,
            Tcl_Namespace *namespacePtr, int isProcCallFrame)







|







533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
declare 213 {
    Tcl_Obj *TclGetObjNameOfExecutable(void)
}
declare 214 {
    void TclSetObjNameOfExecutable(Tcl_Obj *name, Tcl_Encoding encoding)
}
declare 215 {
    void *TclStackAlloc(Tcl_Interp *interp, TCL_HASH_TYPE numBytes)
}
declare 216 {
    void TclStackFree(Tcl_Interp *interp, void *freePtr)
}
declare 217 {
    int TclPushStackFrame(Tcl_Interp *interp, Tcl_CallFrame **framePtrPtr,
            Tcl_Namespace *namespacePtr, int isProcCallFrame)
658
659
660
661
662
663
664

665
666
667
668
669
670
671
672
673
}
# TIP #285: Script cancellation support.
declare 250 {
    void TclSetChildCancelFlags(Tcl_Interp *interp, int flags, int force)
}

# Allow extensions for optimization

declare 251 {
    Tcl_Size TclRegisterLiteral(void *envPtr,
	    const char *bytes, Tcl_Size length, int flags)
}

# Exporting of the internal API to variables.

declare 252 {
    Tcl_Obj *TclPtrGetVar(Tcl_Interp *interp, Tcl_Var varPtr,







>

|







660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
}
# TIP #285: Script cancellation support.
declare 250 {
    void TclSetChildCancelFlags(Tcl_Interp *interp, int flags, int force)
}

# Allow extensions for optimization
# Do NOT change width of the size. TclEmitPush cannot handle it
declare 251 {
    int TclRegisterLiteral(void *envPtr,
	    const char *bytes, Tcl_Size length, int flags)
}

# Exporting of the internal API to variables.

declare 252 {
    Tcl_Obj *TclPtrGetVar(Tcl_Interp *interp, Tcl_Var varPtr,
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
declare 258 {
    Tcl_Obj *TclpCreateTemporaryDirectory(Tcl_Obj *dirObj,
	    Tcl_Obj *basenameObj)
}

# TIP 625: for unit testing - create list objects with span
declare 260 {
    Tcl_Obj *TclListTestObj(int length, int leadingSpace, int endSpace)
}

# TIP 625: for unit testing - check list invariants
declare 261 {
    void TclListObjValidate(Tcl_Interp *interp, Tcl_Obj *listObj)
}








|







704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
declare 258 {
    Tcl_Obj *TclpCreateTemporaryDirectory(Tcl_Obj *dirObj,
	    Tcl_Obj *basenameObj)
}

# TIP 625: for unit testing - create list objects with span
declare 260 {
    Tcl_Obj *TclListTestObj(size_t length, size_t leadingSpace, size_t endSpace)
}

# TIP 625: for unit testing - check list invariants
declare 261 {
    void TclListObjValidate(Tcl_Interp *interp, Tcl_Obj *listObj)
}


Changes to generic/tclInt.h.

62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80

#include "tclPort.h"

#include <stdio.h>

#include <ctype.h>
#include <stdarg.h>
#ifdef NO_STDLIB_H
#   include "../compat/stdlib.h"
#else
#   include <stdlib.h>
#endif
#ifdef NO_STRING_H
#include "../compat/string.h"
#else
#include <string.h>
#endif
#include <locale.h>








<
<
<
|
|







62
63
64
65
66
67
68



69
70
71
72
73
74
75
76
77

#include "tclPort.h"

#include <stdio.h>

#include <ctype.h>
#include <stdarg.h>



#include <stdlib.h>
#include <stdint.h>
#ifdef NO_STRING_H
#include "../compat/string.h"
#else
#include <string.h>
#endif
#include <locale.h>

100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
#    ifdef LITTLE_ENDIAN
#	 if BYTE_ORDER == LITTLE_ENDIAN
#	     undef WORDS_BIGENDIAN
#	 endif
#    endif
#endif

/*
 * Maximum *signed* value that can be stored in a Tcl_Size type. This is
 * primarily used for checking overflows in dynamically allocating memory.
 */
#define TCL_SIZE_SMAX ((((Tcl_Size) 1) << ((8*sizeof(Tcl_Size)) - 1)) - 1)

/*
 * Macros used to cast between pointers and integers (e.g. when storing an int
 * in ClientData), on 64-bit architectures they avoid gcc warning about "cast
 * to/from pointer from/to integer of different size".
 */

#if !defined(INT2PTR)







<
<
<
<
<
<







97
98
99
100
101
102
103






104
105
106
107
108
109
110
#    ifdef LITTLE_ENDIAN
#	 if BYTE_ORDER == LITTLE_ENDIAN
#	     undef WORDS_BIGENDIAN
#	 endif
#    endif
#endif







/*
 * Macros used to cast between pointers and integers (e.g. when storing an int
 * in ClientData), on 64-bit architectures they avoid gcc warning about "cast
 * to/from pointer from/to integer of different size".
 */

#if !defined(INT2PTR)
127
128
129
130
131
132
133

134
135
136
137
138
139
140
#endif
#if !defined(PTR2UINT)
#   define PTR2UINT(p) ((size_t)(p))
#endif

#if defined(_WIN32) && defined(_MSC_VER)
#   define vsnprintf _vsnprintf

#endif

#if !defined(TCL_THREADS)
#   define TCL_THREADS 1
#endif
#if !TCL_THREADS
#   undef TCL_DECLARE_MUTEX







>







118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
#endif
#if !defined(PTR2UINT)
#   define PTR2UINT(p) ((size_t)(p))
#endif

#if defined(_WIN32) && defined(_MSC_VER)
#   define vsnprintf _vsnprintf
#   define snprintf _snprintf
#endif

#if !defined(TCL_THREADS)
#   define TCL_THREADS 1
#endif
#if !TCL_THREADS
#   undef TCL_DECLARE_MUTEX
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
 *----------------------------------------------------------------
 */

typedef struct Tcl_Ensemble Tcl_Ensemble;
typedef struct NamespacePathEntry NamespacePathEntry;

/*
 * Special hashtable for variables: this is just a Tcl_HashTable with nsPtr
 * and arrayPtr fields added at the end: in this way variables can find their
 * namespace and possibly containing array without having to copy a pointer in
 * their struct: they can access them via their hPtr->tablePtr.
 */

typedef struct TclVarHashTable {
    Tcl_HashTable table;
    struct Namespace *nsPtr;
#if TCL_MAJOR_VERSION > 8
    struct Var *arrayPtr;







|
|

|







209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
 *----------------------------------------------------------------
 */

typedef struct Tcl_Ensemble Tcl_Ensemble;
typedef struct NamespacePathEntry NamespacePathEntry;

/*
 * Special hashtable for variables:  This is just a Tcl_HashTable with nsPtr
 * and arrayPtr fields added at the end so that variables can find their
 * namespace and possibly containing array without having to copy a pointer in
 * their struct by accessing them via their hPtr->tablePtr.
 */

typedef struct TclVarHashTable {
    Tcl_HashTable table;
    struct Namespace *nsPtr;
#if TCL_MAJOR_VERSION > 8
    struct Var *arrayPtr;
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
    struct EnsembleConfig *next;/* The next ensemble in the linked list of
				 * ensembles associated with a namespace. If
				 * this field points to this ensemble, the
				 * structure has already been unlinked from
				 * all lists, and cannot be found by scanning
				 * the list from the namespace's ensemble
				 * field. */
    int flags;			/* ORed combo of TCL_ENSEMBLE_PREFIX,
				 * ENSEMBLE_DEAD and ENSEMBLE_COMPILE. */

    /* OBJECT FIELDS FOR ENSEMBLE CONFIGURATION */

    Tcl_Obj *subcommandDict;	/* Dictionary providing mapping from
				 * subcommands to their implementing command
				 * prefixes, or NULL if we are to build the







|







466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
    struct EnsembleConfig *next;/* The next ensemble in the linked list of
				 * ensembles associated with a namespace. If
				 * this field points to this ensemble, the
				 * structure has already been unlinked from
				 * all lists, and cannot be found by scanning
				 * the list from the namespace's ensemble
				 * field. */
    int flags;			/* OR'ed combo of TCL_ENSEMBLE_PREFIX,
				 * ENSEMBLE_DEAD and ENSEMBLE_COMPILE. */

    /* OBJECT FIELDS FOR ENSEMBLE CONFIGURATION */

    Tcl_Obj *subcommandDict;	/* Dictionary providing mapping from
				 * subcommands to their implementing command
				 * prefixes, or NULL if we are to build the
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
				 * NULL to use the default error-generating
				 * behaviour. The script execution gets all
				 * the arguments to the ensemble command
				 * (including objv[0]) and will have the
				 * results passed directly back to the caller
				 * (including the error code) unless the code
				 * is TCL_CONTINUE in which case the
				 * subcommand will be reparsed by the ensemble
				 * core, presumably because the ensemble
				 * itself has been updated. */
    Tcl_Obj *parameterList;	/* List of ensemble parameter names. */
    Tcl_Size numParameters;		/* Cached number of parameters. This is either
				 * 0 (if the parameterList field is NULL) or
				 * the length of the list in the parameterList
				 * field. */







|







493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
				 * NULL to use the default error-generating
				 * behaviour. The script execution gets all
				 * the arguments to the ensemble command
				 * (including objv[0]) and will have the
				 * results passed directly back to the caller
				 * (including the error code) unless the code
				 * is TCL_CONTINUE in which case the
				 * subcommand will be re-parsed by the ensemble
				 * core, presumably because the ensemble
				 * itself has been updated. */
    Tcl_Obj *parameterList;	/* List of ensemble parameter names. */
    Tcl_Size numParameters;		/* Cached number of parameters. This is either
				 * 0 (if the parameterList field is NULL) or
				 * the length of the list in the parameterList
				 * field. */
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
				 * trace active on variable, and 1 if the
				 * variable is a namespace variable. This
				 * record can't be deleted until refCount
				 * becomes 0. */
    Tcl_HashEntry entry;	/* The hash table entry that refers to this
				 * variable. This is used to find the name of
				 * the variable and to delete it from its
				 * hashtable if it is no longer needed. It
				 * also holds the variable's name. */
} VarInHash;

/*
 * Flag bits for variables. The first two (VAR_ARRAY and VAR_LINK) are
 * mutually exclusive and give the "type" of the variable. If none is set,
 * this is a scalar variable.
 *
 * VAR_ARRAY -			1 means this is an array variable rather than
 *				a scalar variable or link. The "tablePtr"
 *				field points to the array's hashtable for its
 *				elements.
 * VAR_LINK -			1 means this Var structure contains a pointer
 *				to another Var structure that either has the
 *				real value or is itself another VAR_LINK
 *				pointer. Variables like this come about
 *				through "upvar" and "global" commands, or
 *				through references to variables in enclosing
 *				namespaces.
 *
 * Flags that indicate the type and status of storage; none is set for
 * compiled local variables (Var structs).
 *
 * VAR_IN_HASHTABLE -		1 means this variable is in a hashtable and
 *				the Var structure is malloced. 0 if it is a
 *				local variable that was assigned a slot in a
 *				procedure frame by the compiler so the Var
 *				storage is part of the call frame.
 * VAR_DEAD_HASH		1 means that this var's entry in the hashtable
 *				has already been deleted.
 * VAR_ARRAY_ELEMENT -		1 means that this variable is an array
 *				element, so it is not legal for it to be an
 *				array itself (the VAR_ARRAY flag had better
 *				not be set).
 * VAR_NAMESPACE_VAR -		1 means that this variable was declared as a
 *				namespace variable. This flag ensures it







|










|












|
|



|







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
				 * trace active on variable, and 1 if the
				 * variable is a namespace variable. This
				 * record can't be deleted until refCount
				 * becomes 0. */
    Tcl_HashEntry entry;	/* The hash table entry that refers to this
				 * variable. This is used to find the name of
				 * the variable and to delete it from its
				 * hash table if it is no longer needed. It
				 * also holds the variable's name. */
} VarInHash;

/*
 * Flag bits for variables. The first two (VAR_ARRAY and VAR_LINK) are
 * mutually exclusive and give the "type" of the variable. If none is set,
 * this is a scalar variable.
 *
 * VAR_ARRAY -			1 means this is an array variable rather than
 *				a scalar variable or link. The "tablePtr"
 *				field points to the array's hash table for its
 *				elements.
 * VAR_LINK -			1 means this Var structure contains a pointer
 *				to another Var structure that either has the
 *				real value or is itself another VAR_LINK
 *				pointer. Variables like this come about
 *				through "upvar" and "global" commands, or
 *				through references to variables in enclosing
 *				namespaces.
 *
 * Flags that indicate the type and status of storage; none is set for
 * compiled local variables (Var structs).
 *
 * VAR_IN_HASHTABLE -		1 means this variable is in a hash table and
 *				the Var structure is malloc'ed. 0 if it is a
 *				local variable that was assigned a slot in a
 *				procedure frame by the compiler so the Var
 *				storage is part of the call frame.
 * VAR_DEAD_HASH		1 means that this var's entry in the hash table
 *				has already been deleted.
 * VAR_ARRAY_ELEMENT -		1 means that this variable is an array
 *				element, so it is not legal for it to be an
 *				array itself (the VAR_ARRAY flag had better
 *				not be set).
 * VAR_NAMESPACE_VAR -		1 means that this variable was declared as a
 *				namespace variable. This flag ensures it
1037
1038
1039
1040
1041
1042
1043
1044
1045



1046

1047
1048
1049
1050
1051
1052
1053

/*
 * The structure below defines a command trace. This is used to allow Tcl
 * clients to find out whenever a command is about to be executed.
 */

typedef struct Trace {
    int level;			/* Only trace commands at nesting level less
				 * than or equal to this. */



    Tcl_CmdObjTraceProc *proc;	/* Procedure to call to trace command. */

    void *clientData;	/* Arbitrary value to pass to proc. */
    struct Trace *nextPtr;	/* Next in list of traces for this interp. */
    int flags;			/* Flags governing the trace - see
				 * Tcl_CreateObjTrace for details. */
    Tcl_CmdObjTraceDeleteProc *delProc;
				/* Procedure to call when trace is deleted. */
} Trace;







|

>
>
>

>







1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049

/*
 * The structure below defines a command trace. This is used to allow Tcl
 * clients to find out whenever a command is about to be executed.
 */

typedef struct Trace {
    Tcl_Size level;		/* Only trace commands at nesting level less
				 * than or equal to this. */
#if TCL_MAJOR_VERSION > 8
    Tcl_CmdObjTraceProc2 *proc;	/* Procedure to call to trace command. */
#else
    Tcl_CmdObjTraceProc *proc;	/* Procedure to call to trace command. */
#endif
    void *clientData;	/* Arbitrary value to pass to proc. */
    struct Trace *nextPtr;	/* Next in list of traces for this interp. */
    int flags;			/* Flags governing the trace - see
				 * Tcl_CreateObjTrace for details. */
    Tcl_CmdObjTraceDeleteProc *delProc;
				/* Procedure to call when trace is deleted. */
} Trace;
1082
1083
1084
1085
1086
1087
1088





































1089
1090
1091
1092
1093
1094
1095
 * TCL_TRACE_LEAVE_EXEC		- triggers leave/leavestep traces.
 * 				- passed to Tcl_CreateObjTrace to set up
 *				  "leavestep" traces.
 */

#define TCL_TRACE_ENTER_EXEC	1
#define TCL_TRACE_LEAVE_EXEC	2






































/*
 * The structure below defines an entry in the assocData hash table which is
 * associated with an interpreter. The entry contains a pointer to a function
 * to call when the interpreter is deleted, and a pointer to a user-defined
 * piece of data.
 */







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







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
 * TCL_TRACE_LEAVE_EXEC		- triggers leave/leavestep traces.
 * 				- passed to Tcl_CreateObjTrace to set up
 *				  "leavestep" traces.
 */

#define TCL_TRACE_ENTER_EXEC	1
#define TCL_TRACE_LEAVE_EXEC	2

/*
 * Versions 0, 1, and 2 are currently supported concurrently for now
 */
#define TclObjTypeHasProc(objPtr, proc)		\
    (((objPtr)->typePtr				\
      && (   (objPtr)->typePtr->version == 1	\
	  || (objPtr)->typePtr->version == 2))	\
     ?	((objPtr)->typePtr)->proc		\
     : NULL)


MODULE_SCOPE Tcl_Size TclLengthOne(Tcl_Obj *);


/*
 * Abstract List
 *
 *  This structure provides the functions used in List operations to emulate a
 *  List for AbstractList types.
 */


#define Tcl_ObjTypeLength(objPtr) (objPtr)->typePtr->lengthProc(objPtr)
#define Tcl_ObjTypeIndex(interp, objPtr, index, elemObjPtr) \
    (objPtr)->typePtr->indexProc((interp),(objPtr),(index),(elemObjPtr))
#define Tcl_ObjTypeSlice(interp, objPtr, fromIdx, toIdx, newObjPtr) \
    (objPtr)->typePtr->sliceProc((interp),(objPtr),(fromIdx),(toIdx),(newObjPtr))
#define Tcl_ObjTypeReverse(interp, objPtr, newObjPtr) \
    (objPtr)->typePtr->reverseProc((interp),(objPtr),(newObjPtr))
#define Tcl_ObjTypeGetElements(interp, objPtr, objCPtr, objVPtr) \
    (objPtr)->typePtr->getElementsProc((interp),(objPtr),(objCPtr),(objVPtr))
#define Tcl_ObjTypeSetElement(interp, objPtr, indexCount, indexArray, valueObj) \
    (objPtr)->typePtr->setElementProc((interp), (objPtr), (indexCount), (indexArray), (valueObj))
#define Tcl_ObjTypeReplace(interp, objPtr, first, numToDelete, numToInsert, insertObjs) \
    (objPtr)->typePtr->replaceProc((interp), (objPtr), (first), (numToDelete), (numToInsert), (insertObjs))


/*
 * The structure below defines an entry in the assocData hash table which is
 * associated with an interpreter. The entry contains a pointer to a function
 * to call when the interpreter is deleted, and a pointer to a user-defined
 * piece of data.
 */
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
    Tcl_Size pc;			/* Instruction pointer of a command in
				 * ExtCmdLoc.loc[.] */
    Tcl_Size word;			/* Index of word in
				 * ExtCmdLoc.loc[cmd]->line[.] */
    struct CFWordBC *prevPtr;	/* Previous entry in stack for same Tcl_Obj. */
    struct CFWordBC *nextPtr;	/* Next entry for same command call. See
				 * CmdFrame litarg field for the list start. */
    Tcl_Obj *obj;		/* Back reference to hashtable key */
} CFWordBC;

/*
 * Structure to record the locations of invisible continuation lines in
 * literal scripts, as character offset from the beginning of the script. Both
 * compiler and direct evaluator use this information to adjust their line
 * counters when tracking through the script, because when it is invoked the
 * continuation line marker as a whole has been removed already, meaning that
 * the \n which was part of it is gone as well, breaking regular line
 * tracking.
 *
 * These structures are allocated and filled by both the function
 * TclSubstTokens() in the file "tclParse.c" and its caller TclEvalEx() in the
 * file "tclBasic.c", and stored in the thread-global hashtable "lineCLPtr" in
 * file "tclObj.c". They are used by the functions TclSetByteCodeFromAny() and
 * TclCompileScript(), both found in the file "tclCompile.c". Their memory is
 * released by the function TclFreeObj(), in the file "tclObj.c", and also by
 * the function TclThreadFinalizeObjects(), in the same file.
 */

#define CLL_END		(-1)







|













|







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
    Tcl_Size pc;			/* Instruction pointer of a command in
				 * ExtCmdLoc.loc[.] */
    Tcl_Size word;			/* Index of word in
				 * ExtCmdLoc.loc[cmd]->line[.] */
    struct CFWordBC *prevPtr;	/* Previous entry in stack for same Tcl_Obj. */
    struct CFWordBC *nextPtr;	/* Next entry for same command call. See
				 * CmdFrame litarg field for the list start. */
    Tcl_Obj *obj;		/* Back reference to hash table key */
} CFWordBC;

/*
 * Structure to record the locations of invisible continuation lines in
 * literal scripts, as character offset from the beginning of the script. Both
 * compiler and direct evaluator use this information to adjust their line
 * counters when tracking through the script, because when it is invoked the
 * continuation line marker as a whole has been removed already, meaning that
 * the \n which was part of it is gone as well, breaking regular line
 * tracking.
 *
 * These structures are allocated and filled by both the function
 * TclSubstTokens() in the file "tclParse.c" and its caller TclEvalEx() in the
 * file "tclBasic.c", and stored in the thread-global hash table "lineCLPtr" in
 * file "tclObj.c". They are used by the functions TclSetByteCodeFromAny() and
 * TclCompileScript(), both found in the file "tclCompile.c". Their memory is
 * released by the function TclFreeObj(), in the file "tclObj.c", and also by
 * the function TclThreadFinalizeObjects(), in the same file.
 */

#define CLL_END		(-1)
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
 * 			complex to compile effectively, or it can indicate
 * 			that in the current state of the interp, the command
 * 			would raise an error. The bytecode compiler will not
 * 			do any error reporting at compiler time. Error
 * 			reporting is deferred until the actual runtime,
 * 			because by then changes in the interp state may allow
 * 			the command to be successfully evaluated.
 * TCL_OUT_LINE_COMPILE	A source-compatible alias for TCL_ERROR, kept for the
 * 			sake of old code only.
 */

#define TCL_OUT_LINE_COMPILE	TCL_ERROR

typedef int (CompileProc)(Tcl_Interp *interp, Tcl_Parse *parsePtr,
	struct Command *cmdPtr, struct CompileEnv *compEnvPtr);

/*
 * The type of procedure called from the compilation hook point in
 * SetByteCodeFromAny.
 */







<
<


<
<







1475
1476
1477
1478
1479
1480
1481


1482
1483


1484
1485
1486
1487
1488
1489
1490
 * 			complex to compile effectively, or it can indicate
 * 			that in the current state of the interp, the command
 * 			would raise an error. The bytecode compiler will not
 * 			do any error reporting at compiler time. Error
 * 			reporting is deferred until the actual runtime,
 * 			because by then changes in the interp state may allow
 * 			the command to be successfully evaluated.


 */



typedef int (CompileProc)(Tcl_Interp *interp, Tcl_Parse *parsePtr,
	struct Command *cmdPtr, struct CompileEnv *compEnvPtr);

/*
 * The type of procedure called from the compilation hook point in
 * SetByteCodeFromAny.
 */
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
 *				information.
 */

#define	TCL_INVOKE_HIDDEN	(1<<0)
#define TCL_INVOKE_NO_UNKNOWN	(1<<1)
#define TCL_INVOKE_NO_TRACEBACK	(1<<2)

#if TCL_MAJOR_VERSION > 8
/*
 * SSIZE_MAX, NOT SIZE_MAX as negative differences need to be expressed
 * between values of the Tcl_Size type so limit the range to signed
 */
#   define ListSizeT_MAX ((Tcl_Size)PTRDIFF_MAX)
#else
#   define ListSizeT_MAX INT_MAX
#endif

/*
 * ListStore --
 *
 * A Tcl list's internal representation is defined through three structures.
 *
 * A ListStore struct is a structure that includes a variable size array that
 * serves as storage for a Tcl list. A contiguous sequence of slots in the







<
<
<
<
<
<
<
<
<
<







2461
2462
2463
2464
2465
2466
2467










2468
2469
2470
2471
2472
2473
2474
 *				information.
 */

#define	TCL_INVOKE_HIDDEN	(1<<0)
#define TCL_INVOKE_NO_UNKNOWN	(1<<1)
#define TCL_INVOKE_NO_TRACEBACK	(1<<2)











/*
 * ListStore --
 *
 * A Tcl list's internal representation is defined through three structures.
 *
 * A ListStore struct is a structure that includes a variable size array that
 * serves as storage for a Tcl list. A contiguous sequence of slots in the
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500

#define LISTSTORE_CANONICAL 0x1 /* All Tcl_Obj's referencing this
                                   store have their string representation
                                   derived from the list representation */

/* Max number of elements that can be contained in a list */
#define LIST_MAX                                               \
    ((ListSizeT_MAX - offsetof(ListStore, slots)) \
		   / sizeof(Tcl_Obj *))
/* Memory size needed for a ListStore to hold numSlots_ elements */
#define LIST_SIZE(numSlots_) \
	(offsetof(ListStore, slots) + ((numSlots_) * sizeof(Tcl_Obj *)))

/*
 * ListSpan --
 * See comments above for ListStore
 */
typedef struct ListSpan {
    Tcl_Size spanStart;    /* Starting index of the span */







|
|


|







2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519

#define LISTSTORE_CANONICAL 0x1 /* All Tcl_Obj's referencing this
                                   store have their string representation
                                   derived from the list representation */

/* Max number of elements that can be contained in a list */
#define LIST_MAX                                               \
    ((Tcl_Size)(((size_t)TCL_SIZE_MAX - offsetof(ListStore, slots)) \
		   / sizeof(Tcl_Obj *)))
/* Memory size needed for a ListStore to hold numSlots_ elements */
#define LIST_SIZE(numSlots_) \
	((Tcl_Size)(offsetof(ListStore, slots) + ((numSlots_) * sizeof(Tcl_Obj *))))

/*
 * ListSpan --
 * See comments above for ListStore
 */
typedef struct ListSpan {
    Tcl_Size spanStart;    /* Starting index of the span */
2574
2575
2576
2577
2578
2579
2580

2581
2582
2583
2584
2585
2586
2587
    (ListObjSpanPtr(listObj_) ? ListObjSpanPtr(listObj_)->spanStart \
			      : ListObjStorePtr(listObj_)->firstUsed)

/* Stores the element count and base address of this list's elements */
#define ListObjGetElements(listObj_, objc_, objv_) \
    (((objv_) = &ListObjStorePtr(listObj_)->slots[ListObjStart(listObj_)]), \
     (ListObjLength(listObj_, (objc_))))


/*
 * Returns 1/0 whether the internal representation (not the Tcl_Obj itself)
 * is shared.  Note by intent this only checks for sharing of ListStore,
 * not spans.
 */
#define ListObjRepIsShared(listObj_) (ListObjStorePtr(listObj_)->refCount > 1)







>







2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
    (ListObjSpanPtr(listObj_) ? ListObjSpanPtr(listObj_)->spanStart \
			      : ListObjStorePtr(listObj_)->firstUsed)

/* Stores the element count and base address of this list's elements */
#define ListObjGetElements(listObj_, objc_, objv_) \
    (((objv_) = &ListObjStorePtr(listObj_)->slots[ListObjStart(listObj_)]), \
     (ListObjLength(listObj_, (objc_))))


/*
 * Returns 1/0 whether the internal representation (not the Tcl_Obj itself)
 * is shared.  Note by intent this only checks for sharing of ListStore,
 * not spans.
 */
#define ListObjRepIsShared(listObj_) (ListObjStorePtr(listObj_)->refCount > 1)
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
    (((listObj_)->typePtr == &tclListType)                   \
	 ? ((ListObjLength((listObj_), *(lenPtr_))), TCL_OK) \
	 : Tcl_ListObjLength((interp_), (listObj_), (lenPtr_)))

#define TclListObjIsCanonical(listObj_) \
    (((listObj_)->typePtr == &tclListType) ? ListObjIsCanonical((listObj_)) : 0)


static inline void Tcl_AbstractListSetType(Tcl_Obj* abstractListObjPtr, void* ptr)
{
    abstractListObjPtr->internalRep.twoPtrValue.ptr2 = ptr;
}

static inline Tcl_WideInt
AbstractListObjLength(Tcl_Obj* abstractListObjPtr)
{
    Tcl_AbstractListType *typePtr = Tcl_AbstractListGetType(abstractListObjPtr);
    return typePtr->lengthProc(abstractListObjPtr);
}

/*
 * Modes for collecting (or not) in the implementations of TclNRForeachCmd,
 * TclNRLmapCmd and their compilations.
 */

#define TCL_EACH_KEEP_NONE  0	/* Discard iteration result like [foreach] */
#define TCL_EACH_COLLECT    1	/* Collect iteration result like [lmap] */







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







2648
2649
2650
2651
2652
2653
2654













2655
2656
2657
2658
2659
2660
2661
    (((listObj_)->typePtr == &tclListType)                   \
	 ? ((ListObjLength((listObj_), *(lenPtr_))), TCL_OK) \
	 : Tcl_ListObjLength((interp_), (listObj_), (lenPtr_)))

#define TclListObjIsCanonical(listObj_) \
    (((listObj_)->typePtr == &tclListType) ? ListObjIsCanonical((listObj_)) : 0)














/*
 * Modes for collecting (or not) in the implementations of TclNRForeachCmd,
 * TclNRLmapCmd and their compilations.
 */

#define TCL_EACH_KEEP_NONE  0	/* Discard iteration result like [foreach] */
#define TCL_EACH_COLLECT    1	/* Collect iteration result like [lmap] */
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
    (((objPtr)->typePtr == &tclIntType \
	    && (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(INT_MIN) \
	    && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(INT_MAX)) \
	    ? ((*(intPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \
	    : Tcl_GetIntFromObj((interp), (objPtr), (intPtr)))
#define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \
    ((((objPtr)->typePtr == &tclIntType) && ((objPtr)->internalRep.wideValue >= 0) \
	    && ((Tcl_WideUInt)(objPtr)->internalRep.wideValue <= (Tcl_WideUInt)(endValue + 1))) \
	    ? ((*(idxPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \
	    : Tcl_GetIntForIndex((interp), (objPtr), (endValue), (idxPtr)))

/*
 * Macro used to save a function call for common uses of
 * Tcl_GetWideIntFromObj(). The ANSI C "prototype" is:
 *







|







2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
    (((objPtr)->typePtr == &tclIntType \
	    && (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(INT_MIN) \
	    && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(INT_MAX)) \
	    ? ((*(intPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \
	    : Tcl_GetIntFromObj((interp), (objPtr), (intPtr)))
#define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \
    ((((objPtr)->typePtr == &tclIntType) && ((objPtr)->internalRep.wideValue >= 0) \
	    && ((objPtr)->internalRep.wideValue <= endValue)) \
	    ? ((*(idxPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \
	    : Tcl_GetIntForIndex((interp), (objPtr), (endValue), (idxPtr)))

/*
 * Macro used to save a function call for common uses of
 * Tcl_GetWideIntFromObj(). The ANSI C "prototype" is:
 *
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
#define TCL_PARSE_NO_WHITESPACE		32
				/* Reject leading/trailing whitespace. */
#define TCL_PARSE_BINARY_ONLY	64
				/* Parse binary even without prefix. */
#define TCL_PARSE_NO_UNDERSCORE	128
				/* Reject underscore digit separator */


/*




















































































 *----------------------------------------------------------------
 * Variables shared among Tcl modules but not used by the outside world.
 *----------------------------------------------------------------
 */

MODULE_SCOPE char *tclNativeExecutableName;
MODULE_SCOPE int tclFindExecutableSearchDone;
MODULE_SCOPE char *tclMemDumpFileName;
MODULE_SCOPE TclPlatformType tclPlatform;





MODULE_SCOPE Tcl_Encoding tclIdentityEncoding;









/*
 * TIP #233 (Virtualized Time)
 * Data for the time hooks, if any.
 */

MODULE_SCOPE Tcl_GetTimeProc *tclGetTimeProcPtr;







>

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










>
>
>
>

>
>
>
>
>
>
>
>







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
#define TCL_PARSE_NO_WHITESPACE		32
				/* Reject leading/trailing whitespace. */
#define TCL_PARSE_BINARY_ONLY	64
				/* Parse binary even without prefix. */
#define TCL_PARSE_NO_UNDERSCORE	128
				/* Reject underscore digit separator */


/*
 *----------------------------------------------------------------------
 * Internal convenience macros for manipulating encoding flags. See
 * TCL_ENCODING_PROFILE_* in tcl.h
 *----------------------------------------------------------------------
 */

#define ENCODING_PROFILE_MASK     0xFF000000
#define ENCODING_PROFILE_GET(flags_)  ((flags_) & ENCODING_PROFILE_MASK)
#define ENCODING_PROFILE_SET(flags_, profile_) \
    do {                                       \
	(flags_) &= ~ENCODING_PROFILE_MASK;    \
	(flags_) |= profile_;                  \
    } while (0)

/*
 *----------------------------------------------------------------------
 * Common functions for calculating overallocation. Trivial but allows for
 * experimenting with growth factors without having to change code in
 * multiple places. See TclAttemptAllocElemsEx and similar for usage
 * examples. Best to use those functions. Direct use of TclUpsizeAlloc /
 * TclResizeAlloc is needed in special cases such as when total size of
 * memory block is limited to less than TCL_SIZE_MAX.
 *
 *----------------------------------------------------------------------
 */
static inline Tcl_Size
TclUpsizeAlloc(TCL_UNUSED(Tcl_Size) /* oldSize. For future experiments with
				     * some growth algorithms that use this
				     * information. */,
	       Tcl_Size needed,
	       Tcl_Size limit)
{
    /* assert (oldCapacity < needed <= limit) */
    if (needed < (limit - needed/2)) {
	return needed + needed / 2;
    }
    else {
	return limit;
    }
}
static inline Tcl_Size TclUpsizeRetry(Tcl_Size needed, Tcl_Size lastAttempt) {
	/* assert (needed < lastAttempt) */
    if (needed < lastAttempt - 1) {
	/* (needed+lastAttempt)/2 but that formula may overflow Tcl_Size */
	return needed + (lastAttempt - needed) / 2;
    } else {
	return needed;
    }
}
MODULE_SCOPE void *TclAllocElemsEx(Tcl_Size elemCount, Tcl_Size elemSize,
			Tcl_Size leadSize, Tcl_Size *capacityPtr);
MODULE_SCOPE void *TclReallocElemsEx(void *oldPtr, Tcl_Size elemCount,
			Tcl_Size elemSize, Tcl_Size leadSize,
			Tcl_Size *capacityPtr);
MODULE_SCOPE void *TclAttemptReallocElemsEx(void *oldPtr,
			Tcl_Size elemCount, Tcl_Size elemSize,
			Tcl_Size leadSize, Tcl_Size *capacityPtr);
/* Alloc elemCount elements of size elemSize with leadSize header
 * returning actual capacity (in elements) in *capacityPtr. */
static inline void *TclAttemptAllocElemsEx(Tcl_Size elemCount, Tcl_Size elemSize,
			Tcl_Size leadSize, Tcl_Size *capacityPtr) {
    return TclAttemptReallocElemsEx(
	NULL, elemCount, elemSize, leadSize, capacityPtr);
}
/* Alloc numByte bytes, returning actual capacity in *capacityPtr. */
static inline void *TclAllocEx(Tcl_Size numBytes, Tcl_Size *capacityPtr) {
    return TclAllocElemsEx(numBytes, 1, 0, capacityPtr);
}
/* Alloc numByte bytes, returning actual capacity in *capacityPtr. */
static inline void *
TclAttemptAllocEx(Tcl_Size numBytes, Tcl_Size *capacityPtr)
{
    return TclAttemptAllocElemsEx(numBytes, 1, 0, capacityPtr);
}
/* Realloc numByte bytes, returning actual capacity in *capacityPtr. */
static inline void *TclReallocEx(void *oldPtr, Tcl_Size numBytes, Tcl_Size *capacityPtr) {
    return TclReallocElemsEx(oldPtr, numBytes, 1, 0, capacityPtr);
}
/* Realloc numByte bytes, returning actual capacity in *capacityPtr. */
static inline void *TclAttemptReallocEx(void *oldPtr, Tcl_Size numBytes, Tcl_Size *capacityPtr) {
    return TclAttemptReallocElemsEx(oldPtr, numBytes, 1, 0, capacityPtr);
}

/*
 *----------------------------------------------------------------
 * Variables shared among Tcl modules but not used by the outside world.
 *----------------------------------------------------------------
 */

MODULE_SCOPE char *tclNativeExecutableName;
MODULE_SCOPE int tclFindExecutableSearchDone;
MODULE_SCOPE char *tclMemDumpFileName;
MODULE_SCOPE TclPlatformType tclPlatform;

/*
 * Declarations related to internal encoding functions.
 */

MODULE_SCOPE Tcl_Encoding tclIdentityEncoding;
MODULE_SCOPE int
TclEncodingProfileNameToId(Tcl_Interp *interp,
			   const char *profileName,
			   int *profilePtr);
MODULE_SCOPE const char *TclEncodingProfileIdToName(Tcl_Interp *interp,
						    int profileId);
MODULE_SCOPE int TclEncodingSetProfileFlags(int flags);
MODULE_SCOPE void TclGetEncodingProfiles(Tcl_Interp *interp);

/*
 * TIP #233 (Virtualized Time)
 * Data for the time hooks, if any.
 */

MODULE_SCOPE Tcl_GetTimeProc *tclGetTimeProcPtr;
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
MODULE_SCOPE const Tcl_ObjType tclBignumType;
MODULE_SCOPE const Tcl_ObjType tclBooleanType;
MODULE_SCOPE const Tcl_ObjType tclByteCodeType;
MODULE_SCOPE const Tcl_ObjType tclDoubleType;
MODULE_SCOPE const Tcl_ObjType tclIntType;
MODULE_SCOPE const Tcl_ObjType tclListType;
MODULE_SCOPE const Tcl_ObjType tclDictType;
MODULE_SCOPE const Tcl_ObjType tclAbstractListType;
MODULE_SCOPE const Tcl_ObjType tclProcBodyType;
MODULE_SCOPE const Tcl_ObjType tclStringType;
MODULE_SCOPE const Tcl_ObjType tclEnsembleCmdType;
MODULE_SCOPE const Tcl_ObjType tclRegexpType;
MODULE_SCOPE Tcl_ObjType tclCmdNameType;

/*







<







2996
2997
2998
2999
3000
3001
3002

3003
3004
3005
3006
3007
3008
3009
MODULE_SCOPE const Tcl_ObjType tclBignumType;
MODULE_SCOPE const Tcl_ObjType tclBooleanType;
MODULE_SCOPE const Tcl_ObjType tclByteCodeType;
MODULE_SCOPE const Tcl_ObjType tclDoubleType;
MODULE_SCOPE const Tcl_ObjType tclIntType;
MODULE_SCOPE const Tcl_ObjType tclListType;
MODULE_SCOPE const Tcl_ObjType tclDictType;

MODULE_SCOPE const Tcl_ObjType tclProcBodyType;
MODULE_SCOPE const Tcl_ObjType tclStringType;
MODULE_SCOPE const Tcl_ObjType tclEnsembleCmdType;
MODULE_SCOPE const Tcl_ObjType tclRegexpType;
MODULE_SCOPE Tcl_ObjType tclCmdNameType;

/*
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
 *----------------------------------------------------------------
 * Procedures shared among Tcl modules but not used by the outside world:
 *----------------------------------------------------------------
 */

#if TCL_MAJOR_VERSION > 8
MODULE_SCOPE void	TclAppendBytesToByteArray(Tcl_Obj *objPtr,
			    const unsigned char *bytes, size_t len);
MODULE_SCOPE int	TclNREvalCmd(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    int flags);
MODULE_SCOPE void	TclAdvanceContinuations(size_t *line, int **next,
			    int loc);
MODULE_SCOPE void	TclAdvanceLines(size_t *line, const char *start,
			    const char *end);
MODULE_SCOPE void	TclArgumentEnter(Tcl_Interp *interp,
			    Tcl_Obj *objv[], int objc, CmdFrame *cf);
MODULE_SCOPE void	TclArgumentRelease(Tcl_Interp *interp,
			    Tcl_Obj *objv[], int objc);
MODULE_SCOPE void	TclArgumentBCEnter(Tcl_Interp *interp,
			    Tcl_Obj *objv[], int objc,
			    void *codePtr, CmdFrame *cfPtr, int cmd, size_t pc);
MODULE_SCOPE void	TclArgumentBCRelease(Tcl_Interp *interp,
			    CmdFrame *cfPtr);
MODULE_SCOPE void	TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj,
			    CmdFrame **cfPtrPtr, int *wordPtr);
MODULE_SCOPE int	TclAsyncNotifier(int sigNumber, Tcl_ThreadId threadId,
			    void *clientData, int *flagPtr, int value);
MODULE_SCOPE void	TclAsyncMarkFromNotifier(void);
MODULE_SCOPE double	TclBignumToDouble(const void *bignum);
MODULE_SCOPE int	TclByteArrayMatch(const unsigned char *string,
			    size_t strLen, const unsigned char *pattern,
			    size_t ptnLen, int flags);
MODULE_SCOPE double	TclCeil(const void *a);
MODULE_SCOPE void	TclChannelPreserve(Tcl_Channel chan);
MODULE_SCOPE void	TclChannelRelease(Tcl_Channel chan);
MODULE_SCOPE int	TclCheckArrayTraces(Tcl_Interp *interp, Var *varPtr,
			    Var *arrayPtr, Tcl_Obj *name, int index);
MODULE_SCOPE int	TclCheckEmptyString(Tcl_Obj *objPtr);
MODULE_SCOPE int	TclChanCaughtErrorBypass(Tcl_Interp *interp,
			    Tcl_Channel chan);
MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd;
MODULE_SCOPE Tcl_NRPostProc TclClearRootEnsemble;
MODULE_SCOPE int	TclCompareTwoNumbers(Tcl_Obj *valuePtr,
			    Tcl_Obj *value2Ptr);
MODULE_SCOPE ContLineLoc *TclContinuationsEnter(Tcl_Obj *objPtr, size_t num,
			    int *loc);
MODULE_SCOPE void	TclContinuationsEnterDerived(Tcl_Obj *objPtr,
			    int start, int *clNext);
MODULE_SCOPE ContLineLoc *TclContinuationsGet(Tcl_Obj *objPtr);
MODULE_SCOPE void	TclContinuationsCopy(Tcl_Obj *objPtr,
			    Tcl_Obj *originObjPtr);
MODULE_SCOPE size_t	TclConvertElement(const char *src, size_t length,
			    char *dst, int flags);
MODULE_SCOPE Tcl_Command TclCreateObjCommandInNs(Tcl_Interp *interp,
			    const char *cmdName, Tcl_Namespace *nsPtr,
			    Tcl_ObjCmdProc *proc, void *clientData,
			    Tcl_CmdDeleteProc *deleteProc);
MODULE_SCOPE Tcl_Command TclCreateEnsembleInNs(Tcl_Interp *interp,
			    const char *name, Tcl_Namespace *nameNamespacePtr,
			    Tcl_Namespace *ensembleNamespacePtr, int flags);
MODULE_SCOPE void	TclDeleteNamespaceVars(Namespace *nsPtr);
MODULE_SCOPE void	TclDeleteNamespaceChildren(Namespace *nsPtr);



MODULE_SCOPE int	TclFindDictElement(Tcl_Interp *interp,
			    const char *dict, size_t dictLength,
			    const char **elementPtr, const char **nextPtr,
			    size_t *sizePtr, int *literalPtr);
/* TIP #280 - Modified token based evaluation, with line information. */
MODULE_SCOPE int	TclEvalEx(Tcl_Interp *interp, const char *script,
			    size_t numBytes, int flags, size_t line,
			    int *clNextOuter, const char *outerScript);
MODULE_SCOPE Tcl_ObjCmdProc TclFileAttrsCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileCopyCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileDeleteCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileLinkCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileMakeDirsCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileReadLinkCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileRenameCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileTempDirCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileTemporaryCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileHomeCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileTildeExpandCmd;
MODULE_SCOPE void	TclCreateLateExitHandler(Tcl_ExitProc *proc,
			    void *clientData);
MODULE_SCOPE void	TclDeleteLateExitHandler(Tcl_ExitProc *proc,
			    void *clientData);
MODULE_SCOPE char *	TclDStringAppendObj(Tcl_DString *dsPtr,
			    Tcl_Obj *objPtr);
MODULE_SCOPE char *	TclDStringAppendDString(Tcl_DString *dsPtr,
			    Tcl_DString *toAppendPtr);
MODULE_SCOPE Tcl_Obj *	TclDStringToObj(Tcl_DString *dsPtr);
MODULE_SCOPE Tcl_Obj *const *TclFetchEnsembleRoot(Tcl_Interp *interp,
			    Tcl_Obj *const *objv, size_t objc, size_t *objcPtr);
MODULE_SCOPE Tcl_Obj *const *TclEnsembleGetRewriteValues(Tcl_Interp *interp);
MODULE_SCOPE Tcl_Namespace *TclEnsureNamespace(Tcl_Interp *interp,
			    Tcl_Namespace *namespacePtr);
MODULE_SCOPE void	TclFinalizeAllocSubsystem(void);
MODULE_SCOPE void	TclFinalizeAsync(void);
MODULE_SCOPE void	TclFinalizeDoubleConversion(void);
MODULE_SCOPE void	TclFinalizeEncodingSubsystem(void);







|


|

|







|









|
|












|






|










>
>
>

|

|


|




















<

|







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
 *----------------------------------------------------------------
 * Procedures shared among Tcl modules but not used by the outside world:
 *----------------------------------------------------------------
 */

#if TCL_MAJOR_VERSION > 8
MODULE_SCOPE void	TclAppendBytesToByteArray(Tcl_Obj *objPtr,
			    const unsigned char *bytes, Tcl_Size len);
MODULE_SCOPE int	TclNREvalCmd(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    int flags);
MODULE_SCOPE void	TclAdvanceContinuations(Tcl_Size *line, int **next,
			    int loc);
MODULE_SCOPE void	TclAdvanceLines(Tcl_Size *line, const char *start,
			    const char *end);
MODULE_SCOPE void	TclArgumentEnter(Tcl_Interp *interp,
			    Tcl_Obj *objv[], int objc, CmdFrame *cf);
MODULE_SCOPE void	TclArgumentRelease(Tcl_Interp *interp,
			    Tcl_Obj *objv[], int objc);
MODULE_SCOPE void	TclArgumentBCEnter(Tcl_Interp *interp,
			    Tcl_Obj *objv[], int objc,
			    void *codePtr, CmdFrame *cfPtr, int cmd, Tcl_Size pc);
MODULE_SCOPE void	TclArgumentBCRelease(Tcl_Interp *interp,
			    CmdFrame *cfPtr);
MODULE_SCOPE void	TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj,
			    CmdFrame **cfPtrPtr, int *wordPtr);
MODULE_SCOPE int	TclAsyncNotifier(int sigNumber, Tcl_ThreadId threadId,
			    void *clientData, int *flagPtr, int value);
MODULE_SCOPE void	TclAsyncMarkFromNotifier(void);
MODULE_SCOPE double	TclBignumToDouble(const void *bignum);
MODULE_SCOPE int	TclByteArrayMatch(const unsigned char *string,
			    Tcl_Size strLen, const unsigned char *pattern,
			    Tcl_Size ptnLen, int flags);
MODULE_SCOPE double	TclCeil(const void *a);
MODULE_SCOPE void	TclChannelPreserve(Tcl_Channel chan);
MODULE_SCOPE void	TclChannelRelease(Tcl_Channel chan);
MODULE_SCOPE int	TclCheckArrayTraces(Tcl_Interp *interp, Var *varPtr,
			    Var *arrayPtr, Tcl_Obj *name, int index);
MODULE_SCOPE int	TclCheckEmptyString(Tcl_Obj *objPtr);
MODULE_SCOPE int	TclChanCaughtErrorBypass(Tcl_Interp *interp,
			    Tcl_Channel chan);
MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd;
MODULE_SCOPE Tcl_NRPostProc TclClearRootEnsemble;
MODULE_SCOPE int	TclCompareTwoNumbers(Tcl_Obj *valuePtr,
			    Tcl_Obj *value2Ptr);
MODULE_SCOPE ContLineLoc *TclContinuationsEnter(Tcl_Obj *objPtr, Tcl_Size num,
			    int *loc);
MODULE_SCOPE void	TclContinuationsEnterDerived(Tcl_Obj *objPtr,
			    int start, int *clNext);
MODULE_SCOPE ContLineLoc *TclContinuationsGet(Tcl_Obj *objPtr);
MODULE_SCOPE void	TclContinuationsCopy(Tcl_Obj *objPtr,
			    Tcl_Obj *originObjPtr);
MODULE_SCOPE Tcl_Size	TclConvertElement(const char *src, Tcl_Size length,
			    char *dst, int flags);
MODULE_SCOPE Tcl_Command TclCreateObjCommandInNs(Tcl_Interp *interp,
			    const char *cmdName, Tcl_Namespace *nsPtr,
			    Tcl_ObjCmdProc *proc, void *clientData,
			    Tcl_CmdDeleteProc *deleteProc);
MODULE_SCOPE Tcl_Command TclCreateEnsembleInNs(Tcl_Interp *interp,
			    const char *name, Tcl_Namespace *nameNamespacePtr,
			    Tcl_Namespace *ensembleNamespacePtr, int flags);
MODULE_SCOPE void	TclDeleteNamespaceVars(Namespace *nsPtr);
MODULE_SCOPE void	TclDeleteNamespaceChildren(Namespace *nsPtr);
MODULE_SCOPE Tcl_Size	TclDictGetSize(Tcl_Obj *dictPtr);
MODULE_SCOPE Tcl_Obj *TclDuplicatePureObj(Tcl_Interp *interp,
			    Tcl_Obj * objPtr, const Tcl_ObjType *typPtr);
MODULE_SCOPE int	TclFindDictElement(Tcl_Interp *interp,
			    const char *dict, Tcl_Size dictLength,
			    const char **elementPtr, const char **nextPtr,
			    Tcl_Size *sizePtr, int *literalPtr);
/* TIP #280 - Modified token based evaluation, with line information. */
MODULE_SCOPE int	TclEvalEx(Tcl_Interp *interp, const char *script,
			    Tcl_Size numBytes, int flags, Tcl_Size line,
			    int *clNextOuter, const char *outerScript);
MODULE_SCOPE Tcl_ObjCmdProc TclFileAttrsCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileCopyCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileDeleteCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileLinkCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileMakeDirsCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileReadLinkCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileRenameCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileTempDirCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileTemporaryCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileHomeCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileTildeExpandCmd;
MODULE_SCOPE void	TclCreateLateExitHandler(Tcl_ExitProc *proc,
			    void *clientData);
MODULE_SCOPE void	TclDeleteLateExitHandler(Tcl_ExitProc *proc,
			    void *clientData);
MODULE_SCOPE char *	TclDStringAppendObj(Tcl_DString *dsPtr,
			    Tcl_Obj *objPtr);
MODULE_SCOPE char *	TclDStringAppendDString(Tcl_DString *dsPtr,
			    Tcl_DString *toAppendPtr);

MODULE_SCOPE Tcl_Obj *const *TclFetchEnsembleRoot(Tcl_Interp *interp,
			    Tcl_Obj *const *objv, Tcl_Size objc, Tcl_Size *objcPtr);
MODULE_SCOPE Tcl_Obj *const *TclEnsembleGetRewriteValues(Tcl_Interp *interp);
MODULE_SCOPE Tcl_Namespace *TclEnsureNamespace(Tcl_Interp *interp,
			    Tcl_Namespace *namespacePtr);
MODULE_SCOPE void	TclFinalizeAllocSubsystem(void);
MODULE_SCOPE void	TclFinalizeAsync(void);
MODULE_SCOPE void	TclFinalizeDoubleConversion(void);
MODULE_SCOPE void	TclFinalizeEncodingSubsystem(void);
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
MODULE_SCOPE int	TclGetOpenModeEx(Tcl_Interp *interp,
			    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,
			    TCL_HASH_TYPE *sizePtr);
MODULE_SCOPE int	TclGetLoadedLibraries(Tcl_Interp *interp,
				const char *targetName,
				const char *packageName);
MODULE_SCOPE int	TclGetWideBitsFromObj(Tcl_Interp *, Tcl_Obj *,
				Tcl_WideInt *);
MODULE_SCOPE int	TclIncrObj(Tcl_Interp *interp, Tcl_Obj *valuePtr,
			    Tcl_Obj *incrPtr);







|







3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
MODULE_SCOPE int	TclGetOpenModeEx(Tcl_Interp *interp,
			    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,
			    Tcl_Size *sizePtr);
MODULE_SCOPE int	TclGetLoadedLibraries(Tcl_Interp *interp,
				const char *targetName,
				const char *packageName);
MODULE_SCOPE int	TclGetWideBitsFromObj(Tcl_Interp *, Tcl_Obj *,
				Tcl_WideInt *);
MODULE_SCOPE int	TclIncrObj(Tcl_Interp *interp, Tcl_Obj *valuePtr,
			    Tcl_Obj *incrPtr);
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
MODULE_SCOPE void	TclInitLimitSupport(Tcl_Interp *interp);
MODULE_SCOPE void	TclInitNamespaceSubsystem(void);
MODULE_SCOPE void	TclInitNotifier(void);
MODULE_SCOPE void	TclInitObjSubsystem(void);
MODULE_SCOPE int	TclInterpReady(Tcl_Interp *interp);
MODULE_SCOPE int	TclIsDigitProc(int byte);
MODULE_SCOPE int	TclIsBareword(int byte);
MODULE_SCOPE Tcl_Obj *	TclJoinPath(size_t elements, Tcl_Obj * const objv[],
			    int forceRelative);
MODULE_SCOPE int	MakeTildeRelativePath(Tcl_Interp *interp, const char *user,
			    const char *subPath, Tcl_DString *dsPtr);
MODULE_SCOPE Tcl_Obj *	TclGetHomeDirObj(Tcl_Interp *interp, const char *user);
MODULE_SCOPE Tcl_Obj *	TclResolveTildePath(Tcl_Interp *interp,
			    Tcl_Obj *pathObj);
MODULE_SCOPE Tcl_Obj *	TclResolveTildePathList(Tcl_Obj *pathsObj);
MODULE_SCOPE int	TclJoinThread(Tcl_ThreadId id, int *result);
MODULE_SCOPE void	TclLimitRemoveAllHandlers(Tcl_Interp *interp);
MODULE_SCOPE Tcl_Obj *	TclLindexList(Tcl_Interp *interp,
			    Tcl_Obj *listPtr, Tcl_Obj *argPtr);
MODULE_SCOPE Tcl_Obj *	TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
			    size_t indexCount, Tcl_Obj *const indexArray[]);

/* TIP #280 */
MODULE_SCOPE void	TclListLines(Tcl_Obj *listObj, size_t line, int n,
			    int *lines, Tcl_Obj *const *elems);
MODULE_SCOPE Tcl_Obj *	TclListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr);
MODULE_SCOPE int	TclListObjAppendElements(Tcl_Interp *interp,
			    Tcl_Obj *toObj, size_t elemCount,
			    Tcl_Obj *const elemObjv[]);
MODULE_SCOPE Tcl_Obj *	TclListObjRange(Tcl_Obj *listPtr, size_t fromIdx,
			    size_t toIdx);
MODULE_SCOPE Tcl_Obj *	TclLsetList(Tcl_Interp *interp, Tcl_Obj *listPtr,
			    Tcl_Obj *indexPtr, Tcl_Obj *valuePtr);
MODULE_SCOPE Tcl_Obj *	TclLsetFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
			    size_t indexCount, Tcl_Obj *const indexArray[],
			    Tcl_Obj *valuePtr);
MODULE_SCOPE Tcl_Command TclMakeEnsemble(Tcl_Interp *interp, const char *name,
			    const EnsembleImplMap map[]);
MODULE_SCOPE int TclMakeSafe(Tcl_Interp *interp);
MODULE_SCOPE int	TclMaxListLength(const char *bytes, size_t numBytes,
			    const char **endPtr);
MODULE_SCOPE int	TclMergeReturnOptions(Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[], Tcl_Obj **optionsPtrPtr,
			    int *codePtr, int *levelPtr);
MODULE_SCOPE Tcl_Obj *	TclNarrowToBytes(Tcl_Obj *objPtr);
MODULE_SCOPE Tcl_Obj *  TclNoErrorStack(Tcl_Interp *interp, Tcl_Obj *options);
MODULE_SCOPE int	TclNokia770Doubles(void);
MODULE_SCOPE void	TclNsDecrRefCount(Namespace *nsPtr);
MODULE_SCOPE int	TclNamespaceDeleted(Namespace *nsPtr);
MODULE_SCOPE void	TclObjVarErrMsg(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
			    Tcl_Obj *part2Ptr, const char *operation,
			    const char *reason, int index);
MODULE_SCOPE int	TclObjInvokeNamespace(Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[],
			    Tcl_Namespace *nsPtr, int flags);
MODULE_SCOPE int	TclObjUnsetVar2(Tcl_Interp *interp,
			    Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags);
MODULE_SCOPE int	TclParseBackslash(const char *src,
			    size_t numBytes, size_t *readPtr, char *dst);
MODULE_SCOPE int	TclParseHex(const char *src, size_t numBytes,
			    int *resultPtr);
MODULE_SCOPE int	TclParseNumber(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    const char *expected, const char *bytes,
			    size_t numBytes, const char **endPtrPtr, int flags);
MODULE_SCOPE void	TclParseInit(Tcl_Interp *interp, const char *string,
			    size_t numBytes, Tcl_Parse *parsePtr);
MODULE_SCOPE size_t	TclParseAllWhiteSpace(const char *src, size_t numBytes);
MODULE_SCOPE int	TclProcessReturn(Tcl_Interp *interp,
			    int code, int level, Tcl_Obj *returnOpts);

MODULE_SCOPE int	TclpObjLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
MODULE_SCOPE Tcl_Obj *	TclpTempFileName(void);
MODULE_SCOPE Tcl_Obj *  TclpTempFileNameForLibrary(Tcl_Interp *interp,
			    Tcl_Obj* pathPtr);



MODULE_SCOPE Tcl_Obj *	TclNewFSPathObj(Tcl_Obj *dirPtr, const char *addStrRep,
			    size_t len);
MODULE_SCOPE void	TclpAlertNotifier(void *clientData);
MODULE_SCOPE void *TclpNotifierData(void);
MODULE_SCOPE void	TclpServiceModeHook(int mode);
MODULE_SCOPE void	TclpSetTimer(const Tcl_Time *timePtr);
MODULE_SCOPE int	TclpWaitForEvent(const Tcl_Time *timePtr);
MODULE_SCOPE void	TclpCreateFileHandler(int fd, int mask,
			    Tcl_FileProc *proc, void *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(void *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,
			    TCL_HASH_TYPE *lengthPtr, Tcl_Encoding *encodingPtr);
MODULE_SCOPE void	TclpInitLock(void);
MODULE_SCOPE void *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);
MODULE_SCOPE int	TclpObjNormalizePath(Tcl_Interp *interp,
			    Tcl_Obj *pathPtr, int nextCheckpoint);
MODULE_SCOPE void	TclpNativeJoinPath(Tcl_Obj *prefix, const char *joining);
MODULE_SCOPE Tcl_Obj *	TclpNativeSplitPath(Tcl_Obj *pathPtr, size_t *lenPtr);
MODULE_SCOPE Tcl_PathType TclpGetNativePathType(Tcl_Obj *pathPtr,
			    size_t *driveNameLengthPtr, Tcl_Obj **driveNameRef);
MODULE_SCOPE int	TclCrossFilesystemCopy(Tcl_Interp *interp,
			    Tcl_Obj *source, Tcl_Obj *target);
MODULE_SCOPE int	TclpMatchInDirectory(Tcl_Interp *interp,
			    Tcl_Obj *resultPtr, Tcl_Obj *pathPtr,
			    const char *pattern, Tcl_GlobTypeData *types);
MODULE_SCOPE void	*TclpGetNativeCwd(void *clientData);
MODULE_SCOPE Tcl_FSDupInternalRepProc TclNativeDupInternalRep;







|












|
>

|

<

|

|
|



|




|




<













|
|



|

|
|


>




>
>
>

|














>
>
>
>
>






|
|














|

|







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
MODULE_SCOPE void	TclInitLimitSupport(Tcl_Interp *interp);
MODULE_SCOPE void	TclInitNamespaceSubsystem(void);
MODULE_SCOPE void	TclInitNotifier(void);
MODULE_SCOPE void	TclInitObjSubsystem(void);
MODULE_SCOPE int	TclInterpReady(Tcl_Interp *interp);
MODULE_SCOPE int	TclIsDigitProc(int byte);
MODULE_SCOPE int	TclIsBareword(int byte);
MODULE_SCOPE Tcl_Obj *	TclJoinPath(Tcl_Size elements, Tcl_Obj * const objv[],
			    int forceRelative);
MODULE_SCOPE int	MakeTildeRelativePath(Tcl_Interp *interp, const char *user,
			    const char *subPath, Tcl_DString *dsPtr);
MODULE_SCOPE Tcl_Obj *	TclGetHomeDirObj(Tcl_Interp *interp, const char *user);
MODULE_SCOPE Tcl_Obj *	TclResolveTildePath(Tcl_Interp *interp,
			    Tcl_Obj *pathObj);
MODULE_SCOPE Tcl_Obj *	TclResolveTildePathList(Tcl_Obj *pathsObj);
MODULE_SCOPE int	TclJoinThread(Tcl_ThreadId id, int *result);
MODULE_SCOPE void	TclLimitRemoveAllHandlers(Tcl_Interp *interp);
MODULE_SCOPE Tcl_Obj *	TclLindexList(Tcl_Interp *interp,
			    Tcl_Obj *listPtr, Tcl_Obj *argPtr);
MODULE_SCOPE Tcl_Obj *	TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
			    Tcl_Size indexCount, Tcl_Obj *const indexArray[]);
MODULE_SCOPE Tcl_Obj *	TclListObjGetElement(Tcl_Obj *listObj, Tcl_Size index);
/* TIP #280 */
MODULE_SCOPE void	TclListLines(Tcl_Obj *listObj, Tcl_Size line, int n,
			    int *lines, Tcl_Obj *const *elems);

MODULE_SCOPE int	TclListObjAppendElements(Tcl_Interp *interp,
			    Tcl_Obj *toObj, Tcl_Size elemCount,
			    Tcl_Obj *const elemObjv[]);
MODULE_SCOPE Tcl_Obj *	TclListObjRange(Tcl_Interp *interp, Tcl_Obj *listPtr,
			    Tcl_Size fromIdx, Tcl_Size toIdx);
MODULE_SCOPE Tcl_Obj *	TclLsetList(Tcl_Interp *interp, Tcl_Obj *listPtr,
			    Tcl_Obj *indexPtr, Tcl_Obj *valuePtr);
MODULE_SCOPE Tcl_Obj *	TclLsetFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
			    Tcl_Size indexCount, Tcl_Obj *const indexArray[],
			    Tcl_Obj *valuePtr);
MODULE_SCOPE Tcl_Command TclMakeEnsemble(Tcl_Interp *interp, const char *name,
			    const EnsembleImplMap map[]);
MODULE_SCOPE int TclMakeSafe(Tcl_Interp *interp);
MODULE_SCOPE Tcl_Size	TclMaxListLength(const char *bytes, Tcl_Size numBytes,
			    const char **endPtr);
MODULE_SCOPE int	TclMergeReturnOptions(Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[], Tcl_Obj **optionsPtrPtr,
			    int *codePtr, int *levelPtr);

MODULE_SCOPE Tcl_Obj *  TclNoErrorStack(Tcl_Interp *interp, Tcl_Obj *options);
MODULE_SCOPE int	TclNokia770Doubles(void);
MODULE_SCOPE void	TclNsDecrRefCount(Namespace *nsPtr);
MODULE_SCOPE int	TclNamespaceDeleted(Namespace *nsPtr);
MODULE_SCOPE void	TclObjVarErrMsg(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
			    Tcl_Obj *part2Ptr, const char *operation,
			    const char *reason, int index);
MODULE_SCOPE int	TclObjInvokeNamespace(Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[],
			    Tcl_Namespace *nsPtr, int flags);
MODULE_SCOPE int	TclObjUnsetVar2(Tcl_Interp *interp,
			    Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags);
MODULE_SCOPE int	TclParseBackslash(const char *src,
			    Tcl_Size numBytes, Tcl_Size *readPtr, char *dst);
MODULE_SCOPE int	TclParseHex(const char *src, Tcl_Size numBytes,
			    int *resultPtr);
MODULE_SCOPE int	TclParseNumber(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    const char *expected, const char *bytes,
			    Tcl_Size numBytes, const char **endPtrPtr, int flags);
MODULE_SCOPE void	TclParseInit(Tcl_Interp *interp, const char *string,
			    Tcl_Size numBytes, Tcl_Parse *parsePtr);
MODULE_SCOPE Tcl_Size	TclParseAllWhiteSpace(const char *src, Tcl_Size numBytes);
MODULE_SCOPE int	TclProcessReturn(Tcl_Interp *interp,
			    int code, int level, Tcl_Obj *returnOpts);
MODULE_SCOPE void 	TclUndoRefCount(Tcl_Obj *objPtr);
MODULE_SCOPE int	TclpObjLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
MODULE_SCOPE Tcl_Obj *	TclpTempFileName(void);
MODULE_SCOPE Tcl_Obj *  TclpTempFileNameForLibrary(Tcl_Interp *interp,
			    Tcl_Obj* pathPtr);
MODULE_SCOPE int	TclNewArithSeriesObj(Tcl_Interp *interp, Tcl_Obj **arithSeriesPtr,
                            int useDoubles, Tcl_Obj *startObj, Tcl_Obj *endObj,
                            Tcl_Obj *stepObj, Tcl_Obj *lenObj);
MODULE_SCOPE Tcl_Obj *	TclNewFSPathObj(Tcl_Obj *dirPtr, const char *addStrRep,
			    Tcl_Size len);
MODULE_SCOPE void	TclpAlertNotifier(void *clientData);
MODULE_SCOPE void *TclpNotifierData(void);
MODULE_SCOPE void	TclpServiceModeHook(int mode);
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, void *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(void *clientData);
MODULE_SCOPE void	TclpFinalizePipes(void);
MODULE_SCOPE void	TclpFinalizeSockets(void);
#ifdef _WIN32
MODULE_SCOPE void	TclInitSockets(void);
#else
#define TclInitSockets() /* do nothing */
#endif
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,
			    TCL_HASH_TYPE stackSize, int flags);
MODULE_SCOPE Tcl_Size	TclpFindVariable(const char *name, Tcl_Size *lengthPtr);
MODULE_SCOPE void	TclpInitLibraryPath(char **valuePtr,
			    TCL_HASH_TYPE *lengthPtr, Tcl_Encoding *encodingPtr);
MODULE_SCOPE void	TclpInitLock(void);
MODULE_SCOPE void *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);
MODULE_SCOPE int	TclpObjNormalizePath(Tcl_Interp *interp,
			    Tcl_Obj *pathPtr, int nextCheckpoint);
MODULE_SCOPE void	TclpNativeJoinPath(Tcl_Obj *prefix, const char *joining);
MODULE_SCOPE Tcl_Obj *	TclpNativeSplitPath(Tcl_Obj *pathPtr, Tcl_Size *lenPtr);
MODULE_SCOPE Tcl_PathType TclpGetNativePathType(Tcl_Obj *pathPtr,
			    Tcl_Size *driveNameLengthPtr, Tcl_Obj **driveNameRef);
MODULE_SCOPE int	TclCrossFilesystemCopy(Tcl_Interp *interp,
			    Tcl_Obj *source, Tcl_Obj *target);
MODULE_SCOPE int	TclpMatchInDirectory(Tcl_Interp *interp,
			    Tcl_Obj *resultPtr, Tcl_Obj *pathPtr,
			    const char *pattern, Tcl_GlobTypeData *types);
MODULE_SCOPE void	*TclpGetNativeCwd(void *clientData);
MODULE_SCOPE Tcl_FSDupInternalRepProc TclNativeDupInternalRep;
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
			    void *data);
MODULE_SCOPE TCL_NORETURN void TclpThreadExit(int status);
MODULE_SCOPE void	TclRememberCondition(Tcl_Condition *mutex);
MODULE_SCOPE void	TclRememberJoinableThread(Tcl_ThreadId id);
MODULE_SCOPE void	TclRememberMutex(Tcl_Mutex *mutex);
MODULE_SCOPE void	TclRemoveScriptLimitCallbacks(Tcl_Interp *interp);
MODULE_SCOPE int	TclReToGlob(Tcl_Interp *interp, const char *reStr,
			    size_t reStrLen, Tcl_DString *dsPtr, int *flagsPtr,
			    int *quantifiersFoundPtr);
MODULE_SCOPE TCL_HASH_TYPE TclScanElement(const char *string, size_t length,
			    char *flagPtr);
MODULE_SCOPE void	TclSetBgErrorHandler(Tcl_Interp *interp,
			    Tcl_Obj *cmdPrefix);
MODULE_SCOPE void	TclSetBignumInternalRep(Tcl_Obj *objPtr,
			    void *bignumValue);
MODULE_SCOPE int	TclSetBooleanFromAny(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
MODULE_SCOPE void	TclSetCmdNameObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    Command *cmdPtr);
MODULE_SCOPE void	TclSetDuplicateObj(Tcl_Obj *dupPtr, Tcl_Obj *objPtr);
MODULE_SCOPE void	TclSetProcessGlobalValue(ProcessGlobalValue *pgvPtr,
			    Tcl_Obj *newValue, Tcl_Encoding encoding);
MODULE_SCOPE void	TclSignalExitThread(Tcl_ThreadId id, int result);
MODULE_SCOPE void	TclSpellFix(Tcl_Interp *interp,
			    Tcl_Obj *const *objv, size_t objc, size_t subIdx,
			    Tcl_Obj *bad, Tcl_Obj *fix);
MODULE_SCOPE void *	TclStackRealloc(Tcl_Interp *interp, void *ptr,
			    size_t numBytes);
typedef int (*memCmpFn_t)(const void*, const void*, size_t);
MODULE_SCOPE int	TclStringCmp(Tcl_Obj *value1Ptr, Tcl_Obj *value2Ptr,
			    int checkEq, int nocase, size_t reqlength);
MODULE_SCOPE int	TclStringCmpOpts(Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[], int *nocase,
			    int *reqlength);
MODULE_SCOPE int	TclStringMatch(const char *str, size_t strLen,
			    const char *pattern, int ptnLen, int flags);
MODULE_SCOPE int	TclStringMatchObj(Tcl_Obj *stringObj,
			    Tcl_Obj *patternObj, int flags);
MODULE_SCOPE void	TclSubstCompile(Tcl_Interp *interp, const char *bytes,
			    size_t numBytes, int flags, size_t line,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclSubstOptions(Tcl_Interp *interp, size_t numOpts,
			    Tcl_Obj *const opts[], int *flagPtr);
MODULE_SCOPE void	TclSubstParse(Tcl_Interp *interp, const char *bytes,
			    size_t numBytes, int flags, Tcl_Parse *parsePtr,
			    Tcl_InterpState *statePtr);
MODULE_SCOPE int	TclSubstTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
			    size_t count, int *tokensLeftPtr, size_t line,
			    int *clNextOuter, const char *outerScript);
MODULE_SCOPE size_t	TclTrim(const char *bytes, size_t numBytes,
			    const char *trim, size_t numTrim, size_t *trimRight);
MODULE_SCOPE size_t	TclTrimLeft(const char *bytes, size_t numBytes,
			    const char *trim, size_t numTrim);
MODULE_SCOPE size_t	TclTrimRight(const char *bytes, size_t numBytes,
			    const char *trim, size_t numTrim);
MODULE_SCOPE const char*TclGetCommandTypeName(Tcl_Command command);
MODULE_SCOPE void	TclRegisterCommandTypeName(
			    Tcl_ObjCmdProc *implementationProc,
			    const char *nameStr);
MODULE_SCOPE int	TclUtfCmp(const char *cs, const char *ct);
MODULE_SCOPE int	TclUtfCasecmp(const char *cs, const char *ct);
MODULE_SCOPE size_t	TclUtfCount(int ch);
#if TCL_UTF_MAX > 3
#   define TclUtfToUCS4 Tcl_UtfToUniChar
#   define TclUniCharToUCS4(src, ptr) (*ptr = *(src),1)
#   define TclUCS4Prev(src, ptr) (((src) > (ptr)) ? ((src) - 1) : (src))
#else
    MODULE_SCOPE int	TclUtfToUCS4(const char *, int *);
    MODULE_SCOPE int	TclUniCharToUCS4(const Tcl_UniChar *, int *);







|

|














|


|


|


|
|




|

|


|


|

|
|
|
|
|
|






|







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
			    void *data);
MODULE_SCOPE TCL_NORETURN void TclpThreadExit(int status);
MODULE_SCOPE void	TclRememberCondition(Tcl_Condition *mutex);
MODULE_SCOPE void	TclRememberJoinableThread(Tcl_ThreadId id);
MODULE_SCOPE void	TclRememberMutex(Tcl_Mutex *mutex);
MODULE_SCOPE void	TclRemoveScriptLimitCallbacks(Tcl_Interp *interp);
MODULE_SCOPE int	TclReToGlob(Tcl_Interp *interp, const char *reStr,
			    Tcl_Size reStrLen, Tcl_DString *dsPtr, int *flagsPtr,
			    int *quantifiersFoundPtr);
MODULE_SCOPE Tcl_Size	TclScanElement(const char *string, Tcl_Size length,
			    char *flagPtr);
MODULE_SCOPE void	TclSetBgErrorHandler(Tcl_Interp *interp,
			    Tcl_Obj *cmdPrefix);
MODULE_SCOPE void	TclSetBignumInternalRep(Tcl_Obj *objPtr,
			    void *bignumValue);
MODULE_SCOPE int	TclSetBooleanFromAny(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
MODULE_SCOPE void	TclSetCmdNameObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    Command *cmdPtr);
MODULE_SCOPE void	TclSetDuplicateObj(Tcl_Obj *dupPtr, Tcl_Obj *objPtr);
MODULE_SCOPE void	TclSetProcessGlobalValue(ProcessGlobalValue *pgvPtr,
			    Tcl_Obj *newValue, Tcl_Encoding encoding);
MODULE_SCOPE void	TclSignalExitThread(Tcl_ThreadId id, int result);
MODULE_SCOPE void	TclSpellFix(Tcl_Interp *interp,
			    Tcl_Obj *const *objv, Tcl_Size objc, Tcl_Size subIdx,
			    Tcl_Obj *bad, Tcl_Obj *fix);
MODULE_SCOPE void *	TclStackRealloc(Tcl_Interp *interp, void *ptr,
			    TCL_HASH_TYPE numBytes);
typedef int (*memCmpFn_t)(const void*, const void*, size_t);
MODULE_SCOPE int	TclStringCmp(Tcl_Obj *value1Ptr, Tcl_Obj *value2Ptr,
			    int checkEq, int nocase, Tcl_Size reqlength);
MODULE_SCOPE int	TclStringCmpOpts(Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[], int *nocase,
			    Tcl_Size *reqlength);
MODULE_SCOPE int	TclStringMatch(const char *str, Tcl_Size strLen,
			    const char *pattern, int ptnLen, int flags);
MODULE_SCOPE int	TclStringMatchObj(Tcl_Obj *stringObj,
			    Tcl_Obj *patternObj, int flags);
MODULE_SCOPE void	TclSubstCompile(Tcl_Interp *interp, const char *bytes,
			    Tcl_Size numBytes, int flags, Tcl_Size line,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclSubstOptions(Tcl_Interp *interp, Tcl_Size numOpts,
			    Tcl_Obj *const opts[], int *flagPtr);
MODULE_SCOPE void	TclSubstParse(Tcl_Interp *interp, const char *bytes,
			    Tcl_Size numBytes, int flags, Tcl_Parse *parsePtr,
			    Tcl_InterpState *statePtr);
MODULE_SCOPE int	TclSubstTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
			    Tcl_Size count, int *tokensLeftPtr, Tcl_Size line,
			    int *clNextOuter, const char *outerScript);
MODULE_SCOPE Tcl_Size	TclTrim(const char *bytes, Tcl_Size numBytes,
			    const char *trim, Tcl_Size numTrim, Tcl_Size *trimRight);
MODULE_SCOPE Tcl_Size	TclTrimLeft(const char *bytes, Tcl_Size numBytes,
			    const char *trim, Tcl_Size numTrim);
MODULE_SCOPE Tcl_Size	TclTrimRight(const char *bytes, Tcl_Size numBytes,
			    const char *trim, Tcl_Size numTrim);
MODULE_SCOPE const char*TclGetCommandTypeName(Tcl_Command command);
MODULE_SCOPE void	TclRegisterCommandTypeName(
			    Tcl_ObjCmdProc *implementationProc,
			    const char *nameStr);
MODULE_SCOPE int	TclUtfCmp(const char *cs, const char *ct);
MODULE_SCOPE int	TclUtfCasecmp(const char *cs, const char *ct);
MODULE_SCOPE int	TclUtfCount(int ch);
#if TCL_UTF_MAX > 3
#   define TclUtfToUCS4 Tcl_UtfToUniChar
#   define TclUniCharToUCS4(src, ptr) (*ptr = *(src),1)
#   define TclUCS4Prev(src, ptr) (((src) > (ptr)) ? ((src) - 1) : (src))
#else
    MODULE_SCOPE int	TclUtfToUCS4(const char *, int *);
    MODULE_SCOPE int	TclUniCharToUCS4(const Tcl_UniChar *, int *);
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455

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,
			    const char *msg, size_t length);
/* Tip 430 */
MODULE_SCOPE int    TclZipfs_Init(Tcl_Interp *interp);


/*
 * Many parsing tasks need a common definition of whitespace.
 * Use this routine and macro to achieve that and place







|







3554
3555
3556
3557
3558
3559
3560
3561
3562
3563
3564
3565
3566
3567
3568

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,
			    const char *msg, Tcl_Size length);
/* Tip 430 */
MODULE_SCOPE int    TclZipfs_Init(Tcl_Interp *interp);


/*
 * Many parsing tasks need a common definition of whitespace.
 * Use this routine and macro to achieve that and place
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
3504
MODULE_SCOPE Tcl_ObjCmdProc TclDefaultBgErrorHandlerObjCmd;
MODULE_SCOPE Tcl_Command TclInitDictCmd(Tcl_Interp *interp);
MODULE_SCOPE int	TclDictWithFinish(Tcl_Interp *interp, Var *varPtr,
			    Var *arrayPtr, Tcl_Obj *part1Ptr,
			    Tcl_Obj *part2Ptr, int index, int pathc,
			    Tcl_Obj *const pathv[], Tcl_Obj *keysPtr);
MODULE_SCOPE Tcl_Obj *	TclDictWithInit(Tcl_Interp *interp, Tcl_Obj *dictPtr,
			    size_t pathc, Tcl_Obj *const pathv[]);
MODULE_SCOPE Tcl_ObjCmdProc Tcl_DisassembleObjCmd;

/* Assemble command function */
MODULE_SCOPE Tcl_ObjCmdProc Tcl_AssembleObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRAssembleObjCmd;
MODULE_SCOPE Tcl_Command TclInitEncodingCmd(Tcl_Interp *interp);
MODULE_SCOPE Tcl_ObjCmdProc Tcl_EofObjCmd;







|







3603
3604
3605
3606
3607
3608
3609
3610
3611
3612
3613
3614
3615
3616
3617
MODULE_SCOPE Tcl_ObjCmdProc TclDefaultBgErrorHandlerObjCmd;
MODULE_SCOPE Tcl_Command TclInitDictCmd(Tcl_Interp *interp);
MODULE_SCOPE int	TclDictWithFinish(Tcl_Interp *interp, Var *varPtr,
			    Var *arrayPtr, Tcl_Obj *part1Ptr,
			    Tcl_Obj *part2Ptr, int index, int pathc,
			    Tcl_Obj *const pathv[], Tcl_Obj *keysPtr);
MODULE_SCOPE Tcl_Obj *	TclDictWithInit(Tcl_Interp *interp, Tcl_Obj *dictPtr,
			    Tcl_Size pathc, Tcl_Obj *const pathv[]);
MODULE_SCOPE Tcl_ObjCmdProc Tcl_DisassembleObjCmd;

/* Assemble command function */
MODULE_SCOPE Tcl_ObjCmdProc Tcl_AssembleObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRAssembleObjCmd;
MODULE_SCOPE Tcl_Command TclInitEncodingCmd(Tcl_Interp *interp);
MODULE_SCOPE Tcl_ObjCmdProc Tcl_EofObjCmd;
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
4029
4030
4031
4032
4033
4034
4035
4036
			    struct CompileEnv *envPtr);

/*
 * Routines that provide the [string] ensemble functionality. Possible
 * candidates for public interface.
 */

MODULE_SCOPE Tcl_Obj *	TclStringCat(Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[], int flags);
MODULE_SCOPE Tcl_Obj *	TclStringFirst(Tcl_Obj *needle, Tcl_Obj *haystack,
			    size_t start);
MODULE_SCOPE Tcl_Obj *	TclStringLast(Tcl_Obj *needle, Tcl_Obj *haystack,
			    size_t last);
MODULE_SCOPE Tcl_Obj *	TclStringRepeat(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    size_t count, int flags);
MODULE_SCOPE Tcl_Obj *	TclStringReplace(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    size_t first, size_t count, Tcl_Obj *insertPtr,
			    int flags);
MODULE_SCOPE Tcl_Obj *	TclStringReverse(Tcl_Obj *objPtr, int flags);

/* Flag values for the [string] ensemble functions. */

#define TCL_STRING_MATCH_NOCASE TCL_MATCH_NOCASE /* (1<<0) in tcl.h */
#define TCL_STRING_IN_PLACE (1<<1)







|


|

|

|

|







4126
4127
4128
4129
4130
4131
4132
4133
4134
4135
4136
4137
4138
4139
4140
4141
4142
4143
4144
4145
4146
4147
4148
4149
			    struct CompileEnv *envPtr);

/*
 * Routines that provide the [string] ensemble functionality. Possible
 * candidates for public interface.
 */

MODULE_SCOPE Tcl_Obj *	TclStringCat(Tcl_Interp *interp, Tcl_Size objc,
			    Tcl_Obj *const objv[], int flags);
MODULE_SCOPE Tcl_Obj *	TclStringFirst(Tcl_Obj *needle, Tcl_Obj *haystack,
			    Tcl_Size start);
MODULE_SCOPE Tcl_Obj *	TclStringLast(Tcl_Obj *needle, Tcl_Obj *haystack,
			    Tcl_Size last);
MODULE_SCOPE Tcl_Obj *	TclStringRepeat(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    Tcl_Size count, int flags);
MODULE_SCOPE Tcl_Obj *	TclStringReplace(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    Tcl_Size first, Tcl_Size count, Tcl_Obj *insertPtr,
			    int flags);
MODULE_SCOPE Tcl_Obj *	TclStringReverse(Tcl_Obj *objPtr, int flags);

/* Flag values for the [string] ensemble functions. */

#define TCL_STRING_MATCH_NOCASE TCL_MATCH_NOCASE /* (1<<0) in tcl.h */
#define TCL_STRING_IN_PLACE (1<<1)
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

MODULE_SCOPE Tcl_Command TclInitProcessCmd(Tcl_Interp *interp);
MODULE_SCOPE void	TclProcessCreated(Tcl_Pid pid);
MODULE_SCOPE TclProcessWaitStatus TclProcessWait(Tcl_Pid pid, int options,
			    int *codePtr, Tcl_Obj **msgObjPtr,
			    Tcl_Obj **errorObjPtr);
MODULE_SCOPE int TclClose(Tcl_Interp *,	Tcl_Channel chan);

/*
 * TIP #508: [array default]
 */

MODULE_SCOPE void	TclInitArrayVar(Var *arrayPtr);
MODULE_SCOPE Tcl_Obj *	TclGetArrayDefault(Var *arrayPtr);

/*
 * Utility routines for encoding index values as integers. Used by both
 * some of the command compilers and by [lsort] and [lsearch].
 */

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








#endif /* TCL_MAJOR_VERSION > 8 */

/* Constants used in index value encoding routines. */
#define TCL_INDEX_END           ((Tcl_Size)-2)
#define TCL_INDEX_START         ((Tcl_Size)0)































/*
 *----------------------------------------------------------------------
 *
 * TclScaleTime --
 *
 *	TIP #233 (Virtualized Time): Wrapper around the time virutalisation







>













|
|
>
>
>
>
>
>
>
>





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







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

MODULE_SCOPE Tcl_Command TclInitProcessCmd(Tcl_Interp *interp);
MODULE_SCOPE void	TclProcessCreated(Tcl_Pid pid);
MODULE_SCOPE TclProcessWaitStatus TclProcessWait(Tcl_Pid pid, int options,
			    int *codePtr, Tcl_Obj **msgObjPtr,
			    Tcl_Obj **errorObjPtr);
MODULE_SCOPE int TclClose(Tcl_Interp *,	Tcl_Channel chan);

/*
 * TIP #508: [array default]
 */

MODULE_SCOPE void	TclInitArrayVar(Var *arrayPtr);
MODULE_SCOPE Tcl_Obj *	TclGetArrayDefault(Var *arrayPtr);

/*
 * Utility routines for encoding index values as integers. Used by both
 * some of the command compilers and by [lsort] and [lsearch].
 */

MODULE_SCOPE int	TclIndexEncode(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    int before, int after, int *indexPtr);
MODULE_SCOPE Tcl_Size	TclIndexDecode(int encoded, Tcl_Size endValue);
MODULE_SCOPE int	TclIndexInvalidError(Tcl_Interp *interp,
			    const char *idxType, Tcl_Size idx);

/*
 * Error message utility functions
 */
MODULE_SCOPE int TclCommandWordLimitError(Tcl_Interp *interp, Tcl_Size count);

#endif /* TCL_MAJOR_VERSION > 8 */

/* Constants used in index value encoding routines. */
#define TCL_INDEX_END           ((Tcl_Size)-2)
#define TCL_INDEX_START         ((Tcl_Size)0)

/*
 *------------------------------------------------------------------------
 *
 * TclGetSizeIntFromObj --
 *
 *    Extract a Tcl_Size from a Tcl_Obj
 *
 * Results:
 *    TCL_OK / TCL_ERROR
 *
 * Side effects:
 *    On success, the integer value is stored in *sizePtr. On error,
 *    an error message in interp it it is not NULL.
 *
 *------------------------------------------------------------------------
 */
static inline int TclGetSizeIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size *sizePtr) {
#if TCL_SIZE_MAX == INT_MAX
    return TclGetIntFromObj(interp, objPtr, sizePtr);
#else
    Tcl_WideInt wide;
    if (TclGetWideIntFromObj(interp, objPtr, &wide) != TCL_OK) {
	return TCL_ERROR;
    }
    *sizePtr = (Tcl_Size)wide;
    return TCL_OK;
#endif
}


/*
 *----------------------------------------------------------------------
 *
 * TclScaleTime --
 *
 *	TIP #233 (Virtualized Time): Wrapper around the time virutalisation
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

# define TclNewObj(objPtr) \
    TclDbNewObj(objPtr, __FILE__, __LINE__);

# define TclDecrRefCount(objPtr) \
    Tcl_DbDecrRefCount(objPtr, __FILE__, __LINE__)

# define TclNewListObjDirect(objc, objv) \
    TclDbNewListObjDirect(objc, objv, __FILE__, __LINE__)

#undef USE_THREAD_ALLOC
#endif /* TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to set a Tcl_Obj's string representation to a
 * copy of the "len" bytes starting at "bytePtr". The value of "len" must
 * not be negative.  When "len" is 0, then it is acceptable to pass
 * "bytePtr" = NULL.  When "len" > 0, "bytePtr" must not be NULL, and it
 * must point to a location from which "len" bytes may be read.  These
 * constraints are not checked here.  The validity of the bytes copied
 * as a value string representation is also not verififed.  This macro
 * must not be called while "objPtr" is being freed or when "objPtr"
 * already has a string representation.  The caller must use
 * this macro properly.  Improper use can lead to dangerous results.
 * Because "len" is referenced multiple times, take care that it is an
 * expression with the same value each use.
 *
 * The ANSI C "prototype" for this macro is:
 *

 * MODULE_SCOPE void TclInitStringRep(Tcl_Obj *objPtr, char *bytePtr, size_t len);

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





#define TclInitStringRep(objPtr, bytePtr, len) \
    if ((len) == 0) { \
	(objPtr)->bytes	 = &tclEmptyString; \
	(objPtr)->length = 0; \
    } else { \
	(objPtr)->bytes = (char *)Tcl_Alloc((len) + 1U); \
	memcpy((objPtr)->bytes, (bytePtr) ? (bytePtr) : &tclEmptyString, (len)); \
	(objPtr)->bytes[len] = '\0'; \
	(objPtr)->length = (len); \
    }











/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to get the string representation's byte array
 * pointer from a Tcl_Obj. This is an inline version of Tcl_GetString(). The
 * macro's expression result is the string rep's byte pointer which might be
 * NULL. The bytes referenced by this pointer must not be modified by the







<
<
<





|












|

>

>



>
>
>
>



|
<






>
>
>
>
>
>
>
>
>
>







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

# define TclNewObj(objPtr) \
    TclDbNewObj(objPtr, __FILE__, __LINE__);

# define TclDecrRefCount(objPtr) \
    Tcl_DbDecrRefCount(objPtr, __FILE__, __LINE__)




#undef USE_THREAD_ALLOC
#endif /* TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------
 * Macros used by the Tcl core to set a Tcl_Obj's string representation to a
 * copy of the "len" bytes starting at "bytePtr". The value of "len" must
 * not be negative.  When "len" is 0, then it is acceptable to pass
 * "bytePtr" = NULL.  When "len" > 0, "bytePtr" must not be NULL, and it
 * must point to a location from which "len" bytes may be read.  These
 * constraints are not checked here.  The validity of the bytes copied
 * as a value string representation is also not verififed.  This macro
 * must not be called while "objPtr" is being freed or when "objPtr"
 * already has a string representation.  The caller must use
 * this macro properly.  Improper use can lead to dangerous results.
 * Because "len" is referenced multiple times, take care that it is an
 * expression with the same value each use.
 *
 * The ANSI C "prototypes" for these macros are:
 *
 * MODULE_SCOPE void TclInitEmptyStringRep(Tcl_Obj *objPtr);
 * MODULE_SCOPE void TclInitStringRep(Tcl_Obj *objPtr, char *bytePtr, size_t len);
 * MODULE_SCOPE void TclAttemptInitStringRep(Tcl_Obj *objPtr, char *bytePtr, size_t len);
 *
 *----------------------------------------------------------------
 */

#define TclInitEmptyStringRep(objPtr) \
	((objPtr)->length = (((objPtr)->bytes = &tclEmptyString), 0))


#define TclInitStringRep(objPtr, bytePtr, len) \
    if ((len) == 0) { \
	TclInitEmptyStringRep(objPtr); \

    } else { \
	(objPtr)->bytes = (char *)Tcl_Alloc((len) + 1U); \
	memcpy((objPtr)->bytes, (bytePtr) ? (bytePtr) : &tclEmptyString, (len)); \
	(objPtr)->bytes[len] = '\0'; \
	(objPtr)->length = (len); \
    }

#define TclAttemptInitStringRep(objPtr, bytePtr, len) \
    ((((len) == 0) ? ( \
	TclInitEmptyStringRep(objPtr) \
    ) : ( \
	(objPtr)->bytes = (char *)Tcl_AttemptAlloc((len) + 1U), \
	(objPtr)->length = ((objPtr)->bytes) ? \
		(memcpy((objPtr)->bytes, (bytePtr) ? (bytePtr) : &tclEmptyString, (len)), \
		(objPtr)->bytes[len] = '\0', (len)) : (-1) \
    )), (objPtr)->bytes)

/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to get the string representation's byte array
 * pointer from a Tcl_Obj. This is an inline version of Tcl_GetString(). The
 * macro's expression result is the string rep's byte pointer which might be
 * NULL. The bytes referenced by this pointer must not be modified by the
4578
4579
4580
4581
4582
4583
4584

4585
4586
4587
4588
4589
4590
4591
4592
4593
4594
4595
4596
#endif

/* Token growth tuning, default to the general value. */
#ifndef TCL_MIN_TOKEN_GROWTH
#define TCL_MIN_TOKEN_GROWTH TCL_MIN_GROWTH/sizeof(Tcl_Token)
#endif


#define TclGrowTokenArray(tokenPtr, used, available, append, staticPtr)	\
    do {								\
	size_t _needed = (used) + (append);					\
	if (_needed > (available)) {					\
	    size_t allocated = 2 * _needed;					\
	    Tcl_Token *oldPtr = (tokenPtr);				\
	    Tcl_Token *newPtr;						\
	    if (oldPtr == (staticPtr)) {				\
		oldPtr = NULL;						\
	    }								\
	    newPtr = (Tcl_Token *)Tcl_AttemptRealloc((char *) oldPtr,	\
		    allocated * sizeof(Tcl_Token));	\







>


|

|







4742
4743
4744
4745
4746
4747
4748
4749
4750
4751
4752
4753
4754
4755
4756
4757
4758
4759
4760
4761
#endif

/* Token growth tuning, default to the general value. */
#ifndef TCL_MIN_TOKEN_GROWTH
#define TCL_MIN_TOKEN_GROWTH TCL_MIN_GROWTH/sizeof(Tcl_Token)
#endif

/* TODO - code below does not check for integer overflow */
#define TclGrowTokenArray(tokenPtr, used, available, append, staticPtr)	\
    do {								\
	Tcl_Size _needed = (used) + (append);				\
	if (_needed > (available)) {					\
	    Tcl_Size allocated = 2 * _needed;				\
	    Tcl_Token *oldPtr = (tokenPtr);				\
	    Tcl_Token *newPtr;						\
	    if (oldPtr == (staticPtr)) {				\
		oldPtr = NULL;						\
	    }								\
	    newPtr = (Tcl_Token *)Tcl_AttemptRealloc((char *) oldPtr,	\
		    allocated * sizeof(Tcl_Token));	\
4640
4641
4642
4643
4644
4645
4646
4647
4648

4649
4650
4651
4652
4653
4654
4655
4656
4657
4658
4659
4660
4661
4662
4663
/*
 *----------------------------------------------------------------
 * Macro counterpart of the Tcl_NumUtfChars() function. To be used in speed-
 * -sensitive points where it pays to avoid a function call in the common case
 * of counting along a string of all one-byte characters.  The ANSI C
 * "prototype" for this macro is:
 *
 * MODULE_SCOPE void	TclNumUtfCharsM(int numChars, const char *bytes,
 *				int numBytes);

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

#define TclNumUtfCharsM(numChars, bytes, numBytes) \
    do { \
	size_t _count, _i = (numBytes); \
	unsigned char *_str = (unsigned char *) (bytes); \
	while (_i && (*_str < 0xC0)) { _i--; _str++; } \
	_count = (numBytes) - _i; \
	if (_i) { \
	    _count += Tcl_NumUtfChars((bytes) + _count, _i); \
	} \
	(numChars) = _count; \
    } while (0);








|
|
>





|

|







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
/*
 *----------------------------------------------------------------
 * Macro counterpart of the Tcl_NumUtfChars() function. To be used in speed-
 * -sensitive points where it pays to avoid a function call in the common case
 * of counting along a string of all one-byte characters.  The ANSI C
 * "prototype" for this macro is:
 *
 * MODULE_SCOPE void	TclNumUtfCharsM(Tcl_Size numChars, const char *bytes,
 *				Tcl_Size numBytes);
 * numBytes must be >= 0
 *----------------------------------------------------------------
 */

#define TclNumUtfCharsM(numChars, bytes, numBytes) \
    do { \
	Tcl_Size _count = 0, _i = (numBytes); \
	unsigned char *_str = (unsigned char *) (bytes); \
	while (_i > 0 && (*_str < 0xC0)) { _i--; _str++; } \
	_count = (numBytes) - _i; \
	if (_i) { \
	    _count += Tcl_NumUtfChars((bytes) + _count, _i); \
	} \
	(numChars) = _count; \
    } while (0);

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
MODULE_SCOPE int	TclIsPureByteArray(Tcl_Obj *objPtr);
#define TclIsPureDict(objPtr) \
	(((objPtr)->bytes==NULL) && ((objPtr)->typePtr==&tclDictType))
#define TclHasInternalRep(objPtr, type) \
	((objPtr)->typePtr == (type))
#define TclFetchInternalRep(objPtr, type) \
	(TclHasInternalRep((objPtr), (type)) ? &((objPtr)->internalRep) : NULL)

static inline int
TclAbstractListHasProc(Tcl_Obj* abstractListObjPtr, Tcl_AbstractListProcType ptype)
{
    Tcl_AbstractListType *typePtr;
    if ( ! TclHasInternalRep(abstractListObjPtr,&tclAbstractListType)) {
	return 0;
    }
    typePtr = Tcl_AbstractListGetType(abstractListObjPtr);
    switch (ptype) {
    case TCL_ABSL_NEW:
	return (typePtr->newObjProc != NULL);
    case TCL_ABSL_DUPREP:
	return (typePtr->dupRepProc != NULL);
    case TCL_ABSL_LENGTH:
	return (typePtr->lengthProc != NULL);
    case TCL_ABSL_INDEX:
	return (typePtr->indexProc != NULL);
    case TCL_ABSL_SLICE:
	return (typePtr->sliceProc != NULL);
    case TCL_ABSL_REVERSE:
	return (typePtr->reverseProc != NULL);
    case TCL_ABSL_GETELEMENTS:
        return (typePtr->getElementsProc != NULL);
    case TCL_ABSL_FREEREP:
	return (typePtr->freeRepProc != NULL);
    case TCL_ABSL_TOSTRING:
	return (typePtr->toStringProc != NULL);
    case TCL_ABSL_SETELEMENT:
	return (typePtr->setElementProc != NULL);
    case TCL_ABSL_REPLACE:
	return (typePtr->replaceProc != NULL);
    }
    return 0;
}



/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to compare Unicode strings. On big-endian
 * systems we can use the more efficient memcmp, but this would not be
 * lexically correct on little-endian systems. The ANSI C "prototype" for







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







4845
4846
4847
4848
4849
4850
4851




































4852
4853
4854
4855
4856
4857
4858
MODULE_SCOPE int	TclIsPureByteArray(Tcl_Obj *objPtr);
#define TclIsPureDict(objPtr) \
	(((objPtr)->bytes==NULL) && ((objPtr)->typePtr==&tclDictType))
#define TclHasInternalRep(objPtr, type) \
	((objPtr)->typePtr == (type))
#define TclFetchInternalRep(objPtr, type) \
	(TclHasInternalRep((objPtr), (type)) ? &((objPtr)->internalRep) : NULL)






































/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to compare Unicode strings. On big-endian
 * systems we can use the more efficient memcmp, but this would not be
 * lexically correct on little-endian systems. The ANSI C "prototype" for
4776
4777
4778
4779
4780
4781
4782

4783
4784
4785
4786
4787
4788
4789

MODULE_SCOPE Tcl_LibraryInitProc TclplatformtestInit;
MODULE_SCOPE Tcl_LibraryInitProc TclObjTest_Init;
MODULE_SCOPE Tcl_LibraryInitProc TclThread_Init;
MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_Init;
MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init;


/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to check whether a pattern has any characters
 * special to [string match]. The ANSI C "prototype" for this macro is:
 *
 * MODULE_SCOPE int	TclMatchIsTrivial(const char *pattern);







>







4906
4907
4908
4909
4910
4911
4912
4913
4914
4915
4916
4917
4918
4919
4920

MODULE_SCOPE Tcl_LibraryInitProc TclplatformtestInit;
MODULE_SCOPE Tcl_LibraryInitProc TclObjTest_Init;
MODULE_SCOPE Tcl_LibraryInitProc TclThread_Init;
MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_Init;
MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init;


/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to check whether a pattern has any characters
 * special to [string match]. The ANSI C "prototype" for this macro is:
 *
 * MODULE_SCOPE int	TclMatchIsTrivial(const char *pattern);
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
 *----------------------------------------------------------------
 * Macros used by the Tcl core to create and initialise objects of standard
 * types, avoiding the corresponding function calls in time critical parts of
 * the core. The ANSI C "prototypes" for these macros are:
 *
 * MODULE_SCOPE void	TclNewIntObj(Tcl_Obj *objPtr, Tcl_WideInt w);
 * MODULE_SCOPE void	TclNewDoubleObj(Tcl_Obj *objPtr, double d);
 * MODULE_SCOPE void	TclNewStringObj(Tcl_Obj *objPtr, const char *s, size_t len);
 * MODULE_SCOPE void	TclNewLiteralStringObj(Tcl_Obj*objPtr, const char *sLiteral);
 *
 *----------------------------------------------------------------
 */

#ifndef TCL_MEM_DEBUG
#define TclNewIntObj(objPtr, w) \
    do {						\
	TclIncrObjsAllocated();				\
	TclAllocObjStorage(objPtr);			\
	(objPtr)->refCount = 0;				\
	(objPtr)->bytes = NULL;				\
	(objPtr)->internalRep.wideValue = (Tcl_WideInt)(w);	\
	(objPtr)->typePtr = &tclIntType;		\
	TCL_DTRACE_OBJ_CREATE(objPtr);			\
    } while (0)

#define TclNewIndexObj(objPtr, w) \
    do {						\
	size_t _w = (w);		\
	TclIncrObjsAllocated();				\
	TclAllocObjStorage(objPtr);			\
	(objPtr)->refCount = 0;				\
	(objPtr)->bytes = NULL;				\








	(objPtr)->internalRep.wideValue = ((size_t)(_w) == (size_t)TCL_INDEX_NONE) ? -1 : (Tcl_WideInt)(_w); \
	(objPtr)->typePtr = &tclIntType;		\

	TCL_DTRACE_OBJ_CREATE(objPtr);			\
    } while (0)




#define TclNewDoubleObj(objPtr, d) \
    do {							\
	TclIncrObjsAllocated();					\
	TclAllocObjStorage(objPtr);				\
	(objPtr)->refCount = 0;					\
	(objPtr)->bytes = NULL;					\







|

















|

<




>
>
>
>
>
>
>
>
|
|
>


>
>
>







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
 *----------------------------------------------------------------
 * Macros used by the Tcl core to create and initialise objects of standard
 * types, avoiding the corresponding function calls in time critical parts of
 * the core. The ANSI C "prototypes" for these macros are:
 *
 * MODULE_SCOPE void	TclNewIntObj(Tcl_Obj *objPtr, Tcl_WideInt w);
 * MODULE_SCOPE void	TclNewDoubleObj(Tcl_Obj *objPtr, double d);
 * MODULE_SCOPE void	TclNewStringObj(Tcl_Obj *objPtr, const char *s, Tcl_Size len);
 * MODULE_SCOPE void	TclNewLiteralStringObj(Tcl_Obj*objPtr, const char *sLiteral);
 *
 *----------------------------------------------------------------
 */

#ifndef TCL_MEM_DEBUG
#define TclNewIntObj(objPtr, w) \
    do {						\
	TclIncrObjsAllocated();				\
	TclAllocObjStorage(objPtr);			\
	(objPtr)->refCount = 0;				\
	(objPtr)->bytes = NULL;				\
	(objPtr)->internalRep.wideValue = (Tcl_WideInt)(w);	\
	(objPtr)->typePtr = &tclIntType;		\
	TCL_DTRACE_OBJ_CREATE(objPtr);			\
    } while (0)

#define TclNewUIntObj(objPtr, uw) \
    do {						\

	TclIncrObjsAllocated();				\
	TclAllocObjStorage(objPtr);			\
	(objPtr)->refCount = 0;				\
	(objPtr)->bytes = NULL;				\
	Tcl_WideUInt uw_ = (uw);		\
	if (uw_ > WIDE_MAX) {			\
	    mp_int bignumValue_;		\
	    if (mp_init_u64(&bignumValue_, uw_) != MP_OKAY) {	\
		Tcl_Panic("%s: memory overflow", "TclNewUIntObj");	\
	    }	\
	    TclSetBignumInternalRep((objPtr), &bignumValue_);	\
	} else {	\
	    (objPtr)->internalRep.wideValue = (Tcl_WideInt)(uw_);	\
	    (objPtr)->typePtr = &tclIntType;		\
	}	\
	TCL_DTRACE_OBJ_CREATE(objPtr);			\
    } while (0)

#define TclNewIndexObj(objPtr, w) \
    TclNewIntObj(objPtr, w)

#define TclNewDoubleObj(objPtr, d) \
    do {							\
	TclIncrObjsAllocated();					\
	TclAllocObjStorage(objPtr);				\
	(objPtr)->refCount = 0;					\
	(objPtr)->bytes = NULL;					\
4879
4880
4881
4882
4883
4884
4885
4886















4887
4888
4889
4890
4891
4892
4893
4894
4895
	(objPtr)->typePtr = NULL;				\
	TCL_DTRACE_OBJ_CREATE(objPtr);				\
    } while (0)

#else /* TCL_MEM_DEBUG */
#define TclNewIntObj(objPtr, w) \
    (objPtr) = Tcl_NewWideIntObj(w)
















#define TclNewIndexObj(objPtr, w) \
    (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 */








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

|







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
	(objPtr)->typePtr = NULL;				\
	TCL_DTRACE_OBJ_CREATE(objPtr);				\
    } while (0)

#else /* TCL_MEM_DEBUG */
#define TclNewIntObj(objPtr, w) \
    (objPtr) = Tcl_NewWideIntObj(w)

#define TclNewUIntObj(objPtr, uw) \
    do {						\
	Tcl_WideUInt uw_ = (uw);		\
	if (uw_ > WIDE_MAX) {			\
	    mp_int bignumValue_;		\
	    if (mp_init_u64(&bignumValue_, uw_) == MP_OKAY) {	\
		(objPtr) = Tcl_NewBignumObj(&bignumValue_);	\
	    } else {	\
		(objPtr) = NULL; \
	    } \
	} else {	\
	    (objPtr) = Tcl_NewWideIntObj(uw_);	\
	}	\
    } while (0)

#define TclNewIndexObj(objPtr, w) \
    TclNewIntObj(objPtr, w)

#define TclNewDoubleObj(objPtr, d) \
    (objPtr) = Tcl_NewDoubleObj(d)

#define TclNewStringObj(objPtr, s, len) \
    (objPtr) = Tcl_NewStringObj((s), (len))
#endif /* TCL_MEM_DEBUG */
5108
5109
5110
5111
5112
5113
5114
5115
5116
5117
5118
5119
5120
5121
5122

#if NRE_USE_SMALL_ALLOC
#define TCLNR_ALLOC(interp, ptr) \
    TclSmallAllocEx(interp, sizeof(NRE_callback), (ptr))
#define TCLNR_FREE(interp, ptr)  TclSmallFreeEx((interp), (ptr))
#else
#define TCLNR_ALLOC(interp, ptr) \
    (ptr = (Tcl_Alloc(sizeof(NRE_callback))))
#define TCLNR_FREE(interp, ptr)  Tcl_Free(ptr)
#endif

#if NRE_ENABLE_ASSERTS
#define NRE_ASSERT(expr) assert((expr))
#else
#define NRE_ASSERT(expr)







|







5265
5266
5267
5268
5269
5270
5271
5272
5273
5274
5275
5276
5277
5278
5279

#if NRE_USE_SMALL_ALLOC
#define TCLNR_ALLOC(interp, ptr) \
    TclSmallAllocEx(interp, sizeof(NRE_callback), (ptr))
#define TCLNR_FREE(interp, ptr)  TclSmallFreeEx((interp), (ptr))
#else
#define TCLNR_ALLOC(interp, ptr) \
    ((ptr) = Tcl_Alloc(sizeof(NRE_callback)))
#define TCLNR_FREE(interp, ptr)  Tcl_Free(ptr)
#endif

#if NRE_ENABLE_ASSERTS
#define NRE_ASSERT(expr) assert((expr))
#else
#define NRE_ASSERT(expr)
5156
5157
5158
5159
5160
5161
5162
5163
5164
5165
5166
5167
5168
5169
5170
 * 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:
 */







|







5313
5314
5315
5316
5317
5318
5319
5320
5321
5322
5323
5324
5325
5326
5327
 * 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.

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
				const char *name);
/* 131 */
EXTERN void		Tcl_SetNamespaceResolvers(
				Tcl_Namespace *namespacePtr,
				Tcl_ResolveCmdProc *cmdProc,
				Tcl_ResolveVarProc *varProc,
				Tcl_ResolveCompiledVarProc *compiledVarProc);
/* 132 */
EXTERN int		TclpHasSockets(Tcl_Interp *interp);
/* Slot 133 is reserved */
/* Slot 134 is reserved */
/* Slot 135 is reserved */
/* Slot 136 is reserved */
/* Slot 137 is reserved */
/* 138 */
EXTERN const char *	TclGetEnv(const char *name, Tcl_DString *valuePtr);
/* Slot 139 is reserved */
/* Slot 140 is reserved */
/* 141 */
EXTERN const char *	TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr);
/* 142 */
EXTERN int		TclSetByteCodeFromAny(Tcl_Interp *interp,
				Tcl_Obj *objPtr, CompileHookProc *hookProc,
				void *clientData);
/* 143 */
EXTERN Tcl_Size		TclAddLiteralObj(struct CompileEnv *envPtr,
				Tcl_Obj *objPtr, LiteralEntry **litPtrPtr);
/* 144 */
EXTERN void		TclHideLiteral(Tcl_Interp *interp,
				struct CompileEnv *envPtr, int index);
/* 145 */
EXTERN const struct AuxDataType * TclGetAuxDataType(const char *typeName);
/* 146 */







|
<
















|







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
				const char *name);
/* 131 */
EXTERN void		Tcl_SetNamespaceResolvers(
				Tcl_Namespace *namespacePtr,
				Tcl_ResolveCmdProc *cmdProc,
				Tcl_ResolveVarProc *varProc,
				Tcl_ResolveCompiledVarProc *compiledVarProc);
/* Slot 132 is reserved */

/* Slot 133 is reserved */
/* Slot 134 is reserved */
/* Slot 135 is reserved */
/* Slot 136 is reserved */
/* Slot 137 is reserved */
/* 138 */
EXTERN const char *	TclGetEnv(const char *name, Tcl_DString *valuePtr);
/* Slot 139 is reserved */
/* Slot 140 is reserved */
/* 141 */
EXTERN const char *	TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr);
/* 142 */
EXTERN int		TclSetByteCodeFromAny(Tcl_Interp *interp,
				Tcl_Obj *objPtr, CompileHookProc *hookProc,
				void *clientData);
/* 143 */
EXTERN int		TclAddLiteralObj(struct CompileEnv *envPtr,
				Tcl_Obj *objPtr, LiteralEntry **litPtrPtr);
/* 144 */
EXTERN void		TclHideLiteral(Tcl_Interp *interp,
				struct CompileEnv *envPtr, int index);
/* 145 */
EXTERN const struct AuxDataType * TclGetAuxDataType(const char *typeName);
/* 146 */
448
449
450
451
452
453
454
455

456
457
458
459
460
461
462
EXTERN void		TclpFindExecutable(const char *argv0);
/* 213 */
EXTERN Tcl_Obj *	TclGetObjNameOfExecutable(void);
/* 214 */
EXTERN void		TclSetObjNameOfExecutable(Tcl_Obj *name,
				Tcl_Encoding encoding);
/* 215 */
EXTERN void *		TclStackAlloc(Tcl_Interp *interp, Tcl_Size numBytes);

/* 216 */
EXTERN void		TclStackFree(Tcl_Interp *interp, void *freePtr);
/* 217 */
EXTERN int		TclPushStackFrame(Tcl_Interp *interp,
				Tcl_CallFrame **framePtrPtr,
				Tcl_Namespace *namespacePtr,
				int isProcCallFrame);







|
>







447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
EXTERN void		TclpFindExecutable(const char *argv0);
/* 213 */
EXTERN Tcl_Obj *	TclGetObjNameOfExecutable(void);
/* 214 */
EXTERN void		TclSetObjNameOfExecutable(Tcl_Obj *name,
				Tcl_Encoding encoding);
/* 215 */
EXTERN void *		TclStackAlloc(Tcl_Interp *interp,
				TCL_HASH_TYPE numBytes);
/* 216 */
EXTERN void		TclStackFree(Tcl_Interp *interp, void *freePtr);
/* 217 */
EXTERN int		TclPushStackFrame(Tcl_Interp *interp,
				Tcl_CallFrame **framePtrPtr,
				Tcl_Namespace *namespacePtr,
				int isProcCallFrame);
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
/* 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 */
EXTERN Tcl_Size		TclRegisterLiteral(void *envPtr, const char *bytes,
				Tcl_Size length, int flags);
/* 252 */
EXTERN Tcl_Obj *	TclPtrGetVar(Tcl_Interp *interp, Tcl_Var varPtr,
				Tcl_Var arrayPtr, Tcl_Obj *part1Ptr,
				Tcl_Obj *part2Ptr, int flags);
/* 253 */
EXTERN Tcl_Obj *	TclPtrSetVar(Tcl_Interp *interp, Tcl_Var varPtr,







|







541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
/* 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 */
EXTERN int		TclRegisterLiteral(void *envPtr, const char *bytes,
				Tcl_Size length, int flags);
/* 252 */
EXTERN Tcl_Obj *	TclPtrGetVar(Tcl_Interp *interp, Tcl_Var varPtr,
				Tcl_Var arrayPtr, Tcl_Obj *part1Ptr,
				Tcl_Obj *part2Ptr, int flags);
/* 253 */
EXTERN Tcl_Obj *	TclPtrSetVar(Tcl_Interp *interp, Tcl_Var varPtr,
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
				Tcl_LibraryInitProc *initProc,
				Tcl_LibraryInitProc *safeInitProc);
/* 258 */
EXTERN Tcl_Obj *	TclpCreateTemporaryDirectory(Tcl_Obj *dirObj,
				Tcl_Obj *basenameObj);
/* Slot 259 is reserved */
/* 260 */
EXTERN Tcl_Obj *	TclListTestObj(int length, int leadingSpace,
				int endSpace);
/* 261 */
EXTERN void		TclListObjValidate(Tcl_Interp *interp,
				Tcl_Obj *listObj);

typedef struct TclIntStubs {
    int magic;
    void *hooks;







|
|







575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
				Tcl_LibraryInitProc *initProc,
				Tcl_LibraryInitProc *safeInitProc);
/* 258 */
EXTERN Tcl_Obj *	TclpCreateTemporaryDirectory(Tcl_Obj *dirObj,
				Tcl_Obj *basenameObj);
/* Slot 259 is reserved */
/* 260 */
EXTERN Tcl_Obj *	TclListTestObj(size_t length, size_t leadingSpace,
				size_t endSpace);
/* 261 */
EXTERN void		TclListObjValidate(Tcl_Interp *interp,
				Tcl_Obj *listObj);

typedef struct TclIntStubs {
    int magic;
    void *hooks;
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
    void (*reserved125)(void);
    void (*tcl_GetVariableFullName) (Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr); /* 126 */
    void (*reserved127)(void);
    void (*tcl_PopCallFrame) (Tcl_Interp *interp); /* 128 */
    int (*tcl_PushCallFrame) (Tcl_Interp *interp, Tcl_CallFrame *framePtr, Tcl_Namespace *nsPtr, int isProcCallFrame); /* 129 */
    int (*tcl_RemoveInterpResolvers) (Tcl_Interp *interp, const char *name); /* 130 */
    void (*tcl_SetNamespaceResolvers) (Tcl_Namespace *namespacePtr, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 131 */
    int (*tclpHasSockets) (Tcl_Interp *interp); /* 132 */
    void (*reserved133)(void);
    void (*reserved134)(void);
    void (*reserved135)(void);
    void (*reserved136)(void);
    void (*reserved137)(void);
    const char * (*tclGetEnv) (const char *name, Tcl_DString *valuePtr); /* 138 */
    void (*reserved139)(void);
    void (*reserved140)(void);
    const char * (*tclpGetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 141 */
    int (*tclSetByteCodeFromAny) (Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, void *clientData); /* 142 */
    Tcl_Size (*tclAddLiteralObj) (struct CompileEnv *envPtr, Tcl_Obj *objPtr, LiteralEntry **litPtrPtr); /* 143 */
    void (*tclHideLiteral) (Tcl_Interp *interp, struct CompileEnv *envPtr, int index); /* 144 */
    const struct AuxDataType * (*tclGetAuxDataType) (const char *typeName); /* 145 */
    TclHandle (*tclHandleCreate) (void *ptr); /* 146 */
    void (*tclHandleFree) (TclHandle handle); /* 147 */
    TclHandle (*tclHandlePreserve) (TclHandle handle); /* 148 */
    void (*tclHandleRelease) (TclHandle handle); /* 149 */
    int (*tclRegAbout) (Tcl_Interp *interp, Tcl_RegExp re); /* 150 */







|










|







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
    void (*reserved125)(void);
    void (*tcl_GetVariableFullName) (Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr); /* 126 */
    void (*reserved127)(void);
    void (*tcl_PopCallFrame) (Tcl_Interp *interp); /* 128 */
    int (*tcl_PushCallFrame) (Tcl_Interp *interp, Tcl_CallFrame *framePtr, Tcl_Namespace *nsPtr, int isProcCallFrame); /* 129 */
    int (*tcl_RemoveInterpResolvers) (Tcl_Interp *interp, const char *name); /* 130 */
    void (*tcl_SetNamespaceResolvers) (Tcl_Namespace *namespacePtr, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 131 */
    void (*reserved132)(void);
    void (*reserved133)(void);
    void (*reserved134)(void);
    void (*reserved135)(void);
    void (*reserved136)(void);
    void (*reserved137)(void);
    const char * (*tclGetEnv) (const char *name, Tcl_DString *valuePtr); /* 138 */
    void (*reserved139)(void);
    void (*reserved140)(void);
    const char * (*tclpGetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 141 */
    int (*tclSetByteCodeFromAny) (Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, void *clientData); /* 142 */
    int (*tclAddLiteralObj) (struct CompileEnv *envPtr, Tcl_Obj *objPtr, LiteralEntry **litPtrPtr); /* 143 */
    void (*tclHideLiteral) (Tcl_Interp *interp, struct CompileEnv *envPtr, int index); /* 144 */
    const struct AuxDataType * (*tclGetAuxDataType) (const char *typeName); /* 145 */
    TclHandle (*tclHandleCreate) (void *ptr); /* 146 */
    void (*tclHandleFree) (TclHandle handle); /* 147 */
    TclHandle (*tclHandlePreserve) (TclHandle handle); /* 148 */
    void (*tclHandleRelease) (TclHandle handle); /* 149 */
    int (*tclRegAbout) (Tcl_Interp *interp, Tcl_RegExp re); /* 150 */
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
    Tcl_Channel (*tclpOpenFileChannel) (Tcl_Interp *interp, Tcl_Obj *pathPtr, int mode, int permissions); /* 208 */
    void (*reserved209)(void);
    void (*reserved210)(void);
    void (*reserved211)(void);
    void (*tclpFindExecutable) (const char *argv0); /* 212 */
    Tcl_Obj * (*tclGetObjNameOfExecutable) (void); /* 213 */
    void (*tclSetObjNameOfExecutable) (Tcl_Obj *name, Tcl_Encoding encoding); /* 214 */
    void * (*tclStackAlloc) (Tcl_Interp *interp, Tcl_Size numBytes); /* 215 */
    void (*tclStackFree) (Tcl_Interp *interp, void *freePtr); /* 216 */
    int (*tclPushStackFrame) (Tcl_Interp *interp, Tcl_CallFrame **framePtrPtr, Tcl_Namespace *namespacePtr, int isProcCallFrame); /* 217 */
    void (*tclPopStackFrame) (Tcl_Interp *interp); /* 218 */
    void (*reserved219)(void);
    void (*reserved220)(void);
    void (*reserved221)(void);
    void (*reserved222)(void);







|







800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
    Tcl_Channel (*tclpOpenFileChannel) (Tcl_Interp *interp, Tcl_Obj *pathPtr, int mode, int permissions); /* 208 */
    void (*reserved209)(void);
    void (*reserved210)(void);
    void (*reserved211)(void);
    void (*tclpFindExecutable) (const char *argv0); /* 212 */
    Tcl_Obj * (*tclGetObjNameOfExecutable) (void); /* 213 */
    void (*tclSetObjNameOfExecutable) (Tcl_Obj *name, Tcl_Encoding encoding); /* 214 */
    void * (*tclStackAlloc) (Tcl_Interp *interp, TCL_HASH_TYPE numBytes); /* 215 */
    void (*tclStackFree) (Tcl_Interp *interp, void *freePtr); /* 216 */
    int (*tclPushStackFrame) (Tcl_Interp *interp, Tcl_CallFrame **framePtrPtr, Tcl_Namespace *namespacePtr, int isProcCallFrame); /* 217 */
    void (*tclPopStackFrame) (Tcl_Interp *interp); /* 218 */
    void (*reserved219)(void);
    void (*reserved220)(void);
    void (*reserved221)(void);
    void (*reserved222)(void);
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
    Tcl_HashTable * (*tclGetNamespaceChildTable) (Tcl_Namespace *nsPtr); /* 244 */
    Tcl_HashTable * (*tclGetNamespaceCommandTable) (Tcl_Namespace *nsPtr); /* 245 */
    int (*tclInitRewriteEnsemble) (Tcl_Interp *interp, Tcl_Size numRemoved, Tcl_Size numInserted, Tcl_Obj *const *objv); /* 246 */
    void (*tclResetRewriteEnsemble) (Tcl_Interp *interp, int isRootEnsemble); /* 247 */
    int (*tclCopyChannel) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, long long toRead, Tcl_Obj *cmdPtr); /* 248 */
    char * (*tclDoubleDigits) (double dv, int ndigits, int flags, int *decpt, int *signum, char **endPtr); /* 249 */
    void (*tclSetChildCancelFlags) (Tcl_Interp *interp, int flags, int force); /* 250 */
    Tcl_Size (*tclRegisterLiteral) (void *envPtr, const char *bytes, Tcl_Size length, int flags); /* 251 */
    Tcl_Obj * (*tclPtrGetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); /* 252 */
    Tcl_Obj * (*tclPtrSetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags); /* 253 */
    Tcl_Obj * (*tclPtrIncrObjVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, 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, int flags); /* 256 */
    void (*tclStaticLibrary) (Tcl_Interp *interp, const char *prefix, Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc); /* 257 */
    Tcl_Obj * (*tclpCreateTemporaryDirectory) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj); /* 258 */
    void (*reserved259)(void);
    Tcl_Obj * (*tclListTestObj) (int length, int leadingSpace, int endSpace); /* 260 */
    void (*tclListObjValidate) (Tcl_Interp *interp, Tcl_Obj *listObj); /* 261 */
} TclIntStubs;

extern const TclIntStubs *tclIntStubsPtr;

#ifdef __cplusplus
}







|








|







836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
    Tcl_HashTable * (*tclGetNamespaceChildTable) (Tcl_Namespace *nsPtr); /* 244 */
    Tcl_HashTable * (*tclGetNamespaceCommandTable) (Tcl_Namespace *nsPtr); /* 245 */
    int (*tclInitRewriteEnsemble) (Tcl_Interp *interp, Tcl_Size numRemoved, Tcl_Size numInserted, Tcl_Obj *const *objv); /* 246 */
    void (*tclResetRewriteEnsemble) (Tcl_Interp *interp, int isRootEnsemble); /* 247 */
    int (*tclCopyChannel) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, long long toRead, Tcl_Obj *cmdPtr); /* 248 */
    char * (*tclDoubleDigits) (double dv, int ndigits, int flags, int *decpt, int *signum, char **endPtr); /* 249 */
    void (*tclSetChildCancelFlags) (Tcl_Interp *interp, int flags, int force); /* 250 */
    int (*tclRegisterLiteral) (void *envPtr, const char *bytes, Tcl_Size length, int flags); /* 251 */
    Tcl_Obj * (*tclPtrGetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); /* 252 */
    Tcl_Obj * (*tclPtrSetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags); /* 253 */
    Tcl_Obj * (*tclPtrIncrObjVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, 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, int flags); /* 256 */
    void (*tclStaticLibrary) (Tcl_Interp *interp, const char *prefix, Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc); /* 257 */
    Tcl_Obj * (*tclpCreateTemporaryDirectory) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj); /* 258 */
    void (*reserved259)(void);
    Tcl_Obj * (*tclListTestObj) (size_t length, size_t leadingSpace, size_t endSpace); /* 260 */
    void (*tclListObjValidate) (Tcl_Interp *interp, Tcl_Obj *listObj); /* 261 */
} TclIntStubs;

extern const TclIntStubs *tclIntStubsPtr;

#ifdef __cplusplus
}
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
	(tclIntStubsPtr->tcl_PopCallFrame) /* 128 */
#define Tcl_PushCallFrame \
	(tclIntStubsPtr->tcl_PushCallFrame) /* 129 */
#define Tcl_RemoveInterpResolvers \
	(tclIntStubsPtr->tcl_RemoveInterpResolvers) /* 130 */
#define Tcl_SetNamespaceResolvers \
	(tclIntStubsPtr->tcl_SetNamespaceResolvers) /* 131 */
#define TclpHasSockets \
	(tclIntStubsPtr->tclpHasSockets) /* 132 */
/* Slot 133 is reserved */
/* Slot 134 is reserved */
/* Slot 135 is reserved */
/* Slot 136 is reserved */
/* Slot 137 is reserved */
#define TclGetEnv \
	(tclIntStubsPtr->tclGetEnv) /* 138 */







<
|







1054
1055
1056
1057
1058
1059
1060

1061
1062
1063
1064
1065
1066
1067
1068
	(tclIntStubsPtr->tcl_PopCallFrame) /* 128 */
#define Tcl_PushCallFrame \
	(tclIntStubsPtr->tcl_PushCallFrame) /* 129 */
#define Tcl_RemoveInterpResolvers \
	(tclIntStubsPtr->tcl_RemoveInterpResolvers) /* 130 */
#define Tcl_SetNamespaceResolvers \
	(tclIntStubsPtr->tcl_SetNamespaceResolvers) /* 131 */

/* Slot 132 is reserved */
/* Slot 133 is reserved */
/* Slot 134 is reserved */
/* Slot 135 is reserved */
/* Slot 136 is reserved */
/* Slot 137 is reserved */
#define TclGetEnv \
	(tclIntStubsPtr->tclGetEnv) /* 138 */

Changes to generic/tclIntPlatDecls.h.

136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
/* 7 */
EXTERN int		TclWinSetSockOpt(SOCKET s, int level, int optname,
				const char *optval, int optlen);
/* 8 */
EXTERN int		TclpGetPid(Tcl_Pid pid);
/* 9 */
EXTERN int		TclWinGetPlatformId(void);
/* 10 */
EXTERN Tcl_DirEntry *	TclpReaddir(TclDIR *dir);
/* 11 */
EXTERN void		TclGetAndDetachPids(Tcl_Interp *interp,
				Tcl_Channel chan);
/* 12 */
EXTERN int		TclpCloseFile(TclFile file);
/* 13 */
EXTERN Tcl_Channel	TclpCreateCommandChannel(TclFile readFile,







<
<







136
137
138
139
140
141
142


143
144
145
146
147
148
149
/* 7 */
EXTERN int		TclWinSetSockOpt(SOCKET s, int level, int optname,
				const char *optval, int optlen);
/* 8 */
EXTERN int		TclpGetPid(Tcl_Pid pid);
/* 9 */
EXTERN int		TclWinGetPlatformId(void);


/* 11 */
EXTERN void		TclGetAndDetachPids(Tcl_Interp *interp,
				Tcl_Channel chan);
/* 12 */
EXTERN int		TclpCloseFile(TclFile file);
/* 13 */
EXTERN Tcl_Channel	TclpCreateCommandChannel(TclFile readFile,
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
    int (*tclWinGetSockOpt) (SOCKET s, int level, int optname, char *optval, int *optlen); /* 3 */
    HINSTANCE (*tclWinGetTclInstance) (void); /* 4 */
    int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 5 */
    unsigned short (*tclWinNToHS) (unsigned short ns); /* 6 */
    int (*tclWinSetSockOpt) (SOCKET s, int level, int optname, const char *optval, int optlen); /* 7 */
    int (*tclpGetPid) (Tcl_Pid pid); /* 8 */
    int (*tclWinGetPlatformId) (void); /* 9 */
    Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */
    void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */
    int (*tclpCloseFile) (TclFile file); /* 12 */
    Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 13 */
    int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 14 */
    int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 15 */
    int (*tclpIsAtty) (int fd); /* 16 */
    int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 17 */







|







310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
    int (*tclWinGetSockOpt) (SOCKET s, int level, int optname, char *optval, int *optlen); /* 3 */
    HINSTANCE (*tclWinGetTclInstance) (void); /* 4 */
    int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 5 */
    unsigned short (*tclWinNToHS) (unsigned short ns); /* 6 */
    int (*tclWinSetSockOpt) (SOCKET s, int level, int optname, const char *optval, int optlen); /* 7 */
    int (*tclpGetPid) (Tcl_Pid pid); /* 8 */
    int (*tclWinGetPlatformId) (void); /* 9 */
    void *(*tclpReaddir) (void *dir); /* 10 */
    void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */
    int (*tclpCloseFile) (TclFile file); /* 12 */
    Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 13 */
    int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 14 */
    int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 15 */
    int (*tclpIsAtty) (int fd); /* 16 */
    int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 17 */
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
	(tclIntPlatStubsPtr->tclWinNToHS) /* 6 */
#define TclWinSetSockOpt \
	(tclIntPlatStubsPtr->tclWinSetSockOpt) /* 7 */
#define TclpGetPid \
	(tclIntPlatStubsPtr->tclpGetPid) /* 8 */
#define TclWinGetPlatformId \
	(tclIntPlatStubsPtr->tclWinGetPlatformId) /* 9 */
#define TclpReaddir \
	(tclIntPlatStubsPtr->tclpReaddir) /* 10 */
#define TclGetAndDetachPids \
	(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 11 */
#define TclpCloseFile \
	(tclIntPlatStubsPtr->tclpCloseFile) /* 12 */
#define TclpCreateCommandChannel \
	(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 13 */
#define TclpCreatePipe \







<
<







456
457
458
459
460
461
462


463
464
465
466
467
468
469
	(tclIntPlatStubsPtr->tclWinNToHS) /* 6 */
#define TclWinSetSockOpt \
	(tclIntPlatStubsPtr->tclWinSetSockOpt) /* 7 */
#define TclpGetPid \
	(tclIntPlatStubsPtr->tclpGetPid) /* 8 */
#define TclWinGetPlatformId \
	(tclIntPlatStubsPtr->tclWinGetPlatformId) /* 9 */


#define TclGetAndDetachPids \
	(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 11 */
#define TclpCloseFile \
	(tclIntPlatStubsPtr->tclpCloseFile) /* 12 */
#define TclpCreateCommandChannel \
	(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 13 */
#define TclpCreatePipe \

Changes to generic/tclInterp.c.

56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
				 * interpreter. Additional arguments specified
				 * when calling the alias in the child interp
				 * will be appended to the prefix before the
				 * command is invoked. */
    Tcl_Obj *objPtr;		/* The first actual prefix object - the target
				 * command name; this has to be at the end of
				 * the structure, which will be extended to
				 * accomodate the remaining objects in the
				 * prefix. */
} Alias;

/*
 *
 * Child:
 *







|







56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
				 * interpreter. Additional arguments specified
				 * when calling the alias in the child interp
				 * will be appended to the prefix before the
				 * command is invoked. */
    Tcl_Obj *objPtr;		/* The first actual prefix object - the target
				 * command name; this has to be at the end of
				 * the structure, which will be extended to
				 * accommodate the remaining objects in the
				 * prefix. */
} Alias;

/*
 *
 * Child:
 *
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
 * TIP#143 limit handler internal representation.
 */

struct LimitHandler {
    int flags;			/* The state of this particular handler. */
    Tcl_LimitHandlerProc *handlerProc;
				/* The handler callback. */
    ClientData clientData;	/* Opaque argument to the handler callback. */
    Tcl_LimitHandlerDeleteProc *deleteProc;
				/* How to delete the clientData. */
    LimitHandler *prevPtr;	/* Previous item in linked list of
				 * handlers. */
    LimitHandler *nextPtr;	/* Next item in linked list of handlers. */
};

/*
 * Values for the LimitHandler flags field.
 *      LIMIT_HANDLER_ACTIVE - Whether the handler is currently being
 *              processed; handlers are never to be entered reentrantly.
 *      LIMIT_HANDLER_DELETED - Whether the handler has been deleted. This
 *              should not normally be observed because when a handler is
 *              deleted it is also spliced out of the list of handlers, but
 *              even so we will be careful.
 */

#define LIMIT_HANDLER_ACTIVE    0x01







|










|







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
 * TIP#143 limit handler internal representation.
 */

struct LimitHandler {
    int flags;			/* The state of this particular handler. */
    Tcl_LimitHandlerProc *handlerProc;
				/* The handler callback. */
    void *clientData;	/* Opaque argument to the handler callback. */
    Tcl_LimitHandlerDeleteProc *deleteProc;
				/* How to delete the clientData. */
    LimitHandler *prevPtr;	/* Previous item in linked list of
				 * handlers. */
    LimitHandler *nextPtr;	/* Next item in linked list of handlers. */
};

/*
 * Values for the LimitHandler flags field.
 *      LIMIT_HANDLER_ACTIVE - Whether the handler is currently being
 *              processed; handlers are never to be reentered.
 *      LIMIT_HANDLER_DELETED - Whether the handler has been deleted. This
 *              should not normally be observed because when a handler is
 *              deleted it is also spliced out of the list of handlers, but
 *              even so we will be careful.
 */

#define LIMIT_HANDLER_ACTIVE    0x01
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
static int		ChildTimeLimitCmd(Tcl_Interp *interp,
			    Tcl_Interp *childInterp, int consumedObjc,
			    int objc, Tcl_Obj *const objv[]);
static void		InheritLimitsFromParent(Tcl_Interp *childInterp,
			    Tcl_Interp *parentInterp);
static void		SetScriptLimitCallback(Tcl_Interp *interp, int type,
			    Tcl_Interp *targetInterp, Tcl_Obj *scriptObj);
static void		CallScriptLimitCallback(ClientData clientData,
			    Tcl_Interp *interp);
static void		DeleteScriptLimitCallback(ClientData clientData);
static void		RunLimitHandlers(LimitHandler *handlerPtr,
			    Tcl_Interp *interp);
static void		TimeLimitCallback(ClientData clientData);

/* NRE enabling */
static Tcl_NRPostProc	NRPostInvokeHidden;
static Tcl_ObjCmdProc	NRInterpCmd;
static Tcl_ObjCmdProc	NRChildCmd;









|

|


|







261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
static int		ChildTimeLimitCmd(Tcl_Interp *interp,
			    Tcl_Interp *childInterp, int consumedObjc,
			    int objc, Tcl_Obj *const objv[]);
static void		InheritLimitsFromParent(Tcl_Interp *childInterp,
			    Tcl_Interp *parentInterp);
static void		SetScriptLimitCallback(Tcl_Interp *interp, int type,
			    Tcl_Interp *targetInterp, Tcl_Obj *scriptObj);
static void		CallScriptLimitCallback(void *clientData,
			    Tcl_Interp *interp);
static void		DeleteScriptLimitCallback(void *clientData);
static void		RunLimitHandlers(LimitHandler *handlerPtr,
			    Tcl_Interp *interp);
static void		TimeLimitCallback(void *clientData);

/* NRE enabling */
static Tcl_NRPostProc	NRPostInvokeHidden;
static Tcl_ObjCmdProc	NRInterpCmd;
static Tcl_ObjCmdProc	NRChildCmd;


328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
    char name[4];
} PkgName;

int
Tcl_Init(
    Tcl_Interp *interp)		/* Interpreter to initialize. */
{
    PkgName pkgName = {NULL, "Tcl"};
    PkgName **names = (PkgName **)TclInitPkgFiles(interp);
    int result = TCL_ERROR;

    pkgName.nextPtr = *names;
    *names = &pkgName;
    if (tclPreInitScript != NULL) {
	if (Tcl_EvalEx(interp, tclPreInitScript, -1, 0) == TCL_ERROR) {
	    goto end;
	}
    }

    /*
     * In order to find init.tcl during initialization, the following script
     * is invoked by Tcl_Init(). It looks in several different directories:







|






|







328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
    char name[4];
} PkgName;

int
Tcl_Init(
    Tcl_Interp *interp)		/* Interpreter to initialize. */
{
    PkgName pkgName = {NULL, "tcl"};
    PkgName **names = (PkgName **)TclInitPkgFiles(interp);
    int result = TCL_ERROR;

    pkgName.nextPtr = *names;
    *names = &pkgName;
    if (tclPreInitScript != NULL) {
	if (Tcl_EvalEx(interp, tclPreInitScript, TCL_INDEX_NONE, 0) == TCL_ERROR) {
	    goto end;
	}
    }

    /*
     * In order to find init.tcl during initialization, the following script
     * is invoked by Tcl_Init(). It looks in several different directories:
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
"    set msg \"Can't find a usable init.tcl in the following directories: \n\"\n"
"    append msg \"    $dirs\n\n\"\n"
"    append msg \"$errors\n\n\"\n"
"    append msg \"This probably means that Tcl wasn't installed properly.\n\"\n"
"    error $msg\n"
"  }\n"
"}\n"
"tclInit", -1, 0);

end:
    *names = (*names)->nextPtr;
    return result;
}

/*







|







445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
"    set msg \"Can't find a usable init.tcl in the following directories: \n\"\n"
"    append msg \"    $dirs\n\n\"\n"
"    append msg \"$errors\n\n\"\n"
"    append msg \"This probably means that Tcl wasn't installed properly.\n\"\n"
"    error $msg\n"
"  }\n"
"}\n"
"tclInit", TCL_INDEX_NONE, 0);

end:
    *names = (*names)->nextPtr;
    return result;
}

/*
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_InterpObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,			/* Current interpreter. */
    int objc,				/* Number of arguments. */
    Tcl_Obj *const objv[])		/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, NRInterpCmd, clientData, objc, objv);
}








|







597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_InterpObjCmd(
    void *clientData,
    Tcl_Interp *interp,			/* Current interpreter. */
    int objc,				/* Number of arguments. */
    Tcl_Obj *const objv[])		/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, NRInterpCmd, clientData, objc, objv);
}

828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
	     * for the interpreter does not collide with an existing command
	     * in the parent interpreter.
	     */

	    for (i = 0; ; i++) {
		Tcl_CmdInfo cmdInfo;

		sprintf(buf, "interp%d", i);
		if (Tcl_GetCommandInfo(interp, buf, &cmdInfo) == 0) {
		    break;
		}
	    }
	    childPtr = Tcl_NewStringObj(buf, -1);
	}
	if (ChildCreate(interp, childPtr, safe) == NULL) {







|







828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
	     * for the interpreter does not collide with an existing command
	     * in the parent interpreter.
	     */

	    for (i = 0; ; i++) {
		Tcl_CmdInfo cmdInfo;

		snprintf(buf, sizeof(buf), "interp%d", i);
		if (Tcl_GetCommandInfo(interp, buf, &cmdInfo) == 0) {
		    break;
		}
	    }
	    childPtr = Tcl_NewStringObj(buf, -1);
	}
	if (ChildCreate(interp, childPtr, safe) == NULL) {
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212

int
Tcl_CreateAlias(
    Tcl_Interp *childInterp,	/* Interpreter for source command. */
    const char *childCmd,	/* Command to install in child. */
    Tcl_Interp *targetInterp,	/* Interpreter for target command. */
    const char *targetCmd,	/* Name of target command. */
    size_t argc,			/* How many additional arguments? */
    const char *const *argv)	/* These are the additional args. */
{
    Tcl_Obj *childObjPtr, *targetObjPtr;
    Tcl_Obj **objv;
    size_t i;
    int result;

    objv = (Tcl_Obj **)TclStackAlloc(childInterp, sizeof(Tcl_Obj *) * argc);
    for (i = 0; i < argc; i++) {
	objv[i] = Tcl_NewStringObj(argv[i], -1);
	Tcl_IncrRefCount(objv[i]);
    }







|




|







1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212

int
Tcl_CreateAlias(
    Tcl_Interp *childInterp,	/* Interpreter for source command. */
    const char *childCmd,	/* Command to install in child. */
    Tcl_Interp *targetInterp,	/* Interpreter for target command. */
    const char *targetCmd,	/* Name of target command. */
    Tcl_Size argc,			/* How many additional arguments? */
    const char *const *argv)	/* These are the additional args. */
{
    Tcl_Obj *childObjPtr, *targetObjPtr;
    Tcl_Obj **objv;
    Tcl_Size i;
    int result;

    objv = (Tcl_Obj **)TclStackAlloc(childInterp, sizeof(Tcl_Obj *) * argc);
    for (i = 0; i < argc; i++) {
	objv[i] = Tcl_NewStringObj(argv[i], -1);
	Tcl_IncrRefCount(objv[i]);
    }
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262

int
Tcl_CreateAliasObj(
    Tcl_Interp *childInterp,	/* Interpreter for source command. */
    const char *childCmd,	/* Command to install in child. */
    Tcl_Interp *targetInterp,	/* Interpreter for target command. */
    const char *targetCmd,	/* Name of target command. */
    size_t objc,			/* How many additional arguments? */
    Tcl_Obj *const objv[])	/* Argument vector. */
{
    Tcl_Obj *childObjPtr, *targetObjPtr;
    int result;

    childObjPtr = Tcl_NewStringObj(childCmd, -1);
    Tcl_IncrRefCount(childObjPtr);







|







1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262

int
Tcl_CreateAliasObj(
    Tcl_Interp *childInterp,	/* Interpreter for source command. */
    const char *childCmd,	/* Command to install in child. */
    Tcl_Interp *targetInterp,	/* Interpreter for target command. */
    const char *targetCmd,	/* Name of target command. */
    Tcl_Size objc,			/* How many additional arguments? */
    Tcl_Obj *const objv[])	/* Argument vector. */
{
    Tcl_Obj *childObjPtr, *targetObjPtr;
    int result;

    childObjPtr = Tcl_NewStringObj(childCmd, -1);
    Tcl_IncrRefCount(childObjPtr);
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
 *	forwarded.
 *
 *----------------------------------------------------------------------
 */

static int
AliasNRCmd(
    ClientData clientData,	/* Alias record. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument vector. */
{
    Alias *aliasPtr = (Alias *)clientData;
    int prefc, cmdc, i;
    Tcl_Obj **prefv, **cmdv;







|







1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
 *	forwarded.
 *
 *----------------------------------------------------------------------
 */

static int
AliasNRCmd(
    void *clientData,	/* Alias record. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument vector. */
{
    Alias *aliasPtr = (Alias *)clientData;
    int prefc, cmdc, i;
    Tcl_Obj **prefv, **cmdv;
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
    }
    TclSkipTailcall(interp);
    return Tcl_NREvalObj(interp, listPtr, flags);
}

int
TclAliasObjCmd(
    ClientData clientData,	/* Alias record. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument vector. */
{
#define ALIAS_CMDV_PREALLOC 10
    Alias *aliasPtr = (Alias *)clientData;
    Tcl_Interp *targetInterp = aliasPtr->targetInterp;







|







1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
    }
    TclSkipTailcall(interp);
    return Tcl_NREvalObj(interp, listPtr, flags);
}

int
TclAliasObjCmd(
    void *clientData,	/* Alias record. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument vector. */
{
#define ALIAS_CMDV_PREALLOC 10
    Alias *aliasPtr = (Alias *)clientData;
    Tcl_Interp *targetInterp = aliasPtr->targetInterp;
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
    }
    return result;
#undef ALIAS_CMDV_PREALLOC
}

int
TclLocalAliasObjCmd(
    ClientData clientData,	/* Alias record. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument vector. */
{
#define ALIAS_CMDV_PREALLOC 10
    Alias *aliasPtr = (Alias *)clientData;
    int result, prefc, cmdc, i;







|







1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
    }
    return result;
#undef ALIAS_CMDV_PREALLOC
}

int
TclLocalAliasObjCmd(
    void *clientData,	/* Alias record. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument vector. */
{
#define ALIAS_CMDV_PREALLOC 10
    Alias *aliasPtr = (Alias *)clientData;
    int result, prefc, cmdc, i;
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
 *	interpreter.
 *
 *----------------------------------------------------------------------
 */

static void
AliasObjCmdDeleteProc(
    ClientData clientData)	/* The alias record for this alias. */
{
    Alias *aliasPtr = (Alias *)clientData;
    Target *targetPtr;
    int i;
    Tcl_Obj **objv;

    Tcl_DecrRefCount(aliasPtr->token);







|







2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
 *	interpreter.
 *
 *----------------------------------------------------------------------
 */

static void
AliasObjCmdDeleteProc(
    void *clientData)	/* The alias record for this alias. */
{
    Alias *aliasPtr = (Alias *)clientData;
    Target *targetPtr;
    int i;
    Tcl_Obj **objv;

    Tcl_DecrRefCount(aliasPtr->token);
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
    Tcl_Interp *interp,		/* Interp. to start search from. */
    Tcl_Obj *pathPtr)		/* List object containing name of interp. to
				 * be found. */
{
    Tcl_HashEntry *hPtr;	/* Search element. */
    Child *childPtr;		/* Interim child record. */
    Tcl_Obj **objv;
    size_t objc, i;
    Tcl_Interp *searchInterp;	/* Interim storage for interp. to find. */
    InterpInfo *parentInfoPtr;

    if (TclListObjGetElementsM(interp, pathPtr, &objc, &objv) != TCL_OK) {
	return NULL;
    }








|







2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
    Tcl_Interp *interp,		/* Interp. to start search from. */
    Tcl_Obj *pathPtr)		/* List object containing name of interp. to
				 * be found. */
{
    Tcl_HashEntry *hPtr;	/* Search element. */
    Child *childPtr;		/* Interim child record. */
    Tcl_Obj **objv;
    Tcl_Size objc, i;
    Tcl_Interp *searchInterp;	/* Interim storage for interp. to find. */
    InterpInfo *parentInfoPtr;

    if (TclListObjGetElementsM(interp, pathPtr, &objc, &objv) != TCL_OK) {
	return NULL;
    }

2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
ChildBgerror(
    Tcl_Interp *interp,		/* Interp for error return. */
    Tcl_Interp *childInterp,	/* Interp in which limit is set/queried. */
    int objc,			/* Set or Query. */
    Tcl_Obj *const objv[])	/* Argument strings. */
{
    if (objc) {
	size_t length;

	if (TCL_ERROR == TclListObjLengthM(NULL, objv[0], &length)
		|| (length < 1)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "cmdPrefix must be list of length >= 1", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
		    "BGERRORFORMAT", NULL);







|







2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
ChildBgerror(
    Tcl_Interp *interp,		/* Interp for error return. */
    Tcl_Interp *childInterp,	/* Interp in which limit is set/queried. */
    int objc,			/* Set or Query. */
    Tcl_Obj *const objv[])	/* Argument strings. */
{
    if (objc) {
	Tcl_Size length;

	if (TCL_ERROR == TclListObjLengthM(NULL, objv[0], &length)
		|| (length < 1)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "cmdPrefix must be list of length >= 1", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
		    "BGERRORFORMAT", NULL);
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
{
    Tcl_Interp *parentInterp, *childInterp;
    Child *childPtr;
    InterpInfo *parentInfoPtr;
    Tcl_HashEntry *hPtr;
    const char *path;
    int isNew;
    size_t objc;
    Tcl_Obj **objv;

    if (TclListObjGetElementsM(interp, pathPtr, &objc, &objv) != TCL_OK) {
	return NULL;
    }
    if (objc < 2) {
	parentInterp = interp;







|







2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
{
    Tcl_Interp *parentInterp, *childInterp;
    Child *childPtr;
    InterpInfo *parentInfoPtr;
    Tcl_HashEntry *hPtr;
    const char *path;
    int isNew;
    Tcl_Size objc;
    Tcl_Obj **objv;

    if (TclListObjGetElementsM(interp, pathPtr, &objc, &objv) != TCL_OK) {
	return NULL;
    }
    if (objc < 2) {
	parentInterp = interp;
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
 *	See user documentation for details.
 *
 *----------------------------------------------------------------------
 */

int
TclChildObjCmd(
    ClientData clientData,	/* Child interpreter. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, NRChildCmd, clientData, objc, objv);
}

static int
NRChildCmd(
    ClientData clientData,	/* Child interpreter. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Interp *childInterp = (Tcl_Interp *)clientData;
    static const char *const options[] = {
	"alias",	"aliases",	"bgerror",	"debug",







|









|







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
 *	See user documentation for details.
 *
 *----------------------------------------------------------------------
 */

int
TclChildObjCmd(
    void *clientData,	/* Child interpreter. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, NRChildCmd, clientData, objc, objv);
}

static int
NRChildCmd(
    void *clientData,	/* Child interpreter. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Interp *childInterp = (Tcl_Interp *)clientData;
    static const char *const options[] = {
	"alias",	"aliases",	"bgerror",	"debug",
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
 *	the child interpreter.
 *
 *----------------------------------------------------------------------
 */

static void
ChildObjCmdDeleteProc(
    ClientData clientData)	/* The ChildRecord for the command. */
{
    Child *childPtr;		/* Interim storage for Child record. */
    Tcl_Interp *childInterp = (Tcl_Interp *)clientData;
				/* And for a child interp. */

    childPtr = &((InterpInfo *) ((Interp *) childInterp)->interpInfo)->child;








|







2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
 *	the child interpreter.
 *
 *----------------------------------------------------------------------
 */

static void
ChildObjCmdDeleteProc(
    void *clientData)	/* The ChildRecord for the command. */
{
    Child *childPtr;		/* Interim storage for Child record. */
    Tcl_Interp *childInterp = (Tcl_Interp *)clientData;
				/* And for a child interp. */

    childPtr = &((InterpInfo *) ((Interp *) childInterp)->interpInfo)->child;

3005
3006
3007
3008
3009
3010
3011
3012
3013
3014

3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE",
		    NULL);
	    return TCL_ERROR;
	}
	if (TclGetWideIntFromObj(interp, objv[0], &limit) == TCL_ERROR) {
	    return TCL_ERROR;
	}
	if (limit <= 0 || (size_t)limit >= ((Tcl_WideUInt)WIDE_MAX & TCL_INDEX_NONE)) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "recursion limit must be > 0 and < %" TCL_LL_MODIFIER "u", (Tcl_WideUInt)WIDE_MAX & TCL_INDEX_NONE));

	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "BADLIMIT",
		    NULL);
	    return TCL_ERROR;
	}
	Tcl_SetRecursionLimit(childInterp, limit);
	iPtr = (Interp *) childInterp;
	if (interp == childInterp && iPtr->numLevels > (size_t)limit) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "falling back due to new recursion limit", -1));
	    Tcl_SetErrorCode(interp, "TCL", "RECURSION", NULL);
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, objv[0]);
	return TCL_OK;







|
|
|
>
|
<




|







3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016

3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE",
		    NULL);
	    return TCL_ERROR;
	}
	if (TclGetWideIntFromObj(interp, objv[0], &limit) == TCL_ERROR) {
	    return TCL_ERROR;
	}
	if (limit <= 0) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "recursion limit must be > 0", -1));
	    Tcl_SetErrorCode(
		interp, "TCL", "OPERATION", "INTERP", "BADLIMIT", NULL);

	    return TCL_ERROR;
	}
	Tcl_SetRecursionLimit(childInterp, limit);
	iPtr = (Interp *) childInterp;
	if (interp == childInterp && iPtr->numLevels > limit) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "falling back due to new recursion limit", -1));
	    Tcl_SetErrorCode(interp, "TCL", "RECURSION", NULL);
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, objv[0]);
	return TCL_OK;
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193

    Tcl_Release(childInterp);
    return result;
}

static int
NRPostInvokeHidden(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Interp *childInterp = (Tcl_Interp *)data[0];
    NRE_callback *rootPtr = (NRE_callback *)data[1];

    if (interp != childInterp) {







|







3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193

    Tcl_Release(childInterp);
    return result;
}

static int
NRPostInvokeHidden(
    void *data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Interp *childInterp = (Tcl_Interp *)data[0];
    NRE_callback *rootPtr = (NRE_callback *)data[1];

    if (interp != childInterp) {
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
	 * Alias these function implementations in the child to those in the
	 * parent; the overall implementations are safe, but they're normally
	 * defined by init.tcl which is not sourced by safe interpreters.
	 * Assume these functions all work. [Bug 2895741]
	 */

	(void) Tcl_EvalEx(interp,
		"namespace eval ::tcl {namespace eval mathfunc {}}", -1, 0);
    }

    iPtr->flags |= SAFE_INTERP;

    /*
     * Unsetting variables : (which should not have been set in the first
     * place, but...)







|







3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
	 * Alias these function implementations in the child to those in the
	 * parent; the overall implementations are safe, but they're normally
	 * defined by init.tcl which is not sourced by safe interpreters.
	 * Assume these functions all work. [Bug 2895741]
	 */

	(void) Tcl_EvalEx(interp,
		"namespace eval ::tcl {namespace eval mathfunc {}}", TCL_INDEX_NONE, 0);
    }

    iPtr->flags |= SAFE_INTERP;

    /*
     * Unsetting variables : (which should not have been set in the first
     * place, but...)
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335

    Tcl_UnsetVar2(interp, "tcl_platform", "os", TCL_GLOBAL_ONLY);
    Tcl_UnsetVar2(interp, "tcl_platform", "osVersion", TCL_GLOBAL_ONLY);
    Tcl_UnsetVar2(interp, "tcl_platform", "machine", TCL_GLOBAL_ONLY);
    Tcl_UnsetVar2(interp, "tcl_platform", "user", TCL_GLOBAL_ONLY);

    /*
     * Unset path informations variables (the only one remaining is [info
     * nameofexecutable])
     */

    Tcl_UnsetVar2(interp, "tclDefaultLibrary", NULL, TCL_GLOBAL_ONLY);
    Tcl_UnsetVar2(interp, "tcl_library", NULL, TCL_GLOBAL_ONLY);
    Tcl_UnsetVar2(interp, "tcl_pkgPath", NULL, TCL_GLOBAL_ONLY);








|







3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335

    Tcl_UnsetVar2(interp, "tcl_platform", "os", TCL_GLOBAL_ONLY);
    Tcl_UnsetVar2(interp, "tcl_platform", "osVersion", TCL_GLOBAL_ONLY);
    Tcl_UnsetVar2(interp, "tcl_platform", "machine", TCL_GLOBAL_ONLY);
    Tcl_UnsetVar2(interp, "tcl_platform", "user", TCL_GLOBAL_ONLY);

    /*
     * Unset path information variables (the only one remaining is [info
     * nameofexecutable])
     */

    Tcl_UnsetVar2(interp, "tclDefaultLibrary", NULL, TCL_GLOBAL_ONLY);
    Tcl_UnsetVar2(interp, "tcl_library", NULL, TCL_GLOBAL_ONLY);
    Tcl_UnsetVar2(interp, "tcl_pkgPath", NULL, TCL_GLOBAL_ONLY);

3604
3605
3606
3607
3608
3609
3610
3611
3612
3613
3614
3615
3616
3617
3618
 */

void
Tcl_LimitAddHandler(
    Tcl_Interp *interp,
    int type,
    Tcl_LimitHandlerProc *handlerProc,
    ClientData clientData,
    Tcl_LimitHandlerDeleteProc *deleteProc)
{
    Interp *iPtr = (Interp *) interp;
    LimitHandler *handlerPtr;

    /*
     * Convert everything into a real deletion callback.







|







3604
3605
3606
3607
3608
3609
3610
3611
3612
3613
3614
3615
3616
3617
3618
 */

void
Tcl_LimitAddHandler(
    Tcl_Interp *interp,
    int type,
    Tcl_LimitHandlerProc *handlerProc,
    void *clientData,
    Tcl_LimitHandlerDeleteProc *deleteProc)
{
    Interp *iPtr = (Interp *) interp;
    LimitHandler *handlerPtr;

    /*
     * Convert everything into a real deletion callback.
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
 */

void
Tcl_LimitRemoveHandler(
    Tcl_Interp *interp,
    int type,
    Tcl_LimitHandlerProc *handlerProc,
    ClientData clientData)
{
    Interp *iPtr = (Interp *) interp;
    LimitHandler *handlerPtr;

    switch (type) {
    case TCL_LIMIT_COMMANDS:
	handlerPtr = iPtr->limit.cmdHandlers;







|







3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
 */

void
Tcl_LimitRemoveHandler(
    Tcl_Interp *interp,
    int type,
    Tcl_LimitHandlerProc *handlerProc,
    void *clientData)
{
    Interp *iPtr = (Interp *) interp;
    LimitHandler *handlerPtr;

    switch (type) {
    case TCL_LIMIT_COMMANDS:
	handlerPtr = iPtr->limit.cmdHandlers;
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
 *
 *----------------------------------------------------------------------
 */

void
Tcl_LimitSetCommands(
    Tcl_Interp *interp,
    size_t commandLimit)
{
    Interp *iPtr = (Interp *) interp;

    iPtr->limit.cmdCount = commandLimit;
    iPtr->limit.exceeded &= ~TCL_LIMIT_COMMANDS;
}








|







3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
 *
 *----------------------------------------------------------------------
 */

void
Tcl_LimitSetCommands(
    Tcl_Interp *interp,
    Tcl_Size commandLimit)
{
    Interp *iPtr = (Interp *) interp;

    iPtr->limit.cmdCount = commandLimit;
    iPtr->limit.exceeded &= ~TCL_LIMIT_COMMANDS;
}

4077
4078
4079
4080
4081
4082
4083
4084
4085
4086
4087
4088
4089
4090
4091
 *	commands. May make callbacks into other interpreters.
 *
 *----------------------------------------------------------------------
 */

static void
TimeLimitCallback(
    ClientData clientData)
{
    Tcl_Interp *interp = (Tcl_Interp *)clientData;
    Interp *iPtr = (Interp *)clientData;
    int code;

    Tcl_Preserve(interp);
    iPtr->limit.timeEvent = NULL;







|







4077
4078
4079
4080
4081
4082
4083
4084
4085
4086
4087
4088
4089
4090
4091
 *	commands. May make callbacks into other interpreters.
 *
 *----------------------------------------------------------------------
 */

static void
TimeLimitCallback(
    void *clientData)
{
    Tcl_Interp *interp = (Tcl_Interp *)clientData;
    Interp *iPtr = (Interp *)clientData;
    int code;

    Tcl_Preserve(interp);
    iPtr->limit.timeEvent = NULL;
4221
4222
4223
4224
4225
4226
4227
4228
4229
4230
4231
4232
4233
4234
4235
 *	is removed.
 *
 *----------------------------------------------------------------------
 */

static void
DeleteScriptLimitCallback(
    ClientData clientData)
{
    ScriptLimitCallback *limitCBPtr = (ScriptLimitCallback *)clientData;

    Tcl_DecrRefCount(limitCBPtr->scriptObj);
    if (limitCBPtr->entryPtr != NULL) {
	Tcl_DeleteHashEntry(limitCBPtr->entryPtr);
    }







|







4221
4222
4223
4224
4225
4226
4227
4228
4229
4230
4231
4232
4233
4234
4235
 *	is removed.
 *
 *----------------------------------------------------------------------
 */

static void
DeleteScriptLimitCallback(
    void *clientData)
{
    ScriptLimitCallback *limitCBPtr = (ScriptLimitCallback *)clientData;

    Tcl_DecrRefCount(limitCBPtr->scriptObj);
    if (limitCBPtr->entryPtr != NULL) {
	Tcl_DeleteHashEntry(limitCBPtr->entryPtr);
    }
4252
4253
4254
4255
4256
4257
4258
4259
4260
4261
4262
4263
4264
4265
4266
 *	errors.
 *
 *----------------------------------------------------------------------
 */

static void
CallScriptLimitCallback(
    ClientData clientData,
    TCL_UNUSED(Tcl_Interp *))
{
    ScriptLimitCallback *limitCBPtr = (ScriptLimitCallback *)clientData;
    int code;

    if (Tcl_InterpDeleted(limitCBPtr->interp)) {
	return;







|







4252
4253
4254
4255
4256
4257
4258
4259
4260
4261
4262
4263
4264
4265
4266
 *	errors.
 *
 *----------------------------------------------------------------------
 */

static void
CallScriptLimitCallback(
    void *clientData,
    TCL_UNUSED(Tcl_Interp *))
{
    ScriptLimitCallback *limitCBPtr = (ScriptLimitCallback *)clientData;
    int code;

    if (Tcl_InterpDeleted(limitCBPtr->interp)) {
	return;
4285
4286
4287
4288
4289
4290
4291
4292
4293
4294
4295
4296
4297
4298
4299
 *	interpreter through this mechanism (though as many interpreters may be
 *	limited as the programmer chooses overall).
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	A limit callback implemented as an invokation of a Tcl script in
 *	another interpreter is either installed or removed.
 *
 *----------------------------------------------------------------------
 */

static void
SetScriptLimitCallback(







|







4285
4286
4287
4288
4289
4290
4291
4292
4293
4294
4295
4296
4297
4298
4299
 *	interpreter through this mechanism (though as many interpreters may be
 *	limited as the programmer chooses overall).
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	A limit callback implemented as an invocation of a Tcl script in
 *	another interpreter is either installed or removed.
 *
 *----------------------------------------------------------------------
 */

static void
SetScriptLimitCallback(
4582
4583
4584
4585
4586
4587
4588
4589
4590
4591
4592
4593
4594
4595
4596
	}
	return TCL_OK;
    } else if ((objc-consumedObjc) & 1 /* isOdd(objc-consumedObjc) */) {
	Tcl_WrongNumArgs(interp, consumedObjc, objv, "?-option value ...?");
	return TCL_ERROR;
    } else {
	int i;
	size_t scriptLen = 0, limitLen = 0;
	Tcl_Obj *scriptObj = NULL, *granObj = NULL, *limitObj = NULL;
	int gran = 0, limit = 0;

	for (i=consumedObjc ; i<objc ; i+=2) {
	    if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
		    &index) != TCL_OK) {
		return TCL_ERROR;







|







4582
4583
4584
4585
4586
4587
4588
4589
4590
4591
4592
4593
4594
4595
4596
	}
	return TCL_OK;
    } else if ((objc-consumedObjc) & 1 /* isOdd(objc-consumedObjc) */) {
	Tcl_WrongNumArgs(interp, consumedObjc, objv, "?-option value ...?");
	return TCL_ERROR;
    } else {
	int i;
	Tcl_Size scriptLen = 0, limitLen = 0;
	Tcl_Obj *scriptObj = NULL, *granObj = NULL, *limitObj = NULL;
	int gran = 0, limit = 0;

	for (i=consumedObjc ; i<objc ; i+=2) {
	    if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
		    &index) != TCL_OK) {
		return TCL_ERROR;
4787
4788
4789
4790
4791
4792
4793
4794
4795
4796
4797
4798
4799
4800
4801
	}
	return TCL_OK;
    } else if ((objc-consumedObjc) & 1 /* isOdd(objc-consumedObjc) */) {
	Tcl_WrongNumArgs(interp, consumedObjc, objv, "?-option value ...?");
	return TCL_ERROR;
    } else {
	int i;
	size_t scriptLen = 0, milliLen = 0, secLen = 0;
	Tcl_Obj *scriptObj = NULL, *granObj = NULL;
	Tcl_Obj *milliObj = NULL, *secObj = NULL;
	int gran = 0;
	Tcl_Time limitMoment;
	Tcl_WideInt tmp;

	Tcl_LimitGetTime(childInterp, &limitMoment);







|







4787
4788
4789
4790
4791
4792
4793
4794
4795
4796
4797
4798
4799
4800
4801
	}
	return TCL_OK;
    } else if ((objc-consumedObjc) & 1 /* isOdd(objc-consumedObjc) */) {
	Tcl_WrongNumArgs(interp, consumedObjc, objv, "?-option value ...?");
	return TCL_ERROR;
    } else {
	int i;
	Tcl_Size scriptLen = 0, milliLen = 0, secLen = 0;
	Tcl_Obj *scriptObj = NULL, *granObj = NULL;
	Tcl_Obj *milliObj = NULL, *secObj = NULL;
	int gran = 0;
	Tcl_Time limitMoment;
	Tcl_WideInt tmp;

	Tcl_LimitGetTime(childInterp, &limitMoment);

Changes to generic/tclLink.c.

29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
    Tcl_Interp *interp;		/* Interpreter containing Tcl variable. */
    Namespace *nsPtr;		/* Namespace containing Tcl variable */
    Tcl_Obj *varName;		/* Name of variable (must be global). This is
				 * needed during trace callbacks, since the
				 * actual variable may be aliased at that time
				 * via upvar. */
    void *addr;			/* Location of C variable. */
    size_t bytes;		/* Size of C variable array. This is 0 when
				 * single variables, and >0 used for array
				 * variables. */
    size_t numElems;	/* Number of elements in C variable array.
				 * Zero for single variables. */
    int type;			/* Type of link (TCL_LINK_INT, etc.). */
    union {
	char c;
	unsigned char uc;
	int i;
	unsigned int ui;







|


|







29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
    Tcl_Interp *interp;		/* Interpreter containing Tcl variable. */
    Namespace *nsPtr;		/* Namespace containing Tcl variable */
    Tcl_Obj *varName;		/* Name of variable (must be global). This is
				 * needed during trace callbacks, since the
				 * actual variable may be aliased at that time
				 * via upvar. */
    void *addr;			/* Location of C variable. */
    Tcl_Size bytes;		/* Size of C variable array. This is 0 when
				 * single variables, and >0 used for array
				 * variables. */
    Tcl_Size numElems;	/* Number of elements in C variable array.
				 * Zero for single variables. */
    int type;			/* Type of link (TCL_LINK_INT, etc.). */
    union {
	char c;
	unsigned char uc;
	int i;
	unsigned int ui;
110
111
112
113
114
115
116
117

118
119
120
121
122
123
124
 */

static Tcl_ObjType invalidRealType = {
    "invalidReal",			/* name */
    NULL,				/* freeIntRepProc */
    NULL,				/* dupIntRepProc */
    NULL,				/* updateStringProc */
    NULL				/* setFromAnyProc */

};

/*
 * Convenience macro for accessing the value of the C variable pointed to by a
 * link. Note that this macro produces something that may be regarded as an
 * lvalue or rvalue; it may be assigned to as well as read. Also note that
 * this macro assumes the name of the variable being accessed (linkPtr); this







|
>







110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
 */

static Tcl_ObjType invalidRealType = {
    "invalidReal",			/* name */
    NULL,				/* freeIntRepProc */
    NULL,				/* dupIntRepProc */
    NULL,				/* updateStringProc */
    NULL,				/* setFromAnyProc */
    TCL_OBJTYPE_V0
};

/*
 * Convenience macro for accessing the value of the C variable pointed to by a
 * link. Note that this macro produces something that may be regarded as an
 * lvalue or rvalue; it may be assigned to as well as read. Also note that
 * this macro assumes the name of the variable being accessed (linkPtr); this
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
    const char *varName,	/* Name of a global variable in interp. */
    void *addr,			/* Address of a C variable to be linked to
				 * varName. If NULL then the necessary space
				 * will be allocated and returned as the
				 * interpreter result. */
    int type,			/* Type of C variable: TCL_LINK_INT, etc. Also
				 * may have TCL_LINK_READ_ONLY OR'ed in. */
    size_t size)			/* Size of C variable array, >1 if array */
{
    Tcl_Obj *objPtr;
    Link *linkPtr;
    Namespace *dummy;
    const char *name;
    int code;








|







242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
    const char *varName,	/* Name of a global variable in interp. */
    void *addr,			/* Address of a C variable to be linked to
				 * varName. If NULL then the necessary space
				 * will be allocated and returned as the
				 * interpreter result. */
    int type,			/* Type of C variable: TCL_LINK_INT, etc. Also
				 * may have TCL_LINK_READ_ONLY OR'ed in. */
    Tcl_Size size)		/* Size of C variable array, >1 if array */
{
    Tcl_Obj *objPtr;
    Link *linkPtr;
    Namespace *dummy;
    const char *name;
    int code;

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
}

static inline int
GetUWide(
    Tcl_Obj *objPtr,
    Tcl_WideUInt *uwidePtr)
{
    Tcl_WideInt *widePtr = (Tcl_WideInt *) uwidePtr;
    void *clientData;
    int type, intValue;

    if (Tcl_GetNumberFromObj(NULL, objPtr, &clientData, &type) == TCL_OK) {
	if (type == TCL_NUMBER_INT) {
	    *widePtr = *((const Tcl_WideInt *) clientData);
	    return (*widePtr < 0);
	} else if (type == TCL_NUMBER_BIG) {
	    mp_int *numPtr = (mp_int *)clientData;
	    Tcl_WideUInt value = 0;
	    union {
		Tcl_WideUInt value;
		unsigned char bytes[sizeof(Tcl_WideUInt)];
	    } scratch;
	    size_t numBytes;
	    unsigned char *bytes = scratch.bytes;

	    if (numPtr->sign || (MP_OKAY != mp_to_ubin(numPtr,
		    bytes, sizeof(Tcl_WideUInt), &numBytes))) {
		/*
		 * If the sign bit is set (a negative value) or if the value
		 * can't possibly fit in the bits of an unsigned wide, there's
		 * no point in doing further conversion.
		 */
		return 1;
	    }
#ifdef WORDS_BIGENDIAN
	    while (numBytes-- > 0) {
		value = (value << CHAR_BIT) | *bytes++;
	    }
#else /* !WORDS_BIGENDIAN */
	    /*
	     * Little-endian can read the value directly.
	     */
	    value = scratch.value;
#endif /* WORDS_BIGENDIAN */
	    *uwidePtr = value;
	    return 0;
	}
    }

    /*
     * Evil edge case fallback.
     */

    if (GetInvalidIntFromObj(objPtr, &intValue) != TCL_OK) {
	return 1;
    }
    *uwidePtr = intValue;
    return 0;
}

static inline int
GetDouble(
    Tcl_Obj *objPtr,
    double *dblPtr)







|
<
|

<
<
<
<
<
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
|
|
<
<
<
<
<
<
<
<
<
<
|
<
|
<
<
<
<
<
<
<
<
<
<







523
524
525
526
527
528
529
530

531
532













533







534
535










536

537










538
539
540
541
542
543
544
}

static inline int
GetUWide(
    Tcl_Obj *objPtr,
    Tcl_WideUInt *uwidePtr)
{
    if (Tcl_GetWideUIntFromObj(NULL, objPtr, uwidePtr) != TCL_OK) {

	int intValue;














	if (GetInvalidIntFromObj(objPtr, &intValue) != TCL_OK) {







	    return 1;
	}










	*uwidePtr = intValue;

    }










    return 0;
}

static inline int
GetDouble(
    Tcl_Obj *objPtr,
    double *dblPtr)
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
static int
SetInvalidRealFromAny(
    TCL_UNUSED(Tcl_Interp *),
    Tcl_Obj *objPtr)
{
    const char *str;
    const char *endPtr;
    size_t length;

    str = Tcl_GetStringFromObj(objPtr, &length);
    if ((length == 1) && (str[0] == '.')) {
	objPtr->typePtr = &invalidRealType;
	objPtr->internalRep.doubleValue = 0.0;
	return TCL_OK;
    }







|







588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
static int
SetInvalidRealFromAny(
    TCL_UNUSED(Tcl_Interp *),
    Tcl_Obj *objPtr)
{
    const char *str;
    const char *endPtr;
    Tcl_Size length;

    str = Tcl_GetStringFromObj(objPtr, &length);
    if ((length == 1) && (str[0] == '.')) {
	objPtr->typePtr = &invalidRealType;
	objPtr->internalRep.doubleValue = 0.0;
	return TCL_OK;
    }
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
 */

static int
GetInvalidIntFromObj(
    Tcl_Obj *objPtr,
    int *intPtr)
{
    size_t length;
    const char *str = 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])) {







|







634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
 */

static int
GetInvalidIntFromObj(
    Tcl_Obj *objPtr,
    int *intPtr)
{
    Tcl_Size 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])) {
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
				/* Links can only be made to global variables,
				 * so we can find them with need to resolve
				 * caller-supplied name in caller context. */
    int flags)			/* Miscellaneous additional information. */
{
    Link *linkPtr = (Link *)clientData;
    int changed;
    size_t valueLength = 0;
    const char *value;
    char **pp;
    Tcl_Obj *valueObj;
    int valueInt;
    Tcl_WideInt valueWide;
    Tcl_WideUInt valueUWide;
    double valueDouble;
    size_t objc, i;
    Tcl_Obj **objv;

    /*
     * If the variable is being unset, then just re-create it (with a trace)
     * unless the whole interpreter is going away.
     */








|







|







711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
				/* Links can only be made to global variables,
				 * so we can find them with need to resolve
				 * caller-supplied name in caller context. */
    int flags)			/* Miscellaneous additional information. */
{
    Link *linkPtr = (Link *)clientData;
    int changed;
    Tcl_Size valueLength = 0;
    const char *value;
    char **pp;
    Tcl_Obj *valueObj;
    int valueInt;
    Tcl_WideInt valueWide;
    Tcl_WideUInt valueUWide;
    double valueDouble;
    Tcl_Size objc, i;
    Tcl_Obj **objv;

    /*
     * If the variable is being unset, then just re-create it (with a trace)
     * unless the whole interpreter is going away.
     */

867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
	}
	return NULL;
    }

    /*
     * For writes, first make sure that the variable is writable. Then convert
     * the Tcl value to C if possible. If the variable isn't writable or can't
     * be converted, then restore the varaible's old value and return an
     * error. Another tricky thing: we have to save and restore the interp's
     * result, since the variable access could occur when the result has been
     * partially set.
     */

    if (linkPtr->flags & LINK_READ_ONLY) {
	Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),







|







826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
	}
	return NULL;
    }

    /*
     * For writes, first make sure that the variable is writable. Then convert
     * the Tcl value to C if possible. If the variable isn't writable or can't
     * be converted, then restore the variable's old value and return an
     * error. Another tricky thing: we have to save and restore the interp's
     * result, since the variable access could occur when the result has been
     * partially set.
     */

    if (linkPtr->flags & LINK_READ_ONLY) {
	Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
917
918
919
920
921
922
923


924
925
926
927
928
929
930
931
	    linkPtr->lastValue.c = '\0';
	    LinkedVar(char) = linkPtr->lastValue.c;
	}
	return NULL;

    case TCL_LINK_BINARY:
	value = (char *) Tcl_GetByteArrayFromObj(valueObj, &valueLength);


	if (valueLength != linkPtr->bytes) {
	    return (char *) "wrong size of binary value";
	}
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, value, valueLength);
	    memcpy(linkPtr->addr, value, valueLength);
	} else {
	    linkPtr->lastValue.uc = (unsigned char) *value;







>
>
|







876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
	    linkPtr->lastValue.c = '\0';
	    LinkedVar(char) = linkPtr->lastValue.c;
	}
	return NULL;

    case TCL_LINK_BINARY:
	value = (char *) Tcl_GetByteArrayFromObj(valueObj, &valueLength);
	if (value == NULL) {
	    return (char *) "invalid binary value";
	} else 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 {
	    linkPtr->lastValue.uc = (unsigned char) *value;
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298

static Tcl_Obj *
ObjValue(
    Link *linkPtr)		/* Structure describing linked variable. */
{
    char *p;
    Tcl_Obj *resultObj, **objv;
    size_t i;

    switch (linkPtr->type) {
    case TCL_LINK_INT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = (Tcl_Obj **)Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {







|







1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259

static Tcl_Obj *
ObjValue(
    Link *linkPtr)		/* Structure describing linked variable. */
{
    char *p;
    Tcl_Obj *resultObj, **objv;
    Tcl_Size i;

    switch (linkPtr->type) {
    case TCL_LINK_INT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = (Tcl_Obj **)Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
	linkPtr->lastValue.w = LinkedVar(Tcl_WideInt);
	return Tcl_NewWideIntObj(linkPtr->lastValue.w);
    case TCL_LINK_DOUBLE:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = (Tcl_Obj **)Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		objv[i] = Tcl_NewDoubleObj(linkPtr->lastValue.dPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    Tcl_Free(objv);
	    return resultObj;
	}
	linkPtr->lastValue.d = LinkedVar(double);
	return Tcl_NewDoubleObj(linkPtr->lastValue.d);







|







1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
	linkPtr->lastValue.w = LinkedVar(Tcl_WideInt);
	return Tcl_NewWideIntObj(linkPtr->lastValue.w);
    case TCL_LINK_DOUBLE:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = (Tcl_Obj **)Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		TclNewDoubleObj(objv[i], linkPtr->lastValue.dPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    Tcl_Free(objv);
	    return resultObj;
	}
	linkPtr->lastValue.d = LinkedVar(double);
	return Tcl_NewDoubleObj(linkPtr->lastValue.d);
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
	return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ul);
#endif
    case TCL_LINK_FLOAT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = (Tcl_Obj **)Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		objv[i] = Tcl_NewDoubleObj(linkPtr->lastValue.fPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    Tcl_Free(objv);
	    return resultObj;
	}
	linkPtr->lastValue.f = LinkedVar(float);
	return Tcl_NewDoubleObj(linkPtr->lastValue.f);
    case TCL_LINK_WIDE_UINT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = (Tcl_Obj **)Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		TclNewIntObj(objv[i], (Tcl_WideInt)
			linkPtr->lastValue.uwPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    Tcl_Free(objv);
	    return resultObj;
	}
	linkPtr->lastValue.uw = LinkedVar(Tcl_WideUInt);

	return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.uw);



    case TCL_LINK_STRING:
	p = LinkedVar(char *);
	if (p == NULL) {
	    TclNewLiteralStringObj(resultObj, "NULL");
	    return resultObj;
	}







|







|




<
|






>
|
>
>







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
	return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ul);
#endif
    case TCL_LINK_FLOAT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = (Tcl_Obj **)Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		TclNewDoubleObj(objv[i], linkPtr->lastValue.fPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    Tcl_Free(objv);
	    return resultObj;
	}
	linkPtr->lastValue.f = LinkedVar(float);
	return Tcl_NewDoubleObj(linkPtr->lastValue.f);
    case TCL_LINK_WIDE_UINT: {
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = (Tcl_Obj **)Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {

		TclNewUIntObj(objv[i], linkPtr->lastValue.uwPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    Tcl_Free(objv);
	    return resultObj;
	}
	linkPtr->lastValue.uw = LinkedVar(Tcl_WideUInt);
	Tcl_Obj *uwObj;
	TclNewUIntObj(uwObj, linkPtr->lastValue.uw);
	return uwObj;
	}

    case TCL_LINK_STRING:
	p = LinkedVar(char *);
	if (p == NULL) {
	    TclNewLiteralStringObj(resultObj, "NULL");
	    return resultObj;
	}

Changes to generic/tclListObj.c.

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

15
16
17
18
19
20
21
/*
 * tclListObj.c --
 *
 *	This file contains functions that implement the Tcl list object type.
 *
 * Copyright © 2022 Ashok P. Nadkarni.  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 "tclAbstractList.h"
#include <assert.h>
#include "tclInt.h"


/*
 * TODO - memmove is fast. Measure at what size we should prefer memmove
 * (for unshared objects only) in lieu of range operations. On the other
 * hand, more cache dirtied?
 */












<


>







1
2
3
4
5
6
7
8
9
10
11

12
13
14
15
16
17
18
19
20
21
/*
 * tclListObj.c --
 *
 *	This file contains functions that implement the Tcl list object type.
 *
 * Copyright © 2022 Ashok P. Nadkarni.  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 <assert.h>
#include "tclInt.h"
#include "tclTomMath.h"

/*
 * TODO - memmove is fast. Measure at what size we should prefer memmove
 * (for unshared objects only) in lieu of range operations. On the other
 * hand, more cache dirtied?
 */

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
# ifndef NDEBUG
#  define ENABLE_LIST_ASSERTS /* Always activate list asserts in debug mode */
# endif
#endif

#ifdef ENABLE_LIST_ASSERTS

#define LIST_ASSERT(cond_) assert(cond_) /* TODO - is there a Tcl-specific one? */
/*
 * LIST_INDEX_ASSERT is to catch errors with negative indices and counts
 * being passed AFTER validation. On Tcl9 length types are unsigned hence
 * the checks against LIST_MAX. On Tcl8 length types are signed hence the
 * also checks against 0.
 */
#define LIST_INDEX_ASSERT(idxarg_)                                 \
    do {                                                           \
	Tcl_Size idx_ = (idxarg_); /* To guard against ++ etc. */ \
	LIST_ASSERT(idx_ != TCL_INDEX_NONE && idx_ < LIST_MAX);                 \
    } while (0)
/* Ditto for counts except upper limit is different */
#define LIST_COUNT_ASSERT(countarg_)                                   \
    do {                                                               \
	Tcl_Size count_ = (countarg_); /* To guard against ++ etc. */ \
	LIST_ASSERT(count_ != TCL_INDEX_NONE && count_ <= LIST_MAX);                \
    } while (0)

#else

#define LIST_ASSERT(cond_) ((void) 0)
#define LIST_INDEX_ASSERT(idx_) ((void) 0)
#define LIST_COUNT_ASSERT(count_) ((void) 0)

#endif

/* Checks for when caller should have already converted to internal list type */
#define LIST_ASSERT_TYPE(listObj_) \
    LIST_ASSERT((listObj_)->typePtr == &tclListType);


/*
 * If ENABLE_LIST_INVARIANTS is enabled (-DENABLE_LIST_INVARIANTS from the
 * command line), the entire list internal representation is checked for
 * inconsistencies. This has a non-trivial cost so has to be separately
 * enabled and not part of assertions checking. However, the test suite does
 * invoke ListRepValidate directly even without ENABLE_LIST_INVARIANTS.







|









|





|












<
|







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
# ifndef NDEBUG
#  define ENABLE_LIST_ASSERTS /* Always activate list asserts in debug mode */
# endif
#endif

#ifdef ENABLE_LIST_ASSERTS

#define LIST_ASSERT(cond_) assert(cond_)
/*
 * LIST_INDEX_ASSERT is to catch errors with negative indices and counts
 * being passed AFTER validation. On Tcl9 length types are unsigned hence
 * the checks against LIST_MAX. On Tcl8 length types are signed hence the
 * also checks against 0.
 */
#define LIST_INDEX_ASSERT(idxarg_)                                 \
    do {                                                           \
	Tcl_Size idx_ = (idxarg_); /* To guard against ++ etc. */ \
	LIST_ASSERT(idx_ >= 0 && idx_ < LIST_MAX);                 \
    } while (0)
/* Ditto for counts except upper limit is different */
#define LIST_COUNT_ASSERT(countarg_)                                   \
    do {                                                               \
	Tcl_Size count_ = (countarg_); /* To guard against ++ etc. */ \
	LIST_ASSERT(count_ >= 0 && count_ <= LIST_MAX);                \
    } while (0)

#else

#define LIST_ASSERT(cond_) ((void) 0)
#define LIST_INDEX_ASSERT(idx_) ((void) 0)
#define LIST_COUNT_ASSERT(count_) ((void) 0)

#endif

/* Checks for when caller should have already converted to internal list type */
#define LIST_ASSERT_TYPE(listObj_) \

    LIST_ASSERT(TclHasInternalRep((listObj_), &tclListType))

/*
 * If ENABLE_LIST_INVARIANTS is enabled (-DENABLE_LIST_INVARIANTS from the
 * command line), the entire list internal representation is checked for
 * inconsistencies. This has a non-trivial cost so has to be separately
 * enabled and not part of assertions checking. However, the test suite does
 * invoke ListRepValidate directly even without ENABLE_LIST_INVARIANTS.
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
static ListStore *ListStoreReallocate(ListStore *storePtr, Tcl_Size numSlots);
static void	ListRepValidate(const ListRep *repPtr, const char *file,
		    int lineNum);
static void	DupListInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
static void	FreeListInternalRep(Tcl_Obj *listPtr);
static int	SetListFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void	UpdateStringOfList(Tcl_Obj *listPtr);


/*
 * The structure below defines the list Tcl object type by means of functions
 * that can be invoked by generic object code.
 *
 * The internal representation of a list object is ListRep defined in tcl.h.
 */

const Tcl_ObjType tclListType = {
    "list",			/* name */
    FreeListInternalRep,	/* freeIntRepProc */
    DupListInternalRep,		/* dupIntRepProc */
    UpdateStringOfList,		/* updateStringProc */
    SetListFromAny		/* setFromAnyProc */








};

/* Macros to manipulate the List internal rep */
#define ListRepIncrRefs(repPtr_)            \
    do {                                    \
	(repPtr_)->storePtr->refCount++;    \
	if ((repPtr_)->spanPtr)             \







>













|
>
>
>
>
>
>
>
>







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
static ListStore *ListStoreReallocate(ListStore *storePtr, Tcl_Size numSlots);
static void	ListRepValidate(const ListRep *repPtr, const char *file,
		    int lineNum);
static void	DupListInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
static void	FreeListInternalRep(Tcl_Obj *listPtr);
static int	SetListFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void	UpdateStringOfList(Tcl_Obj *listPtr);
static Tcl_Size ListLength(Tcl_Obj *listPtr);

/*
 * The structure below defines the list Tcl object type by means of functions
 * that can be invoked by generic object code.
 *
 * The internal representation of a list object is ListRep defined in tcl.h.
 */

const Tcl_ObjType tclListType = {
    "list",			/* name */
    FreeListInternalRep,	/* freeIntRepProc */
    DupListInternalRep,		/* dupIntRepProc */
    UpdateStringOfList,		/* updateStringProc */
    SetListFromAny,		/* setFromAnyProc */
    TCL_OBJTYPE_V2(
    ListLength,
    NULL,
    NULL,
    NULL,
    NULL,
    NULL,
    NULL)
};

/* Macros to manipulate the List internal rep */
#define ListRepIncrRefs(repPtr_)            \
    do {                                    \
	(repPtr_)->storePtr->refCount++;    \
	if ((repPtr_)->spanPtr)             \
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
static inline int
ListSpanMerited(
    Tcl_Size length,                 /* Length of the proposed span */
    Tcl_Size usedStorageLength,      /* Number of slots currently in used */
    Tcl_Size allocatedStorageLength) /* Length of the currently allocation */
{
    /*
     TODO

     - heuristics thresholds need to be determined
     - currently, information about the sharing (ref count) of existing
       storage is not passed. Perhaps it should be. For example if the
       existing storage has a "large" ref count, then it might make sense
       to do even a small span.
     */

    if (length < LIST_SPAN_THRESHOLD) {
	return 0;/* No span for small lists */
    }
    if (length < (allocatedStorageLength / 2 - allocatedStorageLength / 8)) {
	return 0; /* No span if less than 3/8 of allocation */
    }
    if (length < usedStorageLength / 2) {
	return 0; /* No span if less than half current storage */
    }

    return 1;
}

/*
 *------------------------------------------------------------------------
 *
 * ListStoreUpSize --
 *
 *    For reasons of efficiency, extra space is allocated for a ListStore
 *    compared to what was requested. This function calculates how many
 *    slots should actually be allocated for a given request size.
 *
 * Results:
 *    Number of slots to allocate.
 *
 * Side effects:
 *    None.
 *
 *------------------------------------------------------------------------
 */
static inline Tcl_Size
ListStoreUpSize(Tcl_Size numSlotsRequested) {
    /* TODO -how much extra? May be double only for smaller requests? */
    return numSlotsRequested < (LIST_MAX / 2) ? 2 * numSlotsRequested
						 : LIST_MAX;
}

/*
 *------------------------------------------------------------------------
 *
 * ListRepFreeUnreferenced --
 *
 *    Inline wrapper for ListRepUnsharedFreeUnreferenced that does quick checks







<
>
|
|
|
|
|














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







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
static inline int
ListSpanMerited(
    Tcl_Size length,                 /* Length of the proposed span */
    Tcl_Size usedStorageLength,      /* Number of slots currently in used */
    Tcl_Size allocatedStorageLength) /* Length of the currently allocation */
{
    /*

     * Possible optimizations for future consideration
     * - heuristic LIST_SPAN_THRESHOLD
     * - currently, information about the sharing (ref count) of existing
     * storage is not passed. Perhaps it should be. For example if the
     * existing storage has a "large" ref count, then it might make sense
     * to do even a small span.
     */

    if (length < LIST_SPAN_THRESHOLD) {
	return 0;/* No span for small lists */
    }
    if (length < (allocatedStorageLength / 2 - allocatedStorageLength / 8)) {
	return 0; /* No span if less than 3/8 of allocation */
    }
    if (length < usedStorageLength / 2) {
	return 0; /* No span if less than half current storage */
    }

    return 1;
}

























/*
 *------------------------------------------------------------------------
 *
 * ListRepFreeUnreferenced --
 *
 *    Inline wrapper for ListRepUnsharedFreeUnreferenced that does quick checks
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
    if (objc > LIST_MAX) {
	if (flags & LISTREP_PANIC_ON_FAIL) {
	    Tcl_Panic("max length of a Tcl list exceeded");
	}
	return NULL;
    }


    if (flags & LISTREP_SPACE_FLAGS) {

	capacity = ListStoreUpSize(objc);

    } else {
	capacity = objc;
    }

    storePtr = (ListStore *)Tcl_AttemptAlloc(LIST_SIZE(capacity));
    if (storePtr == NULL && capacity != objc) {
	capacity = objc; /* Try allocating exact size */
	storePtr = (ListStore *)Tcl_AttemptAlloc(LIST_SIZE(capacity));
    }
    if (storePtr == NULL) {
	if (flags & LISTREP_PANIC_ON_FAIL) {
	    Tcl_Panic("list creation failed: unable to alloc %" TCL_Z_MODIFIER "u bytes",

		    LIST_SIZE(objc));
	}
	return NULL;
    }

    storePtr->refCount = 0;
    storePtr->flags = 0;
    storePtr->numAllocated = capacity;







>

>
|
>

<
<
|
<
<
|




|
>
|







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
    if (objc > LIST_MAX) {
	if (flags & LISTREP_PANIC_ON_FAIL) {
	    Tcl_Panic("max length of a Tcl list exceeded");
	}
	return NULL;
    }

    storePtr = NULL;
    if (flags & LISTREP_SPACE_FLAGS) {
	/* Caller requests extra space front, back or both */
	storePtr = (ListStore *)TclAttemptAllocElemsEx(
	    objc, sizeof(Tcl_Obj *), offsetof(ListStore, slots), &capacity);
    } else {


	/* Exact allocation */


	capacity = objc;
	storePtr = (ListStore *)Tcl_AttemptAlloc(LIST_SIZE(capacity));
    }
    if (storePtr == NULL) {
	if (flags & LISTREP_PANIC_ON_FAIL) {
	    Tcl_Panic("list creation failed: unable to alloc %" TCL_Z_MODIFIER
		      "u bytes",
		      LIST_SIZE(objc));
	}
	return NULL;
    }

    storePtr->refCount = 0;
    storePtr->flags = 0;
    storePtr->numAllocated = capacity;
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
}

/*
 *------------------------------------------------------------------------
 *
 * ListStoreReallocate --
 *
 *    Reallocates the memory for a ListStore.

 *
 * Results:
 *    Pointer to the ListStore which may be the same as storePtr or pointer
 *    to a new block of memory. On reallocation failure, NULL is returned.
 *
 *
 * Side effects:
 *    The memory pointed to by storePtr is freed if it a new block has to
 *    be returned.
 *
 *
 *------------------------------------------------------------------------
 */
ListStore *
ListStoreReallocate (ListStore *storePtr, Tcl_Size numSlots)
{
    Tcl_Size newCapacity;
    ListStore *newStorePtr;

    newCapacity = ListStoreUpSize(numSlots);
    newStorePtr =
	(ListStore *)Tcl_AttemptRealloc(storePtr, LIST_SIZE(newCapacity));
    if (newStorePtr == NULL) {
	newCapacity = numSlots;
	newStorePtr = (ListStore *)Tcl_AttemptRealloc(storePtr,
						    LIST_SIZE(newCapacity));
	if (newStorePtr == NULL)
	    return NULL;
    }





    /* Only the capacity has changed, fix it in the header */

    newStorePtr->numAllocated = newCapacity;

    return newStorePtr;
}

/*
 *----------------------------------------------------------------------
 *
 * ListRepInit --
 *
 *      Initializes a ListRep to hold a list internal representation
 *      with space for objc elements.







|
>














|

|
<

<
<
<
<
<
<
<
|
|

>
>
>
>
>

>
|
>
|

|







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
}

/*
 *------------------------------------------------------------------------
 *
 * ListStoreReallocate --
 *
 *    Reallocates the memory for a ListStore allocating extra for
 *    possible future growth.
 *
 * Results:
 *    Pointer to the ListStore which may be the same as storePtr or pointer
 *    to a new block of memory. On reallocation failure, NULL is returned.
 *
 *
 * Side effects:
 *    The memory pointed to by storePtr is freed if it a new block has to
 *    be returned.
 *
 *
 *------------------------------------------------------------------------
 */
ListStore *
ListStoreReallocate (ListStore *storePtr, Tcl_Size needed)
{
    Tcl_Size capacity;









    if (needed > LIST_MAX) {
	return NULL;
    }
    storePtr = (ListStore *)TclAttemptReallocElemsEx(storePtr,
						     needed,
						     sizeof(Tcl_Obj *),
						     offsetof(ListStore, slots),
						     &capacity);
    /* Only the capacity has changed, fix it in the header */
    if (storePtr) {
	storePtr->numAllocated = capacity;
    }
    return storePtr;
}

/*
 *----------------------------------------------------------------------
 *
 * ListRepInit --
 *
 *      Initializes a ListRep to hold a list internal representation
 *      with space for objc elements.
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
	ListObjReplaceRepAndInvalidate(objPtr, &listRep);
    } else {
	TclFreeInternalRep(objPtr);
	TclInvalidateStringRep(objPtr);
	Tcl_InitStringRep(objPtr, NULL, 0);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclListObjCopy --
 *
 *	Makes a "pure list" copy of a list value. This provides for the C
 *	level a counterpart of the [lrange $list 0 end] command, while using
 *	internals details to be as efficient as possible.
 *
 * Results:
 *	Normally returns a pointer to a new Tcl_Obj, that contains the same
 *	list value as *listPtr does. The returned Tcl_Obj has a refCount of
 *	zero. If *listPtr does not hold a list, NULL is returned, and if
 *	interp is non-NULL, an error message is recorded there.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclListObjCopy(
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
    Tcl_Obj *listObj)		/* List object for which an element array is
				 * to be returned. */
{
    Tcl_Obj *copyObj;

    if (!TclHasInternalRep(listObj, &tclListType)) {
	if (TclHasInternalRep(listObj,&tclAbstractListType)) {
	    return Tcl_AbstractListObjCopy(interp, listObj);
	}
	if (SetListFromAny(interp, listObj) != TCL_OK) {
	    return NULL;
	}
    }

    TclNewObj(copyObj);
    TclInvalidateStringRep(copyObj);
    DupListInternalRep(listObj, copyObj);
    return copyObj;
}

/*
 *------------------------------------------------------------------------
 *
 * ListRepRange --
 *
 *	Initializes a ListRep as a range within the passed ListRep.







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







1315
1316
1317
1318
1319
1320
1321












































1322
1323
1324
1325
1326
1327
1328
	ListObjReplaceRepAndInvalidate(objPtr, &listRep);
    } else {
	TclFreeInternalRep(objPtr);
	TclInvalidateStringRep(objPtr);
	Tcl_InitStringRep(objPtr, NULL, 0);
    }
}













































/*
 *------------------------------------------------------------------------
 *
 * ListRepRange --
 *
 *	Initializes a ListRep as a range within the passed ListRep.
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
    /* Take the opportunity to garbage collect */
    /* TODO - we probably do not need the preserveSrcRep here unlike later */
    if (!preserveSrcRep) {
        /* T:listrep-1.{4,5,8,9},2.{4:7},3.{15:18},4.{7,8} */
	ListRepFreeUnreferenced(srcRepPtr);
    } /* else T:listrep-2.{4.2,4.3,5.2,5.3,6.2,7.2,8.1} */

    if (rangeStart == TCL_INDEX_NONE) {
	rangeStart = 0;
    }
    if ((rangeEnd != TCL_INDEX_NONE) && (rangeEnd >= numSrcElems)) {
	rangeEnd = numSrcElems - 1;
    }
    if (rangeStart + 1 > rangeEnd + 1) {
	/* Empty list of capacity 1. */
	ListRepInit(1, NULL, LISTREP_PANIC_ON_FAIL, rangeRepPtr);
	return;
    }

    rangeLen = rangeEnd - rangeStart + 1;








|


|


|







1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
    /* Take the opportunity to garbage collect */
    /* TODO - we probably do not need the preserveSrcRep here unlike later */
    if (!preserveSrcRep) {
        /* T:listrep-1.{4,5,8,9},2.{4:7},3.{15:18},4.{7,8} */
	ListRepFreeUnreferenced(srcRepPtr);
    } /* else T:listrep-2.{4.2,4.3,5.2,5.3,6.2,7.2,8.1} */

    if (rangeStart < 0) {
	rangeStart = 0;
    }
    if (rangeEnd >= numSrcElems) {
	rangeEnd = numSrcElems - 1;
    }
    if (rangeStart > rangeEnd) {
	/* Empty list of capacity 1. */
	ListRepInit(1, NULL, LISTREP_PANIC_ON_FAIL, rangeRepPtr);
	return;
    }

    rangeLen = rangeEnd - rangeStart + 1;

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
 *	to a list object.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclListObjRange(

    Tcl_Obj *listObj,		/* List object to take a range from. */
    Tcl_Size rangeStart,	/* Index of first element to include. */
    Tcl_Size rangeEnd)		/* Index of last element to include. */
{
    ListRep listRep;
    ListRep resultRep;

    int isShared;
    if (TclListObjGetRep(NULL, listObj, &listRep) != TCL_OK)
	return NULL;

    isShared = Tcl_IsShared(listObj);

    ListRepRange(&listRep, rangeStart, rangeEnd, isShared, &resultRep);

    if (isShared) {
        /* T:listrep-1.10.1,2.{4.2,4.3,5.2,5.3,6.2,7.2,8.1} */
	TclNewObj(listObj);
    } /* T:listrep-1.{4.3,5.1,5.2} */
    ListObjReplaceRepAndInvalidate(listObj, &resultRep);
    return listObj;
}
























/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjGetElements --
 *
 *	This function returns an (objc,objv) array of the elements in a list







>








|













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







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
 *	to a list object.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclListObjRange(
    Tcl_Interp *interp,		/* May be NULL. Used for error messages */
    Tcl_Obj *listObj,		/* List object to take a range from. */
    Tcl_Size rangeStart,	/* Index of first element to include. */
    Tcl_Size rangeEnd)		/* Index of last element to include. */
{
    ListRep listRep;
    ListRep resultRep;

    int isShared;
    if (TclListObjGetRep(interp, listObj, &listRep) != TCL_OK)
	return NULL;

    isShared = Tcl_IsShared(listObj);

    ListRepRange(&listRep, rangeStart, rangeEnd, isShared, &resultRep);

    if (isShared) {
        /* T:listrep-1.10.1,2.{4.2,4.3,5.2,5.3,6.2,7.2,8.1} */
	TclNewObj(listObj);
    } /* T:listrep-1.{4.3,5.1,5.2} */
    ListObjReplaceRepAndInvalidate(listObj, &resultRep);
    return listObj;
}

/*
 *----------------------------------------------------------------------
 *
 * TclListObjGetElement --
 *
 *	Returns a single element from the array of the elements in a list
 *	object, without doing doing any bounds checking.  Caller must ensure
 *	that ObjPtr of of type 'tclListType' and that  index is valid for the
 *	list.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclListObjGetElement(
    Tcl_Obj *objPtr,		/* List object for which an element array is
				 * to be returned. */
    Tcl_Size index
)
{
    return ListObjStorePtr(objPtr)->slots[ListObjStart(objPtr) + index];
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjGetElements --
 *
 *	This function returns an (objc,objv) array of the elements in a list
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
    Tcl_Size *objcPtr,		/* Where to store the count of objects
				 * referenced by objv. */
    Tcl_Obj ***objvPtr)		/* Where to store the pointer to an array of
				 * pointers to the list's objects. */
{
    ListRep listRep;

    if (TclAbstractListHasProc(objPtr, TCL_ABSL_GETELEMENTS) &&
	Tcl_AbstractListObjGetElements(interp, objPtr, objcPtr, objvPtr) == TCL_OK) {
	return TCL_OK;
    } else if (TclListObjGetRep(interp, objPtr, &listRep) != TCL_OK) {
	int length;
	(void) Tcl_GetStringFromObj(objPtr, &length);
	if (length == 0) {
	    *objcPtr = 0;
	    *objvPtr = NULL;
	    return TCL_OK;
	}

    	return TCL_ERROR;
    }
    ListRepElements(&listRep, *objcPtr, *objvPtr);
    return TCL_OK;
}

/*







|
|

<
<
<
<
<
<
<
|
>







1622
1623
1624
1625
1626
1627
1628
1629
1630
1631







1632
1633
1634
1635
1636
1637
1638
1639
1640
    Tcl_Size *objcPtr,		/* Where to store the count of objects
				 * referenced by objv. */
    Tcl_Obj ***objvPtr)		/* Where to store the pointer to an array of
				 * pointers to the list's objects. */
{
    ListRep listRep;

    if (TclObjTypeHasProc(objPtr, getElementsProc) &&
	objPtr->typePtr->getElementsProc(interp, objPtr, objcPtr, objvPtr) == TCL_OK) {
	return TCL_OK;







    }
    if (TclListObjGetRep(interp, objPtr, &listRep) != TCL_OK) {
    	return TCL_ERROR;
    }
    ListRepElements(&listRep, *objcPtr, *objvPtr);
    return TCL_OK;
}

/*
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
    if (Tcl_IsShared(toObj)) {
	Tcl_Panic("%s called with shared object", "TclListObjAppendElements");
    }

    if (TclListObjGetRep(interp, toObj, &listRep) != TCL_OK)
	return TCL_ERROR; /* Cannot be converted to a list */

    if (elemCount == 0)
	return TCL_OK; /* Nothing to do. Note AFTER check for list above */

    ListRepElements(&listRep, toLen, toObjv);
    if (elemCount > LIST_MAX || toLen > (LIST_MAX - elemCount)) {
	return ListLimitExceededError(interp);
    }








|







1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
    if (Tcl_IsShared(toObj)) {
	Tcl_Panic("%s called with shared object", "TclListObjAppendElements");
    }

    if (TclListObjGetRep(interp, toObj, &listRep) != TCL_OK)
	return TCL_ERROR; /* Cannot be converted to a list */

    if (elemCount <= 0)
	return TCL_OK; /* Nothing to do. Note AFTER check for list above */

    ListRepElements(&listRep, toLen, toObjv);
    if (elemCount > LIST_MAX || toLen > (LIST_MAX - elemCount)) {
	return ListLimitExceededError(interp);
    }

1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
     */
    if (ListRepInit(finalLen,
		    NULL,
		    listRep.spanPtr ? LISTREP_SPACE_FAVOR_BACK
				    : LISTREP_SPACE_ONLY_BACK,
		    &listRep)
	!= TCL_OK) {
	return TCL_ERROR;
    }
    LIST_ASSERT(listRep.storePtr->numAllocated >= finalLen);

    if (toLen) {
        /* T:listrep-2.{2,9},4.5 */
	ObjArrayCopy(ListRepSlotPtr(&listRep, 0), toLen, toObjv);
    }







|







1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
     */
    if (ListRepInit(finalLen,
		    NULL,
		    listRep.spanPtr ? LISTREP_SPACE_FAVOR_BACK
				    : LISTREP_SPACE_ONLY_BACK,
		    &listRep)
	!= TCL_OK) {
	return MemoryAllocationError(interp, finalLen);
    }
    LIST_ASSERT(listRep.storePtr->numAllocated >= finalLen);

    if (toLen) {
        /* T:listrep-2.{2,9},4.5 */
	ObjArrayCopy(ListRepSlotPtr(&listRep, 0), toLen, toObjv);
    }
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
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjAppendElement --
 *
 *	This function is a special purpose version of Tcl_ListObjAppendList:
 *	it appends a single object referenced by elemObj to the list object
 *	referenced by toObj. If toObj is not already a list object, an
 *	attempt will be made to convert it to one.
 *
 * Results:

 *	The return value is normally TCL_OK; in this case elemObj is added to





 *	the end of toObj's list. If toObj does not refer to a list object
 *	and the object can not be converted to one, TCL_ERROR is returned and
 *	an error message will be left in the interpreter's result if interp is
 *	not NULL.
 *
 * Side effects:


 *	The ref count of elemObj is incremented since the list now refers to
 *	it. toObj will be converted, if necessary, to a list object. Also,
 *	appending the new element may cause listObj's array of element
 *	pointers to grow. toObj's old string representation, if any, is
 *	invalidated.
 *
 *----------------------------------------------------------------------
 */
int
Tcl_ListObjAppendElement(
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
    Tcl_Obj *toObj,		/* List object to append elemObj to. */







|
<
<
<

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

|
>
>
|
<
|
|
|







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
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjAppendElement --
 *
 *	Like 'Tcl_ListObjAppendList', but Appends a single value to a list.



 *
 * Value
 *
 *	TCL_OK
 *
 *	    'objPtr' is appended to the elements of 'listPtr'.
 *
 *	TCL_ERROR
 *
 *	    listPtr does not refer to a list object and the object can not be
 *	    converted to one. An error message will be left in the
 *	    interpreter's result if interp is not NULL.

 *
 * Effect
 *
 *	If 'listPtr' is not already of type 'tclListType', it is converted.
 *	The 'refCount' of 'objPtr' is incremented as it is added to 'listPtr'.

 *	Appending the new element may cause the array of element pointers
 *	in 'listObj' to grow.  Any preexisting string representation of
 *	'listPtr' is invalidated.
 *
 *----------------------------------------------------------------------
 */
int
Tcl_ListObjAppendElement(
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
    Tcl_Obj *toObj,		/* List object to append elemObj to. */
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
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjIndex --
 *
 *	This function returns a pointer to the index'th object from the list
 *	referenced by listPtr. The first element has index 0. If index is
 *	negative or greater than or equal to the number of elements in the
 *	list, a NULL is returned. If listPtr is not a list object, an attempt
 *	will be made to convert it to a list.
 *
 * Results:

 *	The return value is normally TCL_OK; in this case objPtrPtr is set to

 *	the Tcl_Obj pointer for the index'th list element or NULL if index is

 *	out of range. This object should be treated as readonly and its ref
 *	count is _not_ incremented; the caller must do that if it holds on to
 *	the reference. If listPtr does not refer to a list and can't be



 *	converted to one, TCL_ERROR is returned and an error message is left
 *	in the interpreter's result if interp is not NULL.
 *
 * Side effects:

 *	listPtr will be converted, if necessary, to a list object.
 *
 *----------------------------------------------------------------------
 */
int
Tcl_ListObjIndex(
    Tcl_Interp *interp,  /* Used to report errors if not NULL. */
    Tcl_Obj *listObj,    /* List object to index into. */
    Tcl_Size index,           /* Index of element to return. */
    Tcl_Obj **objPtrPtr) /* The resulting Tcl_Obj* is stored here. */
{
    Tcl_Obj **elemObjs;
    Tcl_Size numElems;




    /*
     * TODO

     * Unlike the original list code, this does not optimize for lindex'ing



     * an empty string when the internal rep is not already a list. On the
     * other hand, this code will be faster for the case where the object
     * is currently a dict. Benchmark the two cases.
     */
    if (TclListObjGetElementsM(interp, listObj, &numElems, &elemObjs)
	!= TCL_OK) {
	return TCL_ERROR;
    }
    if (index >= numElems) {
	*objPtrPtr = NULL;
    } else {
	*objPtrPtr = elemObjs[index];
    }

    return TCL_OK;
}







|
|
<
<
<

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

|
>
|







|




>

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




|







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
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjIndex --
 *
 * 	Retrieve a pointer to the element of 'listPtr' at 'index'.  The index
 * 	of the first element is 0.



 *
 * Value
 *
 * 	TCL_OK
 *
 *	    A pointer to the element at 'index' is stored in 'objPtrPtr'.  If
 *	    'index' is out of range, NULL is stored in 'objPtrPtr'.  This
 *	    object should be treated as readonly and its 'refCount' is _not_
 *	    incremented. The caller must do that if it holds on to the
 *	    reference.
 *
 * 	TCL_ERROR
 *
 * 	    'listPtr' is not a valid list. An error message is left in the
 * 	    interpreter's result if 'interp' is not NULL.
 *
 *  Effect
 *
 * 	If 'listPtr' is not already of type 'tclListType', it is converted.
 *
 *----------------------------------------------------------------------
 */
int
Tcl_ListObjIndex(
    Tcl_Interp *interp,  /* Used to report errors if not NULL. */
    Tcl_Obj *listObj,    /* List object to index into. */
    Tcl_Size index,      /* Index of element to return. */
    Tcl_Obj **objPtrPtr) /* The resulting Tcl_Obj* is stored here. */
{
    Tcl_Obj **elemObjs;
    Tcl_Size numElems;
    int hasAbstractList = TclObjTypeHasProc(listObj,indexProc) != 0;

    /* Empty string => empty list. Avoid unnecessary shimmering */
    if (listObj->bytes == &tclEmptyString) {
	*objPtrPtr = NULL;
	return TCL_OK;
    }

    if (hasAbstractList) {
	return Tcl_ObjTypeIndex(interp, listObj, index, objPtrPtr);
    }




    if (TclListObjGetElementsM(interp, listObj, &numElems, &elemObjs)
	!= TCL_OK) {
	return TCL_ERROR;
    }
    if (index < 0 || index >= numElems) {
	*objPtrPtr = NULL;
    } else {
	*objPtrPtr = elemObjs[index];
    }

    return TCL_OK;
}
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
 */

#undef Tcl_ListObjLength
int
Tcl_ListObjLength(
    Tcl_Interp *interp,	/* Used to report errors if not NULL. */
    Tcl_Obj *listObj,	/* List object whose #elements to return. */
    Tcl_Size *lenPtr)	/* The resulting int is stored here. */
{
    ListRep listRep;

    /* Handle AbstractList before attempting SetListFromAny */
    if (!TclHasInternalRep(listObj, &tclListType) &&



	TclHasInternalRep(listObj, &tclAbstractListType)) {


	*lenPtr = Tcl_AbstractListObjLength(listObj);
	return TCL_OK;
    }

    /*
     * TODO
     * Unlike the original list code, this does not optimize for lindex'ing
     * an empty string when the internal rep is not already a list. On the
     * other hand, this code will be faster for the case where the object
     * is currently a dict. Benchmark the two cases.
     */
    if (TclListObjGetRep(interp, listObj, &listRep) != TCL_OK) {
	return TCL_ERROR;
    }
    *lenPtr = ListRepLength(&listRep);
    return TCL_OK;
}










/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjReplace --
 *
 *	This function replaces zero or more elements of the list referenced by







|



|
|
>
>
>
|
>
>
|



|
<
<
<
<
<
<






>
>
>
>
>
>
>
>
>







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

#undef Tcl_ListObjLength
int
Tcl_ListObjLength(
    Tcl_Interp *interp,	/* Used to report errors if not NULL. */
    Tcl_Obj *listObj,	/* List object whose #elements to return. */
    Tcl_Size *lenPtr)	/* The resulting length is stored here. */
{
    ListRep listRep;

    /* Empty string => empty list. Avoid unnecessary shimmering */
    if (listObj->bytes == &tclEmptyString) {
	*lenPtr = 0;
	return TCL_OK;
    }

    Tcl_Size (*lengthProc)(Tcl_Obj *obj) =  TclObjTypeHasProc(listObj, lengthProc);
    if (lengthProc) {
	*lenPtr = lengthProc(listObj);
	return TCL_OK;
    }








    if (TclListObjGetRep(interp, listObj, &listRep) != TCL_OK) {
	return TCL_ERROR;
    }
    *lenPtr = ListRepLength(&listRep);
    return TCL_OK;
}

Tcl_Size
ListLength(Tcl_Obj *listPtr)
{
    ListRep listRep;
    ListObjGetRep(listPtr, &listRep);

    return ListRepLength(&listRep);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjReplace --
 *
 *	This function replaces zero or more elements of the list referenced by
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
    Tcl_Size first,		/* Index of first element to replace. */
    Tcl_Size numToDelete,	/* Number of elements to replace. */
    Tcl_Size numToInsert,	/* Number of objects to insert. */
    Tcl_Obj *const insertObjs[])/* Tcl objects to insert */
{
    ListRep listRep;
    Tcl_Size origListLen;
    ptrdiff_t lenChange;
    ptrdiff_t leadSegmentLen;
    ptrdiff_t tailSegmentLen;
    Tcl_Size numFreeSlots;
    ptrdiff_t leadShift;
    ptrdiff_t tailShift;
    Tcl_Obj **listObjs;
    int favor;

    if (Tcl_IsShared(listObj)) {
	Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace");
    }

    if (TclAbstractListHasProc(listObj, TCL_ABSL_REPLACE)) {
	return Tcl_AbstractListObjReplace(interp, listObj, first,
					  numToDelete, numToInsert, insertObjs);
    }

    if (TclListObjGetRep(interp, listObj, &listRep) != TCL_OK)
	return TCL_ERROR; /* Cannot be converted to a list */

    /* TODO - will need modification if Tcl9 sticks to unsigned indices */

    /* Make limits sane */
    origListLen = ListRepLength(&listRep);
    if (first == TCL_INDEX_NONE) {
	first = 0;
    }
    if (first > origListLen) {
	first = origListLen;	/* So we'll insert after last element. */
    }
    if (numToDelete == TCL_INDEX_NONE) {
	numToDelete = 0;
    } else if (first > ListSizeT_MAX - numToDelete /* Handle integer overflow */
             || origListLen < first + numToDelete) {
	numToDelete = origListLen - first;
    }

    if (numToInsert > ListSizeT_MAX - (origListLen - numToDelete)) {
	return ListLimitExceededError(interp);
    }

    if ((first+numToDelete) >= origListLen) {
	/* Operating at back of list. Favor leaving space at back */
	favor = LISTREP_SPACE_FAVOR_BACK;
    } else if (first == 0) {







|
|
|

|
|







|
|
|





<
<


|





|

|




|







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
    Tcl_Size first,		/* Index of first element to replace. */
    Tcl_Size numToDelete,	/* Number of elements to replace. */
    Tcl_Size numToInsert,	/* Number of objects to insert. */
    Tcl_Obj *const insertObjs[])/* Tcl objects to insert */
{
    ListRep listRep;
    Tcl_Size origListLen;
    Tcl_Size lenChange;
    Tcl_Size leadSegmentLen;
    Tcl_Size tailSegmentLen;
    Tcl_Size numFreeSlots;
    Tcl_Size leadShift;
    Tcl_Size tailShift;
    Tcl_Obj **listObjs;
    int favor;

    if (Tcl_IsShared(listObj)) {
	Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace");
    }

    if (TclObjTypeHasProc(listObj, replaceProc)) {
	return Tcl_ObjTypeReplace(interp, listObj, first,
				  numToDelete, numToInsert, insertObjs);
    }

    if (TclListObjGetRep(interp, listObj, &listRep) != TCL_OK)
	return TCL_ERROR; /* Cannot be converted to a list */



    /* Make limits sane */
    origListLen = ListRepLength(&listRep);
    if (first < 0) {
	first = 0;
    }
    if (first > origListLen) {
	first = origListLen;	/* So we'll insert after last element. */
    }
    if (numToDelete < 0) {
	numToDelete = 0;
    } else if (first > LIST_MAX - numToDelete /* Handle integer overflow */
             || origListLen < first + numToDelete) {
	numToDelete = origListLen - first;
    }

    if (numToInsert > LIST_MAX - (origListLen - numToDelete)) {
	return ListLimitExceededError(interp);
    }

    if ((first+numToDelete) >= origListLen) {
	/* Operating at back of list. Favor leaving space at back */
	favor = LISTREP_SPACE_FAVOR_BACK;
    } else if (first == 0) {
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
     * later by not having to go through the ListRepInit and
     * ListObjReplaceAndInvalidate below.
     * TODO - we could be smarter about the reallocate. Use of realloc
     * means all new free space is at the back. Instead, the realloc could
     * be an explicit alloc and memmove which would let us redistribute
     * free space.
     */
    if ((ptrdiff_t)numFreeSlots < lenChange && !ListRepIsShared(&listRep)) {
	/* T:listrep-1.{1,3,14,18,21},3.{3,10,11,14,27,32,41} */
	ListStore *newStorePtr =
	    ListStoreReallocate(listRep.storePtr, origListLen + lenChange);
	if (newStorePtr == NULL) {
	    return MemoryAllocationError(interp,
					 LIST_SIZE(origListLen + lenChange));
	}







|







2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
     * later by not having to go through the ListRepInit and
     * ListObjReplaceAndInvalidate below.
     * TODO - we could be smarter about the reallocate. Use of realloc
     * means all new free space is at the back. Instead, the realloc could
     * be an explicit alloc and memmove which would let us redistribute
     * free space.
     */
    if (numFreeSlots < lenChange && !ListRepIsShared(&listRep)) {
	/* T:listrep-1.{1,3,14,18,21},3.{3,10,11,14,27,32,41} */
	ListStore *newStorePtr =
	    ListStoreReallocate(listRep.storePtr, origListLen + lenChange);
	if (newStorePtr == NULL) {
	    return MemoryAllocationError(interp,
					 LIST_SIZE(origListLen + lenChange));
	}
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
     * Case (3) a new ListStore is required
     * (a) The passed-in ListStore is shared
     * (b) There is not enough free space in the unshared passed-in ListStore
     * (c) The new unshared size is much "smaller" (TODO) than the allocated space
     * TODO - for unshared case ONLY, consider a "move" based implementation
     */
    if (ListRepIsShared(&listRep) || /* 3a */
	(ptrdiff_t)numFreeSlots < lenChange ||  /* 3b */
	(origListLen + lenChange) < (listRep.storePtr->numAllocated / 4) /* 3c */
    ) {
	ListRep newRep;
	Tcl_Obj **toObjs;
	listObjs = &listRep.storePtr->slots[ListRepStart(&listRep)];
	ListRepInit(origListLen + lenChange,
		    NULL,







|







2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
     * Case (3) a new ListStore is required
     * (a) The passed-in ListStore is shared
     * (b) There is not enough free space in the unshared passed-in ListStore
     * (c) The new unshared size is much "smaller" (TODO) than the allocated space
     * TODO - for unshared case ONLY, consider a "move" based implementation
     */
    if (ListRepIsShared(&listRep) || /* 3a */
	numFreeSlots < lenChange ||  /* 3b */
	(origListLen + lenChange) < (listRep.storePtr->numAllocated / 4) /* 3c */
    ) {
	ListRep newRep;
	Tcl_Obj **toObjs;
	listObjs = &listRep.storePtr->slots[ListRepStart(&listRep)];
	ListRepInit(origListLen + lenChange,
		    NULL,
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
    /*
     * TODO - below the moves are optimized but this may result in needing a
     * span allocation. Perhaps for small lists, it may be more efficient to
     * just move everything up front and save on allocating a span.
     */

    /*
     * Calculate shifts if necessary to accomodate insertions.
     * NOTE: all indices are relative to listObjs which is not necessarily the
     * start of the ListStore storage area.
     *
     * leadShift - how much to shift the lead segment
     * tailShift - how much to shift the tail segment
     * insertTarget - index where to insert.
     */







|







2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
    /*
     * TODO - below the moves are optimized but this may result in needing a
     * span allocation. Perhaps for small lists, it may be more efficient to
     * just move everything up front and save on allocating a span.
     */

    /*
     * Calculate shifts if necessary to accommodate insertions.
     * NOTE: all indices are relative to listObjs which is not necessarily the
     * start of the ListStore storage area.
     *
     * leadShift - how much to shift the lead segment
     * tailShift - how much to shift the tail segment
     * insertTarget - index where to insert.
     */
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

	/*
	 * We need to make room for the insertions. Again we have multiple
	 * possibilities. We may be able to get by just shifting one segment
	 * or need to shift both. In the former case, favor shifting the
	 * smaller segment.
	 */
	ptrdiff_t leadSpace = ListRepNumFreeHead(&listRep);
	ptrdiff_t tailSpace = ListRepNumFreeTail(&listRep);
	ptrdiff_t finalFreeSpace = leadSpace + tailSpace - lenChange;

	LIST_ASSERT((leadSpace + tailSpace) >= lenChange);
	if (leadSpace >= lenChange
	    && (leadSegmentLen < tailSegmentLen || tailSpace < lenChange)) {
	    /* Move only lead to the front to make more room */
            /* T:listrep-3.25,36,38, */
	    leadShift = -lenChange;
	    tailShift = 0;
	    /*
	     * Redistribute the remaining free space between the front and
	     * back if either there is no tail space left or if the
	     * entire list is the head anyways. This is an important
	     * optimization for further operations like further asymmetric
	     * insertions.
	     */
	    if (finalFreeSpace > 1 && (tailSpace == 0 || tailSegmentLen == 0)) {
		ptrdiff_t postShiftLeadSpace = leadSpace - lenChange;
		if (postShiftLeadSpace > (finalFreeSpace/2)) {
		    Tcl_Size extraShift = postShiftLeadSpace - (finalFreeSpace / 2);
		    leadShift -= extraShift;
		    tailShift = -extraShift; /* Move tail to the front as well */
		}
	    } /* else T:listrep-3.{7,12,25,38} */
	    LIST_ASSERT(leadShift >= 0 || leadSpace >= -leadShift);
	} else if (tailSpace >= lenChange) {
	    /* Move only tail segment to the back to make more room. */
            /* T:listrep-3.{8,10,11,14,26,27,30,32,37,39,41} */
	    leadShift = 0;
	    tailShift = lenChange;
	    /*
	     * See comments above. This is analogous.
	     */
	    if (finalFreeSpace > 1 && (leadSpace == 0 || leadSegmentLen == 0)) {
		ptrdiff_t postShiftTailSpace = tailSpace - lenChange;
		if (postShiftTailSpace > (finalFreeSpace/2)) {
		    /* T:listrep-1.{1,3,14,18,21},3.{2,3,26,27} */
		    Tcl_Size extraShift = postShiftTailSpace - (finalFreeSpace / 2);
		    tailShift += extraShift;
		    leadShift = extraShift; /* Move head to the back as well */
		}
	    }







|
|
|
















|
















|







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

	/*
	 * We need to make room for the insertions. Again we have multiple
	 * possibilities. We may be able to get by just shifting one segment
	 * or need to shift both. In the former case, favor shifting the
	 * smaller segment.
	 */
	Tcl_Size leadSpace = ListRepNumFreeHead(&listRep);
	Tcl_Size tailSpace = ListRepNumFreeTail(&listRep);
	Tcl_Size finalFreeSpace = leadSpace + tailSpace - lenChange;

	LIST_ASSERT((leadSpace + tailSpace) >= lenChange);
	if (leadSpace >= lenChange
	    && (leadSegmentLen < tailSegmentLen || tailSpace < lenChange)) {
	    /* Move only lead to the front to make more room */
            /* T:listrep-3.25,36,38, */
	    leadShift = -lenChange;
	    tailShift = 0;
	    /*
	     * Redistribute the remaining free space between the front and
	     * back if either there is no tail space left or if the
	     * entire list is the head anyways. This is an important
	     * optimization for further operations like further asymmetric
	     * insertions.
	     */
	    if (finalFreeSpace > 1 && (tailSpace == 0 || tailSegmentLen == 0)) {
		Tcl_Size postShiftLeadSpace = leadSpace - lenChange;
		if (postShiftLeadSpace > (finalFreeSpace/2)) {
		    Tcl_Size extraShift = postShiftLeadSpace - (finalFreeSpace / 2);
		    leadShift -= extraShift;
		    tailShift = -extraShift; /* Move tail to the front as well */
		}
	    } /* else T:listrep-3.{7,12,25,38} */
	    LIST_ASSERT(leadShift >= 0 || leadSpace >= -leadShift);
	} else if (tailSpace >= lenChange) {
	    /* Move only tail segment to the back to make more room. */
            /* T:listrep-3.{8,10,11,14,26,27,30,32,37,39,41} */
	    leadShift = 0;
	    tailShift = lenChange;
	    /*
	     * See comments above. This is analogous.
	     */
	    if (finalFreeSpace > 1 && (leadSpace == 0 || leadSegmentLen == 0)) {
		Tcl_Size postShiftTailSpace = tailSpace - lenChange;
		if (postShiftTailSpace > (finalFreeSpace/2)) {
		    /* T:listrep-1.{1,3,14,18,21},3.{2,3,26,27} */
		    Tcl_Size extraShift = postShiftTailSpace - (finalFreeSpace / 2);
		    tailShift += extraShift;
		    leadShift = extraShift; /* Move head to the back as well */
		}
	    }
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
    Tcl_Obj *listObj,		/* List being unpacked. */
    Tcl_Obj *argObj)		/* Index or index list. */
{
    Tcl_Size index;			/* Index into the list. */
    Tcl_Obj *indexListCopy;
    Tcl_Obj **indexObjs;
    Tcl_Size numIndexObjs;


    /*
     * Determine whether argPtr designates a list or a single index. We have
     * to be careful about the order of the checks to avoid repeated
     * shimmering; if internal rep is already a list do not shimmer it.
     * see TIP#22 and TIP#33 for the details.
     */
    if (!TclHasInternalRep(argObj, &tclListType)
	&& TclGetIntForIndexM(NULL, argObj, ListSizeT_MAX - 1, &index)
	       == TCL_OK) {
	/*
	 * argPtr designates a single index.
	 */
	return TclLindexFlat(interp, listObj, 1, &argObj);
    }

    /*
     * Here we make a private copy of the index list argument to avoid any
     * shimmering issues that might invalidate the indices array below while
     * we are still using it. This is probably unnecessary. It does not appear
     * that any damaging shimmering is possible, and no test has been devised
     * to show any error when this private copy is not made. But it's cheap,
     * and it offers some future-proofing insurance in case the TclLindexFlat
     * implementation changes in some unexpected way, or some new form of
     * trace or callback permits things to happen that the current
     * implementation does not.
     */


    indexListCopy = TclListObjCopy(NULL, argObj);










    if (indexListCopy == NULL) {
	/*
	 * The argument is neither an index nor a well-formed list.
	 * Report the error via TclLindexFlat.
	 * TODO - This is as original. why not directly return an error?
	 */
	return TclLindexFlat(interp, listObj, 1, &argObj);
    }

    ListObjGetElements(indexListCopy, numIndexObjs, indexObjs);
    listObj = TclLindexFlat(interp, listObj, numIndexObjs, indexObjs);
    Tcl_DecrRefCount(indexListCopy);
    return listObj;
}

/*
 *----------------------------------------------------------------------







>








|








|
|
|
|
|
|
|
|
|


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



|



<
<







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
    Tcl_Obj *listObj,		/* List being unpacked. */
    Tcl_Obj *argObj)		/* Index or index list. */
{
    Tcl_Size index;			/* Index into the list. */
    Tcl_Obj *indexListCopy;
    Tcl_Obj **indexObjs;
    Tcl_Size numIndexObjs;
    int status;

    /*
     * Determine whether argPtr designates a list or a single index. We have
     * to be careful about the order of the checks to avoid repeated
     * shimmering; if internal rep is already a list do not shimmer it.
     * see TIP#22 and TIP#33 for the details.
     */
    if (!TclHasInternalRep(argObj, &tclListType)
	&& TclGetIntForIndexM(NULL, argObj, TCL_SIZE_MAX - 1, &index)
	       == TCL_OK) {
	/*
	 * argPtr designates a single index.
	 */
	return TclLindexFlat(interp, listObj, 1, &argObj);
    }

    /*
     * Make a private copy of the index list argument to keep the internal
     * representation of th indices array unchanged while it is in use.  This
     * is probably unnecessary. It does not appear that any damaging change to
     * the internal representation is possible, and no test has been devised to
     * show any error when this private copy is not made, But it's cheap, and
     * it offers some future-proofing insurance in case the TclLindexFlat
     * implementation changes in some unexpected way, or some new form of trace
     * or callback permits things to happen that the current implementation
     * does not.
     */

    indexListCopy = TclDuplicatePureObj(interp, argObj, &tclListType);
    if (!indexListCopy) {
	/*
	 * The argument is neither an index nor a well-formed list.
	 * Report the error via TclLindexFlat.
	 * TODO - This is as original code. why not directly return an error?
	 */
	return TclLindexFlat(interp, listObj, 1, &argObj);
    }
    status = TclListObjGetElementsM(
	interp, indexListCopy, &numIndexObjs, &indexObjs);
    if (status != TCL_OK) {
	Tcl_DecrRefCount(indexListCopy);
	/*
	 * The argument is neither an index nor a well-formed list.
	 * Report the error via TclLindexFlat.
	 * TODO - This is as original code. why not directly return an error?
	 */
	return TclLindexFlat(interp, listObj, 1, &argObj);
    }


    listObj = TclLindexFlat(interp, listObj, numIndexObjs, indexObjs);
    Tcl_DecrRefCount(indexListCopy);
    return listObj;
}

/*
 *----------------------------------------------------------------------
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
 *
 *----------------------------------------------------------------------
 */
Tcl_Obj *
TclLindexFlat(
    Tcl_Interp *interp,		/* Tcl interpreter. */
    Tcl_Obj *listObj,		/* Tcl object representing the list. */
    Tcl_Size indexCount,		/* Count of indices. */
    Tcl_Obj *const indexArray[])/* Array of pointers to Tcl objects that
				 * represent the indices in the list. */
{

    Tcl_Size i;

    /* Handle AbstractList as special case */
    if (TclHasInternalRep(listObj,&tclAbstractListType)) {
	Tcl_WideInt listLen = Tcl_AbstractListObjLength(listObj);
	Tcl_Size index;
	Tcl_Obj *elemObj = NULL;
	for (i=0 ; i<indexCount && listObj ; i++) {
	    if (TclGetIntForIndexM(interp, indexArray[i], /*endValue*/ listLen-1,
				   &index) == TCL_OK) {
	    }
	    if (i==0) {
		if (Tcl_AbstractListObjIndex(interp, listObj, index, &elemObj) != TCL_OK) {
		    return NULL;
		}
	    } else if (index > 0) {
		// TODO: support nested lists
		// For now, only support 1 index, which is all an ArithSeries has
		Tcl_DecrRefCount(elemObj);
		TclNewObj(elemObj);
		break;
	    }
	}
	Tcl_IncrRefCount(elemObj);
	return elemObj;
    }

    Tcl_IncrRefCount(listObj);

    for (i=0 ; i<indexCount && listObj ; i++) {
	Tcl_Size index, listLen = 0;
	Tcl_Obj **elemPtrs = NULL, *sublistCopy;

	/*
	 * Here we make a private copy of the current sublist, so we avoid any
	 * shimmering issues that might invalidate the elemPtr array below
	 * while we are still using it. See test lindex-8.4.
	 */

	sublistCopy = TclListObjCopy(interp, listObj);

	Tcl_DecrRefCount(listObj);
	listObj = NULL;

	if (sublistCopy == NULL) {
	    /* The sublist is not a list at all => error.  */
	    break;
	}
	LIST_ASSERT_TYPE(sublistCopy);
	ListObjGetElements(sublistCopy, listLen, elemPtrs);

	if (TclGetIntForIndexM(interp, indexArray[i], /*endValue*/ listLen-1,
		&index) == TCL_OK) {
	    if (index >= listLen) {
		/*
		 * Index is out of range. Break out of loop with empty result.
		 * First check remaining indices for validity
		 */

		while (++i < indexCount) {
		    if (TclGetIntForIndexM(
			    interp, indexArray[i], ListSizeT_MAX - 1, &index)
			!= TCL_OK) {
			Tcl_DecrRefCount(sublistCopy);
			return NULL;
		    }
		}

		TclNewObj(listObj);

	    } else {


		/* Extract the pointer to the appropriate element. */






		listObj = elemPtrs[index];

	    }







	    Tcl_IncrRefCount(listObj);



	}

	Tcl_DecrRefCount(sublistCopy);

    }

    return listObj;
}

/*
 *----------------------------------------------------------------------
 *
 * TclLsetList --







|



>



|
|







|




|

|
<










|

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


|







|

|



>

>

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







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
 *
 *----------------------------------------------------------------------
 */
Tcl_Obj *
TclLindexFlat(
    Tcl_Interp *interp,		/* Tcl interpreter. */
    Tcl_Obj *listObj,		/* Tcl object representing the list. */
    Tcl_Size indexCount,	/* Count of indices. */
    Tcl_Obj *const indexArray[])/* Array of pointers to Tcl objects that
				 * represent the indices in the list. */
{
    int status;
    Tcl_Size i;

    /* Handle AbstractList as special case */
    if (TclObjTypeHasProc(listObj,indexProc)) {
	Tcl_Size listLen = TclObjTypeHasProc(listObj,lengthProc)(listObj);
	Tcl_Size index;
	Tcl_Obj *elemObj = NULL;
	for (i=0 ; i<indexCount && listObj ; i++) {
	    if (TclGetIntForIndexM(interp, indexArray[i], /*endValue*/ listLen-1,
				   &index) == TCL_OK) {
	    }
	    if (i==0) {
		if (Tcl_ObjTypeIndex(interp, listObj, index, &elemObj) != TCL_OK) {
		    return NULL;
		}
	    } else if (index > 0) {
		// TODO: support nested lists
		Tcl_Obj *e2Obj = TclLindexFlat(interp, elemObj, 1, &indexArray[i]);
		Tcl_DecrRefCount(elemObj);
		elemObj = e2Obj;

	    }
	}
	Tcl_IncrRefCount(elemObj);
	return elemObj;
    }

    Tcl_IncrRefCount(listObj);

    for (i=0 ; i<indexCount && listObj ; i++) {
	Tcl_Size index, listLen = 0;
	Tcl_Obj **elemPtrs = NULL;






	status = Tcl_ListObjLength(interp, listObj, &listLen);

	if (status != TCL_OK) {
	    Tcl_DecrRefCount(listObj);
	    return NULL;
	}







	if (TclGetIntForIndexM(interp, indexArray[i], /*endValue*/ listLen-1,
		&index) == TCL_OK) {
	    if (index < 0 || index >= listLen) {
		/*
		 * Index is out of range. Break out of loop with empty result.
		 * First check remaining indices for validity
		 */

		while (++i < indexCount) {
		    if (TclGetIntForIndexM(
			    interp, indexArray[i], TCL_SIZE_MAX - 1, &index)
			!= TCL_OK) {
			Tcl_DecrRefCount(listObj);
			return NULL;
		    }
		}
		Tcl_DecrRefCount(listObj);
		TclNewObj(listObj);
		Tcl_IncrRefCount(listObj);
	    } else {
		Tcl_Obj *itemObj;
		/*
		 * Must set the internal rep again because it may have been
		 * changed by TclGetIntForIndexM. See test lindex-8.4.
		 */
		if (!TclHasInternalRep(listObj, &tclListType)) {
		    status = SetListFromAny(interp, listObj);
		    if (status != TCL_OK) {
			/* The list is not a list at all => error.  */
			Tcl_DecrRefCount(listObj);
			return NULL;
		    }
		}

		ListObjGetElements(listObj, listLen, elemPtrs);
		/* increment this reference count first before decrementing
		 * just in case they are the same Tcl_Obj
		 */
		itemObj = elemPtrs[index];
		Tcl_IncrRefCount(itemObj);
		Tcl_DecrRefCount(listObj);
		/* Extract the pointer to the appropriate element. */
		listObj = itemObj;
	    }
	} else {
	    Tcl_DecrRefCount(listObj);
	    listObj = NULL;
	}
    }
    return listObj;
}

/*
 *----------------------------------------------------------------------
 *
 * TclLsetList --
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
    /*
     * Determine whether the index arg designates a list or a single index.
     * We have to be careful about the order of the checks to avoid repeated
     * shimmering; see TIP #22 and #23 for details.
     */

    if (!TclHasInternalRep(indexArgObj, &tclListType) &&
	TclGetIntForIndexM(NULL, indexArgObj, ListSizeT_MAX - 1, &index)
	== TCL_OK) {

	if (TclAbstractListHasProc(listObj, TCL_ABSL_SETELEMENT)) {
	    indices = &indexArgObj;
	    Tcl_Obj *returnValue =
		Tcl_AbstractListSetElement(interp, listObj, 1, indices, valueObj);
	    if (returnValue) Tcl_IncrRefCount(returnValue);
	    return returnValue;
	}

	/* indexArgPtr designates a single index. */
	/* T:listrep-1.{2.1,12.1,15.1,19.1},2.{2.3,9.3,10.1,13.1,16.1}, 3.{4,5,6}.3 */
	return TclLsetFlat(interp, listObj, 1, &indexArgObj, valueObj);

    }

    /*
     * Make copy to not shimmer index argument
     */
    indexListCopy = TclListObjCopy(NULL, indexArgObj);

    if (indexListCopy == NULL) {
	/*
	 * indexArgPtr designates something that is neither an index nor a
	 * well formed list. Report the error via TclLsetFlat.
	 */
	indexCount = 1;
	indices = &indexArgObj;

    } else {




	/*

	 * Expand list into indicies array
	 */



	LIST_ASSERT_TYPE(indexListCopy);
	ListObjGetElements(indexListCopy, indexCount, indices);






    }




    retValueObj = TclLsetFlat(interp, listObj, indexCount, indices, valueObj);

    if (indexListCopy) {
	Tcl_DecrRefCount(indexListCopy);
    }




    return retValueObj;
}

/*
 *----------------------------------------------------------------------
 *
 * TclLsetFlat --







|


|

|
|
|
<
|

|
|
|
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<


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

|
<
|
|
|
|
>
>
>







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
    /*
     * Determine whether the index arg designates a list or a single index.
     * We have to be careful about the order of the checks to avoid repeated
     * shimmering; see TIP #22 and #23 for details.
     */

    if (!TclHasInternalRep(indexArgObj, &tclListType) &&
	TclGetIntForIndexM(NULL, indexArgObj, TCL_SIZE_MAX - 1, &index)
	== TCL_OK) {

	if (TclObjTypeHasProc(listObj, setElementProc)) {
	    indices = &indexArgObj;
	    retValueObj =
		Tcl_ObjTypeSetElement(interp, listObj, 1, indices, valueObj);
	    if (retValueObj) Tcl_IncrRefCount(retValueObj);

	} else {

	    /* indexArgPtr designates a single index. */
	    /* T:listrep-1.{2.1,12.1,15.1,19.1},2.{2.3,9.3,10.1,13.1,16.1}, 3.{4,5,6}.3 */
	    retValueObj = TclLsetFlat(interp, listObj, 1, &indexArgObj, valueObj);
	}















    } else {

	indexListCopy = TclDuplicatePureObj(
	    interp, indexArgObj, &tclListType);
	if (!indexListCopy) {
	    /*
	     * indexArgPtr designates something that is neither an index nor a
	     * well formed list. Report the error via TclLsetFlat.
	     */
	    retValueObj = TclLsetFlat(interp, listObj, 1, &indexArgObj, valueObj);
	} else {
	    if (TCL_OK != TclListObjGetElementsM(
		    interp, indexListCopy, &indexCount, &indices)) {
		Tcl_DecrRefCount(indexListCopy);
		/*
		 * indexArgPtr designates something that is neither an index nor a
		 * well formed list. Report the error via TclLsetFlat.
		 */
		retValueObj = TclLsetFlat(interp, listObj, 1, &indexArgObj, valueObj);
	    } else {

		/*
		 * Let TclLsetFlat perform the actual lset operation.
		 */

		retValueObj = TclLsetFlat(interp, listObj, indexCount, indices, valueObj);

		if (indexListCopy) {
		    Tcl_DecrRefCount(indexListCopy);
		}
	    }
	}
    }
    assert (retValueObj==NULL || retValueObj->typePtr || retValueObj->bytes);
    return retValueObj;
}

/*
 *----------------------------------------------------------------------
 *
 * TclLsetFlat --
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
    Tcl_Obj *listObj,		/* Pointer to the list being modified. */
    Tcl_Size indexCount,		/* Number of index args. */
    Tcl_Obj *const indexArray[],
				/* Index args. */
    Tcl_Obj *valueObj)		/* Value arg to 'lset' or NULL to 'lpop'. */
{
    Tcl_Size index, len;
    int result;
    Tcl_Obj *subListObj, *retValueObj;
    Tcl_Obj *pendingInvalidates[10];
    Tcl_Obj **pendingInvalidatesPtr = pendingInvalidates;
    Tcl_Size numPendingInvalidates = 0;

    /*
     * If there are no indices, simply return the new value.  (Without
     * indices, [lset] is a synonym for [set].
     * [lpop] does not use this but protect for NULL valueObj just in case.
     */

    if (indexCount == 0) {
	if (valueObj != NULL) {
	    Tcl_IncrRefCount(valueObj);
	}
	return valueObj;
    }

    /*
     * If the list is shared, make a copy we can modify (copy-on-write).  We
     * use Tcl_DuplicateObj() instead of TclListObjCopy() for a few reasons:
     * 1) we have not yet confirmed listObj is actually a list; 2) We make a
     * verbatim copy of any existing string rep, and when we combine that with
     * the delayed invalidation of string reps of modified Tcl_Obj's
     * implemented below, the outcome is that any error condition that causes
     * this routine to return NULL, will leave the string rep of listObj and
     * all elements to be unchanged.
     */

    subListObj = Tcl_IsShared(listObj) ? Tcl_DuplicateObj(listObj) : listObj;





    /*
     * Anchor the linked list of Tcl_Obj's whose string reps must be
     * invalidated if the operation succeeds.
     */

    retValueObj = subListObj;







|



















|
<
<
<
<
<
<
|


|
>
>
>
>







2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878






2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
    Tcl_Obj *listObj,		/* Pointer to the list being modified. */
    Tcl_Size indexCount,		/* Number of index args. */
    Tcl_Obj *const indexArray[],
				/* Index args. */
    Tcl_Obj *valueObj)		/* Value arg to 'lset' or NULL to 'lpop'. */
{
    Tcl_Size index, len;
    int copied = 0, result;
    Tcl_Obj *subListObj, *retValueObj;
    Tcl_Obj *pendingInvalidates[10];
    Tcl_Obj **pendingInvalidatesPtr = pendingInvalidates;
    Tcl_Size numPendingInvalidates = 0;

    /*
     * If there are no indices, simply return the new value.  (Without
     * indices, [lset] is a synonym for [set].
     * [lpop] does not use this but protect for NULL valueObj just in case.
     */

    if (indexCount == 0) {
	if (valueObj != NULL) {
	    Tcl_IncrRefCount(valueObj);
	}
	return valueObj;
    }

    /*
     * If the list is shared, make a copy to modify (copy-on-write). The string






     * representation and internal representation of listObj remains unchanged.
     */

    subListObj = Tcl_IsShared(listObj)
	? TclDuplicatePureObj(interp, listObj, &tclListType) : listObj;
    if (!subListObj) {
	return NULL;
    }

    /*
     * Anchor the linked list of Tcl_Obj's whose string reps must be
     * invalidated if the operation succeeds.
     */

    retValueObj = subListObj;
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
	    /* ...the index we're trying to use isn't an index at all. */
	    result = TCL_ERROR;
	    indexArray++; /* Why bother with this increment? TBD */
	    break;
	}
	indexArray++;


	if (index > elemCount


	    || (valueObj == NULL && index >= elemCount)) {
	    /* ...the index points outside the sublist. */
	    if (interp != NULL) {
		Tcl_SetObjResult(interp,
		                 Tcl_ObjPrintf("index \"%s\" out of range",
		                               Tcl_GetString(indexArray[-1])));
		Tcl_SetErrorCode(interp,
		                 "TCL",
		                 "VALUE",
		                 "INDEX"
		                 "OUTOFRANGE",
		                 NULL);
	    }
	    result = TCL_ERROR;
	    break;
	}

	/*
	 * No error conditions.  As long as we're not yet on the last index,
	 * determine the next sublist for the next pass through the loop,
	 * and take steps to make sure it is an unshared copy, as we intend
	 * to modify it.
	 */

	if (--indexCount) {
	    parentList = subListObj;
	    if (index == elemCount) {
		TclNewObj(subListObj);
	    } else {
		subListObj = elemPtrs[index];
	    }
	    if (Tcl_IsShared(subListObj)) {
		subListObj = Tcl_DuplicateObj(subListObj);





	    }

	    /*
	     * Replace the original elemPtr[index] in parentList with a copy
	     * we know to be unshared.  This call will also deal with the
	     * situation where parentList shares its internalrep with other
	     * Tcl_Obj's.  Dealing with the shared internalrep case can
	     * cause subListObj to become shared again, so detect that case
	     * and make and store another copy.
	     */

	    if (index == elemCount) {
		Tcl_ListObjAppendElement(NULL, parentList, subListObj);
	    } else {
		TclListObjSetElement(NULL, parentList, index, subListObj);
	    }
	    if (Tcl_IsShared(subListObj)) {

		subListObj = Tcl_DuplicateObj(subListObj);









		TclListObjSetElement(NULL, parentList, index, subListObj);
	    }

	    /*
	     * The TclListObjSetElement() calls do not spoil the string rep
	     * of parentList, and that's fine for now, since all we've done
	     * so far is replace a list element with an unshared copy.  The







>
|
>
>


















|
|
|
<










|
>
>
>
>
>

















>
|
>
>
>
>
>
>
>
>
>







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
	    /* ...the index we're trying to use isn't an index at all. */
	    result = TCL_ERROR;
	    indexArray++; /* Why bother with this increment? TBD */
	    break;
	}
	indexArray++;

	if ((index == TCL_SIZE_MAX) && (elemCount == 0)) {
	    index = 0;
	}
	if (index < 0 || index > elemCount
	    || (valueObj == NULL && index >= elemCount)) {
	    /* ...the index points outside the sublist. */
	    if (interp != NULL) {
		Tcl_SetObjResult(interp,
		                 Tcl_ObjPrintf("index \"%s\" out of range",
		                               Tcl_GetString(indexArray[-1])));
		Tcl_SetErrorCode(interp,
		                 "TCL",
		                 "VALUE",
		                 "INDEX"
		                 "OUTOFRANGE",
		                 NULL);
	    }
	    result = TCL_ERROR;
	    break;
	}

	/*
	 * No error conditions.  If this is not the last index, determine the
	 * next sublist for the next pass through the loop, and take steps to
	 * make sure it is unshared in order to modify it.

	 */

	if (--indexCount) {
	    parentList = subListObj;
	    if (index == elemCount) {
		TclNewObj(subListObj);
	    } else {
		subListObj = elemPtrs[index];
	    }
	    if (Tcl_IsShared(subListObj)) {
		subListObj = TclDuplicatePureObj(
		    interp, subListObj, &tclListType);
		if (!subListObj) {
		    return NULL;
		}
		copied = 1;
	    }

	    /*
	     * Replace the original elemPtr[index] in parentList with a copy
	     * we know to be unshared.  This call will also deal with the
	     * situation where parentList shares its internalrep with other
	     * Tcl_Obj's.  Dealing with the shared internalrep case can
	     * cause subListObj to become shared again, so detect that case
	     * and make and store another copy.
	     */

	    if (index == elemCount) {
		Tcl_ListObjAppendElement(NULL, parentList, subListObj);
	    } else {
		TclListObjSetElement(NULL, parentList, index, subListObj);
	    }
	    if (Tcl_IsShared(subListObj)) {
		Tcl_Obj * newSubListObj;
		newSubListObj = TclDuplicatePureObj(
		    interp, subListObj, &tclListType);
		if (copied) {
		    Tcl_DecrRefCount(subListObj);
		}
		if (newSubListObj) {
		    subListObj = newSubListObj;
		} else {
		    return NULL;
		}
		TclListObjSetElement(NULL, parentList, index, subListObj);
	    }

	    /*
	     * The TclListObjSetElement() calls do not spoil the string rep
	     * of parentList, and that's fine for now, since all we've done
	     * so far is replace a list element with an unshared copy.  The
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
	while (!done) {
	    *elemPtrs++ = keyPtr;
	    *elemPtrs++ = valuePtr;
	    Tcl_IncrRefCount(keyPtr);
	    Tcl_IncrRefCount(valuePtr);
	    Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done);
	}
    } else if (TclHasInternalRep(objPtr,&tclAbstractListType)) {
	Tcl_Size elemCount, i;

	elemCount = Tcl_AbstractListObjLength(objPtr);

	if (ListRepInitAttempt(interp, elemCount, NULL, &listRep) != TCL_OK) {
	    return TCL_ERROR;
	}

	LIST_ASSERT(listRep.spanPtr == NULL); /* Guard against future changes */
	LIST_ASSERT(listRep.storePtr->firstUsed == 0);

	elemPtrs = listRep.storePtr->slots;

	/* Each iteration, store a list element */
        for (i = 0; i < elemCount; i++) {
	    if (Tcl_AbstractListObjIndex(interp, objPtr, i, elemPtrs) != TCL_OK) {
                return TCL_ERROR;
            }
	    Tcl_IncrRefCount(*elemPtrs++);/* Since list now holds ref to it. */
	}

	LIST_ASSERT((Tcl_Size)(elemPtrs - listRep.storePtr->slots) == elemCount);








|


|












|







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
	while (!done) {
	    *elemPtrs++ = keyPtr;
	    *elemPtrs++ = valuePtr;
	    Tcl_IncrRefCount(keyPtr);
	    Tcl_IncrRefCount(valuePtr);
	    Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done);
	}
    } else if (TclObjTypeHasProc(objPtr,indexProc)) {
	Tcl_Size elemCount, i;

	elemCount = TclObjTypeHasProc(objPtr,lengthProc)(objPtr);

	if (ListRepInitAttempt(interp, elemCount, NULL, &listRep) != TCL_OK) {
	    return TCL_ERROR;
	}

	LIST_ASSERT(listRep.spanPtr == NULL); /* Guard against future changes */
	LIST_ASSERT(listRep.storePtr->firstUsed == 0);

	elemPtrs = listRep.storePtr->slots;

	/* Each iteration, store a list element */
        for (i = 0; i < elemCount; i++) {
	    if (Tcl_ObjTypeIndex(interp, objPtr, i, elemPtrs) != TCL_OK) {
                return TCL_ERROR;
            }
	    Tcl_IncrRefCount(*elemPtrs++);/* Since list now holds ref to it. */
	}

	LIST_ASSERT((Tcl_Size)(elemPtrs - listRep.storePtr->slots) == elemCount);

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
}

/*
 *----------------------------------------------------------------------
 *
 * UpdateStringOfList --
 *
 *	Update the string representation for a list object. Note: This

 *	function does not invalidate an existing old string rep so storage
 *	will be lost if this has not already been done.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The object's string is set to a valid string that results from the
 *	list-to-string conversion. This string will be empty if the list has
 *	no elements. The list internal representation should not be NULL and
 *	we assume it is not NULL.
 *
 *----------------------------------------------------------------------
 */
static void
UpdateStringOfList(
    Tcl_Obj *listObj)		/* List object with string rep to update. */
{







|
>
|
|

|
<

<
|
|
|
<







3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450

3451

3452
3453
3454

3455
3456
3457
3458
3459
3460
3461
}

/*
 *----------------------------------------------------------------------
 *
 * UpdateStringOfList --
 *
 *	Update the string representation for a list object.
 *
 *	Any previously-existing string representation is not invalidated, so
 *	storage is lost if this has not been taken care of.
 *
 * Effect

 *

 *	The string representation of 'listPtr' is set to the resulting string.
 *	This string will be empty if the list has no elements. It is assumed
 *	that the list internal representation is not NULL.

 *
 *----------------------------------------------------------------------
 */
static void
UpdateStringOfList(
    Tcl_Obj *listObj)		/* List object with string rep to update. */
{
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
 *
 * Side effects:
 *    None.
 *
 *------------------------------------------------------------------------
 */
Tcl_Obj *
TclListTestObj (int length, int leadingSpace, int endSpace)
{
    if (length < 0)
	length = 0;
    if (leadingSpace < 0)
	leadingSpace = 0;
    if (endSpace < 0)
	endSpace = 0;

    ListRep listRep;
    Tcl_Size capacity;
    Tcl_Obj *listObj;

    TclNewObj(listObj);

    /* Only a test object so ignoring overflow checks */
    capacity = length + leadingSpace + endSpace;
    if (capacity == 0) {
	return listObj;
    }




    ListRepInit(capacity, NULL, 0, &listRep);

    ListStore *storePtr = listRep.storePtr;
    int i;
    for (i = 0; i < length; ++i) {
	storePtr->slots[i + leadingSpace] = Tcl_NewIntObj(i);
	Tcl_IncrRefCount(storePtr->slots[i + leadingSpace]);
    }
    storePtr->firstUsed = leadingSpace;
    storePtr->numUsed = length;
    if (leadingSpace != 0) {
	listRep.spanPtr = ListSpanNew(leadingSpace, length);
    }







<
<
<
<
<
|
<
<
|

|









>
>
|
>
|


|

|







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
 *
 * Side effects:
 *    None.
 *
 *------------------------------------------------------------------------
 */
Tcl_Obj *





TclListTestObj(size_t length, size_t leadingSpace, size_t endSpace)


{
    ListRep listRep;
    size_t capacity;
    Tcl_Obj *listObj;

    TclNewObj(listObj);

    /* Only a test object so ignoring overflow checks */
    capacity = length + leadingSpace + endSpace;
    if (capacity == 0) {
	return listObj;
    }
    if (capacity > LIST_MAX) {
	return NULL;
    }

    ListRepInit(capacity, NULL, LISTREP_PANIC_ON_FAIL, &listRep);

    ListStore *storePtr = listRep.storePtr;
    size_t i;
    for (i = 0; i < length; ++i) {
	TclNewUIntObj(storePtr->slots[i + leadingSpace], i);
	Tcl_IncrRefCount(storePtr->slots[i + leadingSpace]);
    }
    storePtr->firstUsed = leadingSpace;
    storePtr->numUsed = length;
    if (leadingSpace != 0) {
	listRep.spanPtr = ListSpanNew(leadingSpace, length);
    }

Changes to generic/tclLiteral.c.

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

Tcl_Obj *
TclCreateLiteral(
    Interp *iPtr,
    const char *bytes,	/* The start of the string. Note that this is
				 * not a NUL-terminated string. */
    size_t length,		/* Number of bytes in the string. */
    size_t hash,		/* The string's hash. If -1, it will be
				 * computed here. */
    int *newPtr,
    Namespace *nsPtr,
    int flags,
    LiteralEntry **globalPtrPtr)
{
    LiteralTable *globalTablePtr = &iPtr->literalTable;
    LiteralEntry *globalPtr;
    size_t globalHash;
    Tcl_Obj *objPtr;

    /*
     * Is it in the interpreter's global literal table?
     */

    if (hash == TCL_INDEX_NONE) {
	hash = HashString(bytes, length);
    }
    globalHash = (hash & globalTablePtr->mask);
    for (globalPtr=globalTablePtr->buckets[globalHash] ; globalPtr!=NULL;
	    globalPtr = globalPtr->nextPtr) {
	objPtr = globalPtr->objPtr;
	if (globalPtr->nsPtr == nsPtr) {
	    /*
	     * Literals should always have UTF-8 representations... but this
	     * is not guaranteed so we need to be careful anyway.
	     *
	     * https://stackoverflow.com/q/54337750/301832
	     */

	    size_t objLength;
	    const char *objBytes = Tcl_GetStringFromObj(objPtr, &objLength);

	    if ((objLength == length) && ((length == 0)
		    || ((objBytes[0] == bytes[0])
		    && (memcmp(objBytes, bytes, length) == 0)))) {
		/*
		 * A literal was found: return it







|
|
|














|














|







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

Tcl_Obj *
TclCreateLiteral(
    Interp *iPtr,
    const char *bytes,	/* The start of the string. Note that this is
				 * not a NUL-terminated string. */
    Tcl_Size length,	/* Number of bytes in the string. */
    TCL_HASH_TYPE hash, /* The string's hash. If the value is
				         * TCL_INDEX_NONE, it will be computed here. */
    int *newPtr,
    Namespace *nsPtr,
    int flags,
    LiteralEntry **globalPtrPtr)
{
    LiteralTable *globalTablePtr = &iPtr->literalTable;
    LiteralEntry *globalPtr;
    size_t globalHash;
    Tcl_Obj *objPtr;

    /*
     * Is it in the interpreter's global literal table?
     */

    if (hash == (TCL_HASH_TYPE) TCL_INDEX_NONE) {
	hash = HashString(bytes, length);
    }
    globalHash = (hash & globalTablePtr->mask);
    for (globalPtr=globalTablePtr->buckets[globalHash] ; globalPtr!=NULL;
	    globalPtr = globalPtr->nextPtr) {
	objPtr = globalPtr->objPtr;
	if (globalPtr->nsPtr == nsPtr) {
	    /*
	     * 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
	     */

	    Tcl_Size 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
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclFetchLiteral(
    CompileEnv *envPtr,		/* Points to the CompileEnv from which to
				 * fetch the registered literal value. */
    size_t index)		/* Index of the desired literal, as returned
				 * by prior call to TclRegisterLiteral() */
{
    if (index >= envPtr->literalArrayNext) {
	return NULL;
    }
    return envPtr->literalArrayPtr[index].objPtr;
}







|







347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclFetchLiteral(
    CompileEnv *envPtr,		/* Points to the CompileEnv from which to
				 * fetch the registered literal value. */
    Tcl_Size index)		/* Index of the desired literal, as returned
				 * by prior call to TclRegisterLiteral() */
{
    if (index >= envPtr->literalArrayNext) {
	return NULL;
    }
    return envPtr->literalArrayPtr[index].objPtr;
}
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
 *	is set directly from string, otherwise the string is freed. Typically,
 *	a caller sets LITERAL_ON_HEAP if "string" is an already heap-allocated
 *	buffer holding the result of backslash substitutions.
 *
 *----------------------------------------------------------------------
 */

size_t
TclRegisterLiteral(
    void *ePtr,		/* Points to the CompileEnv in whose object
				 * array an object is found or created. */
    const char *bytes,	/* Points to string for which to find or
				 * create an object in CompileEnv's object
				 * array. */
    size_t length,			/* Number of bytes in the string. If -1, the
				 * string consists of all bytes up to the
				 * first null character. */
    int flags)			/* If LITERAL_ON_HEAP then the caller already
				 * malloc'd bytes and ownership is passed to
				 * this function. If LITERAL_CMD_NAME then
				 * the literal should not be shared accross
				 * namespaces. */
{
    CompileEnv *envPtr = (CompileEnv *)ePtr;
    Interp *iPtr = envPtr->iPtr;
    LiteralTable *localTablePtr = &envPtr->localLitTable;
    LiteralEntry *globalPtr, *localPtr;
    Tcl_Obj *objPtr;
    size_t hash, localHash, objIndex;
    int isNew;
    Namespace *nsPtr;

    if (length == TCL_INDEX_NONE) {
	length = (bytes ? strlen(bytes) : 0);
    }
    hash = HashString(bytes, length);

    /*
     * Is the literal already in the CompileEnv's local literal array? If so,
     * just return its index.







|






|





|











|







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
 *	is set directly from string, otherwise the string is freed. Typically,
 *	a caller sets LITERAL_ON_HEAP if "string" is an already heap-allocated
 *	buffer holding the result of backslash substitutions.
 *
 *----------------------------------------------------------------------
 */

int /* Do NOT change this type. Should not be wider than TclEmitPush operand*/
TclRegisterLiteral(
    void *ePtr,		/* Points to the CompileEnv in whose object
				 * array an object is found or created. */
    const char *bytes,	/* Points to string for which to find or
				 * create an object in CompileEnv's object
				 * array. */
    Tcl_Size length,			/* Number of bytes in the string. If -1, the
				 * string consists of all bytes up to the
				 * first null character. */
    int flags)			/* If LITERAL_ON_HEAP then the caller already
				 * malloc'd bytes and ownership is passed to
				 * this function. If LITERAL_CMD_NAME then
				 * the literal should not be shared across
				 * namespaces. */
{
    CompileEnv *envPtr = (CompileEnv *)ePtr;
    Interp *iPtr = envPtr->iPtr;
    LiteralTable *localTablePtr = &envPtr->localLitTable;
    LiteralEntry *globalPtr, *localPtr;
    Tcl_Obj *objPtr;
    size_t hash, localHash, objIndex;
    int isNew;
    Namespace *nsPtr;

    if (length < 0) {
	length = (bytes ? strlen(bytes) : 0);
    }
    hash = HashString(bytes, length);

    /*
     * Is the literal already in the CompileEnv's local literal array? If so,
     * just return its index.
433
434
435
436
437
438
439



440
441
442
443
444
445
446
447
448
449
450
451
452
453
		Tcl_Free((void *)bytes);
	    }
	    objIndex = (localPtr - envPtr->literalArrayPtr);
#ifdef TCL_COMPILE_DEBUG
	    TclVerifyLocalLiteralTable(envPtr);
#endif /*TCL_COMPILE_DEBUG*/




	    return objIndex;
	}
    }

    /*
     * The literal is new to this CompileEnv. If it is a command name, avoid
     * sharing it accross namespaces, and try not to share it with non-cmd
     * literals. Note that FQ command names can be shared, so that we register
     * the namespace as the interp's global NS.
     */

    if ((flags & LITERAL_CMD_NAME)) {
	if ((length >= 2) && (bytes[0] == ':') && (bytes[1] == ':')) {
	    nsPtr = iPtr->globalNsPtr;







>
>
>






|







433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
		Tcl_Free((void *)bytes);
	    }
	    objIndex = (localPtr - envPtr->literalArrayPtr);
#ifdef TCL_COMPILE_DEBUG
	    TclVerifyLocalLiteralTable(envPtr);
#endif /*TCL_COMPILE_DEBUG*/

	    if (objIndex > INT_MAX) {
		Tcl_Panic("Literal table index too large. Cannot be handled by TclEmitPush");
	    }
	    return objIndex;
	}
    }

    /*
     * The literal is new to this CompileEnv. If it is a command name, avoid
     * sharing it across namespaces, and try not to share it with non-cmd
     * literals. Note that FQ command names can be shared, so that we register
     * the namespace as the interp's global NS.
     */

    if ((flags & LITERAL_CMD_NAME)) {
	if ((length >= 2) && (bytes[0] == ':') && (bytes[1] == ':')) {
	    nsPtr = iPtr->globalNsPtr;
471
472
473
474
475
476
477




478
479
480
481
482
483
484
    if (globalPtr != NULL && (globalPtr->refCount + 1 < 2)) {
	Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %" TCL_Z_MODIFIER "u",
		"TclRegisterLiteral", (length>60? 60 : (int)length), bytes,
		globalPtr->refCount);
    }
    TclVerifyLocalLiteralTable(envPtr);
#endif /*TCL_COMPILE_DEBUG*/




    return objIndex;
}

#ifdef TCL_COMPILE_DEBUG
/*
 *----------------------------------------------------------------------
 *







>
>
>
>







474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
    if (globalPtr != NULL && (globalPtr->refCount + 1 < 2)) {
	Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %" TCL_Z_MODIFIER "u",
		"TclRegisterLiteral", (length>60? 60 : (int)length), bytes,
		globalPtr->refCount);
    }
    TclVerifyLocalLiteralTable(envPtr);
#endif /*TCL_COMPILE_DEBUG*/
    if (objIndex > INT_MAX) {
	Tcl_Panic(
	    "Literal table index too large. Cannot be handled by TclEmitPush");
    }
    return objIndex;
}

#ifdef TCL_COMPILE_DEBUG
/*
 *----------------------------------------------------------------------
 *
549
550
551
552
553
554
555
556

557
558
559
560
561
562
563
    CompileEnv *envPtr,/* Points to CompileEnv whose literal array
				 * contains the entry being hidden. */
    int index)			/* The index of the entry in the literal
				 * array. */
{
    LiteralEntry **nextPtrPtr, *entryPtr, *lPtr;
    LiteralTable *localTablePtr = &envPtr->localLitTable;
    size_t localHash, length;

    const char *bytes;
    Tcl_Obj *newObjPtr;

    lPtr = &envPtr->literalArrayPtr[index];

    /*
     * To avoid unwanted sharing we need to copy the object and remove it from







|
>







556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
    CompileEnv *envPtr,/* Points to CompileEnv whose literal array
				 * contains the entry being hidden. */
    int index)			/* The index of the entry in the literal
				 * array. */
{
    LiteralEntry **nextPtrPtr, *entryPtr, *lPtr;
    LiteralTable *localTablePtr = &envPtr->localLitTable;
    size_t localHash;
    Tcl_Size length;
    const char *bytes;
    Tcl_Obj *newObjPtr;

    lPtr = &envPtr->literalArrayPtr[index];

    /*
     * To avoid unwanted sharing we need to copy the object and remove it from
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
 * Side effects:
 *	Expands the literal array if necessary. Increments the refcount on the
 *	literal object.
 *
 *----------------------------------------------------------------------
 */

size_t
TclAddLiteralObj(
    CompileEnv *envPtr,/* Points to CompileEnv in whose literal array
				 * the object is to be inserted. */
    Tcl_Obj *objPtr,		/* The object to insert into the array. */
    LiteralEntry **litPtrPtr)	/* The location where the pointer to the new
				 * literal entry should be stored. May be
				 * NULL. */
{
    LiteralEntry *lPtr;
    size_t objIndex;

    if (envPtr->literalArrayNext >= envPtr->literalArrayEnd) {
	ExpandLocalLiteralArray(envPtr);
    }
    objIndex = envPtr->literalArrayNext;
    envPtr->literalArrayNext++;





    lPtr = &envPtr->literalArrayPtr[objIndex];
    lPtr->objPtr = objPtr;
    Tcl_IncrRefCount(objPtr);
    lPtr->refCount = TCL_INDEX_NONE;	/* i.e., unused */
    lPtr->nextPtr = NULL;








|
















>
>
>
>







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
 * Side effects:
 *	Expands the literal array if necessary. Increments the refcount on the
 *	literal object.
 *
 *----------------------------------------------------------------------
 */

int
TclAddLiteralObj(
    CompileEnv *envPtr,/* Points to CompileEnv in whose literal array
				 * the object is to be inserted. */
    Tcl_Obj *objPtr,		/* The object to insert into the array. */
    LiteralEntry **litPtrPtr)	/* The location where the pointer to the new
				 * literal entry should be stored. May be
				 * NULL. */
{
    LiteralEntry *lPtr;
    size_t objIndex;

    if (envPtr->literalArrayNext >= envPtr->literalArrayEnd) {
	ExpandLocalLiteralArray(envPtr);
    }
    objIndex = envPtr->literalArrayNext;
    envPtr->literalArrayNext++;
    if (objIndex > INT_MAX) {
	Tcl_Panic(
	    "Literal table index too large. Cannot be handled by TclEmitPush");
    }

    lPtr = &envPtr->literalArrayPtr[objIndex];
    lPtr->objPtr = objPtr;
    Tcl_IncrRefCount(objPtr);
    lPtr->refCount = TCL_INDEX_NONE;	/* i.e., unused */
    lPtr->nextPtr = NULL;

822
823
824
825
826
827
828
829

830
831
832
833
834
835
836
				 * previously created by a call to
				 * TclRegisterLiteral. */
{
    Interp *iPtr = (Interp *) interp;
    LiteralTable *globalTablePtr;
    LiteralEntry *entryPtr, *prevPtr;
    const char *bytes;
    size_t length, index;


    if (iPtr == NULL) {
	goto done;
    }

    globalTablePtr = &iPtr->literalTable;
    bytes = Tcl_GetStringFromObj(objPtr, &length);







|
>







834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
				 * previously created by a call to
				 * TclRegisterLiteral. */
{
    Interp *iPtr = (Interp *) interp;
    LiteralTable *globalTablePtr;
    LiteralEntry *entryPtr, *prevPtr;
    const char *bytes;
    size_t index;
    Tcl_Size length;

    if (iPtr == NULL) {
	goto done;
    }

    globalTablePtr = &iPtr->literalTable;
    bytes = Tcl_GetStringFromObj(objPtr, &length);
965
966
967
968
969
970
971
972

973
974
975
976
977
978
979
				/* Local or global table to enlarge. */
{
    LiteralEntry **oldBuckets;
    LiteralEntry **oldChainPtr, **newChainPtr;
    LiteralEntry *entryPtr;
    LiteralEntry **bucketPtr;
    const char *bytes;
    size_t oldSize, count, index, length;


    oldSize = tablePtr->numBuckets;
    oldBuckets = tablePtr->buckets;

    /*
     * Allocate and initialize the new bucket array, and set up hashing
     * constants for new array size.







|
>







978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
				/* Local or global table to enlarge. */
{
    LiteralEntry **oldBuckets;
    LiteralEntry **oldChainPtr, **newChainPtr;
    LiteralEntry *entryPtr;
    LiteralEntry **bucketPtr;
    const char *bytes;
    size_t oldSize, count, index;
    Tcl_Size length;

    oldSize = tablePtr->numBuckets;
    oldBuckets = tablePtr->buckets;

    /*
     * Allocate and initialize the new bucket array, and set up hashing
     * constants for new array size.
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
    const char *name,		/* Points to the start of the cmd literal
				 * name. */
    Namespace *nsPtr)		/* The namespace for which to lookup and
				 * invalidate a cmd literal. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *literalObjPtr = TclCreateLiteral(iPtr, name,
	    strlen(name), -1, NULL, nsPtr, 0, NULL);

    if (literalObjPtr != NULL) {
	if (TclHasInternalRep(literalObjPtr, &tclCmdNameType)) {
	    TclFreeInternalRep(literalObjPtr);
	}
	/* Balance the refcount effects of TclCreateLiteral() above */
	Tcl_IncrRefCount(literalObjPtr);







|







1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
    const char *name,		/* Points to the start of the cmd literal
				 * name. */
    Namespace *nsPtr)		/* The namespace for which to lookup and
				 * invalidate a cmd literal. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *literalObjPtr = TclCreateLiteral(iPtr, name,
	    strlen(name), TCL_INDEX_NONE, NULL, nsPtr, 0, NULL);

    if (literalObjPtr != NULL) {
	if (TclHasInternalRep(literalObjPtr, &tclCmdNameType)) {
	    TclFreeInternalRep(literalObjPtr);
	}
	/* Balance the refcount effects of TclCreateLiteral() above */
	Tcl_IncrRefCount(literalObjPtr);
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
    }

    /*
     * Print out the histogram and a few other pieces of information.
     */

    result = (char *)Tcl_Alloc(NUM_COUNTERS*60 + 300);
    sprintf(result, "%" TCL_Z_MODIFIER "u entries in table, %" TCL_Z_MODIFIER "u buckets\n",
	    tablePtr->numEntries, tablePtr->numBuckets);
    p = result + strlen(result);
    for (i=0 ; i<NUM_COUNTERS ; i++) {
	sprintf(p, "number of buckets with %" TCL_Z_MODIFIER "u entries: %" TCL_Z_MODIFIER "u\n",
		i, count[i]);
	p += strlen(p);
    }
    sprintf(p, "number of buckets with %d or more entries: %" TCL_Z_MODIFIER "u\n",
	    NUM_COUNTERS, overflow);
    p += strlen(p);
    sprintf(p, "average search distance for entry: %.1f", average);
    return result;
}
#endif /*TCL_COMPILE_STATS*/

#ifdef TCL_COMPILE_DEBUG
/*
 *----------------------------------------------------------------------







|



|



|


|







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
    }

    /*
     * Print out the histogram and a few other pieces of information.
     */

    result = (char *)Tcl_Alloc(NUM_COUNTERS*60 + 300);
    snprintf(result, 60, "%" TCL_Z_MODIFIER "u entries in table, %" TCL_Z_MODIFIER "u buckets\n",
	    tablePtr->numEntries, tablePtr->numBuckets);
    p = result + strlen(result);
    for (i=0 ; i<NUM_COUNTERS ; i++) {
	snprintf(p, 60, "number of buckets with %" TCL_Z_MODIFIER "u entries: %" TCL_Z_MODIFIER "u\n",
		i, count[i]);
	p += strlen(p);
    }
    snprintf(p, 60, "number of buckets with %d or more entries: %" TCL_Z_MODIFIER "u\n",
	    NUM_COUNTERS, overflow);
    p += strlen(p);
    snprintf(p, 60, "average search distance for entry: %.1f", average);
    return result;
}
#endif /*TCL_COMPILE_STATS*/

#ifdef TCL_COMPILE_DEBUG
/*
 *----------------------------------------------------------------------

Changes to generic/tclLoad.c.

306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
	 * Figure out the prefix if it wasn't provided explicitly.
	 */

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

	    /*
	     * Threading note - this call used to be protected by a mutex.
	     */

	    /*







|







306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
	 * Figure out the prefix if it wasn't provided explicitly.
	 */

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

	    /*
	     * Threading note - this call used to be protected by a mutex.
	     */

	    /*

Changes to generic/tclMain.c.

51
52
53
54
55
56
57
58
59
60
61
62
63
64
65

#ifdef UNICODE
    Tcl_DStringInit(&ds);
    Tcl_WCharToUtfDString(string, -1, &ds);
#else
    (void)Tcl_ExternalToUtfDString(NULL, (char *)string, -1, &ds);
#endif
    return TclDStringToObj(&ds);
}

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







|







51
52
53
54
55
56
57
58
59
60
61
62
63
64
65

#ifdef UNICODE
    Tcl_DStringInit(&ds);
    Tcl_WCharToUtfDString(string, -1, &ds);
#else
    (void)Tcl_ExternalToUtfDString(NULL, (char *)string, -1, &ds);
#endif
    return Tcl_DStringToObj(&ds);
}

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

TCL_NORETURN void
Tcl_MainEx(
    size_t argc,			/* Number of arguments. */
    TCHAR **argv,		/* Array of argument strings. */
    Tcl_AppInitProc *appInitProc,
				/* Application-specific initialization
				 * function to call after most initialization
				 * but before starting to execute commands. */
    Tcl_Interp *interp)
{
    size_t i=0;			/* argv[i] index */
    Tcl_Obj *path, *resultPtr, *argvPtr, *appName;
    const char *encodingName = NULL;
    int code, exitCode = 0;
    Tcl_MainLoopProc *mainLoopProc;
    Tcl_Channel chan;
    InteractiveState is;

    TclpSetInitialEncodings();
    if (argc + 1 > 1) {
	--argc;			/* consume argv[0] */
	++i;
    }
    TclpFindExecutable ((const char *)argv [0]);	/* nb: this could be NULL
							 * w/ (eg) an empty argv
							 * supplied to execve() */








|







|








|







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

TCL_NORETURN void
Tcl_MainEx(
    Tcl_Size argc,			/* Number of arguments. */
    TCHAR **argv,		/* Array of argument strings. */
    Tcl_AppInitProc *appInitProc,
				/* Application-specific initialization
				 * function to call after most initialization
				 * but before starting to execute commands. */
    Tcl_Interp *interp)
{
    Tcl_Size i=0;		/* argv[i] index */
    Tcl_Obj *path, *resultPtr, *argvPtr, *appName;
    const char *encodingName = NULL;
    int code, exitCode = 0;
    Tcl_MainLoopProc *mainLoopProc;
    Tcl_Channel chan;
    InteractiveState is;

    TclpSetInitialEncodings();
    if (argc > 0) {
	--argc;			/* consume argv[0] */
	++i;
    }
    TclpFindExecutable ((const char *)argv [0]);	/* nb: this could be NULL
							 * w/ (eg) an empty argv
							 * supplied to execve() */

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
	 * Check whether first 3 args (argv[1] - argv[3]) look like
	 *  -encoding ENCODING FILENAME
	 * or like
	 *  FILENAME
	 */

	/* mind argc is being adjusted as we proceed */
	if ((argc >= 3) && argv[1] && argv[2] && argv[3] && (0 == _tcscmp(TEXT("-encoding"), argv[1]))
		&& ('-' != argv[3][0])) {
	    Tcl_Obj *value = NewNativeObj(argv[2]);
	    Tcl_SetStartupScript(NewNativeObj(argv[3]),
		    TclGetString(value));
	    Tcl_DecrRefCount(value);
	    argc -= 3;
	    i += 3;
	} else if ((argc >= 1) && argv[1] && ('-' != argv[1][0])) {
	    Tcl_SetStartupScript(NewNativeObj(argv[1]), NULL);
	    argc--;
	    i++;
	}
    }

    path = Tcl_GetStartupScript(&encodingName);
    if (path != NULL) {
	appName = path;
    } else if (argv[0]) {
	appName = NewNativeObj(argv[0]);
    } else {
    	appName = Tcl_NewStringObj("tclsh", -1);
    }
    Tcl_SetVar2Ex(interp, "argv0", NULL, appName, TCL_GLOBAL_ONLY);

    Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewWideIntObj(argc), TCL_GLOBAL_ONLY);

    argvPtr = Tcl_NewListObj(0, NULL);
    while (argc-- && argv[i]) {
	Tcl_ListObjAppendElement(NULL, argvPtr, NewNativeObj(argv[i++]));
    }
    Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY);

    /*
     * Set the "tcl_interactive" variable.
     */







|







|



















|







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
	 * Check whether first 3 args (argv[1] - argv[3]) look like
	 *  -encoding ENCODING FILENAME
	 * or like
	 *  FILENAME
	 */

	/* mind argc is being adjusted as we proceed */
	if ((argc >= 3) && (0 == _tcscmp(TEXT("-encoding"), argv[1]))
		&& ('-' != argv[3][0])) {
	    Tcl_Obj *value = NewNativeObj(argv[2]);
	    Tcl_SetStartupScript(NewNativeObj(argv[3]),
		    TclGetString(value));
	    Tcl_DecrRefCount(value);
	    argc -= 3;
	    i += 3;
	} else if ((argc >= 1) && ('-' != argv[1][0])) {
	    Tcl_SetStartupScript(NewNativeObj(argv[1]), NULL);
	    argc--;
	    i++;
	}
    }

    path = Tcl_GetStartupScript(&encodingName);
    if (path != NULL) {
	appName = path;
    } else if (argv[0]) {
	appName = NewNativeObj(argv[0]);
    } else {
    	appName = Tcl_NewStringObj("tclsh", -1);
    }
    Tcl_SetVar2Ex(interp, "argv0", NULL, appName, TCL_GLOBAL_ONLY);

    Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewWideIntObj(argc), TCL_GLOBAL_ONLY);

    argvPtr = Tcl_NewListObj(0, NULL);
    while (argc--) {
	Tcl_ListObjAppendElement(NULL, argvPtr, NewNativeObj(argv[i++]));
    }
    Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY);

    /*
     * Set the "tcl_interactive" variable.
     */
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
     */

    Tcl_LinkVar(interp, "tcl_interactive", &is.tty, TCL_LINK_BOOLEAN);
    is.input = Tcl_GetStdChannel(TCL_STDIN);
    while ((is.input != NULL) && !Tcl_InterpDeleted(interp)) {
	mainLoopProc = TclGetMainLoop();
	if (mainLoopProc == NULL) {
	    size_t length;

	    if (is.tty) {
		Prompt(interp, &is);
		if (Tcl_InterpDeleted(interp)) {
		    break;
		}
		if (Tcl_LimitExceeded(interp)) {
		    break;
		}
		is.input = Tcl_GetStdChannel(TCL_STDIN);
		if (is.input == NULL) {
		    break;
		}
	    }
	    if (Tcl_IsShared(is.commandPtr)) {
		Tcl_DecrRefCount(is.commandPtr);
		is.commandPtr = Tcl_DuplicateObj(is.commandPtr);
		Tcl_IncrRefCount(is.commandPtr);
	    }
	    length = Tcl_GetsObj(is.input, is.commandPtr);
	    if (length == TCL_INDEX_NONE) {
		if (Tcl_InputBlocked(is.input)) {
		    /*
		     * This can only happen if stdin has been set to
		     * non-blocking. In that case cycle back and try again.
		     * This sets up a tight polling loop (since we have no
		     * event loop running). If this causes bad CPU hogging, we
		     * might try toggling the blocking on stdin instead.







|




















|







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

    Tcl_LinkVar(interp, "tcl_interactive", &is.tty, TCL_LINK_BOOLEAN);
    is.input = Tcl_GetStdChannel(TCL_STDIN);
    while ((is.input != NULL) && !Tcl_InterpDeleted(interp)) {
	mainLoopProc = TclGetMainLoop();
	if (mainLoopProc == NULL) {
	    Tcl_Size length;

	    if (is.tty) {
		Prompt(interp, &is);
		if (Tcl_InterpDeleted(interp)) {
		    break;
		}
		if (Tcl_LimitExceeded(interp)) {
		    break;
		}
		is.input = Tcl_GetStdChannel(TCL_STDIN);
		if (is.input == NULL) {
		    break;
		}
	    }
	    if (Tcl_IsShared(is.commandPtr)) {
		Tcl_DecrRefCount(is.commandPtr);
		is.commandPtr = Tcl_DuplicateObj(is.commandPtr);
		Tcl_IncrRefCount(is.commandPtr);
	    }
	    length = Tcl_GetsObj(is.input, is.commandPtr);
	    if (length < 0) {
		if (Tcl_InputBlocked(is.input)) {
		    /*
		     * This can only happen if stdin has been set to
		     * non-blocking. In that case cycle back and try again.
		     * This sets up a tight polling loop (since we have no
		     * event loop running). If this causes bad CPU hogging, we
		     * might try toggling the blocking on stdin instead.
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

static void
StdinProc(
    void *clientData,	/* The state of interactive cmd line */
    TCL_UNUSED(int) /*mask*/)
{
    int code;
    size_t length;
    InteractiveState *isPtr = (InteractiveState *)clientData;
    Tcl_Channel chan = isPtr->input;
    Tcl_Obj *commandPtr = isPtr->commandPtr;
    Tcl_Interp *interp = isPtr->interp;

    if (Tcl_IsShared(commandPtr)) {
	Tcl_DecrRefCount(commandPtr);
	commandPtr = Tcl_DuplicateObj(commandPtr);
	Tcl_IncrRefCount(commandPtr);
    }
    length = Tcl_GetsObj(chan, commandPtr);
    if (length == TCL_INDEX_NONE) {
	if (Tcl_InputBlocked(chan)) {
	    return;
	}
	if (isPtr->tty) {
	    /*
	     * Would be better to find a way to exit the mainLoop? Or perhaps
	     * evaluate [exit]? Leaving as is for now due to compatibility







|











|







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

static void
StdinProc(
    void *clientData,	/* The state of interactive cmd line */
    TCL_UNUSED(int) /*mask*/)
{
    int code;
    Tcl_Size length;
    InteractiveState *isPtr = (InteractiveState *)clientData;
    Tcl_Channel chan = isPtr->input;
    Tcl_Obj *commandPtr = isPtr->commandPtr;
    Tcl_Interp *interp = isPtr->interp;

    if (Tcl_IsShared(commandPtr)) {
	Tcl_DecrRefCount(commandPtr);
	commandPtr = Tcl_DuplicateObj(commandPtr);
	Tcl_IncrRefCount(commandPtr);
    }
    length = Tcl_GetsObj(chan, commandPtr);
    if (length < 0) {
	if (Tcl_InputBlocked(chan)) {
	    return;
	}
	if (isPtr->tty) {
	    /*
	     * Would be better to find a way to exit the mainLoop? Or perhaps
	     * evaluate [exit]? Leaving as is for now due to compatibility

Changes to generic/tclNamesp.c.

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
				 * becomes zero. */
} ResolvedNsName;

/*
 * Declarations for functions local to this file:
 */

static void		DeleteImportedCmd(ClientData clientData);
static int		DoImport(Tcl_Interp *interp,
			    Namespace *nsPtr, Tcl_HashEntry *hPtr,
			    const char *cmdName, const char *pattern,
			    Namespace *importNsPtr, int allowOverwrite);
static void		DupNsNameInternalRep(Tcl_Obj *objPtr,Tcl_Obj *copyPtr);
static char *		ErrorCodeRead(ClientData clientData,Tcl_Interp *interp,
			    const char *name1, const char *name2, int flags);
static char *		ErrorInfoRead(ClientData clientData,Tcl_Interp *interp,
			    const char *name1, const char *name2, int flags);
static char *		EstablishErrorCodeTraces(ClientData clientData,
			    Tcl_Interp *interp, const char *name1,
			    const char *name2, int flags);
static char *		EstablishErrorInfoTraces(ClientData clientData,
			    Tcl_Interp *interp, const char *name1,
			    const char *name2, int flags);
static void		FreeNsNameInternalRep(Tcl_Obj *objPtr);
static int		GetNamespaceFromObj(Tcl_Interp *interp,
			    Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr);
static int		InvokeImportedNRCmd(ClientData clientData,
			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static Tcl_ObjCmdProc	NamespaceChildrenCmd;
static Tcl_ObjCmdProc	NamespaceCodeCmd;
static Tcl_ObjCmdProc	NamespaceCurrentCmd;
static Tcl_ObjCmdProc	NamespaceDeleteCmd;
static Tcl_ObjCmdProc	NamespaceEvalCmd;
static Tcl_ObjCmdProc	NRNamespaceEvalCmd;







|





|

|

|


|





|







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
				 * becomes zero. */
} ResolvedNsName;

/*
 * Declarations for functions local to this file:
 */

static void		DeleteImportedCmd(void *clientData);
static int		DoImport(Tcl_Interp *interp,
			    Namespace *nsPtr, Tcl_HashEntry *hPtr,
			    const char *cmdName, const char *pattern,
			    Namespace *importNsPtr, int allowOverwrite);
static void		DupNsNameInternalRep(Tcl_Obj *objPtr,Tcl_Obj *copyPtr);
static char *		ErrorCodeRead(void *clientData,Tcl_Interp *interp,
			    const char *name1, const char *name2, int flags);
static char *		ErrorInfoRead(void *clientData,Tcl_Interp *interp,
			    const char *name1, const char *name2, int flags);
static char *		EstablishErrorCodeTraces(void *clientData,
			    Tcl_Interp *interp, const char *name1,
			    const char *name2, int flags);
static char *		EstablishErrorInfoTraces(void *clientData,
			    Tcl_Interp *interp, const char *name1,
			    const char *name2, int flags);
static void		FreeNsNameInternalRep(Tcl_Obj *objPtr);
static int		GetNamespaceFromObj(Tcl_Interp *interp,
			    Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr);
static int		InvokeImportedNRCmd(void *clientData,
			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static Tcl_ObjCmdProc	NamespaceChildrenCmd;
static Tcl_ObjCmdProc	NamespaceCodeCmd;
static Tcl_ObjCmdProc	NamespaceCurrentCmd;
static Tcl_ObjCmdProc	NamespaceDeleteCmd;
static Tcl_ObjCmdProc	NamespaceEvalCmd;
static Tcl_ObjCmdProc	NRNamespaceEvalCmd;
126
127
128
129
130
131
132
133

134
135
136
137
138
139
140
 */

static const Tcl_ObjType nsNameType = {
    "nsName",			/* the type's name */
    FreeNsNameInternalRep,	/* freeIntRepProc */
    DupNsNameInternalRep,	/* dupIntRepProc */
    NULL,			/* updateStringProc */
    SetNsNameFromAny		/* setFromAnyProc */

};

#define NsNameSetInternalRep(objPtr, nnPtr)					\
    do {								\
	Tcl_ObjInternalRep ir;						\
	(nnPtr)->refCount++;						\
	ir.twoPtrValue.ptr1 = (nnPtr);					\







|
>







126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
 */

static const Tcl_ObjType nsNameType = {
    "nsName",			/* the type's name */
    FreeNsNameInternalRep,	/* freeIntRepProc */
    DupNsNameInternalRep,	/* dupIntRepProc */
    NULL,			/* updateStringProc */
    SetNsNameFromAny,		/* setFromAnyProc */
    TCL_OBJTYPE_V0
};

#define NsNameSetInternalRep(objPtr, nnPtr)					\
    do {								\
	Tcl_ObjInternalRep ir;						\
	(nnPtr)->refCount++;						\
	ir.twoPtrValue.ptr1 = (nnPtr);					\
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
    }

    if (framePtr->varTablePtr != NULL) {
	TclDeleteVars(iPtr, framePtr->varTablePtr);
	Tcl_Free(framePtr->varTablePtr);
	framePtr->varTablePtr = NULL;
    }
    if (framePtr->numCompiledLocals + 1 > 1) {
	TclDeleteCompiledLocalVars(iPtr, framePtr);
	if (framePtr->localCachePtr->refCount-- <= 1) {
	    TclFreeLocalCache(interp, framePtr->localCachePtr);
	}
	framePtr->localCachePtr = NULL;
    }

    /*
     * Decrement the namespace's count of active call frames. If the namespace
     * is "dying" and there are no more active call frames, call
     * Tcl_DeleteNamespace to destroy it.
     */

    nsPtr = framePtr->nsPtr;
    if ((--nsPtr->activationCount <= (unsigned)(nsPtr == iPtr->globalNsPtr))
	    && (nsPtr->flags & NS_DYING)) {
	Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr);
    }
    framePtr->nsPtr = NULL;

    if (framePtr->tailcallPtr) {


	TclSetTailcall(interp, framePtr->tailcallPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *







|














|






>
>







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
    }

    if (framePtr->varTablePtr != NULL) {
	TclDeleteVars(iPtr, framePtr->varTablePtr);
	Tcl_Free(framePtr->varTablePtr);
	framePtr->varTablePtr = NULL;
    }
    if (framePtr->numCompiledLocals > 0) {
	TclDeleteCompiledLocalVars(iPtr, framePtr);
	if (framePtr->localCachePtr->refCount-- <= 1) {
	    TclFreeLocalCache(interp, framePtr->localCachePtr);
	}
	framePtr->localCachePtr = NULL;
    }

    /*
     * Decrement the namespace's count of active call frames. If the namespace
     * is "dying" and there are no more active call frames, call
     * Tcl_DeleteNamespace to destroy it.
     */

    nsPtr = framePtr->nsPtr;
    if ((--nsPtr->activationCount <= (nsPtr == iPtr->globalNsPtr))
	    && (nsPtr->flags & NS_DYING)) {
	Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr);
    }
    framePtr->nsPtr = NULL;

    if (framePtr->tailcallPtr) {
	/* Reusing the existing reference count from framePtr->tailcallPtr, so
	 * no need to Tcl_IncrRefCount(framePtr->tailcallPtr)*/
	TclSetTailcall(interp, framePtr->tailcallPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
Tcl_CreateNamespace(
    Tcl_Interp *interp,		/* Interpreter in which a new namespace is
				 * being created. Also used for error
				 * reporting. */
    const char *name,		/* Name for the new namespace. May be a
				 * qualified name with names of ancestor
				 * namespaces separated by "::"s. */
    ClientData clientData,	/* One-word value to store with namespace. */
    Tcl_NamespaceDeleteProc *deleteProc)
				/* Function called to delete client data when
				 * the namespace is deleted. NULL if no
				 * function should be called. */
{
    Interp *iPtr = (Interp *) interp;
    Namespace *nsPtr, *ancestorPtr;







|







649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
Tcl_CreateNamespace(
    Tcl_Interp *interp,		/* Interpreter in which a new namespace is
				 * being created. Also used for error
				 * reporting. */
    const char *name,		/* Name for the new namespace. May be a
				 * qualified name with names of ancestor
				 * namespaces separated by "::"s. */
    void *clientData,	/* One-word value to store with namespace. */
    Tcl_NamespaceDeleteProc *deleteProc)
				/* Function called to delete client data when
				 * the namespace is deleted. NULL if no
				 * function should be called. */
{
    Interp *iPtr = (Interp *) interp;
    Namespace *nsPtr, *ancestorPtr;
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
	 * nonzero, the namespace's commands and variables are deleted but the
	 * structure isn't freed. Instead, NS_DEAD is OR'd into the structure's
	 * flags to allow the namespace resolution code to recognize that the
	 * namespace is "deleted".  The structure's storage is freed by
	 * FreeNsNameInternalRep when its refCount reaches 0.
     */

    if (nsPtr->activationCount > (unsigned)(nsPtr == globalNsPtr)) {
	nsPtr->flags |= NS_DYING;
	if (nsPtr->parentPtr != NULL) {
	    entryPtr = Tcl_FindHashEntry(
		    TclGetNamespaceChildTable((Tcl_Namespace *)
			    nsPtr->parentPtr), nsPtr->name);
	    if (entryPtr != NULL) {
		Tcl_DeleteHashEntry(entryPtr);







|







1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
	 * nonzero, the namespace's commands and variables are deleted but the
	 * structure isn't freed. Instead, NS_DEAD is OR'd into the structure's
	 * flags to allow the namespace resolution code to recognize that the
	 * namespace is "deleted".  The structure's storage is freed by
	 * FreeNsNameInternalRep when its refCount reaches 0.
     */

    if (nsPtr->activationCount > (nsPtr == globalNsPtr)) {
	nsPtr->flags |= NS_DYING;
	if (nsPtr->parentPtr != NULL) {
	    entryPtr = Tcl_FindHashEntry(
		    TclGetNamespaceChildTable((Tcl_Namespace *)
			    nsPtr->parentPtr), nsPtr->name);
	    if (entryPtr != NULL) {
		Tcl_DeleteHashEntry(entryPtr);
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
TclTeardownNamespace(
    Namespace *nsPtr)	/* Points to the namespace to be dismantled
				 * and unlinked from its parent. */
{
    Interp *iPtr = (Interp *) nsPtr->interp;
    Tcl_HashEntry *entryPtr;
    Tcl_HashSearch search;
    size_t i;

    /*
     * Start by destroying the namespace's variable table, since variables
     * might trigger traces. Variable table should be cleared but not freed!
     * TclDeleteNamespaceVars frees it, so we reinitialize it afterwards.
     */

    TclDeleteNamespaceVars(nsPtr);
    TclInitVarHashTable(&nsPtr->varTable, nsPtr);

    /*
     * Delete all commands in this namespace. Be careful when traversing the
     * hash table: when each command is deleted, it removes itself from the
     * command table. Because of traces (and the desire to avoid the quadratic
     * problems of just using Tcl_FirstHashEntry over and over, [Bug
     * f97d4ee020]) we copy to a temporary array and then delete all those
     * commands.
     */

    while (nsPtr->cmdTable.numEntries > 0) {
	size_t length = nsPtr->cmdTable.numEntries;
	Command **cmds = (Command **)TclStackAlloc((Tcl_Interp *) iPtr,
		sizeof(Command *) * length);

	i = 0;
	for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
		entryPtr != NULL;
		entryPtr = Tcl_NextHashEntry(&search)) {







|




















|







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
TclTeardownNamespace(
    Namespace *nsPtr)	/* Points to the namespace to be dismantled
				 * and unlinked from its parent. */
{
    Interp *iPtr = (Interp *) nsPtr->interp;
    Tcl_HashEntry *entryPtr;
    Tcl_HashSearch search;
    Tcl_Size i;

    /*
     * Start by destroying the namespace's variable table, since variables
     * might trigger traces. Variable table should be cleared but not freed!
     * TclDeleteNamespaceVars frees it, so we reinitialize it afterwards.
     */

    TclDeleteNamespaceVars(nsPtr);
    TclInitVarHashTable(&nsPtr->varTable, nsPtr);

    /*
     * Delete all commands in this namespace. Be careful when traversing the
     * hash table: when each command is deleted, it removes itself from the
     * command table. Because of traces (and the desire to avoid the quadratic
     * problems of just using Tcl_FirstHashEntry over and over, [Bug
     * f97d4ee020]) we copy to a temporary array and then delete all those
     * commands.
     */

    while (nsPtr->cmdTable.numEntries > 0) {
	Tcl_Size length = nsPtr->cmdTable.numEntries;
	Command **cmds = (Command **)TclStackAlloc((Tcl_Interp *) iPtr,
		sizeof(Command *) * length);

	i = 0;
	for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
		entryPtr != NULL;
		entryPtr = Tcl_NextHashEntry(&search)) {
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
				 * list before appending. */
{
#define INIT_EXPORT_PATTERNS 5
    Namespace *nsPtr, *exportNsPtr, *dummyPtr;
    Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    const char *simplePattern;
    char *patternCpy;
    size_t neededElems, len, i;

    /*
     * If the specified namespace is NULL, use the current namespace.
     */

    if (namespacePtr == NULL) {
	nsPtr = (Namespace *) currNsPtr;







|







1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
				 * list before appending. */
{
#define INIT_EXPORT_PATTERNS 5
    Namespace *nsPtr, *exportNsPtr, *dummyPtr;
    Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    const char *simplePattern;
    char *patternCpy;
    Tcl_Size neededElems, len, i;

    /*
     * If the specified namespace is NULL, use the current namespace.
     */

    if (namespacePtr == NULL) {
	nsPtr = (Namespace *) currNsPtr;
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
    Tcl_Namespace *namespacePtr,/* Points to the namespace whose export
				 * pattern list is appended onto objPtr. NULL
				 * for the current namespace. */
    Tcl_Obj *objPtr)		/* Points to the Tcl object onto which the
				 * export pattern list is appended. */
{
    Namespace *nsPtr;
    size_t i;
    int result;

    /*
     * If the specified namespace is NULL, use the current namespace.
     */

    if (namespacePtr == NULL) {







|







1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
    Tcl_Namespace *namespacePtr,/* Points to the namespace whose export
				 * pattern list is appended onto objPtr. NULL
				 * for the current namespace. */
    Tcl_Obj *objPtr)		/* Points to the Tcl object onto which the
				 * export pattern list is appended. */
{
    Namespace *nsPtr;
    Tcl_Size i;
    int result;

    /*
     * If the specified namespace is NULL, use the current namespace.
     */

    if (namespacePtr == NULL) {
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
    Namespace *nsPtr,
    Tcl_HashEntry *hPtr,
    const char *cmdName,
    const char *pattern,
    Namespace *importNsPtr,
    int allowOverwrite)
{
    size_t i = 0, exported = 0;
    Tcl_HashEntry *found;

    /*
     * The command cmdName in the source namespace matches the pattern. Check
     * whether it was exported. If it wasn't, we ignore it.
     */








|







1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
    Namespace *nsPtr,
    Tcl_HashEntry *hPtr,
    const char *cmdName,
    const char *pattern,
    Namespace *importNsPtr,
    int allowOverwrite)
{
    Tcl_Size i = 0, exported = 0;
    Tcl_HashEntry *found;

    /*
     * The command cmdName in the source namespace matches the pattern. Check
     * whether it was exported. If it wasn't, we ignore it.
     */

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
 *	wrong, the result object is set to an error message.
 *
 *----------------------------------------------------------------------
 */

static int
InvokeImportedNRCmd(
    ClientData clientData,	/* Points to the imported command's
				 * ImportedCmdData structure. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    ImportedCmdData *dataPtr = (ImportedCmdData *)clientData;
    Command *realCmdPtr = dataPtr->realCmdPtr;

    TclSkipTailcall(interp);
    return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NOERR, realCmdPtr);
}

int
TclInvokeImportedCmd(
    ClientData clientData,	/* Points to the imported command's
				 * ImportedCmdData structure. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    return Tcl_NRCallObjProc(interp, InvokeImportedNRCmd, clientData,
	    objc, objv);







|














|







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
 *	wrong, the result object is set to an error message.
 *
 *----------------------------------------------------------------------
 */

static int
InvokeImportedNRCmd(
    void *clientData,	/* Points to the imported command's
				 * ImportedCmdData structure. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    ImportedCmdData *dataPtr = (ImportedCmdData *)clientData;
    Command *realCmdPtr = dataPtr->realCmdPtr;

    TclSkipTailcall(interp);
    return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NOERR, realCmdPtr);
}

int
TclInvokeImportedCmd(
    void *clientData,	/* Points to the imported command's
				 * ImportedCmdData structure. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    return Tcl_NRCallObjProc(interp, InvokeImportedNRCmd, clientData,
	    objc, objv);
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
 *	Removes the imported command from the real command's import list.
 *
 *----------------------------------------------------------------------
 */

static void
DeleteImportedCmd(
    ClientData clientData)	/* Points to the imported command's
				 * ImportedCmdData structure. */
{
    ImportedCmdData *dataPtr = (ImportedCmdData *)clientData;
    Command *realCmdPtr = dataPtr->realCmdPtr;
    Command *selfPtr = dataPtr->selfPtr;
    ImportRef *refPtr, *prevPtr;








|







2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
 *	Removes the imported command from the real command's import list.
 *
 *----------------------------------------------------------------------
 */

static void
DeleteImportedCmd(
    void *clientData)	/* Points to the imported command's
				 * ImportedCmdData structure. */
{
    ImportedCmdData *dataPtr = (ImportedCmdData *)clientData;
    Command *realCmdPtr = dataPtr->realCmdPtr;
    Command *selfPtr = dataPtr->selfPtr;
    ImportRef *refPtr, *prevPtr;

2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
    /*
     * Find the namespace(s) that contain the command.
     */

    cmdPtr = NULL;
    if (cxtNsPtr->commandPathLength!=0 && strncmp(name, "::", 2)
	    && !(flags & TCL_NAMESPACE_ONLY)) {
	size_t i;
	Namespace *pathNsPtr, *realNsPtr, *dummyNsPtr;

	(void) TclGetNamespaceForQualName(interp, name, cxtNsPtr,
		TCL_NAMESPACE_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr,
		&simpleName);
	if ((realNsPtr != NULL) && (simpleName != NULL)) {
	    if ((cxtNsPtr == realNsPtr)







|







2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
    /*
     * Find the namespace(s) that contain the command.
     */

    cmdPtr = NULL;
    if (cxtNsPtr->commandPathLength!=0 && strncmp(name, "::", 2)
	    && !(flags & TCL_NAMESPACE_ONLY)) {
	Tcl_Size i;
	Namespace *pathNsPtr, *realNsPtr, *dummyNsPtr;

	(void) TclGetNamespaceForQualName(interp, name, cxtNsPtr,
		TCL_NAMESPACE_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr,
		&simpleName);
	if ((realNsPtr != NULL) && (simpleName != NULL)) {
	    if ((cxtNsPtr == realNsPtr)
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Namespace *currNsPtr;
    Tcl_Obj *listPtr, *objPtr;
    const char *arg;
    size_t length;

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

    /*







|







3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Namespace *currNsPtr;
    Tcl_Obj *listPtr, *objPtr;
    const char *arg;
    Tcl_Size length;

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

    /*
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
 *	result.
 *
 *----------------------------------------------------------------------
 */

static int
NamespaceEvalCmd(
    ClientData clientData,	/* Arbitrary value passed to cmd. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, NRNamespaceEvalCmd, clientData, objc,
	    objv);
}







|







3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
 *	result.
 *
 *----------------------------------------------------------------------
 */

static int
NamespaceEvalCmd(
    void *clientData,	/* Arbitrary value passed to cmd. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, NRNamespaceEvalCmd, clientData, objc,
	    objv);
}
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
    TclNRAddCallback(interp, NsEval_Callback, namespacePtr, "eval",
	    NULL, NULL);
    return TclNREvalObjEx(interp, objPtr, 0, invoker, word);
}

static int
NsEval_Callback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Namespace *namespacePtr = (Tcl_Namespace *)data[0];

    if (result == TCL_ERROR) {
	size_t length = strlen(namespacePtr->fullName);







|







3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
    TclNRAddCallback(interp, NsEval_Callback, namespacePtr, "eval",
	    NULL, NULL);
    return TclNREvalObjEx(interp, objPtr, 0, invoker, word);
}

static int
NsEval_Callback(
    void *data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Namespace *namespacePtr = (Tcl_Namespace *)data[0];

    if (result == TCL_ERROR) {
	size_t length = strlen(namespacePtr->fullName);
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
 *	Returns a result in the Tcl interpreter's result object.
 *
 *----------------------------------------------------------------------
 */

static int
NamespaceInscopeCmd(
    ClientData clientData,	/* Arbitrary value passed to cmd. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, NRNamespaceInscopeCmd, clientData, objc,
	    objv);
}







|







3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
 *	Returns a result in the Tcl interpreter's result object.
 *
 *----------------------------------------------------------------------
 */

static int
NamespaceInscopeCmd(
    void *clientData,	/* Arbitrary value passed to cmd. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, NRNamespaceInscopeCmd, clientData, objc,
	    objv);
}
4032
4033
4034
4035
4036
4037
4038
4039
4040
4041
4042
4043
4044
4045
4046
NamespacePathCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    size_t nsObjc, i;
    int result = TCL_ERROR;
    Tcl_Obj **nsObjv;
    Tcl_Namespace **namespaceList = NULL;

    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?pathList?");
	return TCL_ERROR;







|







4035
4036
4037
4038
4039
4040
4041
4042
4043
4044
4045
4046
4047
4048
4049
NamespacePathCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    Tcl_Size nsObjc, i;
    int result = TCL_ERROR;
    Tcl_Obj **nsObjv;
    Tcl_Namespace **namespaceList = NULL;

    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?pathList?");
	return TCL_ERROR;
4116
4117
4118
4119
4120
4121
4122
4123
4124
4125
4126
4127
4128
4129
4130
4131
4132
4133
4134
4135
4136
 *
 *----------------------------------------------------------------------
 */

void
TclSetNsPath(
    Namespace *nsPtr,		/* Namespace whose path is to be set. */
    size_t pathLength,		/* Length of pathAry. */
    Tcl_Namespace *pathAry[])	/* Array of namespaces that are the path. */
{
    if (pathLength != 0) {
	NamespacePathEntry *tmpPathArray =
		(NamespacePathEntry *)Tcl_Alloc(sizeof(NamespacePathEntry) * pathLength);
	size_t i;

	for (i=0 ; i<pathLength ; i++) {
	    tmpPathArray[i].nsPtr = (Namespace *) pathAry[i];
	    tmpPathArray[i].creatorNsPtr = nsPtr;
	    tmpPathArray[i].prevPtr = NULL;
	    tmpPathArray[i].nextPtr =
		    tmpPathArray[i].nsPtr->commandPathSourceList;







|





|







4119
4120
4121
4122
4123
4124
4125
4126
4127
4128
4129
4130
4131
4132
4133
4134
4135
4136
4137
4138
4139
 *
 *----------------------------------------------------------------------
 */

void
TclSetNsPath(
    Namespace *nsPtr,		/* Namespace whose path is to be set. */
    Tcl_Size pathLength,	/* Length of pathAry. */
    Tcl_Namespace *pathAry[])	/* Array of namespaces that are the path. */
{
    if (pathLength != 0) {
	NamespacePathEntry *tmpPathArray =
		(NamespacePathEntry *)Tcl_Alloc(sizeof(NamespacePathEntry) * pathLength);
	Tcl_Size i;

	for (i=0 ; i<pathLength ; i++) {
	    tmpPathArray[i].nsPtr = (Namespace *) pathAry[i];
	    tmpPathArray[i].creatorNsPtr = nsPtr;
	    tmpPathArray[i].prevPtr = NULL;
	    tmpPathArray[i].nextPtr =
		    tmpPathArray[i].nsPtr->commandPathSourceList;
4173
4174
4175
4176
4177
4178
4179
4180
4181
4182
4183
4184
4185
4186
4187
 *----------------------------------------------------------------------
 */

static void
UnlinkNsPath(
    Namespace *nsPtr)
{
    size_t i;
    for (i=0 ; i<nsPtr->commandPathLength ; i++) {
	NamespacePathEntry *nsPathPtr = &nsPtr->commandPathArray[i];

	if (nsPathPtr->prevPtr != NULL) {
	    nsPathPtr->prevPtr->nextPtr = nsPathPtr->nextPtr;
	}
	if (nsPathPtr->nextPtr != NULL) {







|







4176
4177
4178
4179
4180
4181
4182
4183
4184
4185
4186
4187
4188
4189
4190
 *----------------------------------------------------------------------
 */

static void
UnlinkNsPath(
    Namespace *nsPtr)
{
    Tcl_Size i;
    for (i=0 ; i<nsPtr->commandPathLength ; i++) {
	NamespacePathEntry *nsPathPtr = &nsPtr->commandPathArray[i];

	if (nsPathPtr->prevPtr != NULL) {
	    nsPathPtr->prevPtr->nextPtr = nsPathPtr->nextPtr;
	}
	if (nsPathPtr->nextPtr != NULL) {
4206
4207
4208
4209
4210
4211
4212
4213
4214
4215
4216
4217
4218
4219
4220
 *
 * Results:
 *	nothing
 *
 * Side effects:
 *	Increments the command reference epoch in each namespace whose path
 *	includes the given namespace. This causes any cached resolved names
 *	whose root cacheing context starts at that namespace to be recomputed
 *	the next time they are used.
 *
 *----------------------------------------------------------------------
 */

void
TclInvalidateNsPath(







|







4209
4210
4211
4212
4213
4214
4215
4216
4217
4218
4219
4220
4221
4222
4223
 *
 * Results:
 *	nothing
 *
 * Side effects:
 *	Increments the command reference epoch in each namespace whose path
 *	includes the given namespace. This causes any cached resolved names
 *	whose root caching context starts at that namespace to be recomputed
 *	the next time they are used.
 *
 *----------------------------------------------------------------------
 */

void
TclInvalidateNsPath(
4279
4280
4281
4282
4283
4284
4285
4286
4287
4288
4289
4290
4291
4292
4293
    for (p = name;  *p != '\0';  p++) {
	/* empty body */
    }
    while (--p >= name) {
	if ((*p == ':') && (p > name) && (*(p-1) == ':')) {
	    p -= 2;			/* Back up over the :: */
	    while ((p >= name) && (*p == ':')) {
		p--;			/* Back up over the preceeding : */
	    }
	    break;
	}
    }

    if (p >= name) {
	length = p-name+1;







|







4282
4283
4284
4285
4286
4287
4288
4289
4290
4291
4292
4293
4294
4295
4296
    for (p = name;  *p != '\0';  p++) {
	/* empty body */
    }
    while (--p >= name) {
	if ((*p == ':') && (p > name) && (*(p-1) == ':')) {
	    p -= 2;			/* Back up over the :: */
	    while ((p >= name) && (*p == ':')) {
		p--;			/* Back up over the preceding : */
	    }
	    break;
	}
    }

    if (p >= name) {
	length = p-name+1;
4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
int
Tcl_SetNamespaceUnknownHandler(
    Tcl_Interp *interp,		/* Interpreter in which the namespace
				 * exists. */
    Tcl_Namespace *nsPtr,	/* Namespace which is being updated. */
    Tcl_Obj *handlerPtr)	/* The new handler, or NULL to reset. */
{
    size_t lstlen = 0;
    Namespace *currNsPtr = (Namespace *) nsPtr;

    /*
     * Ensure that we check for errors *first* before we change anything.
     */

    if (handlerPtr != NULL) {







|







4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
4441
int
Tcl_SetNamespaceUnknownHandler(
    Tcl_Interp *interp,		/* Interpreter in which the namespace
				 * exists. */
    Tcl_Namespace *nsPtr,	/* Namespace which is being updated. */
    Tcl_Obj *handlerPtr)	/* The new handler, or NULL to reset. */
{
    Tcl_Size lstlen = 0;
    Namespace *currNsPtr = (Namespace *) nsPtr;

    /*
     * Ensure that we check for errors *first* before we change anything.
     */

    if (handlerPtr != NULL) {
4558
4559
4560
4561
4562
4563
4564
4565
4566
4567
4568
4569
4570
4571
4572
 *	    namespace upvar ns otherVar myVar ?otherVar myVar ...?
 *
 * Results:
 *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
 *
 * Side effects:
 *	Creates new variables in the current scope, linked to the
 *	corresponding variables in the stipulated nmamespace. If anything goes
 *	wrong, the result is an error message.
 *
 *----------------------------------------------------------------------
 */

static int
NamespaceUpvarCmd(







|







4561
4562
4563
4564
4565
4566
4567
4568
4569
4570
4571
4572
4573
4574
4575
 *	    namespace upvar ns otherVar myVar ?otherVar myVar ...?
 *
 * Results:
 *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
 *
 * Side effects:
 *	Creates new variables in the current scope, linked to the
 *	corresponding variables in the stipulated namespace. If anything goes
 *	wrong, the result is an error message.
 *
 *----------------------------------------------------------------------
 */

static int
NamespaceUpvarCmd(
4920
4921
4922
4923
4924
4925
4926
4927
4928
4929
4930
4931
4932
4933
4934
4935
void
TclLogCommandInfo(
    Tcl_Interp *interp,		/* Interpreter in which to log information. */
    const char *script,		/* First character in script containing
				 * command (must be <= command). */
    const char *command,	/* First character in command that generated
				 * the error. */
    size_t length,		/* Number of bytes in command (TCL_INDEX_NONE
				 * means use all bytes up to first null byte).
				*/
    const unsigned char *pc,    /* Current pc of bytecode execution context */
    Tcl_Obj **tosPtr)		/* Current stack of bytecode execution
				 * context */
{
    const char *p;
    Interp *iPtr = (Interp *) interp;







|
|







4923
4924
4925
4926
4927
4928
4929
4930
4931
4932
4933
4934
4935
4936
4937
4938
void
TclLogCommandInfo(
    Tcl_Interp *interp,		/* Interpreter in which to log information. */
    const char *script,		/* First character in script containing
				 * command (must be <= command). */
    const char *command,	/* First character in command that generated
				 * the error. */
    Tcl_Size length,		/* Number of bytes in command (< 0 means use
				 * all bytes up to first null byte).
				*/
    const unsigned char *pc,    /* Current pc of bytecode execution context */
    Tcl_Obj **tosPtr)		/* Current stack of bytecode execution
				 * context */
{
    const char *p;
    Interp *iPtr = (Interp *) interp;
4953
4954
4955
4956
4957
4958
4959
4960
4961
4962
4963
4964
4965
4966
4967
4968
4969
4970
	iPtr->errorLine = 1;
	for (p = script; p != command; p++) {
	    if (*p == '\n') {
		iPtr->errorLine++;
	    }
	}

	if (length == TCL_INDEX_NONE) {
	    length = strlen(command);
	}
	overflow = (length > (size_t)limit);
	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    %s\n\"%.*s%s\"", ((iPtr->errorInfo == NULL)
		? "while executing" : "invoked from within"),
		(overflow ? limit : (int)length), command,
		(overflow ? "..." : "")));

	varPtr = TclObjLookupVarEx(interp, iPtr->eiVar, NULL, TCL_GLOBAL_ONLY,







|


|







4956
4957
4958
4959
4960
4961
4962
4963
4964
4965
4966
4967
4968
4969
4970
4971
4972
4973
	iPtr->errorLine = 1;
	for (p = script; p != command; p++) {
	    if (*p == '\n') {
		iPtr->errorLine++;
	    }
	}

	if (length < 0) {
	    length = strlen(command);
	}
	overflow = (length > limit);
	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    %s\n\"%.*s%s\"", ((iPtr->errorInfo == NULL)
		? "while executing" : "invoked from within"),
		(overflow ? limit : (int)length), command,
		(overflow ? "..." : "")));

	varPtr = TclObjLookupVarEx(interp, iPtr->eiVar, NULL, TCL_GLOBAL_ONLY,
5006
5007
5008
5009
5010
5011
5012
5013
5014
5015
5016
5017
5018
5019
5020

	newObj = Tcl_DuplicateObj(iPtr->errorStack);
	Tcl_DecrRefCount(iPtr->errorStack);
	Tcl_IncrRefCount(newObj);
	iPtr->errorStack = newObj;
    }
    if (iPtr->resetErrorStack) {
	size_t len;

	iPtr->resetErrorStack = 0;
	TclListObjLengthM(interp, iPtr->errorStack, &len);

	/*
	 * Reset while keeping the list internalrep as much as possible.
	 */







|







5009
5010
5011
5012
5013
5014
5015
5016
5017
5018
5019
5020
5021
5022
5023

	newObj = Tcl_DuplicateObj(iPtr->errorStack);
	Tcl_DecrRefCount(iPtr->errorStack);
	Tcl_IncrRefCount(newObj);
	iPtr->errorStack = newObj;
    }
    if (iPtr->resetErrorStack) {
	Tcl_Size len;

	iPtr->resetErrorStack = 0;
	TclListObjLengthM(interp, iPtr->errorStack, &len);

	/*
	 * Reset while keeping the list internalrep as much as possible.
	 */
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
 *----------------------------------------------------------------------
 */

void
TclErrorStackResetIf(
    Tcl_Interp *interp,
    const char *msg,
    size_t length)
{
    Interp *iPtr = (Interp *) interp;

    if (Tcl_IsShared(iPtr->errorStack)) {
	Tcl_Obj *newObj;

	newObj = Tcl_DuplicateObj(iPtr->errorStack);
	Tcl_DecrRefCount(iPtr->errorStack);
	Tcl_IncrRefCount(newObj);
	iPtr->errorStack = newObj;
    }
    if (iPtr->resetErrorStack) {
	size_t len;

	iPtr->resetErrorStack = 0;
	TclListObjLengthM(interp, iPtr->errorStack, &len);

	/*
	 * Reset while keeping the list internalrep as much as possible.
	 */







|












|







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

void
TclErrorStackResetIf(
    Tcl_Interp *interp,
    const char *msg,
    Tcl_Size length)
{
    Interp *iPtr = (Interp *) interp;

    if (Tcl_IsShared(iPtr->errorStack)) {
	Tcl_Obj *newObj;

	newObj = Tcl_DuplicateObj(iPtr->errorStack);
	Tcl_DecrRefCount(iPtr->errorStack);
	Tcl_IncrRefCount(newObj);
	iPtr->errorStack = newObj;
    }
    if (iPtr->resetErrorStack) {
	Tcl_Size len;

	iPtr->resetErrorStack = 0;
	TclListObjLengthM(interp, iPtr->errorStack, &len);

	/*
	 * Reset while keeping the list internalrep as much as possible.
	 */
5133
5134
5135
5136
5137
5138
5139
5140
5141
5142
5143
5144
5145
5146
5147
void
Tcl_LogCommandInfo(
    Tcl_Interp *interp,		/* Interpreter in which to log information. */
    const char *script,		/* First character in script containing
				 * command (must be <= command). */
    const char *command,	/* First character in command that generated
				 * the error. */
    size_t length)		/* Number of bytes in command (-1 means use
				 * all bytes up to first null byte). */
{
    TclLogCommandInfo(interp, script, command, length, NULL, NULL);
}


/*







|







5136
5137
5138
5139
5140
5141
5142
5143
5144
5145
5146
5147
5148
5149
5150
void
Tcl_LogCommandInfo(
    Tcl_Interp *interp,		/* Interpreter in which to log information. */
    const char *script,		/* First character in script containing
				 * command (must be <= command). */
    const char *command,	/* First character in command that generated
				 * the error. */
    Tcl_Size length)		/* Number of bytes in command (-1 means use
				 * all bytes up to first null byte). */
{
    TclLogCommandInfo(interp, script, command, length, NULL, NULL);
}


/*

Changes to generic/tclNotify.c.

1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
	    }
	}
	if (flags & TCL_DONT_WAIT) {
	    break;
	}

	/*
	 * If Tcl_WaitForEvent has returned 1, indicating that one system
	 * event has been dispatched (and thus that some Tcl code might have
	 * been indirectly executed), we break out of the loop. We do this to
	 * give VwaitCmd for instance a chance to check if that system event
	 * had the side effect of changing the variable (so the vwait can
	 * return and unwind properly).
	 *
	 * NB: We will process idle events if any first, because otherwise we
	 *     might never do the idle events if the notifier always gets
	 *     system events.
	 */

	if (result) {







|
|
|
|
|
|







1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
	    }
	}
	if (flags & TCL_DONT_WAIT) {
	    break;
	}

	/*
	 * If Tcl_WaitForEvent has returned 1, indicating that one system event
	 * has been dispatched (and thus that some Tcl code might have been
	 * indirectly executed), we break out of the loop in order, e.g.  to
	 * give vwait a chance to determine whether that system event had the
	 * side effect of changing the variable (so the vwait can return and
	 * unwind properly).
	 *
	 * NB: We will process idle events if any first, because otherwise we
	 *     might never do the idle events if the notifier always gets
	 *     system events.
	 */

	if (result) {

Changes to generic/tclOO.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
/*
 * tclOO.c --
 *
 *	This file contains the object-system core (NB: not Tcl_Obj, but ::oo)
 *
 * Copyright © 2005-2012 Donal K. Fellows
 * Copyright © 2017 Nathan Coulter
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifdef HAVE_CONFIG_H





|







1
2
3
4
5
6
7
8
9
10
11
12
13
/*
 * tclOO.c --
 *
 *	This file contains the object-system core (NB: not Tcl_Obj, but ::oo)
 *
 * Copyright © 2005-2019 Donal K. Fellows
 * Copyright © 2017 Nathan Coulter
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifdef HAVE_CONFIG_H
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
static Object *		AllocObject(Tcl_Interp *interp, const char *nameStr,
			    Namespace *nsPtr, const char *nsNameStr);
static int		CloneClassMethod(Tcl_Interp *interp, Class *clsPtr,
			    Method *mPtr, Tcl_Obj *namePtr,
			    Method **newMPtrPtr);
static int		CloneObjectMethod(Tcl_Interp *interp, Object *oPtr,
			    Method *mPtr, Tcl_Obj *namePtr);
static void		DeletedDefineNamespace(ClientData clientData);
static void		DeletedObjdefNamespace(ClientData clientData);
static void		DeletedHelpersNamespace(ClientData clientData);
static Tcl_NRPostProc	FinalizeAlloc;
static Tcl_NRPostProc	FinalizeNext;
static Tcl_NRPostProc	FinalizeObjectCall;
static inline void	InitClassPath(Tcl_Interp * interp, Class *clsPtr);
static void		InitClassSystemRoots(Tcl_Interp *interp,
			    Foundation *fPtr);
static int		InitFoundation(Tcl_Interp *interp);
static Tcl_InterpDeleteProc	KillFoundation;
static void		MyDeleted(ClientData clientData);
static void		ObjectNamespaceDeleted(ClientData clientData);
static Tcl_CommandTraceProc	ObjectRenamedTrace;
static inline void	RemoveClass(Class **list, int num, int idx);
static inline void	RemoveObject(Object **list, int num, int idx);
static inline void	SquelchCachedName(Object *oPtr);

static int		PublicNRObjectCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
static int		PrivateNRObjectCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
static int		MyClassNRObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
static void		MyClassDeleted(ClientData clientData);

/*
 * Methods in the oo::object and oo::class classes. First, we define a helper
 * macro that makes building the method type declaration structure a lot
 * easier. No point in making life harder than it has to be!
 *
 * Note that the core methods don't need clone or free proc callbacks.







|
|
|








|
|

|
|


|


|


|


|







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
static Object *		AllocObject(Tcl_Interp *interp, const char *nameStr,
			    Namespace *nsPtr, const char *nsNameStr);
static int		CloneClassMethod(Tcl_Interp *interp, Class *clsPtr,
			    Method *mPtr, Tcl_Obj *namePtr,
			    Method **newMPtrPtr);
static int		CloneObjectMethod(Tcl_Interp *interp, Object *oPtr,
			    Method *mPtr, Tcl_Obj *namePtr);
static void		DeletedDefineNamespace(void *clientData);
static void		DeletedObjdefNamespace(void *clientData);
static void		DeletedHelpersNamespace(void *clientData);
static Tcl_NRPostProc	FinalizeAlloc;
static Tcl_NRPostProc	FinalizeNext;
static Tcl_NRPostProc	FinalizeObjectCall;
static inline void	InitClassPath(Tcl_Interp * interp, Class *clsPtr);
static void		InitClassSystemRoots(Tcl_Interp *interp,
			    Foundation *fPtr);
static int		InitFoundation(Tcl_Interp *interp);
static Tcl_InterpDeleteProc	KillFoundation;
static void		MyDeleted(void *clientData);
static void		ObjectNamespaceDeleted(void *clientData);
static Tcl_CommandTraceProc	ObjectRenamedTrace;
static inline void	RemoveClass(Class **list, size_t num, size_t idx);
static inline void	RemoveObject(Object **list, size_t num, size_t idx);
static inline void	SquelchCachedName(Object *oPtr);

static int		PublicNRObjectCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
static int		PrivateNRObjectCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
static int		MyClassNRObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
static void		MyClassDeleted(void *clientData);

/*
 * Methods in the oo::object and oo::class classes. First, we define a helper
 * macro that makes building the method type declaration structure a lot
 * easier. No point in making life harder than it has to be!
 *
 * Note that the core methods don't need clone or free proc callbacks.
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
 *
 * ----------------------------------------------------------------------
 */

static inline void
RemoveClass(
    Class **list,
    int num,
    int idx)
{
    for (; idx < num - 1; idx++) {
	list[idx] = list[idx + 1];
    }
    list[idx] = NULL;
}

static inline void
RemoveObject(
    Object **list,
    int num,
    int idx)
{
    for (; idx < num - 1; idx++) {
	list[idx] = list[idx + 1];
    }
    list[idx] = NULL;
}

/*
 * ----------------------------------------------------------------------







|
|

|








|
|

|







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

static inline void
RemoveClass(
    Class **list,
    size_t num,
    size_t idx)
{
    for (; idx + 1 < num; idx++) {
	list[idx] = list[idx + 1];
    }
    list[idx] = NULL;
}

static inline void
RemoveObject(
    Object **list,
    size_t num,
    size_t idx)
{
    for (; idx + 1 < num; idx++) {
	list[idx] = list[idx + 1];
    }
    list[idx] = NULL;
}

/*
 * ----------------------------------------------------------------------
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
    }

    /*
     * Run our initialization script and, if that works, declare the package
     * to be fully provided.
     */

    if (Tcl_EvalEx(interp, initScript, -1, 0) != TCL_OK) {
	return TCL_ERROR;
    }

#ifndef TCL_NO_DEPRECATED
    Tcl_PkgProvideEx(interp, "TclOO", TCLOO_PATCHLEVEL,
	    &tclOOStubs);
#endif







|







252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
    }

    /*
     * Run our initialization script and, if that works, declare the package
     * to be fully provided.
     */

    if (Tcl_EvalEx(interp, initScript, TCL_INDEX_NONE, 0) != TCL_OK) {
	return TCL_ERROR;
    }

#ifndef TCL_NO_DEPRECATED
    Tcl_PkgProvideEx(interp, "TclOO", TCLOO_PATCHLEVEL,
	    &tclOOStubs);
#endif
323
324
325
326
327
328
329

330
331
332
333
334
335
336
    Tcl_Export(interp, fPtr->ooNs, "[a-z]*", 1);
    fPtr->defineNs = Tcl_CreateNamespace(interp, "::oo::define", fPtr,
	    DeletedDefineNamespace);
    fPtr->objdefNs = Tcl_CreateNamespace(interp, "::oo::objdefine", fPtr,
	    DeletedObjdefNamespace);
    fPtr->helpersNs = Tcl_CreateNamespace(interp, "::oo::Helpers", fPtr,
	    DeletedHelpersNamespace);

    fPtr->epoch = 1;
    fPtr->tsdPtr = tsdPtr;
    TclNewLiteralStringObj(fPtr->unknownMethodNameObj, "unknown");
    TclNewLiteralStringObj(fPtr->constructorName, "<constructor>");
    TclNewLiteralStringObj(fPtr->destructorName, "<destructor>");
    TclNewLiteralStringObj(fPtr->clonedName, "<cloned>");
    TclNewLiteralStringObj(fPtr->defineName, "::oo::define");







>







323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
    Tcl_Export(interp, fPtr->ooNs, "[a-z]*", 1);
    fPtr->defineNs = Tcl_CreateNamespace(interp, "::oo::define", fPtr,
	    DeletedDefineNamespace);
    fPtr->objdefNs = Tcl_CreateNamespace(interp, "::oo::objdefine", fPtr,
	    DeletedObjdefNamespace);
    fPtr->helpersNs = Tcl_CreateNamespace(interp, "::oo::Helpers", fPtr,
	    DeletedHelpersNamespace);
    Tcl_CreateNamespace(interp, "::oo::configuresupport", NULL, NULL);
    fPtr->epoch = 1;
    fPtr->tsdPtr = tsdPtr;
    TclNewLiteralStringObj(fPtr->unknownMethodNameObj, "unknown");
    TclNewLiteralStringObj(fPtr->constructorName, "<constructor>");
    TclNewLiteralStringObj(fPtr->destructorName, "<destructor>");
    TclNewLiteralStringObj(fPtr->clonedName, "<cloned>");
    TclNewLiteralStringObj(fPtr->defineName, "::oo::define");
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
	return TCL_ERROR;
    }

    /*
     * Evaluate the remaining definitions, which are a compiled-in Tcl script.
     */

    return Tcl_EvalEx(interp, tclOOSetupScript, -1, 0);
}

/*
 * ----------------------------------------------------------------------
 *
 * InitClassSystemRoots --
 *







|







426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
	return TCL_ERROR;
    }

    /*
     * Evaluate the remaining definitions, which are a compiled-in Tcl script.
     */

    return Tcl_EvalEx(interp, tclOOSetupScript, TCL_INDEX_NONE, 0);
}

/*
 * ----------------------------------------------------------------------
 *
 * InitClassSystemRoots --
 *
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
 *	longer hold useful information.
 *
 * ----------------------------------------------------------------------
 */

static void
DeletedDefineNamespace(
    ClientData clientData)
{
    Foundation *fPtr = (Foundation *)clientData;

    fPtr->defineNs = NULL;
}

static void
DeletedObjdefNamespace(
    ClientData clientData)
{
    Foundation *fPtr = (Foundation *)clientData;

    fPtr->objdefNs = NULL;
}

static void
DeletedHelpersNamespace(
    ClientData clientData)
{
    Foundation *fPtr = (Foundation *)clientData;

    fPtr->helpersNs = NULL;
}

/*







|








|








|







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
 *	longer hold useful information.
 *
 * ----------------------------------------------------------------------
 */

static void
DeletedDefineNamespace(
    void *clientData)
{
    Foundation *fPtr = (Foundation *)clientData;

    fPtr->defineNs = NULL;
}

static void
DeletedObjdefNamespace(
    void *clientData)
{
    Foundation *fPtr = (Foundation *)clientData;

    fPtr->objdefNs = NULL;
}

static void
DeletedHelpersNamespace(
    void *clientData)
{
    Foundation *fPtr = (Foundation *)clientData;

    fPtr->helpersNs = NULL;
}

/*
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
	}
	Tcl_ResetResult(interp);
    }

    while (1) {
	char objName[10 + TCL_INTEGER_SPACE];

	sprintf(objName, "::oo::Obj%" TCL_Z_MODIFIER "u", ++fPtr->tsdPtr->nsCount);
	oPtr->namespacePtr = Tcl_CreateNamespace(interp, objName, oPtr, NULL);
	if (oPtr->namespacePtr != NULL) {
	    creationEpoch = fPtr->tsdPtr->nsCount;
	    break;
	}

	/*







|







651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
	}
	Tcl_ResetResult(interp);
    }

    while (1) {
	char objName[10 + TCL_INTEGER_SPACE];

	snprintf(objName, sizeof(objName), "::oo::Obj%" TCL_Z_MODIFIER "u", ++fPtr->tsdPtr->nsCount);
	oPtr->namespacePtr = Tcl_CreateNamespace(interp, objName, oPtr, NULL);
	if (oPtr->namespacePtr != NULL) {
	    creationEpoch = fPtr->tsdPtr->nsCount;
	    break;
	}

	/*
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
 *	of those commands when the object itself is deleted.
 *
 * ----------------------------------------------------------------------
 */

static void
MyDeleted(
    ClientData clientData)	/* Reference to the object whose [my] has been
				 * squelched. */
{
    Object *oPtr = (Object *)clientData;

    oPtr->myCommand = NULL;
}

static void
MyClassDeleted(
    ClientData clientData)
{
    Object *oPtr = (Object *)clientData;
    oPtr->myclassCommand = NULL;
}

/*
 * ----------------------------------------------------------------------
 *
 * ObjectRenamedTrace --
 *
 *	This callback is triggered when the object is deleted by any
 *	mechanism. It runs the destructors and arranges for the actual cleanup
 *	of the object's namespace, which in turn triggers cleansing of the
 *	object data structures.
 *
 * ----------------------------------------------------------------------
 */

static void
ObjectRenamedTrace(
    ClientData clientData,	/* The object being deleted. */
    TCL_UNUSED(Tcl_Interp *),
    TCL_UNUSED(const char *) /*oldName*/,
    TCL_UNUSED(const char *) /*newName*/,
    int flags)			/* Why was the object deleted? */
{
    Object *oPtr = (Object *)clientData;








|









|




















|







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
 *	of those commands when the object itself is deleted.
 *
 * ----------------------------------------------------------------------
 */

static void
MyDeleted(
    void *clientData)	/* Reference to the object whose [my] has been
				 * squelched. */
{
    Object *oPtr = (Object *)clientData;

    oPtr->myCommand = NULL;
}

static void
MyClassDeleted(
    void *clientData)
{
    Object *oPtr = (Object *)clientData;
    oPtr->myclassCommand = NULL;
}

/*
 * ----------------------------------------------------------------------
 *
 * ObjectRenamedTrace --
 *
 *	This callback is triggered when the object is deleted by any
 *	mechanism. It runs the destructors and arranges for the actual cleanup
 *	of the object's namespace, which in turn triggers cleansing of the
 *	object data structures.
 *
 * ----------------------------------------------------------------------
 */

static void
ObjectRenamedTrace(
    void *clientData,	/* The object being deleted. */
    TCL_UNUSED(Tcl_Interp *),
    TCL_UNUSED(const char *) /*oldName*/,
    TCL_UNUSED(const char *) /*newName*/,
    int flags)			/* Why was the object deleted? */
{
    Object *oPtr = (Object *)clientData;

956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974

void
TclOOReleaseClassContents(
    Tcl_Interp *interp,		/* The interpreter containing the class. */
    Object *oPtr)		/* The object representing the class. */
{
    FOREACH_HASH_DECLS;
    size_t i;
    Class *clsPtr = oPtr->classPtr, *tmpClsPtr;
    Method *mPtr;
    Foundation *fPtr = oPtr->fPtr;
    Tcl_Obj *variableObj;
    PrivateVariableMapping *privateVariable;

    /*
     * Sanity check!
     */

    if (!Destructing(oPtr)) {







|



|







957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975

void
TclOOReleaseClassContents(
    Tcl_Interp *interp,		/* The interpreter containing the class. */
    Object *oPtr)		/* The object representing the class. */
{
    FOREACH_HASH_DECLS;
    Tcl_Size i;
    Class *clsPtr = oPtr->classPtr, *tmpClsPtr;
    Method *mPtr;
    Foundation *fPtr = oPtr->fPtr;
    Tcl_Obj *variableObj, *propertyObj;
    PrivateVariableMapping *privateVariable;

    /*
     * Sanity check!
     */

    if (!Destructing(oPtr)) {
1012
1013
1014
1015
1016
1017
1018























1019
1020
1021
1022
1023
1024
1025
	FOREACH_HASH_VALUE(callPtr, clsPtr->classChainCache) {
	    TclOODeleteChain(callPtr);
	}
	Tcl_DeleteHashTable(clsPtr->classChainCache);
	Tcl_Free(clsPtr->classChainCache);
	clsPtr->classChainCache = NULL;
    }
























    /*
     * Squelch our filter list.
     */

    if (clsPtr->filters.num) {
	Tcl_Obj *filterObj;







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







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
	FOREACH_HASH_VALUE(callPtr, clsPtr->classChainCache) {
	    TclOODeleteChain(callPtr);
	}
	Tcl_DeleteHashTable(clsPtr->classChainCache);
	Tcl_Free(clsPtr->classChainCache);
	clsPtr->classChainCache = NULL;
    }

    /*
     * Squelch the property lists.
     */

    if (clsPtr->properties.allReadableCache) {
	Tcl_DecrRefCount(clsPtr->properties.allReadableCache);
    }
    if (clsPtr->properties.allWritableCache) {
	Tcl_DecrRefCount(clsPtr->properties.allWritableCache);
    }
    if (clsPtr->properties.readable.num) {
	FOREACH(propertyObj, clsPtr->properties.readable) {
	    Tcl_DecrRefCount(propertyObj);
	}
	Tcl_Free(clsPtr->properties.readable.list);
    }
    if (clsPtr->properties.writable.num) {
	FOREACH(propertyObj, clsPtr->properties.writable) {
	    Tcl_DecrRefCount(propertyObj);
	}
	Tcl_Free(clsPtr->properties.writable.list);
    }

    /*
     * Squelch our filter list.
     */

    if (clsPtr->filters.num) {
	Tcl_Obj *filterObj;
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048

    /*
     * Squelch our metadata.
     */

    if (clsPtr->metadataPtr != NULL) {
	Tcl_ObjectMetadataType *metadataTypePtr;
	ClientData value;

	FOREACH_HASH(metadataTypePtr, value, clsPtr->metadataPtr) {
	    metadataTypePtr->deleteProc(value);
	}
	Tcl_DeleteHashTable(clsPtr->metadataPtr);
	Tcl_Free(clsPtr->metadataPtr);
	clsPtr->metadataPtr = NULL;







|







1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072

    /*
     * Squelch our metadata.
     */

    if (clsPtr->metadataPtr != NULL) {
	Tcl_ObjectMetadataType *metadataTypePtr;
	void *value;

	FOREACH_HASH(metadataTypePtr, value, clsPtr->metadataPtr) {
	    metadataTypePtr->deleteProc(value);
	}
	Tcl_DeleteHashTable(clsPtr->metadataPtr);
	Tcl_Free(clsPtr->metadataPtr);
	clsPtr->metadataPtr = NULL;
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
 *	(interpreter teardown is complex!)
 *
 * ----------------------------------------------------------------------
 */

static void
ObjectNamespaceDeleted(
    ClientData clientData)	/* Pointer to the class whose namespace is
				 * being deleted. */
{
    Object *oPtr = (Object *)clientData;
    Foundation *fPtr = oPtr->fPtr;
    FOREACH_HASH_DECLS;
    Class *mixinPtr;
    Method *mPtr;
    Tcl_Obj *filterObj, *variableObj;
    PrivateVariableMapping *privateVariable;
    Tcl_Interp *interp = oPtr->fPtr->interp;
    size_t i;

    if (Destructing(oPtr)) {
	/*
	 * TODO:  Can ObjectNamespaceDeleted ever be called twice?  If not,
	 * this guard could be removed.
	 */

	return;
    }

    /*
     * One rule for the teardown routines is that if an object is in the
     * process of being deleted, nothing else may modify its bookeeping
     * records.  This is the flag that
     */

    oPtr->flags |= OBJECT_DESTRUCTING;

    /*
     * Let the dominoes fall!







|







|


|












|







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
 *	(interpreter teardown is complex!)
 *
 * ----------------------------------------------------------------------
 */

static void
ObjectNamespaceDeleted(
    void *clientData)	/* Pointer to the class whose namespace is
				 * being deleted. */
{
    Object *oPtr = (Object *)clientData;
    Foundation *fPtr = oPtr->fPtr;
    FOREACH_HASH_DECLS;
    Class *mixinPtr;
    Method *mPtr;
    Tcl_Obj *filterObj, *variableObj, *propertyObj;
    PrivateVariableMapping *privateVariable;
    Tcl_Interp *interp = oPtr->fPtr->interp;
    Tcl_Size i;

    if (Destructing(oPtr)) {
	/*
	 * TODO:  Can ObjectNamespaceDeleted ever be called twice?  If not,
	 * this guard could be removed.
	 */

	return;
    }

    /*
     * One rule for the teardown routines is that if an object is in the
     * process of being deleted, nothing else may modify its bookkeeping
     * records.  This is the flag that
     */

    oPtr->flags |= OBJECT_DESTRUCTING;

    /*
     * Let the dominoes fall!
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
     * still exists) because otherwise its pointer to the object points into
     * freed memory.
     */

    if (((Command *) oPtr->command)->flags && CMD_DYING) {
	/*
	 * Something has already started the command deletion process. We can
	 * go ahead and clean up the the namespace,
	 */
    } else {
	/*
	 * The namespace must have been deleted directly.  Delete the command
	 * as well.
	 */








|







1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
     * still exists) because otherwise its pointer to the object points into
     * freed memory.
     */

    if (((Command *) oPtr->command)->flags && CMD_DYING) {
	/*
	 * Something has already started the command deletion process. We can
	 * go ahead and clean up the namespace,
	 */
    } else {
	/*
	 * The namespace must have been deleted directly.  Delete the command
	 * as well.
	 */

1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272























1273
1274
1275
1276
1277
1278
1279
	TclOODeleteChainCache(oPtr->chainCache);
    }

    SquelchCachedName(oPtr);

    if (oPtr->metadataPtr != NULL) {
	Tcl_ObjectMetadataType *metadataTypePtr;
	ClientData value;

	FOREACH_HASH(metadataTypePtr, value, oPtr->metadataPtr) {
	    metadataTypePtr->deleteProc(value);
	}
	Tcl_DeleteHashTable(oPtr->metadataPtr);
	Tcl_Free(oPtr->metadataPtr);
	oPtr->metadataPtr = NULL;
    }
























    /*
     * Because an object can be a class that is an instance of itself, the
     * class object's class structure should only be cleaned after most of
     * the cleanup on the object is done.
     *
     * The class of objects needs some special care; if it is deleted (and







|








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







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
	TclOODeleteChainCache(oPtr->chainCache);
    }

    SquelchCachedName(oPtr);

    if (oPtr->metadataPtr != NULL) {
	Tcl_ObjectMetadataType *metadataTypePtr;
	void *value;

	FOREACH_HASH(metadataTypePtr, value, oPtr->metadataPtr) {
	    metadataTypePtr->deleteProc(value);
	}
	Tcl_DeleteHashTable(oPtr->metadataPtr);
	Tcl_Free(oPtr->metadataPtr);
	oPtr->metadataPtr = NULL;
    }

    /*
     * Squelch the property lists.
     */

    if (oPtr->properties.allReadableCache) {
	Tcl_DecrRefCount(oPtr->properties.allReadableCache);
    }
    if (oPtr->properties.allWritableCache) {
	Tcl_DecrRefCount(oPtr->properties.allWritableCache);
    }
    if (oPtr->properties.readable.num) {
	FOREACH(propertyObj, oPtr->properties.readable) {
	    Tcl_DecrRefCount(propertyObj);
	}
	Tcl_Free(oPtr->properties.readable.list);
    }
    if (oPtr->properties.writable.num) {
	FOREACH(propertyObj, oPtr->properties.writable) {
	    Tcl_DecrRefCount(propertyObj);
	}
	Tcl_Free(oPtr->properties.writable.list);
    }

    /*
     * Because an object can be a class that is an instance of itself, the
     * class object's class structure should only be cleaned after most of
     * the cleanup on the object is done.
     *
     * The class of objects needs some special care; if it is deleted (and
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372

int
TclOORemoveFromInstances(
    Object *oPtr,		/* The instance to remove. */
    Class *clsPtr)		/* The class (possibly) containing the
				 * reference to the instance. */
{
    size_t i;
    int res = 0;
    Object *instPtr;

    FOREACH(instPtr, clsPtr->instances) {
	if (oPtr == instPtr) {
	    RemoveItem(Object, clsPtr->instances, i);
	    TclOODecrRefCount(oPtr);







|







1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419

int
TclOORemoveFromInstances(
    Object *oPtr,		/* The instance to remove. */
    Class *clsPtr)		/* The class (possibly) containing the
				 * reference to the instance. */
{
    Tcl_Size i;
    int res = 0;
    Object *instPtr;

    FOREACH(instPtr, clsPtr->instances) {
	if (oPtr == instPtr) {
	    RemoveItem(Object, clsPtr->instances, i);
	    TclOODecrRefCount(oPtr);
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435

int
TclOORemoveFromMixins(
    Class *mixinPtr,		/* The mixin to remove. */
    Object *oPtr)		/* The object (possibly) containing the
				 * reference to the mixin. */
{
    size_t i;
    int res = 0;
    Class *mixPtr;

    FOREACH(mixPtr, oPtr->mixins) {
	if (mixinPtr == mixPtr) {
	    RemoveItem(Class, oPtr->mixins, i);
	    TclOODecrRefCount(mixPtr->thisPtr);







|







1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482

int
TclOORemoveFromMixins(
    Class *mixinPtr,		/* The mixin to remove. */
    Object *oPtr)		/* The object (possibly) containing the
				 * reference to the mixin. */
{
    Tcl_Size i;
    int res = 0;
    Class *mixPtr;

    FOREACH(mixPtr, oPtr->mixins) {
	if (mixinPtr == mixPtr) {
	    RemoveItem(Class, oPtr->mixins, i);
	    TclOODecrRefCount(mixPtr->thisPtr);
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471

int
TclOORemoveFromSubclasses(
    Class *subPtr,		/* The subclass to remove. */
    Class *superPtr)		/* The superclass to possibly remove the
				 * subclass reference from. */
{
    size_t i;
    int res = 0;
    Class *subclsPtr;

    FOREACH(subclsPtr, superPtr->subclasses) {
	if (subPtr == subclsPtr) {
	    RemoveItem(Class, superPtr->subclasses, i);
	    TclOODecrRefCount(subPtr->thisPtr);







|







1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518

int
TclOORemoveFromSubclasses(
    Class *subPtr,		/* The subclass to remove. */
    Class *superPtr)		/* The superclass to possibly remove the
				 * subclass reference from. */
{
    Tcl_Size i;
    int res = 0;
    Class *subclsPtr;

    FOREACH(subclsPtr, superPtr->subclasses) {
	if (subPtr == subclsPtr) {
	    RemoveItem(Class, superPtr->subclasses, i);
	    TclOODecrRefCount(subPtr->thisPtr);
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536

int
TclOORemoveFromMixinSubs(
    Class *subPtr,		/* The subclass to remove. */
    Class *superPtr)		/* The superclass to possibly remove the
				 * subclass reference from. */
{
    size_t i;
    int res = 0;
    Class *subclsPtr;

    FOREACH(subclsPtr, superPtr->mixinSubs) {
	if (subPtr == subclsPtr) {
	    RemoveItem(Class, superPtr->mixinSubs, i);
	    TclOODecrRefCount(subPtr->thisPtr);







|







1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583

int
TclOORemoveFromMixinSubs(
    Class *subPtr,		/* The subclass to remove. */
    Class *superPtr)		/* The superclass to possibly remove the
				 * subclass reference from. */
{
    Tcl_Size i;
    int res = 0;
    Class *subclsPtr;

    FOREACH(subclsPtr, superPtr->mixinSubs) {
	if (subPtr == subclsPtr) {
	    RemoveItem(Class, superPtr->mixinSubs, i);
	    TclOODecrRefCount(subPtr->thisPtr);
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
    Tcl_Interp *interp,		/* Interpreter context. */
    Tcl_Class cls,		/* Class to create an instance of. */
    const char *nameStr,	/* Name of object to create, or NULL to ask
				 * the code to pick its own unique name. */
    const char *nsNameStr,	/* Name of namespace to create inside object,
				 * or NULL to ask the code to pick its own
				 * unique name. */
    size_t objc,			/* Number of arguments. Negative value means
				 * do not call constructor. */
    Tcl_Obj *const *objv,	/* Argument list. */
    size_t skip)			/* Number of arguments to _not_ pass to the
				 * constructor. */
{
    Class *classPtr = (Class *) cls;
    Object *oPtr;
    ClientData clientData[4];

    oPtr = TclNewObjectInstanceCommon(interp, classPtr, nameStr, nsNameStr);
    if (oPtr == NULL) {
	return NULL;
    }

    /*







|


|




|







1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
    Tcl_Interp *interp,		/* Interpreter context. */
    Tcl_Class cls,		/* Class to create an instance of. */
    const char *nameStr,	/* Name of object to create, or NULL to ask
				 * the code to pick its own unique name. */
    const char *nsNameStr,	/* Name of namespace to create inside object,
				 * or NULL to ask the code to pick its own
				 * unique name. */
    Tcl_Size objc,			/* Number of arguments. Negative value means
				 * do not call constructor. */
    Tcl_Obj *const *objv,	/* Argument list. */
    Tcl_Size skip)			/* Number of arguments to _not_ pass to the
				 * constructor. */
{
    Class *classPtr = (Class *) cls;
    Object *oPtr;
    void *clientData[4];

    oPtr = TclNewObjectInstanceCommon(interp, classPtr, nameStr, nsNameStr);
    if (oPtr == NULL) {
	return NULL;
    }

    /*
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
    Tcl_Interp *interp,		/* Interpreter context. */
    Tcl_Class cls,		/* Class to create an instance of. */
    const char *nameStr,	/* Name of object to create, or NULL to ask
				 * the code to pick its own unique name. */
    const char *nsNameStr,	/* Name of namespace to create inside object,
				 * or NULL to ask the code to pick its own
				 * unique name. */
    size_t objc,			/* Number of arguments. Negative value means
				 * do not call constructor. */
    Tcl_Obj *const *objv,	/* Argument list. */
    size_t skip,			/* Number of arguments to _not_ pass to the
				 * constructor. */
    Tcl_Object *objectPtr)	/* Place to write the object reference upon
				 * successful allocation. */
{
    Class *classPtr = (Class *) cls;
    CallContext *contextPtr;
    Tcl_InterpState state;
    Object *oPtr;

    oPtr = TclNewObjectInstanceCommon(interp, classPtr, nameStr, nsNameStr);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }

    /*
     * Run constructors, except when objc == TCL_INDEX_NONE (a special flag case used for
     * object cloning only). If there aren't any constructors, we do nothing.
     */

    if (objc == TCL_INDEX_NONE) {
	*objectPtr = (Tcl_Object) oPtr;
	return TCL_OK;
    }
    contextPtr = TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL, NULL, NULL);
    if (contextPtr == NULL) {
	*objectPtr = (Tcl_Object) oPtr;
	return TCL_OK;







|


|



















|







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
    Tcl_Interp *interp,		/* Interpreter context. */
    Tcl_Class cls,		/* Class to create an instance of. */
    const char *nameStr,	/* Name of object to create, or NULL to ask
				 * the code to pick its own unique name. */
    const char *nsNameStr,	/* Name of namespace to create inside object,
				 * or NULL to ask the code to pick its own
				 * unique name. */
    Tcl_Size objc,			/* Number of arguments. Negative value means
				 * do not call constructor. */
    Tcl_Obj *const *objv,	/* Argument list. */
    Tcl_Size skip,			/* Number of arguments to _not_ pass to the
				 * constructor. */
    Tcl_Object *objectPtr)	/* Place to write the object reference upon
				 * successful allocation. */
{
    Class *classPtr = (Class *) cls;
    CallContext *contextPtr;
    Tcl_InterpState state;
    Object *oPtr;

    oPtr = TclNewObjectInstanceCommon(interp, classPtr, nameStr, nsNameStr);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }

    /*
     * Run constructors, except when objc == TCL_INDEX_NONE (a special flag case used for
     * object cloning only). If there aren't any constructors, we do nothing.
     */

    if (objc < 0) {
	*objectPtr = (Tcl_Object) oPtr;
	return TCL_OK;
    }
    contextPtr = TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL, NULL, NULL);
    if (contextPtr == NULL) {
	*objectPtr = (Tcl_Object) oPtr;
	return TCL_OK;
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
	oPtr->classPtr = NULL;
    }
    return oPtr;
}

static int
FinalizeAlloc(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    CallContext *contextPtr = (CallContext *)data[0];
    Object *oPtr = (Object *)data[1];
    Tcl_InterpState state = (Tcl_InterpState)data[2];
    Tcl_Object *objectPtr = (Tcl_Object *)data[3];







|







1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
	oPtr->classPtr = NULL;
    }
    return oPtr;
}

static int
FinalizeAlloc(
    void *data[],
    Tcl_Interp *interp,
    int result)
{
    CallContext *contextPtr = (CallContext *)data[0];
    Object *oPtr = (Object *)data[1];
    Tcl_InterpState state = (Tcl_InterpState)data[2];
    Tcl_Object *objectPtr = (Tcl_Object *)data[3];
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
    Object *oPtr = (Object *) sourceObject, *o2Ptr;
    FOREACH_HASH_DECLS;
    Method *mPtr;
    Class *mixinPtr;
    CallContext *contextPtr;
    Tcl_Obj *keyPtr, *filterObj, *variableObj, *args[3];
    PrivateVariableMapping *privateVariable;
    size_t i;
    int result;

    /*
     * Sanity check.
     */

    if (IsRootClass(oPtr)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"may not clone the class of classes", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "CLONING_CLASS", NULL);
	return NULL;
    }

    /*
     * Build the instance. Note that this does not run any constructors.
     */

    o2Ptr = (Object *) Tcl_NewObjectInstance(interp,
	    (Tcl_Class) oPtr->selfCls, targetName, targetNamespaceName, -1,
	    NULL, -1);
    if (o2Ptr == NULL) {
	return NULL;
    }

    /*
     * Copy the object-local methods to the new object.







|


















|







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
    Object *oPtr = (Object *) sourceObject, *o2Ptr;
    FOREACH_HASH_DECLS;
    Method *mPtr;
    Class *mixinPtr;
    CallContext *contextPtr;
    Tcl_Obj *keyPtr, *filterObj, *variableObj, *args[3];
    PrivateVariableMapping *privateVariable;
    Tcl_Size i;
    int result;

    /*
     * Sanity check.
     */

    if (IsRootClass(oPtr)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"may not clone the class of classes", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "CLONING_CLASS", NULL);
	return NULL;
    }

    /*
     * Build the instance. Note that this does not run any constructors.
     */

    o2Ptr = (Object *) Tcl_NewObjectInstance(interp,
	    (Tcl_Class) oPtr->selfCls, targetName, targetNamespaceName, TCL_INDEX_NONE,
	    NULL, -1);
    if (o2Ptr == NULL) {
	return NULL;
    }

    /*
     * Copy the object-local methods to the new object.
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047

    /*
     * Copy the object's metadata.
     */

    if (oPtr->metadataPtr != NULL) {
	Tcl_ObjectMetadataType *metadataTypePtr;
	ClientData value, duplicate;

	FOREACH_HASH(metadataTypePtr, value, oPtr->metadataPtr) {
	    if (metadataTypePtr->cloneProc == NULL) {
		duplicate = value;
	    } else {
		if (metadataTypePtr->cloneProc(interp, value,
			&duplicate) != TCL_OK) {







|







2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094

    /*
     * Copy the object's metadata.
     */

    if (oPtr->metadataPtr != NULL) {
	Tcl_ObjectMetadataType *metadataTypePtr;
	void *value, *duplicate;

	FOREACH_HASH(metadataTypePtr, value, oPtr->metadataPtr) {
	    if (metadataTypePtr->cloneProc == NULL) {
		duplicate = value;
	    } else {
		if (metadataTypePtr->cloneProc(interp, value,
			&duplicate) != TCL_OK) {
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192

	/*
	 * Duplicate the class's metadata.
	 */

	if (clsPtr->metadataPtr != NULL) {
	    Tcl_ObjectMetadataType *metadataTypePtr;
	    ClientData value, duplicate;

	    FOREACH_HASH(metadataTypePtr, value, clsPtr->metadataPtr) {
		if (metadataTypePtr->cloneProc == NULL) {
		    duplicate = value;
		} else {
		    if (metadataTypePtr->cloneProc(interp, value,
			    &duplicate) != TCL_OK) {







|







2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239

	/*
	 * Duplicate the class's metadata.
	 */

	if (clsPtr->metadataPtr != NULL) {
	    Tcl_ObjectMetadataType *metadataTypePtr;
	    void *value, *duplicate;

	    FOREACH_HASH(metadataTypePtr, value, clsPtr->metadataPtr) {
		if (metadataTypePtr->cloneProc == NULL) {
		    duplicate = value;
		} else {
		    if (metadataTypePtr->cloneProc(interp, value,
			    &duplicate) != TCL_OK) {
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
    Method *mPtr,
    Tcl_Obj *namePtr)
{
    if (mPtr->typePtr == NULL) {
	TclNewInstanceMethod(interp, (Tcl_Object) oPtr, namePtr,
		mPtr->flags & PUBLIC_METHOD, NULL, NULL);
    } else if (mPtr->typePtr->cloneProc) {
	ClientData newClientData;

	if (mPtr->typePtr->cloneProc(interp, mPtr->clientData,
		&newClientData) != TCL_OK) {
	    return TCL_ERROR;
	}
	TclNewInstanceMethod(interp, (Tcl_Object) oPtr, namePtr,
		mPtr->flags & PUBLIC_METHOD, mPtr->typePtr, newClientData);







|







2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
    Method *mPtr,
    Tcl_Obj *namePtr)
{
    if (mPtr->typePtr == NULL) {
	TclNewInstanceMethod(interp, (Tcl_Object) oPtr, namePtr,
		mPtr->flags & PUBLIC_METHOD, NULL, NULL);
    } else if (mPtr->typePtr->cloneProc) {
	void *newClientData;

	if (mPtr->typePtr->cloneProc(interp, mPtr->clientData,
		&newClientData) != TCL_OK) {
	    return TCL_ERROR;
	}
	TclNewInstanceMethod(interp, (Tcl_Object) oPtr, namePtr,
		mPtr->flags & PUBLIC_METHOD, mPtr->typePtr, newClientData);
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
{
    Method *m2Ptr;

    if (mPtr->typePtr == NULL) {
	m2Ptr = (Method *) TclNewMethod(interp, (Tcl_Class) clsPtr,
		namePtr, mPtr->flags & PUBLIC_METHOD, NULL, NULL);
    } else if (mPtr->typePtr->cloneProc) {
	ClientData newClientData;

	if (mPtr->typePtr->cloneProc(interp, mPtr->clientData,
		&newClientData) != TCL_OK) {
	    return TCL_ERROR;
	}
	m2Ptr = (Method *) TclNewMethod(interp, (Tcl_Class) clsPtr,
		namePtr, mPtr->flags & PUBLIC_METHOD, mPtr->typePtr,







|







2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
{
    Method *m2Ptr;

    if (mPtr->typePtr == NULL) {
	m2Ptr = (Method *) TclNewMethod(interp, (Tcl_Class) clsPtr,
		namePtr, mPtr->flags & PUBLIC_METHOD, NULL, NULL);
    } else if (mPtr->typePtr->cloneProc) {
	void *newClientData;

	if (mPtr->typePtr->cloneProc(interp, mPtr->clientData,
		&newClientData) != TCL_OK) {
	    return TCL_ERROR;
	}
	m2Ptr = (Method *) TclNewMethod(interp, (Tcl_Class) clsPtr,
		namePtr, mPtr->flags & PUBLIC_METHOD, mPtr->typePtr,
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
 *	attached (replacing the previous value, which is deleted if present)
 *	otherwise. This means it is impossible to attach a NULL value for any
 *	metadata type.
 *
 * ----------------------------------------------------------------------
 */

ClientData
Tcl_ClassGetMetadata(
    Tcl_Class clazz,
    const Tcl_ObjectMetadataType *typePtr)
{
    Class *clsPtr = (Class *) clazz;
    Tcl_HashEntry *hPtr;








|







2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
 *	attached (replacing the previous value, which is deleted if present)
 *	otherwise. This means it is impossible to attach a NULL value for any
 *	metadata type.
 *
 * ----------------------------------------------------------------------
 */

void *
Tcl_ClassGetMetadata(
    Tcl_Class clazz,
    const Tcl_ObjectMetadataType *typePtr)
{
    Class *clsPtr = (Class *) clazz;
    Tcl_HashEntry *hPtr;

2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
    return Tcl_GetHashValue(hPtr);
}

void
Tcl_ClassSetMetadata(
    Tcl_Class clazz,
    const Tcl_ObjectMetadataType *typePtr,
    ClientData metadata)
{
    Class *clsPtr = (Class *) clazz;
    Tcl_HashEntry *hPtr;
    int isNew;

    /*
     * Attach the metadata store if not done already.







|







2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
    return Tcl_GetHashValue(hPtr);
}

void
Tcl_ClassSetMetadata(
    Tcl_Class clazz,
    const Tcl_ObjectMetadataType *typePtr,
    void *metadata)
{
    Class *clsPtr = (Class *) clazz;
    Tcl_HashEntry *hPtr;
    int isNew;

    /*
     * Attach the metadata store if not done already.
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
    hPtr = Tcl_CreateHashEntry(clsPtr->metadataPtr, typePtr, &isNew);
    if (!isNew) {
	typePtr->deleteProc(Tcl_GetHashValue(hPtr));
    }
    Tcl_SetHashValue(hPtr, metadata);
}

ClientData
Tcl_ObjectGetMetadata(
    Tcl_Object object,
    const Tcl_ObjectMetadataType *typePtr)
{
    Object *oPtr = (Object *) object;
    Tcl_HashEntry *hPtr;








|







2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
    hPtr = Tcl_CreateHashEntry(clsPtr->metadataPtr, typePtr, &isNew);
    if (!isNew) {
	typePtr->deleteProc(Tcl_GetHashValue(hPtr));
    }
    Tcl_SetHashValue(hPtr, metadata);
}

void *
Tcl_ObjectGetMetadata(
    Tcl_Object object,
    const Tcl_ObjectMetadataType *typePtr)
{
    Object *oPtr = (Object *) object;
    Tcl_HashEntry *hPtr;

2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
    return Tcl_GetHashValue(hPtr);
}

void
Tcl_ObjectSetMetadata(
    Tcl_Object object,
    const Tcl_ObjectMetadataType *typePtr,
    ClientData metadata)
{
    Object *oPtr = (Object *) object;
    Tcl_HashEntry *hPtr;
    int isNew;

    /*
     * Attach the metadata store if not done already.







|







2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
    return Tcl_GetHashValue(hPtr);
}

void
Tcl_ObjectSetMetadata(
    Tcl_Object object,
    const Tcl_ObjectMetadataType *typePtr,
    void *metadata)
{
    Object *oPtr = (Object *) object;
    Tcl_HashEntry *hPtr;
    int isNew;

    /*
     * Attach the metadata store if not done already.
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
 *	function. Note that the core is function is NRE-aware.
 *
 * ----------------------------------------------------------------------
 */

int
TclOOPublicObjectCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    return Tcl_NRCallObjProc(interp, PublicNRObjectCmd, clientData,objc,objv);
}

static int
PublicNRObjectCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    return TclOOObjectCmdCore((Object *)clientData, interp, objc, objv, PUBLIC_METHOD,
	    NULL);
}

int
TclOOPrivateObjectCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    return Tcl_NRCallObjProc(interp, PrivateNRObjectCmd,clientData,objc,objv);
}

static int
PrivateNRObjectCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    return TclOOObjectCmdCore((Object *)clientData, interp, objc, objv, 0, NULL);
}

int
TclOOInvokeObject(
    Tcl_Interp *interp,		/* Interpreter for commands, variables,
				 * results, error reporting, etc. */
    Tcl_Object object,		/* The object to invoke. */
    Tcl_Class startCls,		/* Where in the class chain to start the
				 * invoke from, or NULL to traverse the whole
				 * chain including filters. */
    int publicPrivate,		/* Whether this is an invoke from a public
				 * context (PUBLIC_METHOD), a private context
				 * (PRIVATE_METHOD), or a *really* private
				 * context (any other value; conventionally
				 * 0). */
    size_t objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Array of argument objects. It is assumed
				 * that the name of the method to invoke will
				 * be at index 1. */
{
    switch (publicPrivate) {
    case PUBLIC_METHOD:
	return TclOOObjectCmdCore((Object *) object, interp, objc, objv,







|









|










|









|




















|







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
 *	function. Note that the core is function is NRE-aware.
 *
 * ----------------------------------------------------------------------
 */

int
TclOOPublicObjectCmd(
    void *clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    return Tcl_NRCallObjProc(interp, PublicNRObjectCmd, clientData,objc,objv);
}

static int
PublicNRObjectCmd(
    void *clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    return TclOOObjectCmdCore((Object *)clientData, interp, objc, objv, PUBLIC_METHOD,
	    NULL);
}

int
TclOOPrivateObjectCmd(
    void *clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    return Tcl_NRCallObjProc(interp, PrivateNRObjectCmd,clientData,objc,objv);
}

static int
PrivateNRObjectCmd(
    void *clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    return TclOOObjectCmdCore((Object *)clientData, interp, objc, objv, 0, NULL);
}

int
TclOOInvokeObject(
    Tcl_Interp *interp,		/* Interpreter for commands, variables,
				 * results, error reporting, etc. */
    Tcl_Object object,		/* The object to invoke. */
    Tcl_Class startCls,		/* Where in the class chain to start the
				 * invoke from, or NULL to traverse the whole
				 * chain including filters. */
    int publicPrivate,		/* Whether this is an invoke from a public
				 * context (PUBLIC_METHOD), a private context
				 * (PRIVATE_METHOD), or a *really* private
				 * context (any other value; conventionally
				 * 0). */
    Tcl_Size objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Array of argument objects. It is assumed
				 * that the name of the method to invoke will
				 * be at index 1. */
{
    switch (publicPrivate) {
    case PUBLIC_METHOD:
	return TclOOObjectCmdCore((Object *) object, interp, objc, objv,
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
 *	Special trap door to allow an object to delegate simply to its class.
 *
 * ----------------------------------------------------------------------
 */

int
TclOOMyClassObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    return Tcl_NRCallObjProc(interp, MyClassNRObjCmd, clientData, objc, objv);
}

static int
MyClassNRObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *)clientData;

    if (objc < 2) {







|









|







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
 *	Special trap door to allow an object to delegate simply to its class.
 *
 * ----------------------------------------------------------------------
 */

int
TclOOMyClassObjCmd(
    void *clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    return Tcl_NRCallObjProc(interp, MyClassNRObjCmd, clientData, objc, objv);
}

static int
MyClassNRObjCmd(
    void *clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *)clientData;

    if (objc < 2) {
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
 * ----------------------------------------------------------------------
 */

int
TclOOObjectCmdCore(
    Object *oPtr,		/* The object being invoked. */
    Tcl_Interp *interp,		/* The interpreter containing the object. */
    size_t objc,			/* How many arguments are being passed in. */
    Tcl_Obj *const *objv,	/* The array of arguments. */
    int flags,			/* Whether this is an invocation through the
				 * public or the private command interface. */
    Class *startCls)		/* Where to start in the call chain, or NULL
				 * if we are to start at the front with
				 * filters and the object's methods (which is
				 * the normal case). */
{
    CallContext *contextPtr;
    Tcl_Obj *methodNamePtr;
    CallFrame *framePtr = ((Interp *) interp)->varFramePtr;
    Object *callerObjPtr = NULL;
    Class *callerClsPtr = NULL;
    int result;

    /*
     * If we've no method name, throw this directly into the unknown
     * processing.
     */

    if (objc + 1 < 3) {
	flags |= FORCE_UNKNOWN;
	methodNamePtr = NULL;
	goto noMapping;
    }

    /*
     * Determine if we're in a context that can see the extra, private methods







|




















|







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

int
TclOOObjectCmdCore(
    Object *oPtr,		/* The object being invoked. */
    Tcl_Interp *interp,		/* The interpreter containing the object. */
    Tcl_Size objc,			/* How many arguments are being passed in. */
    Tcl_Obj *const *objv,	/* The array of arguments. */
    int flags,			/* Whether this is an invocation through the
				 * public or the private command interface. */
    Class *startCls)		/* Where to start in the call chain, or NULL
				 * if we are to start at the front with
				 * filters and the object's methods (which is
				 * the normal case). */
{
    CallContext *contextPtr;
    Tcl_Obj *methodNamePtr;
    CallFrame *framePtr = ((Interp *) interp)->varFramePtr;
    Object *callerObjPtr = NULL;
    Class *callerClsPtr = NULL;
    int result;

    /*
     * If we've no method name, throw this directly into the unknown
     * processing.
     */

    if (objc < 2) {
	flags |= FORCE_UNKNOWN;
	methodNamePtr = NULL;
	goto noMapping;
    }

    /*
     * Determine if we're in a context that can see the extra, private methods
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778

    TclNRAddCallback(interp, FinalizeObjectCall, contextPtr, NULL,NULL,NULL);
    return TclOOInvokeContext(contextPtr, interp, objc, objv);
}

static int
FinalizeObjectCall(
    ClientData data[],
    TCL_UNUSED(Tcl_Interp *),
    int result)
{
    /*
     * Dispose of the call chain, which drops the lock on the object's
     * structure.
     */







|







2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825

    TclNRAddCallback(interp, FinalizeObjectCall, contextPtr, NULL,NULL,NULL);
    return TclOOInvokeContext(contextPtr, interp, objc, objv);
}

static int
FinalizeObjectCall(
    void *data[],
    TCL_UNUSED(Tcl_Interp *),
    int result)
{
    /*
     * Dispose of the call chain, which drops the lock on the object's
     * structure.
     */
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
 * ----------------------------------------------------------------------
 */

int
Tcl_ObjectContextInvokeNext(
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    size_t objc,
    Tcl_Obj *const *objv,
    size_t skip)
{
    CallContext *contextPtr = (CallContext *) context;
    size_t savedIndex = contextPtr->index;
    size_t savedSkip = contextPtr->skip;
    int result;

    if (contextPtr->index + 1 >= contextPtr->callPtr->numChain) {







|

|







2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
 * ----------------------------------------------------------------------
 */

int
Tcl_ObjectContextInvokeNext(
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    Tcl_Size objc,
    Tcl_Obj *const *objv,
    Tcl_Size skip)
{
    CallContext *contextPtr = (CallContext *) context;
    size_t savedIndex = contextPtr->index;
    size_t savedSkip = contextPtr->skip;
    int result;

    if (contextPtr->index + 1 >= contextPtr->callPtr->numChain) {
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
    return result;
}

int
TclNRObjectContextInvokeNext(
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    size_t objc,
    Tcl_Obj *const *objv,
    size_t skip)
{
    CallContext *contextPtr = (CallContext *) context;

    if (contextPtr->index + 1 >= contextPtr->callPtr->numChain) {
	/*
	 * We're at the end of the chain; generate an error message unless the
	 * interpreter is being torn down, in which case we might be getting







|

|







2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
    return result;
}

int
TclNRObjectContextInvokeNext(
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    Tcl_Size objc,
    Tcl_Obj *const *objv,
    Tcl_Size skip)
{
    CallContext *contextPtr = (CallContext *) context;

    if (contextPtr->index + 1 >= contextPtr->callPtr->numChain) {
	/*
	 * We're at the end of the chain; generate an error message unless the
	 * interpreter is being torn down, in which case we might be getting
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
     */

    return TclOOInvokeContext(contextPtr, interp, objc, objv);
}

static int
FinalizeNext(
    ClientData data[],
    TCL_UNUSED(Tcl_Interp *),
    int result)
{
    CallContext *contextPtr = (CallContext *)data[0];

    /*
     * Restore the call chain context index as we've finished the inner invoke







|







2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
     */

    return TclOOInvokeContext(contextPtr, interp, objc, objv);
}

static int
FinalizeNext(
    void *data[],
    TCL_UNUSED(Tcl_Interp *),
    int result)
{
    CallContext *contextPtr = (CallContext *)data[0];

    /*
     * Restore the call chain context index as we've finished the inner invoke
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
 */

int
TclOOIsReachable(
    Class *targetPtr,
    Class *startPtr)
{
    size_t i;
    Class *superPtr;

  tailRecurse:
    if (startPtr == targetPtr) {
	return 1;
    }
    if (startPtr->superclasses.num == 1 && startPtr->mixins.num == 0) {







|







3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
 */

int
TclOOIsReachable(
    Class *targetPtr,
    Class *startPtr)
{
    Tcl_Size i;
    Class *superPtr;

  tailRecurse:
    if (startPtr == targetPtr) {
	return 1;
    }
    if (startPtr->superclasses.num == 1 && startPtr->mixins.num == 0) {
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
Tcl_Object
Tcl_ObjectContextObject(
    Tcl_ObjectContext context)
{
    return (Tcl_Object) ((CallContext *)context)->oPtr;
}

size_t
Tcl_ObjectContextSkippedArgs(
    Tcl_ObjectContext context)
{
    return ((CallContext *)context)->skip;
}

Tcl_Namespace *







|







3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
Tcl_Object
Tcl_ObjectContextObject(
    Tcl_ObjectContext context)
{
    return (Tcl_Object) ((CallContext *)context)->oPtr;
}

Tcl_Size
Tcl_ObjectContextSkippedArgs(
    Tcl_ObjectContext context)
{
    return ((CallContext *)context)->skip;
}

Tcl_Namespace *

Changes to generic/tclOO.decls.

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
declare 12 {
    Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
	    Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr,
	    void *clientData)
}
declare 13 {
    Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp, Tcl_Class cls,
	    const char *nameStr, const char *nsNameStr, size_t objc,
	    Tcl_Obj *const *objv, size_t skip)
}
declare 14 {
    int Tcl_ObjectDeleted(Tcl_Object object)
}
declare 15 {
    int Tcl_ObjectContextIsFiltering(Tcl_ObjectContext context)
}
declare 16 {
    Tcl_Method Tcl_ObjectContextMethod(Tcl_ObjectContext context)
}
declare 17 {
    Tcl_Object Tcl_ObjectContextObject(Tcl_ObjectContext context)
}
declare 18 {
    size_t Tcl_ObjectContextSkippedArgs(Tcl_ObjectContext context)
}
declare 19 {
    void *Tcl_ClassGetMetadata(Tcl_Class clazz,
	    const Tcl_ObjectMetadataType *typePtr)
}
declare 20 {
    void Tcl_ClassSetMetadata(Tcl_Class clazz,
	    const Tcl_ObjectMetadataType *typePtr, void *metadata)
}
declare 21 {
    void *Tcl_ObjectGetMetadata(Tcl_Object object,
	    const Tcl_ObjectMetadataType *typePtr)
}
declare 22 {
    void Tcl_ObjectSetMetadata(Tcl_Object object,
	    const Tcl_ObjectMetadataType *typePtr, void *metadata)
}
declare 23 {
    int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp,
	    Tcl_ObjectContext context, size_t objc, Tcl_Obj *const *objv,
	    size_t skip)
}
declare 24 {
    Tcl_ObjectMapMethodNameProc *Tcl_ObjectGetMethodNameMapper(
	    Tcl_Object object)
}
declare 25 {
    void Tcl_ObjectSetMethodNameMapper(Tcl_Object object,







|
|














|



















|
|







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
declare 12 {
    Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
	    Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr,
	    void *clientData)
}
declare 13 {
    Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp, Tcl_Class cls,
	    const char *nameStr, const char *nsNameStr, Tcl_Size objc,
	    Tcl_Obj *const *objv, Tcl_Size skip)
}
declare 14 {
    int Tcl_ObjectDeleted(Tcl_Object object)
}
declare 15 {
    int Tcl_ObjectContextIsFiltering(Tcl_ObjectContext context)
}
declare 16 {
    Tcl_Method Tcl_ObjectContextMethod(Tcl_ObjectContext context)
}
declare 17 {
    Tcl_Object Tcl_ObjectContextObject(Tcl_ObjectContext context)
}
declare 18 {
    Tcl_Size Tcl_ObjectContextSkippedArgs(Tcl_ObjectContext context)
}
declare 19 {
    void *Tcl_ClassGetMetadata(Tcl_Class clazz,
	    const Tcl_ObjectMetadataType *typePtr)
}
declare 20 {
    void Tcl_ClassSetMetadata(Tcl_Class clazz,
	    const Tcl_ObjectMetadataType *typePtr, void *metadata)
}
declare 21 {
    void *Tcl_ObjectGetMetadata(Tcl_Object object,
	    const Tcl_ObjectMetadataType *typePtr)
}
declare 22 {
    void Tcl_ObjectSetMetadata(Tcl_Object object,
	    const Tcl_ObjectMetadataType *typePtr, void *metadata)
}
declare 23 {
    int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp,
	    Tcl_ObjectContext context, Tcl_Size objc, Tcl_Obj *const *objv,
	    Tcl_Size skip)
}
declare 24 {
    Tcl_ObjectMapMethodNameProc *Tcl_ObjectGetMethodNameMapper(
	    Tcl_Object object)
}
declare 25 {
    void Tcl_ObjectSetMethodNameMapper(Tcl_Object object,
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
}
declare 4 {
    Method *TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr,
	    int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
	    ProcedureMethod **pmPtrPtr)
}
declare 5 {
    int TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp, size_t objc,
	    Tcl_Obj *const *objv, int publicOnly, Class *startCls)
}
declare 6 {
    int TclOOIsReachable(Class *targetPtr, Class *startPtr)
}
declare 7 {
    Method *TclOONewForwardMethod(Tcl_Interp *interp, Class *clsPtr,







|







180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
}
declare 4 {
    Method *TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr,
	    int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
	    ProcedureMethod **pmPtrPtr)
}
declare 5 {
    int TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp, Tcl_Size objc,
	    Tcl_Obj *const *objv, int publicOnly, Class *startCls)
}
declare 6 {
    int TclOOIsReachable(Class *targetPtr, Class *startPtr)
}
declare 7 {
    Method *TclOONewForwardMethod(Tcl_Interp *interp, Class *clsPtr,
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
	    TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr,
	    ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj,
	    Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags,
	    void **internalTokenPtr)
}
declare 11 {
    int TclOOInvokeObject(Tcl_Interp *interp, Tcl_Object object,
	    Tcl_Class startCls, int publicPrivate, size_t objc,
	    Tcl_Obj *const *objv)
}
declare 12 {
    void TclOOObjectSetFilters(Object *oPtr, size_t numFilters,
	    Tcl_Obj *const *filters)
}
declare 13 {
    void TclOOClassSetFilters(Tcl_Interp *interp, Class *classPtr,
	    size_t numFilters, Tcl_Obj *const *filters)
}
declare 14 {
    void TclOOObjectSetMixins(Object *oPtr, size_t numMixins,
	    Class *const *mixins)
}
declare 15 {
    void TclOOClassSetMixins(Tcl_Interp *interp, Class *classPtr,
	    size_t numMixins, Class *const *mixins)
}

return

# Local Variables:
# mode: tcl
# End:







|



|




|


|




|







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
	    TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr,
	    ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj,
	    Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags,
	    void **internalTokenPtr)
}
declare 11 {
    int TclOOInvokeObject(Tcl_Interp *interp, Tcl_Object object,
	    Tcl_Class startCls, int publicPrivate, Tcl_Size objc,
	    Tcl_Obj *const *objv)
}
declare 12 {
    void TclOOObjectSetFilters(Object *oPtr, Tcl_Size numFilters,
	    Tcl_Obj *const *filters)
}
declare 13 {
    void TclOOClassSetFilters(Tcl_Interp *interp, Class *classPtr,
	    Tcl_Size numFilters, Tcl_Obj *const *filters)
}
declare 14 {
    void TclOOObjectSetMixins(Object *oPtr, Tcl_Size numMixins,
	    Class *const *mixins)
}
declare 15 {
    void TclOOClassSetMixins(Tcl_Interp *interp, Class *classPtr,
	    Tcl_Size numMixins, Class *const *mixins)
}

return

# Local Variables:
# mode: tcl
# End:

Changes to generic/tclOO.h.

59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
 * implementation. These are used to implement custom types of method calls
 * and to allow the attachment of arbitrary data to objects and classes.
 */

typedef int (Tcl_MethodCallProc)(void *clientData, Tcl_Interp *interp,
	Tcl_ObjectContext objectContext, int objc, Tcl_Obj *const *objv);
typedef int (Tcl_MethodCallProc2)(void *clientData, Tcl_Interp *interp,
	Tcl_ObjectContext objectContext, size_t objc, Tcl_Obj *const *objv);
typedef void (Tcl_MethodDeleteProc)(void *clientData);
typedef int (Tcl_CloneProc)(Tcl_Interp *interp, void *oldClientData,
	void **newClientData);
typedef void (Tcl_ObjectMetadataDeleteProc)(void *clientData);
typedef int (Tcl_ObjectMapMethodNameProc)(Tcl_Interp *interp,
	Tcl_Object object, Tcl_Class *startClsPtr, Tcl_Obj *methodNameObj);








|







59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
 * implementation. These are used to implement custom types of method calls
 * and to allow the attachment of arbitrary data to objects and classes.
 */

typedef int (Tcl_MethodCallProc)(void *clientData, Tcl_Interp *interp,
	Tcl_ObjectContext objectContext, int objc, Tcl_Obj *const *objv);
typedef int (Tcl_MethodCallProc2)(void *clientData, Tcl_Interp *interp,
	Tcl_ObjectContext objectContext, Tcl_Size objc, Tcl_Obj *const *objv);
typedef void (Tcl_MethodDeleteProc)(void *clientData);
typedef int (Tcl_CloneProc)(Tcl_Interp *interp, void *oldClientData,
	void **newClientData);
typedef void (Tcl_ObjectMetadataDeleteProc)(void *clientData);
typedef int (Tcl_ObjectMapMethodNameProc)(Tcl_Interp *interp,
	Tcl_Object object, Tcl_Class *startClsPtr, Tcl_Obj *methodNameObj);


Changes to generic/tclOOBasic.c.

11
12
13
14
15
16
17

18
19
20
21
22
23
24
 */

#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include "tclInt.h"
#include "tclOOInt.h"


static inline Tcl_Object *AddConstructionFinalizer(Tcl_Interp *interp);
static Tcl_NRPostProc	AfterNRDestructor;
static Tcl_NRPostProc	DecrRefsPostClassConstructor;
static Tcl_NRPostProc	FinalizeConstruction;
static Tcl_NRPostProc	FinalizeEval;
static Tcl_NRPostProc	NextRestoreFrame;







>







11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
 */

#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include "tclInt.h"
#include "tclOOInt.h"
#include "tclTomMath.h"

static inline Tcl_Object *AddConstructionFinalizer(Tcl_Interp *interp);
static Tcl_NRPostProc	AfterNRDestructor;
static Tcl_NRPostProc	DecrRefsPostClassConstructor;
static Tcl_NRPostProc	FinalizeConstruction;
static Tcl_NRPostProc	FinalizeEval;
static Tcl_NRPostProc	NextRestoreFrame;
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
{
    TclNRAddCallback(interp, FinalizeConstruction, NULL, NULL, NULL, NULL);
    return (Tcl_Object *) &(TOP_CB(interp)->data[0]);
}

static int
FinalizeConstruction(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Object *oPtr = (Object *)data[0];

    if (result != TCL_OK) {
	return result;







|







48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
{
    TclNRAddCallback(interp, FinalizeConstruction, NULL, NULL, NULL, NULL);
    return (Tcl_Object *) &(TOP_CB(interp)->data[0]);
}

static int
FinalizeConstruction(
    void *data[],
    Tcl_Interp *interp,
    int result)
{
    Object *oPtr = (Object *)data[0];

    if (result != TCL_OK) {
	return result;
81
82
83
84
85
86
87
88

89
90
91
92
93
94
95
96
97
98
99
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
    Tcl_Obj **invoke, *nameObj;

    if (objc-1 > (int)Tcl_ObjectContextSkippedArgs(context)) {

	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"?definitionScript?");
	return TCL_ERROR;
    } else if (objc == (int)Tcl_ObjectContextSkippedArgs(context)) {
	return TCL_OK;
    }

    /*
     * Make the class definition delegate. This is special; it doesn't reenter
     * here (and the class definition delegate doesn't run any constructors).
     */







|
>
|


|







82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
    Tcl_Obj **invoke, *nameObj;

    size_t skip = Tcl_ObjectContextSkippedArgs(context);
    if ((size_t)objc > skip + 1) {
	Tcl_WrongNumArgs(interp, skip, objv,
		"?definitionScript?");
	return TCL_ERROR;
    } else if ((size_t)objc == skip) {
	return TCL_OK;
    }

    /*
     * Make the class definition delegate. This is special; it doesn't reenter
     * here (and the class definition delegate doesn't run any constructors).
     */
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
     */

    return TclNREvalObjv(interp, 3, invoke, TCL_EVAL_NOERR, NULL);
}

static int
DecrRefsPostClassConstructor(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj **invoke = (Tcl_Obj **)data[0];
    Object *oPtr = (Object *)data[1];
    Tcl_InterpState saved;
    int code;







|







132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
     */

    return TclNREvalObjv(interp, 3, invoke, TCL_EVAL_NOERR, NULL);
}

static int
DecrRefsPostClassConstructor(
    void *data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj **invoke = (Tcl_Obj **)data[0];
    Object *oPtr = (Object *)data[1];
    Tcl_InterpState saved;
    int code;
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
				 * also used for error reporting. */
    Tcl_ObjectContext context,	/* The object/call context. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* The actual arguments. */
{
    Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
    const char *objName;
    size_t len;

    /*
     * Sanity check; should not be possible to invoke this method on a
     * non-class.
     */

    if (oPtr->classPtr == NULL) {
	Tcl_Obj *cmdnameObj = TclOOObjectName(interp, oPtr);

	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"object \"%s\" is not a class", TclGetString(cmdnameObj)));
	Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", NULL);
	return TCL_ERROR;
    }

    /*
     * Check we have the right number of (sensible) arguments.
     */

    if (objc - Tcl_ObjectContextSkippedArgs(context) < 1) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"objectName ?arg ...?");
	return TCL_ERROR;
    }
    objName = Tcl_GetStringFromObj(
	    objv[Tcl_ObjectContextSkippedArgs(context)], &len);
    if (len == 0) {







|



















|







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
				 * also used for error reporting. */
    Tcl_ObjectContext context,	/* The object/call context. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* The actual arguments. */
{
    Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
    const char *objName;
    Tcl_Size len;

    /*
     * Sanity check; should not be possible to invoke this method on a
     * non-class.
     */

    if (oPtr->classPtr == NULL) {
	Tcl_Obj *cmdnameObj = TclOOObjectName(interp, oPtr);

	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"object \"%s\" is not a class", TclGetString(cmdnameObj)));
	Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", NULL);
	return TCL_ERROR;
    }

    /*
     * Check we have the right number of (sensible) arguments.
     */

    if (objc < 1 + Tcl_ObjectContextSkippedArgs(context)) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"objectName ?arg ...?");
	return TCL_ERROR;
    }
    objName = Tcl_GetStringFromObj(
	    objv[Tcl_ObjectContextSkippedArgs(context)], &len);
    if (len == 0) {
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
				 * also used for error reporting. */
    Tcl_ObjectContext context,	/* The object/call context. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* The actual arguments. */
{
    Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
    const char *objName, *nsName;
    size_t len;

    /*
     * Sanity check; should not be possible to invoke this method on a
     * non-class.
     */

    if (oPtr->classPtr == NULL) {
	Tcl_Obj *cmdnameObj = TclOOObjectName(interp, oPtr);

	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"object \"%s\" is not a class", TclGetString(cmdnameObj)));
	Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", NULL);
	return TCL_ERROR;
    }

    /*
     * Check we have the right number of (sensible) arguments.
     */

    if (objc - Tcl_ObjectContextSkippedArgs(context) < 2) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"objectName namespaceName ?arg ...?");
	return TCL_ERROR;
    }
    objName = Tcl_GetStringFromObj(
	    objv[Tcl_ObjectContextSkippedArgs(context)], &len);
    if (len == 0) {







|



















|







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
				 * also used for error reporting. */
    Tcl_ObjectContext context,	/* The object/call context. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* The actual arguments. */
{
    Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
    const char *objName, *nsName;
    Tcl_Size len;

    /*
     * Sanity check; should not be possible to invoke this method on a
     * non-class.
     */

    if (oPtr->classPtr == NULL) {
	Tcl_Obj *cmdnameObj = TclOOObjectName(interp, oPtr);

	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"object \"%s\" is not a class", TclGetString(cmdnameObj)));
	Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", NULL);
	return TCL_ERROR;
    }

    /*
     * Check we have the right number of (sensible) arguments.
     */

    if (objc + 1 < Tcl_ObjectContextSkippedArgs(context) + 3) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"objectName namespaceName ?arg ...?");
	return TCL_ERROR;
    }
    objName = Tcl_GetStringFromObj(
	    objv[Tcl_ObjectContextSkippedArgs(context)], &len);
    if (len == 0) {
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
	Tcl_DeleteCommandFromToken(interp, oPtr->command);
    }
    return TCL_OK;
}

static int
AfterNRDestructor(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    CallContext *contextPtr = (CallContext *)data[0];

    if (contextPtr->oPtr->command) {
	Tcl_DeleteCommandFromToken(interp, contextPtr->oPtr->command);







|







390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
	Tcl_DeleteCommandFromToken(interp, oPtr->command);
    }
    return TCL_OK;
}

static int
AfterNRDestructor(
    void *data[],
    Tcl_Interp *interp,
    int result)
{
    CallContext *contextPtr = (CallContext *)data[0];

    if (contextPtr->oPtr->command) {
	Tcl_DeleteCommandFromToken(interp, contextPtr->oPtr->command);
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
				 * also used for error reporting. */
    Tcl_ObjectContext context,	/* The object/call context. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* The actual arguments. */
{
    CallContext *contextPtr = (CallContext *) context;
    Tcl_Object object = Tcl_ObjectContextObject(context);
    const int skip = Tcl_ObjectContextSkippedArgs(context);
    CallFrame *framePtr, **framePtrPtr = &framePtr;
    Tcl_Obj *scriptPtr;
    CmdFrame *invoker;

    if (objc-1 < skip) {
	Tcl_WrongNumArgs(interp, skip, objv, "arg ?arg ...?");
	return TCL_ERROR;
    }

    /*
     * Make the object's namespace the current namespace and evaluate the
     * command(s).







|




|







424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
				 * also used for error reporting. */
    Tcl_ObjectContext context,	/* The object/call context. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* The actual arguments. */
{
    CallContext *contextPtr = (CallContext *) context;
    Tcl_Object object = Tcl_ObjectContextObject(context);
    size_t skip = Tcl_ObjectContextSkippedArgs(context);
    CallFrame *framePtr, **framePtrPtr = &framePtr;
    Tcl_Obj *scriptPtr;
    CmdFrame *invoker;

    if ((size_t)objc < skip + 1) {
	Tcl_WrongNumArgs(interp, skip, objv, "arg ?arg ...?");
	return TCL_ERROR;
    }

    /*
     * Make the object's namespace the current namespace and evaluate the
     * command(s).
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
     * Work out what script we are actually going to evaluate.
     *
     * When there's more than one argument, we concatenate them together with
     * spaces between, then evaluate the result. Tcl_EvalObjEx will delete the
     * object when it decrements its refcount after eval'ing it.
     */

    if (objc != skip+1) {
	scriptPtr = Tcl_ConcatObj(objc-skip, objv+skip);
	invoker = NULL;
    } else {
	scriptPtr = objv[skip];
	invoker = ((Interp *) interp)->cmdFramePtr;
    }

    /*
     * Evaluate the script now, with FinalizeEval to do the processing after
     * the script completes.
     */

    TclNRAddCallback(interp, FinalizeEval, object, NULL, NULL, NULL);
    return TclNREvalObjEx(interp, scriptPtr, 0, invoker, skip);
}

static int
FinalizeEval(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    if (result == TCL_ERROR) {
	Object *oPtr = (Object *)data[0];
	const char *namePtr;








|


















|







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
     * Work out what script we are actually going to evaluate.
     *
     * When there's more than one argument, we concatenate them together with
     * spaces between, then evaluate the result. Tcl_EvalObjEx will delete the
     * object when it decrements its refcount after eval'ing it.
     */

    if ((size_t)objc != skip+1) {
	scriptPtr = Tcl_ConcatObj(objc-skip, objv+skip);
	invoker = NULL;
    } else {
	scriptPtr = objv[skip];
	invoker = ((Interp *) interp)->cmdFramePtr;
    }

    /*
     * Evaluate the script now, with FinalizeEval to do the processing after
     * the script completes.
     */

    TclNRAddCallback(interp, FinalizeEval, object, NULL, NULL, NULL);
    return TclNREvalObjEx(interp, scriptPtr, 0, invoker, skip);
}

static int
FinalizeEval(
    void *data[],
    Tcl_Interp *interp,
    int result)
{
    if (result == TCL_ERROR) {
	Object *oPtr = (Object *)data[0];
	const char *namePtr;

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
    Tcl_Obj *const *objv)	/* The actual arguments. */
{
    CallContext *contextPtr = (CallContext *) context;
    Object *callerObj = NULL;
    Class *callerCls = NULL;
    Object *oPtr = contextPtr->oPtr;
    const char **methodNames;

    int numMethodNames, i, skip = Tcl_ObjectContextSkippedArgs(context);
    CallFrame *framePtr = ((Interp *) interp)->varFramePtr;
    Tcl_Obj *errorMsg;

    /*
     * If no method name, generate an error asking for a method name. (Only by
     * overriding *this* method can an object handle the absence of a method
     * name without an error).
     */

    if (objc < skip+1) {
	Tcl_WrongNumArgs(interp, skip, objv, "method ?arg ...?");
	return TCL_ERROR;
    }

    /*
     * Determine if the calling context should know about extra private
     * methods, and if so, which.







>
|









|







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
    Tcl_Obj *const *objv)	/* The actual arguments. */
{
    CallContext *contextPtr = (CallContext *) context;
    Object *callerObj = NULL;
    Class *callerCls = NULL;
    Object *oPtr = contextPtr->oPtr;
    const char **methodNames;
    int numMethodNames, i;
    size_t skip = Tcl_ObjectContextSkippedArgs(context);
    CallFrame *framePtr = ((Interp *) interp)->varFramePtr;
    Tcl_Obj *errorMsg;

    /*
     * If no method name, generate an error asking for a method name. (Only by
     * overriding *this* method can an object handle the absence of a method
     * name without an error).
     */

    if ((size_t)objc < skip+1) {
	Tcl_WrongNumArgs(interp, skip, objv, "method ?arg ...?");
	return TCL_ERROR;
    }

    /*
     * Determine if the calling context should know about extra private
     * methods, and if so, which.
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
    Tcl_ObjectContext context,	/* The object/call context. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* The actual arguments. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Object object = Tcl_ObjectContextObject(context);
    Namespace *savedNsPtr;
    int i;

    if ((size_t)objc < Tcl_ObjectContextSkippedArgs(context)) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"?varName ...?");
	return TCL_ERROR;
    }

    /*
     * A sanity check. Shouldn't ever happen. (This is all that remains of a
     * more complex check inherited from [global] after we have applied the
     * fix for [Bug 2903811]; note that the fix involved *removing* code.)
     */

    if (iPtr->varFramePtr == NULL) {
	return TCL_OK;
    }

    for (i=Tcl_ObjectContextSkippedArgs(context) ; i<objc ; i++) {
	Var *varPtr, *aryPtr;
	const char *varName = TclGetString(objv[i]);

	/*
	 * The variable name must not contain a '::' since that's illegal in
	 * local names.
	 */







|

|















|







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
    Tcl_ObjectContext context,	/* The object/call context. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* The actual arguments. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Object object = Tcl_ObjectContextObject(context);
    Namespace *savedNsPtr;
    Tcl_Size i;

    if (objc < Tcl_ObjectContextSkippedArgs(context)) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"?varName ...?");
	return TCL_ERROR;
    }

    /*
     * A sanity check. Shouldn't ever happen. (This is all that remains of a
     * more complex check inherited from [global] after we have applied the
     * fix for [Bug 2903811]; note that the fix involved *removing* code.)
     */

    if (iPtr->varFramePtr == NULL) {
	return TCL_OK;
    }

    for (i = Tcl_ObjectContextSkippedArgs(context) ; i < objc ; i++) {
	Var *varPtr, *aryPtr;
	const char *varName = TclGetString(objv[i]);

	/*
	 * The variable name must not contain a '::' since that's illegal in
	 * local names.
	 */
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787

	if (framePtr->isProcCallFrame & FRAME_IS_METHOD) {
	    Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
	    CallContext *callerContext = (CallContext *)framePtr->clientData;
	    Method *mPtr = callerContext->callPtr->chain[
		    callerContext->index].mPtr;
	    PrivateVariableMapping *pvPtr;
	    size_t i;

	    if (mPtr->declaringObjectPtr == oPtr) {
		FOREACH_STRUCT(pvPtr, oPtr->privateVariables) {
		    if (!strcmp(TclGetString(pvPtr->variableObj),
			    TclGetString(argPtr))) {
			argPtr = pvPtr->fullNameObj;
			break;







|







776
777
778
779
780
781
782
783
784
785
786
787
788
789
790

	if (framePtr->isProcCallFrame & FRAME_IS_METHOD) {
	    Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
	    CallContext *callerContext = (CallContext *)framePtr->clientData;
	    Method *mPtr = callerContext->callPtr->chain[
		    callerContext->index].mPtr;
	    PrivateVariableMapping *pvPtr;
	    Tcl_Size i;

	    if (mPtr->declaringObjectPtr == oPtr) {
		FOREACH_STRUCT(pvPtr, oPtr->privateVariables) {
		    if (!strcmp(TclGetString(pvPtr->variableObj),
			    TclGetString(argPtr))) {
			argPtr = pvPtr->fullNameObj;
			break;
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
    int objc,
    Tcl_Obj *const *objv)
{
    Interp *iPtr = (Interp *) interp;
    CallFrame *framePtr = iPtr->varFramePtr;
    Class *classPtr;
    CallContext *contextPtr;
    size_t i;
    Tcl_Object object;
    const char *methodType;

    /*
     * Start with sanity checks on the calling context to make sure that we
     * are invoked from a suitable method context. If so, we can safely
     * retrieve the handle to the object call context.







|







908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
    int objc,
    Tcl_Obj *const *objv)
{
    Interp *iPtr = (Interp *) interp;
    CallFrame *framePtr = iPtr->varFramePtr;
    Class *classPtr;
    CallContext *contextPtr;
    Tcl_Size i;
    Tcl_Object object;
    const char *methodType;

    /*
     * Start with sanity checks on the calling context to make sure that we
     * are invoked from a suitable method context. If so, we can safely
     * retrieve the handle to the object call context.
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
	    methodType, TclGetString(objv[1])));
    Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_THERE", NULL);
    return TCL_ERROR;
}

static int
NextRestoreFrame(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    CallContext *contextPtr = (CallContext *)data[1];

    iPtr->varFramePtr = (CallFrame *)data[0];
    if (contextPtr != NULL) {
	contextPtr->index = PTR2INT(data[2]);
    }
    return result;
}

/*
 * ----------------------------------------------------------------------
 *







|








|







1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
	    methodType, TclGetString(objv[1])));
    Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_THERE", NULL);
    return TCL_ERROR;
}

static int
NextRestoreFrame(
    void *data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    CallContext *contextPtr = (CallContext *)data[1];

    iPtr->varFramePtr = (CallFrame *)data[0];
    if (contextPtr != NULL) {
	contextPtr->index = PTR2UINT(data[2]);
    }
    return result;
}

/*
 * ----------------------------------------------------------------------
 *
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099

    switch (index) {
    case SELF_OBJECT:
	Tcl_SetObjResult(interp, TclOOObjectName(interp, contextPtr->oPtr));
	return TCL_OK;
    case SELF_NS:
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		contextPtr->oPtr->namespacePtr->fullName,-1));
	return TCL_OK;
    case SELF_CLASS: {
	Class *clsPtr = CurrentlyInvoked(contextPtr).mPtr->declaringClassPtr;

	if (clsPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "method not defined by a class", -1));







|







1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102

    switch (index) {
    case SELF_OBJECT:
	Tcl_SetObjResult(interp, TclOOObjectName(interp, contextPtr->oPtr));
	return TCL_OK;
    case SELF_NS:
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		contextPtr->oPtr->namespacePtr->fullName, -1));
	return TCL_OK;
    case SELF_CLASS: {
	Class *clsPtr = CurrentlyInvoked(contextPtr).mPtr->declaringClassPtr;

	if (clsPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "method not defined by a class", -1));
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "not inside a filtering context", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", NULL);
	    return TCL_ERROR;
	} else {
	    Method *mPtr;
	    Object *declarerPtr;
	    size_t i;

	    for (i=contextPtr->index ; i<contextPtr->callPtr->numChain ; i++){
		if (!contextPtr->callPtr->chain[i].isFilter) {
		    break;
		}
	    }
	    if (i == contextPtr->callPtr->numChain) {







|







1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "not inside a filtering context", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", NULL);
	    return TCL_ERROR;
	} else {
	    Method *mPtr;
	    Object *declarerPtr;
	    Tcl_Size i;

	    for (i=contextPtr->index ; i<contextPtr->callPtr->numChain ; i++){
		if (!contextPtr->callPtr->chain[i].isFilter) {
		    break;
		}
	    }
	    if (i == contextPtr->callPtr->numChain) {
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
	    result[0] = TclOOObjectName(interp, declarerPtr);
	    result[1] = mPtr->namePtr;
	    Tcl_SetObjResult(interp, Tcl_NewListObj(2, result));
	    return TCL_OK;
	}
    case SELF_CALL:
	result[0] = TclOORenderCallChain(interp, contextPtr->callPtr);
	TclNewIntObj(result[1], contextPtr->index);
	Tcl_SetObjResult(interp, Tcl_NewListObj(2, result));
	return TCL_OK;
    }
    return TCL_ERROR;
}

/*







|







1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
	    result[0] = TclOOObjectName(interp, declarerPtr);
	    result[1] = mPtr->namePtr;
	    Tcl_SetObjResult(interp, Tcl_NewListObj(2, result));
	    return TCL_OK;
	}
    case SELF_CALL:
	result[0] = TclOORenderCallChain(interp, contextPtr->callPtr);
	TclNewIndexObj(result[1], contextPtr->index);
	Tcl_SetObjResult(interp, Tcl_NewListObj(2, result));
	return TCL_OK;
    }
    return TCL_ERROR;
}

/*

Changes to generic/tclOOCall.c.

1
2
3
4
5

6
7
8
9
10
11
12
13
14
/*
 * tclOOCall.c --
 *
 *	This file contains the method call chain management code for the
 *	object-system core.

 *
 * Copyright © 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"




|
>

|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
/*
 * tclOOCall.c --
 *
 *	This file contains the method call chain management code for the
 *	object-system core. It also contains everything else that does
 *	inheritance hierarchy traversal.
 *
 * Copyright © 2005-2019 Donal K. Fellows
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifdef HAVE_CONFIG_H
#include "config.h"
54
55
56
57
58
59
60

61
62
63
64
65
66
67
#define DEFINITE_PROTECTED 0x100000
#define DEFINITE_PUBLIC    0x200000
#define KNOWN_STATE	   (DEFINITE_PROTECTED | DEFINITE_PUBLIC)
#define SPECIAL		   (CONSTRUCTOR | DESTRUCTOR | FORCE_UNKNOWN)
#define BUILDING_MIXINS	   0x400000
#define TRAVERSED_MIXIN	   0x800000
#define OBJECT_MIXIN	   0x1000000

#define MIXIN_CONSISTENT(flags) \
    (((flags) & OBJECT_MIXIN) ||					\
	!((flags) & BUILDING_MIXINS) == !((flags) & TRAVERSED_MIXIN))

/*
 * Note that the flag bit PRIVATE_METHOD has a confusing name; it's just for
 * Itcl's special type of private.







>







55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
#define DEFINITE_PROTECTED 0x100000
#define DEFINITE_PUBLIC    0x200000
#define KNOWN_STATE	   (DEFINITE_PROTECTED | DEFINITE_PUBLIC)
#define SPECIAL		   (CONSTRUCTOR | DESTRUCTOR | FORCE_UNKNOWN)
#define BUILDING_MIXINS	   0x400000
#define TRAVERSED_MIXIN	   0x800000
#define OBJECT_MIXIN	   0x1000000
#define DEFINE_FOR_CLASS   0x2000000
#define MIXIN_CONSISTENT(flags) \
    (((flags) & OBJECT_MIXIN) ||					\
	!((flags) & BUILDING_MIXINS) == !((flags) & TRAVERSED_MIXIN))

/*
 * Note that the flag bit PRIVATE_METHOD has a confusing name; it's just for
 * Itcl's special type of private.
146
147
148
149
150
151
152
153

154
155
156
157
158
159
160
 */

static const Tcl_ObjType methodNameType = {
    "TclOO method name",
    FreeMethodNameRep,
    DupMethodNameRep,
    NULL,
    NULL

};


/*
 * ----------------------------------------------------------------------
 *
 * TclOODeleteContext --







|
>







148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
 */

static const Tcl_ObjType methodNameType = {
    "TclOO method name",
    FreeMethodNameRep,
    DupMethodNameRep,
    NULL,
    NULL,
    TCL_OBJTYPE_V0
};


/*
 * ----------------------------------------------------------------------
 *
 * TclOODeleteContext --
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
    /*
     * If this is the first step along the chain, we preserve the method
     * entries in the chain so that they do not get deleted out from under our
     * feet.
     */

    if (contextPtr->index == 0) {
	size_t i;

	for (i = 0 ; i < contextPtr->callPtr->numChain ; i++) {
	    AddRef(contextPtr->callPtr->chain[i].mPtr);
	}

	/*
	 * Ensure that the method name itself is part of the arguments when







|







325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
    /*
     * If this is the first step along the chain, we preserve the method
     * entries in the chain so that they do not get deleted out from under our
     * feet.
     */

    if (contextPtr->index == 0) {
	Tcl_Size i;

	for (i = 0 ; i < contextPtr->callPtr->numChain ; i++) {
	    AddRef(contextPtr->callPtr->chain[i].mPtr);
	}

	/*
	 * Ensure that the method name itself is part of the arguments when
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
static int
FinalizeMethodRefs(
    void *data[],
    TCL_UNUSED(Tcl_Interp *),
    int result)
{
    CallContext *contextPtr = (CallContext *)data[0];
    size_t i;

    for (i = 0 ; i < contextPtr->callPtr->numChain ; i++) {
	TclOODelMethodRef(contextPtr->callPtr->chain[i].mPtr);
    }
    return result;
}








|







407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
static int
FinalizeMethodRefs(
    void *data[],
    TCL_UNUSED(Tcl_Interp *),
    int result)
{
    CallContext *contextPtr = (CallContext *)data[0];
    Tcl_Size i;

    for (i = 0 ; i < contextPtr->callPtr->numChain ; i++) {
	TclOODelMethodRef(contextPtr->callPtr->chain[i].mPtr);
    }
    return result;
}

445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
    Tcl_HashTable names;	/* Tcl_Obj* method name to "wanted in list"
				 * mapping. */
    Tcl_HashTable examinedClasses;
				/* Used to track what classes have been looked
				 * at. Is set-like in nature and keyed by
				 * pointer to class. */
    FOREACH_HASH_DECLS;
    size_t i, numStrings;
    Class *mixinPtr;
    Tcl_Obj *namePtr;
    Method *mPtr;

    Tcl_InitObjHashTable(&names);
    Tcl_InitHashTable(&examinedClasses, TCL_ONE_WORD_KEYS);








|







448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
    Tcl_HashTable names;	/* Tcl_Obj* method name to "wanted in list"
				 * mapping. */
    Tcl_HashTable examinedClasses;
				/* Used to track what classes have been looked
				 * at. Is set-like in nature and keyed by
				 * pointer to class. */
    FOREACH_HASH_DECLS;
    Tcl_Size i, numStrings;
    Class *mixinPtr;
    Tcl_Obj *namePtr;
    Method *mPtr;

    Tcl_InitObjHashTable(&names);
    Tcl_InitHashTable(&examinedClasses, TCL_ONE_WORD_KEYS);

686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
				 * semantics are handled correctly. */
    Tcl_HashTable *const examinedClassesPtr)
				/* Hash table that tracks what classes have
				 * already been looked at. The keys are the
				 * pointers to the classes, and the values are
				 * immaterial. */
{
    size_t i;

    /*
     * If we've already started looking at this class, stop working on it now
     * to prevent repeated work.
     */

    if (Tcl_FindHashEntry(examinedClassesPtr, clsPtr)) {







|







689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
				 * semantics are handled correctly. */
    Tcl_HashTable *const examinedClassesPtr)
				/* Hash table that tracks what classes have
				 * already been looked at. The keys are the
				 * pointers to the classes, and the values are
				 * immaterial. */
{
    Tcl_Size i;

    /*
     * If we've already started looking at this class, stop working on it now
     * to prevent repeated work.
     */

    if (Tcl_FindHashEntry(examinedClassesPtr, clsPtr)) {
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
				/* Where to record what call chain entries
				 * have been processed. */
    int flags,			/* What sort of call chain are we building. */
    Class *const filterDecl)	/* The class that declared the filter. If
				 * NULL, either the filter was declared by the
				 * object or this isn't a filter. */
{
    size_t i;
    int foundPrivate = 0, blockedUnexported = 0;
    Tcl_HashEntry *hPtr;
    Method *mPtr;

    if (!(flags & (KNOWN_STATE | SPECIAL)) && oPtr->methodsPtr) {
	hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, methodNameObj);








|







880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
				/* Where to record what call chain entries
				 * have been processed. */
    int flags,			/* What sort of call chain are we building. */
    Class *const filterDecl)	/* The class that declared the filter. If
				 * NULL, either the filter was declared by the
				 * object or this isn't a filter. */
{
    Tcl_Size i;
    int foundPrivate = 0, blockedUnexported = 0;
    Tcl_HashEntry *hPtr;
    Method *mPtr;

    if (!(flags & (KNOWN_STATE | SPECIAL)) && oPtr->methodsPtr) {
	hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, methodNameObj);

970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
				 * only. Mixin-consistent means that either
				 * we're looking to add things from a mixin
				 * and we have passed a mixin, or we're not
				 * looking to add things from a mixin and have
				 * not passed a mixin. */
{
    CallChain *callPtr = cbPtr->callChainPtr;
    size_t i;

    /*
     * Return if this is just an entry used to record whether this is a public
     * method. If so, there's nothing real to call and so nothing to add to
     * the call chain.
     *
     * This is also where we enforce mixin-consistency.







|







973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
				 * only. Mixin-consistent means that either
				 * we're looking to add things from a mixin
				 * and we have passed a mixin, or we're not
				 * looking to add things from a mixin and have
				 * not passed a mixin. */
{
    CallChain *callPtr = cbPtr->callChainPtr;
    Tcl_Size i;

    /*
     * Return if this is just an entry used to record whether this is a public
     * method. If so, there's nothing real to call and so nothing to add to
     * the call chain.
     *
     * This is also where we enforce mixin-consistency.
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
    Tcl_Obj *cacheInThisObj)	/* What object to cache in, or NULL if it is
				 * to be in the same object as the
				 * methodNameObj. */
{
    CallContext *contextPtr;
    CallChain *callPtr;
    struct ChainBuilder cb;
    size_t i, count;
    int doFilters, donePrivate = 0;
    Tcl_HashEntry *hPtr;
    Tcl_HashTable doneFilters;

    if (cacheInThisObj == NULL) {
	cacheInThisObj = methodNameObj;
    }







|







1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
    Tcl_Obj *cacheInThisObj)	/* What object to cache in, or NULL if it is
				 * to be in the same object as the
				 * methodNameObj. */
{
    CallContext *contextPtr;
    CallChain *callPtr;
    struct ChainBuilder cb;
    Tcl_Size i, count;
    int doFilters, donePrivate = 0;
    Tcl_HashEntry *hPtr;
    Tcl_HashTable doneFilters;

    if (cacheInThisObj == NULL) {
	cacheInThisObj = methodNameObj;
    }
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
    int flags)			/* What sort of context are we looking for.
				 * Only the bits PUBLIC_METHOD, CONSTRUCTOR,
				 * PRIVATE_METHOD, DESTRUCTOR and
				 * FILTER_HANDLING are useful. */
{
    CallChain *callPtr;
    struct ChainBuilder cb;
    size_t count;
    Foundation *fPtr = clsPtr->thisPtr->fPtr;
    Tcl_HashEntry *hPtr;
    Tcl_HashTable doneFilters;
    Object obj;

    /*
     * Synthesize a temporary stereotypical object so that we can use existing







|







1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
    int flags)			/* What sort of context are we looking for.
				 * Only the bits PUBLIC_METHOD, CONSTRUCTOR,
				 * PRIVATE_METHOD, DESTRUCTOR and
				 * FILTER_HANDLING are useful. */
{
    CallChain *callPtr;
    struct ChainBuilder cb;
    Tcl_Size count;
    Foundation *fPtr = clsPtr->thisPtr->fPtr;
    Tcl_HashEntry *hPtr;
    Tcl_HashTable doneFilters;
    Object obj;

    /*
     * Synthesize a temporary stereotypical object so that we can use existing
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
	    flags|BUILDING_MIXINS, NULL);
    AddSimpleChainToCallContext(&obj, NULL, methodNameObj, &cb, NULL, flags,
	    NULL);

    /*
     * Check to see if the method has no implementation. If so, we probably
     * need to add in a call to the unknown method. Otherwise, set up the
     * cacheing of the method implementation (if relevant).
     */

    if (count == callPtr->numChain) {
	AddSimpleChainToCallContext(&obj, NULL, fPtr->unknownMethodNameObj,
		&cb, NULL, BUILDING_MIXINS, NULL);
	AddSimpleChainToCallContext(&obj, NULL, fPtr->unknownMethodNameObj,
		&cb, NULL, 0, NULL);







|







1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
	    flags|BUILDING_MIXINS, NULL);
    AddSimpleChainToCallContext(&obj, NULL, methodNameObj, &cb, NULL, flags,
	    NULL);

    /*
     * Check to see if the method has no implementation. If so, we probably
     * need to add in a call to the unknown method. Otherwise, set up the
     * caching of the method implementation (if relevant).
     */

    if (count == callPtr->numChain) {
	AddSimpleChainToCallContext(&obj, NULL, fPtr->unknownMethodNameObj,
		&cb, NULL, BUILDING_MIXINS, NULL);
	AddSimpleChainToCallContext(&obj, NULL, fPtr->unknownMethodNameObj,
		&cb, NULL, 0, NULL);
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
    Tcl_HashTable *const doneFilters,
				/* Where to record what filters have been
				 * processed. Keys are objects, values are
				 * ignored. */
    int flags)			/* Whether we've gone along a mixin link
				 * yet. */
{
    size_t i;
    int clearedFlags =
	    flags & ~(TRAVERSED_MIXIN|OBJECT_MIXIN|BUILDING_MIXINS);
    Class *superPtr, *mixinPtr;
    Tcl_Obj *filterObj;

  tailRecurse:
    if (clsPtr == NULL) {







|







1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
    Tcl_HashTable *const doneFilters,
				/* Where to record what filters have been
				 * processed. Keys are objects, values are
				 * ignored. */
    int flags)			/* Whether we've gone along a mixin link
				 * yet. */
{
    Tcl_Size i;
    int clearedFlags =
	    flags & ~(TRAVERSED_MIXIN|OBJECT_MIXIN|BUILDING_MIXINS);
    Class *superPtr, *mixinPtr;
    Tcl_Obj *filterObj;

  tailRecurse:
    if (clsPtr == NULL) {
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
				/* Where to record what call chain entries
				 * have been processed. */
    int flags,			/* What sort of call chain are we building. */
    Class *const filterDecl)	/* The class that declared the filter. If
				 * NULL, either the filter was declared by the
				 * object or this isn't a filter. */
{
    size_t i;
    Class *superPtr;

    /*
     * We hard-code the tail-recursive form. It's by far the most common case
     * *and* it is much more gentle on the stack.
     *
     * Note that mixins must be processed before the main class hierarchy.







|







1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
				/* Where to record what call chain entries
				 * have been processed. */
    int flags,			/* What sort of call chain are we building. */
    Class *const filterDecl)	/* The class that declared the filter. If
				 * NULL, either the filter was declared by the
				 * object or this isn't a filter. */
{
    Tcl_Size i;
    Class *superPtr;

    /*
     * We hard-code the tail-recursive form. It's by far the most common case
     * *and* it is much more gentle on the stack.
     *
     * Note that mixins must be processed before the main class hierarchy.
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
				/* Where to record what call chain entries
				 * have been processed. */
    int flags,			/* What sort of call chain are we building. */
    Class *const filterDecl)	/* The class that declared the filter. If
				 * NULL, either the filter was declared by the
				 * object or this isn't a filter. */
{
    size_t i;
    int privateDanger = 0;
    Class *superPtr;

    /*
     * We hard-code the tail-recursive form. It's by far the most common case
     * *and* it is much more gentle on the stack.
     *







|







1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
				/* Where to record what call chain entries
				 * have been processed. */
    int flags,			/* What sort of call chain are we building. */
    Class *const filterDecl)	/* The class that declared the filter. If
				 * NULL, either the filter was declared by the
				 * object or this isn't a filter. */
{
    Tcl_Size i;
    int privateDanger = 0;
    Class *superPtr;

    /*
     * We hard-code the tail-recursive form. It's by far the most common case
     * *and* it is much more gentle on the stack.
     *
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
TclOORenderCallChain(
    Tcl_Interp *interp,
    CallChain *callPtr)
{
    Tcl_Obj *filterLiteral, *methodLiteral, *objectLiteral, *privateLiteral;
    Tcl_Obj *resultObj, *descObjs[4], **objv;
    Foundation *fPtr = TclOOGetFoundation(interp);
    size_t i;

    /*
     * Allocate the literals (potentially) used in our description.
     */

    TclNewLiteralStringObj(filterLiteral, "filter");
    Tcl_IncrRefCount(filterLiteral);







|







1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
TclOORenderCallChain(
    Tcl_Interp *interp,
    CallChain *callPtr)
{
    Tcl_Obj *filterLiteral, *methodLiteral, *objectLiteral, *privateLiteral;
    Tcl_Obj *resultObj, *descObjs[4], **objv;
    Foundation *fPtr = TclOOGetFoundation(interp);
    Tcl_Size i;

    /*
     * Allocate the literals (potentially) used in our description.
     */

    TclNewLiteralStringObj(filterLiteral, "filter");
    Tcl_IncrRefCount(filterLiteral);
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
     * special because it's a filter method). The second word is the name of
     * the method in question (which differs for "unknown" and "filter" types)
     * and the third word is the full name of the class that declares the
     * method (or "object" if it is declared on the instance).
     */

    objv = (Tcl_Obj **)TclStackAlloc(interp, callPtr->numChain * sizeof(Tcl_Obj *));
    for (i = 0 ; i < (size_t)callPtr->numChain ; i++) {
	struct MInvoke *miPtr = &callPtr->chain[i];

	descObjs[0] =
	    miPtr->isFilter ? filterLiteral :
	    callPtr->flags & OO_UNKNOWN_METHOD ? fPtr->unknownMethodNameObj :
	    IS_PRIVATE(miPtr->mPtr) ? privateLiteral :
		    methodLiteral;







|







1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
     * special because it's a filter method). The second word is the name of
     * the method in question (which differs for "unknown" and "filter" types)
     * and the third word is the full name of the class that declares the
     * method (or "object" if it is declared on the instance).
     */

    objv = (Tcl_Obj **)TclStackAlloc(interp, callPtr->numChain * sizeof(Tcl_Obj *));
    for (i = 0 ; i < callPtr->numChain ; i++) {
	struct MInvoke *miPtr = &callPtr->chain[i];

	descObjs[0] =
	    miPtr->isFilter ? filterLiteral :
	    callPtr->flags & OO_UNKNOWN_METHOD ? fPtr->unknownMethodNameObj :
	    IS_PRIVATE(miPtr->mPtr) ? privateLiteral :
		    methodLiteral;
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
				 * [oo::define], otherwise, we are going to
				 * use this for [oo::objdefine]. */
{
    DefineChain define;
    DefineEntry staticSpace[DEFINE_CHAIN_STATIC_SIZE];
    DefineEntry *entryPtr;
    Tcl_Namespace *nsPtr = NULL;
    int i;

    define.list = staticSpace;
    define.num = 0;
    define.size = DEFINE_CHAIN_STATIC_SIZE;

    /*
     * Add the actual define locations. We have to do this twice to handle
     * class mixins right.
     */

    AddSimpleDefineNamespaces(oPtr, &define, forClass | BUILDING_MIXINS);
    AddSimpleDefineNamespaces(oPtr, &define, forClass);

    /*
     * Go through the list until we find a namespace whose name we can
     * resolve.
     */

    FOREACH_STRUCT(entryPtr, define) {







|










|
|







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
				 * [oo::define], otherwise, we are going to
				 * use this for [oo::objdefine]. */
{
    DefineChain define;
    DefineEntry staticSpace[DEFINE_CHAIN_STATIC_SIZE];
    DefineEntry *entryPtr;
    Tcl_Namespace *nsPtr = NULL;
    int i, flags = (forClass ? DEFINE_FOR_CLASS : 0);

    define.list = staticSpace;
    define.num = 0;
    define.size = DEFINE_CHAIN_STATIC_SIZE;

    /*
     * Add the actual define locations. We have to do this twice to handle
     * class mixins right.
     */

    AddSimpleDefineNamespaces(oPtr, &define, flags | BUILDING_MIXINS);
    AddSimpleDefineNamespaces(oPtr, &define, flags);

    /*
     * Go through the list until we find a namespace whose name we can
     * resolve.
     */

    FOREACH_STRUCT(entryPtr, define) {
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
    Object *const oPtr,		/* Object to add define chain entries for. */
    DefineChain *const definePtr,
				/* Where to add the define chain entries. */
    int flags)			/* What sort of define chain are we
				 * building. */
{
    Class *mixinPtr;
    size_t i;

    FOREACH(mixinPtr, oPtr->mixins) {
	AddSimpleClassDefineNamespaces(mixinPtr, definePtr,
		flags | TRAVERSED_MIXIN);
    }

    AddSimpleClassDefineNamespaces(oPtr->selfCls, definePtr, flags);







|







1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
    Object *const oPtr,		/* Object to add define chain entries for. */
    DefineChain *const definePtr,
				/* Where to add the define chain entries. */
    int flags)			/* What sort of define chain are we
				 * building. */
{
    Class *mixinPtr;
    Tcl_Size i;

    FOREACH(mixinPtr, oPtr->mixins) {
	AddSimpleClassDefineNamespaces(mixinPtr, definePtr,
		flags | TRAVERSED_MIXIN);
    }

    AddSimpleClassDefineNamespaces(oPtr->selfCls, definePtr, flags);
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
AddSimpleClassDefineNamespaces(
    Class *classPtr,		/* Class to add the define chain entries for. */
    DefineChain *const definePtr,
				/* Where to add the define chain entries. */
    int flags)			/* What sort of define chain are we
				 * building. */
{
    size_t i;
    Class *superPtr;

    /*
     * We hard-code the tail-recursive form. It's by far the most common case
     * *and* it is much more gentle on the stack.
     */

  tailRecurse:
    FOREACH(superPtr, classPtr->mixins) {
	AddSimpleClassDefineNamespaces(superPtr, definePtr,
		flags | TRAVERSED_MIXIN);
    }

    if (flags & ~(TRAVERSED_MIXIN | BUILDING_MIXINS)) {
	AddDefinitionNamespaceToChain(classPtr, classPtr->clsDefinitionNs,
		definePtr, flags);
    } else {
	AddDefinitionNamespaceToChain(classPtr, classPtr->objDefinitionNs,
		definePtr, flags);
    }








|













|







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
AddSimpleClassDefineNamespaces(
    Class *classPtr,		/* Class to add the define chain entries for. */
    DefineChain *const definePtr,
				/* Where to add the define chain entries. */
    int flags)			/* What sort of define chain are we
				 * building. */
{
    Tcl_Size i;
    Class *superPtr;

    /*
     * We hard-code the tail-recursive form. It's by far the most common case
     * *and* it is much more gentle on the stack.
     */

  tailRecurse:
    FOREACH(superPtr, classPtr->mixins) {
	AddSimpleClassDefineNamespaces(superPtr, definePtr,
		flags | TRAVERSED_MIXIN);
    }

    if (flags & DEFINE_FOR_CLASS) {
	AddDefinitionNamespaceToChain(classPtr, classPtr->clsDefinitionNs,
		definePtr, flags);
    } else {
	AddDefinitionNamespaceToChain(classPtr, classPtr->objDefinitionNs,
		definePtr, flags);
    }

2106
2107
2108
2109
2110
2111
2112





























































































































































































































































2113
2114
2115
2116
2117
2118
2119
2120
		    sizeof(DefineEntry) * definePtr->size);
	}
    }
    definePtr->list[i].definerCls = definerCls;
    definePtr->list[i].namespaceName = namespaceName;
    definePtr->num++;
}






























































































































































































































































/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







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








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
		    sizeof(DefineEntry) * definePtr->size);
	}
    }
    definePtr->list[i].definerCls = definerCls;
    definePtr->list[i].namespaceName = namespaceName;
    definePtr->num++;
}

/*
 * ----------------------------------------------------------------------
 *
 * FindClassProps --
 *
 *	Discover the properties known to a class and its superclasses.
 *	The property names become the keys in the accumulator hash table
 *	(which is used as a set).
 *
 * ----------------------------------------------------------------------
 */

static void
FindClassProps(
    Class *clsPtr,		/* The object to inspect. Must exist. */
    int writable,		/* Whether we're after the readable or writable
				 * property set. */
    Tcl_HashTable *accumulator)	/* Where to gather the names. */
{
    int i, dummy;
    Tcl_Obj *propName;
    Class *mixin, *sup;

  tailRecurse:
    if (writable) {
	FOREACH(propName, clsPtr->properties.writable) {
	    Tcl_CreateHashEntry(accumulator, (void *) propName, &dummy);
	}
    } else {
	FOREACH(propName, clsPtr->properties.readable) {
	    Tcl_CreateHashEntry(accumulator, (void *) propName, &dummy);
	}
    }
    if (clsPtr->thisPtr->flags & ROOT_OBJECT) {
	/*
	 * We do *not* traverse upwards from the root!
	 */
	return;
    }
    FOREACH(mixin, clsPtr->mixins) {
	FindClassProps(mixin, writable, accumulator);
    }
    if (clsPtr->superclasses.num == 1) {
	clsPtr = clsPtr->superclasses.list[0];
	goto tailRecurse;
    }
    FOREACH(sup, clsPtr->superclasses) {
	FindClassProps(sup, writable, accumulator);
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * FindObjectProps --
 *
 *	Discover the properties known to an object and all its classes.
 *	The property names become the keys in the accumulator hash table
 *	(which is used as a set).
 *
 * ----------------------------------------------------------------------
 */

static void
FindObjectProps(
    Object *oPtr,		/* The object to inspect. Must exist. */
    int writable,		/* Whether we're after the readable or writable
				 * property set. */
    Tcl_HashTable *accumulator)	/* Where to gather the names. */
{
    int i, dummy;
    Tcl_Obj *propName;
    Class *mixin;

    if (writable) {
	FOREACH(propName, oPtr->properties.writable) {
	    Tcl_CreateHashEntry(accumulator, (void *) propName, &dummy);
	}
    } else {
	FOREACH(propName, oPtr->properties.readable) {
	    Tcl_CreateHashEntry(accumulator, (void *) propName, &dummy);
	}
    }
    FOREACH(mixin, oPtr->mixins) {
	FindClassProps(mixin, writable, accumulator);
    }
    FindClassProps(oPtr->selfCls, writable, accumulator);
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOGetAllClassProperties --
 *
 *	Get the list of all properties known to a class, including to its
 *	superclasses. Manages a cache so this operation is usually cheap.
 *	The order of properties in the resulting list is undefined.
 *
 * ----------------------------------------------------------------------
 */

Tcl_Obj *
TclOOGetAllClassProperties(
    Class *clsPtr,		/* The class to inspect. Must exist. */
    int writable,		/* Whether to get writable properties. If
				 * false, readable properties will be returned
				 * instead. */
    int *allocated)		/* Address of variable to set to true if a
				 * Tcl_Obj was allocated and may be safely
				 * modified by the caller. */
{
    Tcl_HashTable hashTable;
    FOREACH_HASH_DECLS;
    Tcl_Obj *propName, *result;
    void *dummy;

    /*
     * Look in the cache.
     */

    if (clsPtr->properties.epoch == clsPtr->thisPtr->fPtr->epoch) {
	if (writable) {
	    if (clsPtr->properties.allWritableCache) {
		*allocated = 0;
		return clsPtr->properties.allWritableCache;
	    }
	} else {
	    if (clsPtr->properties.allReadableCache) {
		*allocated = 0;
		return clsPtr->properties.allReadableCache;
	    }
	}
    }

    /*
     * Gather the information. Unsorted! (Caller will sort.)
     */

    *allocated = 1;
    Tcl_InitObjHashTable(&hashTable);
    FindClassProps(clsPtr, writable, &hashTable);
    TclNewObj(result);
    FOREACH_HASH(propName, dummy, &hashTable) {
	Tcl_ListObjAppendElement(NULL, result, propName);
    }
    Tcl_DeleteHashTable(&hashTable);

    /*
     * Cache the information. Also purges the cache.
     */

    if (clsPtr->properties.epoch != clsPtr->thisPtr->fPtr->epoch) {
	if (clsPtr->properties.allWritableCache) {
	    Tcl_DecrRefCount(clsPtr->properties.allWritableCache);
	    clsPtr->properties.allWritableCache = NULL;
	}
	if (clsPtr->properties.allReadableCache) {
	    Tcl_DecrRefCount(clsPtr->properties.allReadableCache);
	    clsPtr->properties.allReadableCache = NULL;
	}
    }
    clsPtr->properties.epoch = clsPtr->thisPtr->fPtr->epoch;
    if (writable) {
	clsPtr->properties.allWritableCache = result;
    } else {
	clsPtr->properties.allReadableCache = result;
    }
    Tcl_IncrRefCount(result);
    return result;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOGetAllObjectProperties --
 *
 *	Get the list of all properties known to a object, including to its
 *	classes. Manages a cache so this operation is usually cheap.
 *	The order of properties in the resulting list is undefined.
 *
 * ----------------------------------------------------------------------
 */

Tcl_Obj *
TclOOGetAllObjectProperties(
    Object *oPtr,		/* The object to inspect. Must exist. */
    int writable,		/* Whether to get writable properties. If
				 * false, readable properties will be returned
				 * instead. */
    int *allocated)		/* Address of variable to set to true if a
				 * Tcl_Obj was allocated and may be safely
				 * modified by the caller. */
{
    Tcl_HashTable hashTable;
    FOREACH_HASH_DECLS;
    Tcl_Obj *propName, *result;
    void *dummy;

    /*
     * Look in the cache.
     */

    if (oPtr->properties.epoch == oPtr->fPtr->epoch) {
	if (writable) {
	    if (oPtr->properties.allWritableCache) {
		*allocated = 0;
		return oPtr->properties.allWritableCache;
	    }
	} else {
	    if (oPtr->properties.allReadableCache) {
		*allocated = 0;
		return oPtr->properties.allReadableCache;
	    }
	}
    }

    /*
     * Gather the information. Unsorted! (Caller will sort.)
     */

    *allocated = 1;
    Tcl_InitObjHashTable(&hashTable);
    FindObjectProps(oPtr, writable, &hashTable);
    TclNewObj(result);
    FOREACH_HASH(propName, dummy, &hashTable) {
	Tcl_ListObjAppendElement(NULL, result, propName);
    }
    Tcl_DeleteHashTable(&hashTable);

    /*
     * Cache the information.
     */

    if (oPtr->properties.epoch != oPtr->fPtr->epoch) {
	if (oPtr->properties.allWritableCache) {
	    Tcl_DecrRefCount(oPtr->properties.allWritableCache);
	    oPtr->properties.allWritableCache = NULL;
	}
	if (oPtr->properties.allReadableCache) {
	    Tcl_DecrRefCount(oPtr->properties.allReadableCache);
	    oPtr->properties.allReadableCache = NULL;
	}
    }
    oPtr->properties.epoch = oPtr->fPtr->epoch;
    if (writable) {
	oPtr->properties.allWritableCache = result;
    } else {
	oPtr->properties.allReadableCache = result;
    }
    Tcl_IncrRefCount(result);
    return result;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclOODecls.h.

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
TCLAPI Tcl_Method	Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
				Tcl_Obj *nameObj, int flags,
				const Tcl_MethodType *typePtr,
				void *clientData);
/* 13 */
TCLAPI Tcl_Object	Tcl_NewObjectInstance(Tcl_Interp *interp,
				Tcl_Class cls, const char *nameStr,
				const char *nsNameStr, size_t objc,
				Tcl_Obj *const *objv, size_t skip);
/* 14 */
TCLAPI int		Tcl_ObjectDeleted(Tcl_Object object);
/* 15 */
TCLAPI int		Tcl_ObjectContextIsFiltering(
				Tcl_ObjectContext context);
/* 16 */
TCLAPI Tcl_Method	Tcl_ObjectContextMethod(Tcl_ObjectContext context);
/* 17 */
TCLAPI Tcl_Object	Tcl_ObjectContextObject(Tcl_ObjectContext context);
/* 18 */
TCLAPI size_t		Tcl_ObjectContextSkippedArgs(
				Tcl_ObjectContext context);
/* 19 */
TCLAPI void *		Tcl_ClassGetMetadata(Tcl_Class clazz,
				const Tcl_ObjectMetadataType *typePtr);
/* 20 */
TCLAPI void		Tcl_ClassSetMetadata(Tcl_Class clazz,
				const Tcl_ObjectMetadataType *typePtr,
				void *metadata);
/* 21 */
TCLAPI void *		Tcl_ObjectGetMetadata(Tcl_Object object,
				const Tcl_ObjectMetadataType *typePtr);
/* 22 */
TCLAPI void		Tcl_ObjectSetMetadata(Tcl_Object object,
				const Tcl_ObjectMetadataType *typePtr,
				void *metadata);
/* 23 */
TCLAPI int		Tcl_ObjectContextInvokeNext(Tcl_Interp *interp,
				Tcl_ObjectContext context, size_t objc,
				Tcl_Obj *const *objv, size_t skip);
/* 24 */
TCLAPI Tcl_ObjectMapMethodNameProc * Tcl_ObjectGetMethodNameMapper(
				Tcl_Object object);
/* 25 */
TCLAPI void		Tcl_ObjectSetMethodNameMapper(Tcl_Object object,
				Tcl_ObjectMapMethodNameProc *mapMethodNameProc);
/* 26 */







|
|










|

















|
|







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
TCLAPI Tcl_Method	Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
				Tcl_Obj *nameObj, int flags,
				const Tcl_MethodType *typePtr,
				void *clientData);
/* 13 */
TCLAPI Tcl_Object	Tcl_NewObjectInstance(Tcl_Interp *interp,
				Tcl_Class cls, const char *nameStr,
				const char *nsNameStr, Tcl_Size objc,
				Tcl_Obj *const *objv, Tcl_Size skip);
/* 14 */
TCLAPI int		Tcl_ObjectDeleted(Tcl_Object object);
/* 15 */
TCLAPI int		Tcl_ObjectContextIsFiltering(
				Tcl_ObjectContext context);
/* 16 */
TCLAPI Tcl_Method	Tcl_ObjectContextMethod(Tcl_ObjectContext context);
/* 17 */
TCLAPI Tcl_Object	Tcl_ObjectContextObject(Tcl_ObjectContext context);
/* 18 */
TCLAPI Tcl_Size		Tcl_ObjectContextSkippedArgs(
				Tcl_ObjectContext context);
/* 19 */
TCLAPI void *		Tcl_ClassGetMetadata(Tcl_Class clazz,
				const Tcl_ObjectMetadataType *typePtr);
/* 20 */
TCLAPI void		Tcl_ClassSetMetadata(Tcl_Class clazz,
				const Tcl_ObjectMetadataType *typePtr,
				void *metadata);
/* 21 */
TCLAPI void *		Tcl_ObjectGetMetadata(Tcl_Object object,
				const Tcl_ObjectMetadataType *typePtr);
/* 22 */
TCLAPI void		Tcl_ObjectSetMetadata(Tcl_Object object,
				const Tcl_ObjectMetadataType *typePtr,
				void *metadata);
/* 23 */
TCLAPI int		Tcl_ObjectContextInvokeNext(Tcl_Interp *interp,
				Tcl_ObjectContext context, Tcl_Size objc,
				Tcl_Obj *const *objv, Tcl_Size skip);
/* 24 */
TCLAPI Tcl_ObjectMapMethodNameProc * Tcl_ObjectGetMethodNameMapper(
				Tcl_Object object);
/* 25 */
TCLAPI void		Tcl_ObjectSetMethodNameMapper(Tcl_Object object,
				Tcl_ObjectMapMethodNameProc *mapMethodNameProc);
/* 26 */
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
    Tcl_Class (*tcl_MethodDeclarerClass) (Tcl_Method method); /* 6 */
    Tcl_Object (*tcl_MethodDeclarerObject) (Tcl_Method method); /* 7 */
    int (*tcl_MethodIsPublic) (Tcl_Method method); /* 8 */
    int (*tcl_MethodIsType) (Tcl_Method method, const Tcl_MethodType *typePtr, void **clientDataPtr); /* 9 */
    Tcl_Obj * (*tcl_MethodName) (Tcl_Method method); /* 10 */
    Tcl_Method (*tcl_NewInstanceMethod) (Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, void *clientData); /* 11 */
    Tcl_Method (*tcl_NewMethod) (Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, void *clientData); /* 12 */
    Tcl_Object (*tcl_NewObjectInstance) (Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, const char *nsNameStr, size_t objc, Tcl_Obj *const *objv, size_t skip); /* 13 */
    int (*tcl_ObjectDeleted) (Tcl_Object object); /* 14 */
    int (*tcl_ObjectContextIsFiltering) (Tcl_ObjectContext context); /* 15 */
    Tcl_Method (*tcl_ObjectContextMethod) (Tcl_ObjectContext context); /* 16 */
    Tcl_Object (*tcl_ObjectContextObject) (Tcl_ObjectContext context); /* 17 */
    size_t (*tcl_ObjectContextSkippedArgs) (Tcl_ObjectContext context); /* 18 */
    void * (*tcl_ClassGetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr); /* 19 */
    void (*tcl_ClassSetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr, void *metadata); /* 20 */
    void * (*tcl_ObjectGetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr); /* 21 */
    void (*tcl_ObjectSetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr, void *metadata); /* 22 */
    int (*tcl_ObjectContextInvokeNext) (Tcl_Interp *interp, Tcl_ObjectContext context, size_t objc, Tcl_Obj *const *objv, size_t skip); /* 23 */
    Tcl_ObjectMapMethodNameProc * (*tcl_ObjectGetMethodNameMapper) (Tcl_Object object); /* 24 */
    void (*tcl_ObjectSetMethodNameMapper) (Tcl_Object object, Tcl_ObjectMapMethodNameProc *mapMethodNameProc); /* 25 */
    void (*tcl_ClassSetConstructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 26 */
    void (*tcl_ClassSetDestructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 27 */
    Tcl_Obj * (*tcl_GetObjectName) (Tcl_Interp *interp, Tcl_Object object); /* 28 */
    int (*tcl_MethodIsPrivate) (Tcl_Method method); /* 29 */
    Tcl_Class (*tcl_GetClassOfObject) (Tcl_Object object); /* 30 */







|




|




|







155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
    Tcl_Class (*tcl_MethodDeclarerClass) (Tcl_Method method); /* 6 */
    Tcl_Object (*tcl_MethodDeclarerObject) (Tcl_Method method); /* 7 */
    int (*tcl_MethodIsPublic) (Tcl_Method method); /* 8 */
    int (*tcl_MethodIsType) (Tcl_Method method, const Tcl_MethodType *typePtr, void **clientDataPtr); /* 9 */
    Tcl_Obj * (*tcl_MethodName) (Tcl_Method method); /* 10 */
    Tcl_Method (*tcl_NewInstanceMethod) (Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, void *clientData); /* 11 */
    Tcl_Method (*tcl_NewMethod) (Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, void *clientData); /* 12 */
    Tcl_Object (*tcl_NewObjectInstance) (Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, const char *nsNameStr, Tcl_Size objc, Tcl_Obj *const *objv, Tcl_Size skip); /* 13 */
    int (*tcl_ObjectDeleted) (Tcl_Object object); /* 14 */
    int (*tcl_ObjectContextIsFiltering) (Tcl_ObjectContext context); /* 15 */
    Tcl_Method (*tcl_ObjectContextMethod) (Tcl_ObjectContext context); /* 16 */
    Tcl_Object (*tcl_ObjectContextObject) (Tcl_ObjectContext context); /* 17 */
    Tcl_Size (*tcl_ObjectContextSkippedArgs) (Tcl_ObjectContext context); /* 18 */
    void * (*tcl_ClassGetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr); /* 19 */
    void (*tcl_ClassSetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr, void *metadata); /* 20 */
    void * (*tcl_ObjectGetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr); /* 21 */
    void (*tcl_ObjectSetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr, void *metadata); /* 22 */
    int (*tcl_ObjectContextInvokeNext) (Tcl_Interp *interp, Tcl_ObjectContext context, Tcl_Size objc, Tcl_Obj *const *objv, Tcl_Size skip); /* 23 */
    Tcl_ObjectMapMethodNameProc * (*tcl_ObjectGetMethodNameMapper) (Tcl_Object object); /* 24 */
    void (*tcl_ObjectSetMethodNameMapper) (Tcl_Object object, Tcl_ObjectMapMethodNameProc *mapMethodNameProc); /* 25 */
    void (*tcl_ClassSetConstructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 26 */
    void (*tcl_ClassSetDestructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 27 */
    Tcl_Obj * (*tcl_GetObjectName) (Tcl_Interp *interp, Tcl_Object object); /* 28 */
    int (*tcl_MethodIsPrivate) (Tcl_Method method); /* 29 */
    Tcl_Class (*tcl_GetClassOfObject) (Tcl_Object object); /* 30 */

Changes to generic/tclOODefineCmds.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
/*
 * tclOODefineCmds.c --
 *
 *	This file contains the implementation of the ::oo::define command,
 *	part of the object-system core (NB: not Tcl_Obj, but ::oo).
 *
 * Copyright © 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"






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
/*
 * tclOODefineCmds.c --
 *
 *	This file contains the implementation of the ::oo::define command,
 *	part of the object-system core (NB: not Tcl_Obj, but ::oo).
 *
 * Copyright © 2006-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.
 */

#ifdef HAVE_CONFIG_H
#include "config.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
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
#define PUBLIC_PATTERN		"[a-z]*"

/*
 * Forward declarations.
 */

static inline void	BumpGlobalEpoch(Tcl_Interp *interp, Class *classPtr);

static Tcl_Command	FindCommand(Tcl_Interp *interp, Tcl_Obj *stringObj,
			    Tcl_Namespace *const namespacePtr);
static inline void	GenerateErrorInfo(Tcl_Interp *interp, Object *oPtr,
			    Tcl_Obj *savedNameObj, const char *typeOfSubject);
static inline int	MagicDefinitionInvoke(Tcl_Interp *interp,
			    Tcl_Namespace *nsPtr, int cmdIndex,
			    int objc, Tcl_Obj *const *objv);
static inline Class *	GetClassInOuterContext(Tcl_Interp *interp,
			    Tcl_Obj *className, const char *errMsg);
static inline Tcl_Namespace *GetNamespaceInOuterContext(Tcl_Interp *interp,
			    Tcl_Obj *namespaceName);
static inline int	InitDefineContext(Tcl_Interp *interp,
			    Tcl_Namespace *namespacePtr, Object *oPtr,
			    int objc, Tcl_Obj *const objv[]);
static inline void	RecomputeClassCacheFlag(Object *oPtr);
static int		RenameDeleteMethod(Tcl_Interp *interp, Object *oPtr,
			    int useClass, Tcl_Obj *const fromPtr,
			    Tcl_Obj *const toPtr);
static int		ClassFilterGet(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ClassFilterSet(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ClassMixinGet(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ClassMixinSet(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ClassSuperGet(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ClassSuperSet(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ClassVarsGet(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,



			    int objc, Tcl_Obj *const *objv);
static int		ClassVarsSet(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ObjFilterGet(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ObjFilterSet(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ObjMixinGet(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ObjMixinSet(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ObjVarsGet(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ObjVarsSet(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);


static int		ResolveClass(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);

/*
 * Now define the slots used in declarations.
 */

static const struct DeclaredSlot slots[] = {
    SLOT("define::filter",      ClassFilterGet, ClassFilterSet, NULL),
    SLOT("define::mixin",       ClassMixinGet,  ClassMixinSet, ResolveClass),
    SLOT("define::superclass",  ClassSuperGet,  ClassSuperSet, ResolveClass),
    SLOT("define::variable",    ClassVarsGet,   ClassVarsSet, NULL),
    SLOT("objdefine::filter",   ObjFilterGet,   ObjFilterSet, NULL),
    SLOT("objdefine::mixin",    ObjMixinGet,    ObjMixinSet, ResolveClass),
    SLOT("objdefine::variable", ObjVarsGet,     ObjVarsSet, NULL),








    {NULL, {0, 0, 0, 0, 0}, {0, 0, 0, 0, 0}, {0, 0, 0, 0, 0}}
};

/*
 * How to build the in-namespace name of a private variable. This is a pattern
 * used with Tcl_ObjPrintf().
 */







>


















|


|


|


|


|


|


|

>
>
>

|
<
|
|


|


|


|


|


|


>
>
|















>
>
>
>
>
>
>
>







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
#define PUBLIC_PATTERN		"[a-z]*"

/*
 * Forward declarations.
 */

static inline void	BumpGlobalEpoch(Tcl_Interp *interp, Class *classPtr);
static inline void	BumpInstanceEpoch(Object *oPtr);
static Tcl_Command	FindCommand(Tcl_Interp *interp, Tcl_Obj *stringObj,
			    Tcl_Namespace *const namespacePtr);
static inline void	GenerateErrorInfo(Tcl_Interp *interp, Object *oPtr,
			    Tcl_Obj *savedNameObj, const char *typeOfSubject);
static inline int	MagicDefinitionInvoke(Tcl_Interp *interp,
			    Tcl_Namespace *nsPtr, int cmdIndex,
			    int objc, Tcl_Obj *const *objv);
static inline Class *	GetClassInOuterContext(Tcl_Interp *interp,
			    Tcl_Obj *className, const char *errMsg);
static inline Tcl_Namespace *GetNamespaceInOuterContext(Tcl_Interp *interp,
			    Tcl_Obj *namespaceName);
static inline int	InitDefineContext(Tcl_Interp *interp,
			    Tcl_Namespace *namespacePtr, Object *oPtr,
			    int objc, Tcl_Obj *const objv[]);
static inline void	RecomputeClassCacheFlag(Object *oPtr);
static int		RenameDeleteMethod(Tcl_Interp *interp, Object *oPtr,
			    int useClass, Tcl_Obj *const fromPtr,
			    Tcl_Obj *const toPtr);
static int		ClassFilterGet(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ClassFilterSet(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ClassMixinGet(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ClassMixinSet(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ClassSuperGet(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ClassSuperSet(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ClassVarsGet(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ClassVarsSet(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static Tcl_MethodCallProc ClassRPropsGet, ClassRPropsSet;

static Tcl_MethodCallProc ClassWPropsGet, ClassWPropsSet;
static int		ObjFilterGet(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ObjFilterSet(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ObjMixinGet(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ObjMixinSet(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ObjVarsGet(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ObjVarsSet(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static Tcl_MethodCallProc ObjRPropsGet, ObjRPropsSet;
static Tcl_MethodCallProc ObjWPropsGet, ObjWPropsSet;
static int		ResolveClass(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);

/*
 * Now define the slots used in declarations.
 */

static const struct DeclaredSlot slots[] = {
    SLOT("define::filter",      ClassFilterGet, ClassFilterSet, NULL),
    SLOT("define::mixin",       ClassMixinGet,  ClassMixinSet, ResolveClass),
    SLOT("define::superclass",  ClassSuperGet,  ClassSuperSet, ResolveClass),
    SLOT("define::variable",    ClassVarsGet,   ClassVarsSet, NULL),
    SLOT("objdefine::filter",   ObjFilterGet,   ObjFilterSet, NULL),
    SLOT("objdefine::mixin",    ObjMixinGet,    ObjMixinSet, ResolveClass),
    SLOT("objdefine::variable", ObjVarsGet,     ObjVarsSet, NULL),
    SLOT("configuresupport::readableproperties",
	    ClassRPropsGet, ClassRPropsSet, NULL),
    SLOT("configuresupport::writableproperties",
	    ClassWPropsGet, ClassWPropsSet, NULL),
    SLOT("configuresupport::objreadableproperties",
	    ObjRPropsGet, ObjRPropsSet, NULL),
    SLOT("configuresupport::objwritableproperties",
	    ObjWPropsGet, ObjWPropsSet, NULL),
    {NULL, {0, 0, 0, 0, 0}, {0, 0, 0, 0, 0}, {0, 0, 0, 0, 0}}
};

/*
 * How to build the in-namespace name of a private variable. This is a pattern
 * used with Tcl_ObjPrintf().
 */
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
	 * invalidate any call chains. Note that we still bump our object's
	 * epoch if it has any mixins; the relation between a class and its
	 * representative object is special. But it won't hurt.
	 */

	if (classPtr->thisPtr->mixins.num > 0) {
	    classPtr->thisPtr->epoch++;













	}
	return;
    }

    /*
     * Either there's no class (?!) or we're reconfiguring something that is
     * in use. Force regeneration of call chains.
     */

    TclOOGetFoundation(interp)->epoch++;
}




























/*
 * ----------------------------------------------------------------------
 *
 * RecomputeClassCacheFlag --
 *
 *	Determine whether the object is prototypical of its class, and hence







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






|




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







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
	 * invalidate any call chains. Note that we still bump our object's
	 * epoch if it has any mixins; the relation between a class and its
	 * representative object is special. But it won't hurt.
	 */

	if (classPtr->thisPtr->mixins.num > 0) {
	    classPtr->thisPtr->epoch++;

	    /*
	     * Invalidate the property caches directly.
	     */

	    if (classPtr->properties.allReadableCache) {
		Tcl_DecrRefCount(classPtr->properties.allReadableCache);
		classPtr->properties.allReadableCache = NULL;
	    }
	    if (classPtr->properties.allWritableCache) {
		Tcl_DecrRefCount(classPtr->properties.allWritableCache);
		classPtr->properties.allWritableCache = NULL;
	    }
	}
	return;
    }

    /*
     * Either there's no class (?!) or we're reconfiguring something that is
     * in use. Force regeneration of call chains and properties.
     */

    TclOOGetFoundation(interp)->epoch++;
}

/*
 * ----------------------------------------------------------------------
 *
 * BumpInstanceEpoch --
 *
 *	Advances the epoch and clears the property cache of an object. The
 *	equivalent for classes is BumpGlobalEpoch(), as classes have a more
 *	complex set of relationships to other entities.
 *
 * ----------------------------------------------------------------------
 */

static inline void
BumpInstanceEpoch(
    Object *oPtr)
{
    oPtr->epoch++;
    if (oPtr->properties.allReadableCache) {
	Tcl_DecrRefCount(oPtr->properties.allReadableCache);
	oPtr->properties.allReadableCache = NULL;
    }
    if (oPtr->properties.allWritableCache) {
	Tcl_DecrRefCount(oPtr->properties.allWritableCache);
	oPtr->properties.allWritableCache = NULL;
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * RecomputeClassCacheFlag --
 *
 *	Determine whether the object is prototypical of its class, and hence
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
 *
 * ----------------------------------------------------------------------
 */

void
TclOOObjectSetFilters(
    Object *oPtr,
    size_t numFilters,
    Tcl_Obj *const *filters)
{
    size_t i;

    if (oPtr->filters.num) {
	Tcl_Obj *filterObj;

	FOREACH(filterObj, oPtr->filters) {
	    Tcl_DecrRefCount(filterObj);
	}







|


|







298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
 *
 * ----------------------------------------------------------------------
 */

void
TclOOObjectSetFilters(
    Object *oPtr,
    Tcl_Size numFilters,
    Tcl_Obj *const *filters)
{
    Tcl_Size i;

    if (oPtr->filters.num) {
	Tcl_Obj *filterObj;

	FOREACH(filterObj, oPtr->filters) {
	    Tcl_DecrRefCount(filterObj);
	}
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
	    filtersList[i] = filters[i];
	    Tcl_IncrRefCount(filters[i]);
	}
	oPtr->filters.list = filtersList;
	oPtr->filters.num = numFilters;
	oPtr->flags &= ~USE_CLASS_CACHE;
    }
    oPtr->epoch++;		/* Only this object can be affected. */
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOClassSetFilters --
 *
 *	Install a list of filter method names into a class.
 *
 * ----------------------------------------------------------------------
 */

void
TclOOClassSetFilters(
    Tcl_Interp *interp,
    Class *classPtr,
    size_t numFilters,
    Tcl_Obj *const *filters)
{
    size_t i;

    if (classPtr->filters.num) {
	Tcl_Obj *filterObj;

	FOREACH(filterObj, classPtr->filters) {
	    Tcl_DecrRefCount(filterObj);
	}







|
















|


|







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
	    filtersList[i] = filters[i];
	    Tcl_IncrRefCount(filters[i]);
	}
	oPtr->filters.list = filtersList;
	oPtr->filters.num = numFilters;
	oPtr->flags &= ~USE_CLASS_CACHE;
    }
    BumpInstanceEpoch(oPtr);	/* Only this object can be affected. */
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOClassSetFilters --
 *
 *	Install a list of filter method names into a class.
 *
 * ----------------------------------------------------------------------
 */

void
TclOOClassSetFilters(
    Tcl_Interp *interp,
    Class *classPtr,
    Tcl_Size numFilters,
    Tcl_Obj *const *filters)
{
    Tcl_Size i;

    if (classPtr->filters.num) {
	Tcl_Obj *filterObj;

	FOREACH(filterObj, classPtr->filters) {
	    Tcl_DecrRefCount(filterObj);
	}
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
 *
 * ----------------------------------------------------------------------
 */

void
TclOOObjectSetMixins(
    Object *oPtr,
    size_t numMixins,
    Class *const *mixins)
{
    Class *mixinPtr;
    size_t i;

    if (numMixins == 0) {
	if (oPtr->mixins.num != 0) {
	    FOREACH(mixinPtr, oPtr->mixins) {
		TclOORemoveFromInstances(oPtr, mixinPtr);
		TclOODecrRefCount(mixinPtr->thisPtr);
	    }







|



|







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

void
TclOOObjectSetMixins(
    Object *oPtr,
    Tcl_Size numMixins,
    Class *const *mixins)
{
    Class *mixinPtr;
    Tcl_Size i;

    if (numMixins == 0) {
	if (oPtr->mixins.num != 0) {
	    FOREACH(mixinPtr, oPtr->mixins) {
		TclOORemoveFromInstances(oPtr, mixinPtr);
		TclOODecrRefCount(mixinPtr->thisPtr);
	    }
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
		 * For the new copy created by memcpy().
		 */

		AddRef(mixinPtr->thisPtr);
	    }
	}
    }
    oPtr->epoch++;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOClassSetMixins --
 *
 *	Install a list of mixin classes into a class.
 *
 * ----------------------------------------------------------------------
 */

void
TclOOClassSetMixins(
    Tcl_Interp *interp,
    Class *classPtr,
    size_t numMixins,
    Class *const *mixins)
{
    Class *mixinPtr;
    size_t i;

    if (numMixins == 0) {
	if (classPtr->mixins.num != 0) {
	    FOREACH(mixinPtr, classPtr->mixins) {
		TclOORemoveFromMixinSubs(classPtr, mixinPtr);
		TclOODecrRefCount(mixinPtr->thisPtr);
	    }







|
















|



|







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
		 * For the new copy created by memcpy().
		 */

		AddRef(mixinPtr->thisPtr);
	    }
	}
    }
    BumpInstanceEpoch(oPtr);
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOClassSetMixins --
 *
 *	Install a list of mixin classes into a class.
 *
 * ----------------------------------------------------------------------
 */

void
TclOOClassSetMixins(
    Tcl_Interp *interp,
    Class *classPtr,
    Tcl_Size numMixins,
    Class *const *mixins)
{
    Class *mixinPtr;
    Tcl_Size i;

    if (numMixins == 0) {
	if (classPtr->mixins.num != 0) {
	    FOREACH(mixinPtr, classPtr->mixins) {
		TclOORemoveFromMixinSubs(classPtr, mixinPtr);
		TclOODecrRefCount(mixinPtr->thisPtr);
	    }
478
479
480
481
482
483
484

485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
 *
 * InstallStandardVariableMapping, InstallPrivateVariableMapping --
 *
 *	Helpers for installing standard and private variable maps.
 *
 * ----------------------------------------------------------------------
 */

static inline void
InstallStandardVariableMapping(
    VariableNameList *vnlPtr,
    size_t varc,
    Tcl_Obj *const *varv)
{
    Tcl_Obj *variableObj;
    size_t i, n;
    int created;
    Tcl_HashTable uniqueTable;

    for (i=0 ; i<varc ; i++) {
	Tcl_IncrRefCount(varv[i]);
    }
    FOREACH(variableObj, *vnlPtr) {







>



|



|







531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
 *
 * InstallStandardVariableMapping, InstallPrivateVariableMapping --
 *
 *	Helpers for installing standard and private variable maps.
 *
 * ----------------------------------------------------------------------
 */

static inline void
InstallStandardVariableMapping(
    VariableNameList *vnlPtr,
    Tcl_Size varc,
    Tcl_Obj *const *varv)
{
    Tcl_Obj *variableObj;
    Tcl_Size i, n;
    int created;
    Tcl_HashTable uniqueTable;

    for (i=0 ; i<varc ; i++) {
	Tcl_IncrRefCount(varv[i]);
    }
    FOREACH(variableObj, *vnlPtr) {
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
	Tcl_DeleteHashTable(&uniqueTable);
    }
}

static inline void
InstallPrivateVariableMapping(
    PrivateVariableList *pvlPtr,
    size_t varc,
    Tcl_Obj *const *varv,
    int creationEpoch)
{
    PrivateVariableMapping *privatePtr;
    size_t i, n;
    int created;
    Tcl_HashTable uniqueTable;

    for (i=0 ; i<varc ; i++) {
	Tcl_IncrRefCount(varv[i]);
    }
    FOREACH_STRUCT(privatePtr, *pvlPtr) {







|




|







585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
	Tcl_DeleteHashTable(&uniqueTable);
    }
}

static inline void
InstallPrivateVariableMapping(
    PrivateVariableList *pvlPtr,
    Tcl_Size varc,
    Tcl_Obj *const *varv,
    int creationEpoch)
{
    PrivateVariableMapping *privatePtr;
    Tcl_Size i, n;
    int created;
    Tcl_HashTable uniqueTable;

    for (i=0 ; i<varc ; i++) {
	Tcl_IncrRefCount(varv[i]);
    }
    FOREACH_STRUCT(privatePtr, *pvlPtr) {
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Namespace *nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
    Tcl_HashSearch search;
    Tcl_HashEntry *hPtr;
    size_t soughtLen;
    const char *soughtStr, *matchedStr = NULL;

    if (objc < 2) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"bad call of unknown handler", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_UNKNOWN", NULL);
	return TCL_ERROR;







|







754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Namespace *nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
    Tcl_HashSearch search;
    Tcl_HashEntry *hPtr;
    Tcl_Size soughtLen;
    const char *soughtStr, *matchedStr = NULL;

    if (objc < 2) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"bad call of unknown handler", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_UNKNOWN", NULL);
	return TCL_ERROR;
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788

static Tcl_Command
FindCommand(
    Tcl_Interp *interp,
    Tcl_Obj *stringObj,
    Tcl_Namespace *const namespacePtr)
{
    size_t length;
    const char *nameStr, *string = Tcl_GetStringFromObj(stringObj, &length);
    Namespace *const nsPtr = (Namespace *) namespacePtr;
    FOREACH_HASH_DECLS;
    Tcl_Command cmd, cmd2;

    /*
     * If someone is playing games, we stop playing right now.







|







828
829
830
831
832
833
834
835
836
837
838
839
840
841
842

static Tcl_Command
FindCommand(
    Tcl_Interp *interp,
    Tcl_Obj *stringObj,
    Tcl_Namespace *const namespacePtr)
{
    Tcl_Size 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.
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
				 * current name (post-execution) has to be
				 * used. This matters, because the object
				 * could have been renamed... */
    const char *typeOfSubject)	/* Part of the message, saying whether it was
				 * an object, class or class-as-object that
				 * was being configured. */
{
    size_t length;
    Tcl_Obj *realNameObj = Tcl_ObjectDeleted((Tcl_Object) oPtr)
	    ? savedNameObj : TclOOObjectName(interp, oPtr);
    const char *objName = Tcl_GetStringFromObj(realNameObj, &length);
    unsigned limit = OBJNAME_LENGTH_IN_ERRORINFO_LIMIT;
    int overflow = (length > limit);

    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
	    "\n    (in definition script for %s \"%.*s%s\" line %d)",
	    typeOfSubject, (overflow ? limit : (unsigned)length), objName,
	    (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
}

/*
 * ----------------------------------------------------------------------
 *
 * MagicDefinitionInvoke --







|



|




|







1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
				 * current name (post-execution) has to be
				 * used. This matters, because the object
				 * could have been renamed... */
    const char *typeOfSubject)	/* Part of the message, saying whether it was
				 * an object, class or class-as-object that
				 * was being configured. */
{
    Tcl_Size length;
    Tcl_Obj *realNameObj = Tcl_ObjectDeleted((Tcl_Object) oPtr)
	    ? savedNameObj : TclOOObjectName(interp, oPtr);
    const char *objName = Tcl_GetStringFromObj(realNameObj, &length);
    int 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 : (int)length), objName,
	    (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
}

/*
 * ----------------------------------------------------------------------
 *
 * MagicDefinitionInvoke --
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
    int cmdIndex,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *objPtr, *obj2Ptr, **objs;
    Tcl_Command cmd;
    int isRoot, result, offset = cmdIndex + 1;
    size_t dummy;

    /*
     * More than one argument: fire them through the ensemble processing
     * engine so that everything appears to be good and proper in error
     * messages. Note that we cannot just concatenate and send through
     * Tcl_EvalObjEx, as that doesn't do ensemble processing, and we cannot go
     * through Tcl_EvalObjv without the extra work to pre-find the command, as







|







1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
    int cmdIndex,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *objPtr, *obj2Ptr, **objs;
    Tcl_Command cmd;
    int isRoot, result, offset = cmdIndex + 1;
    Tcl_Size dummy;

    /*
     * More than one argument: fire them through the ensemble processing
     * engine so that everything appears to be good and proper in error
     * messages. Note that we cannot just concatenate and send through
     * Tcl_EvalObjEx, as that doesn't do ensemble processing, and we cannot go
     * through Tcl_EvalObjv without the extra work to pre-find the command, as
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
 *	and "oo::objdefine" commands.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefinePrivateObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    int isInstancePrivate = (clientData != NULL);
				/* Just so that we can generate the correct
				 * error message depending on the context of







|







1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
 *	and "oo::objdefine" commands.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefinePrivateObjCmd(
    void *clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    int isInstancePrivate = (clientData != NULL);
				/* Just so that we can generate the correct
				 * error message depending on the context of
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
	} else if (!wasClass && willBeClass) {
	    TclOOAllocClass(interp, oPtr);
	}

	if (oPtr->classPtr != NULL) {
	    BumpGlobalEpoch(interp, oPtr->classPtr);
	} else {
	    oPtr->epoch++;
	}
    }
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------







|







1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
	} else if (!wasClass && willBeClass) {
	    TclOOAllocClass(interp, oPtr);
	}

	if (oPtr->classPtr != NULL) {
	    BumpGlobalEpoch(interp, oPtr->classPtr);
	} else {
	    BumpInstanceEpoch(oPtr);
	}
    }
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr;
    Class *clsPtr;
    Tcl_Method method;
    size_t bodyLength;

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

    /*







|







1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr;
    Class *clsPtr;
    Tcl_Method method;
    Tcl_Size bodyLength;

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

    /*
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
 *	and "oo::objdefine" commands.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefineDeleteMethodObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    int isInstanceDeleteMethod = (clientData != NULL);
    Object *oPtr;
    int i;







|







1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
 *	and "oo::objdefine" commands.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefineDeleteMethodObjCmd(
    void *clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    int isInstanceDeleteMethod = (clientData != NULL);
    Object *oPtr;
    int i;
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
	if (RenameDeleteMethod(interp, oPtr, !isInstanceDeleteMethod,
		objv[i], NULL) != TCL_OK) {
	    return TCL_ERROR;
	}
    }

    if (isInstanceDeleteMethod) {
	oPtr->epoch++;
    } else {
	BumpGlobalEpoch(interp, oPtr->classPtr);
    }
    return TCL_OK;
}

/*







|







1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
	if (RenameDeleteMethod(interp, oPtr, !isInstanceDeleteMethod,
		objv[i], NULL) != TCL_OK) {
	    return TCL_ERROR;
	}
    }

    if (isInstanceDeleteMethod) {
	BumpInstanceEpoch(oPtr);
    } else {
	BumpGlobalEpoch(interp, oPtr->classPtr);
    }
    return TCL_OK;
}

/*
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr;
    Class *clsPtr;
    Tcl_Method method;
    size_t bodyLength;

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

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);







|







1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr;
    Class *clsPtr;
    Tcl_Method method;
    Tcl_Size bodyLength;

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

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
 *	"oo::objdefine" commands.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefineExportObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    int isInstanceExport = (clientData != NULL);
    Object *oPtr;
    Method *mPtr;







|







1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
 *	"oo::objdefine" commands.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefineExportObjCmd(
    void *clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    int isInstanceExport = (clientData != NULL);
    Object *oPtr;
    Method *mPtr;
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

    /*
     * Bump the right epoch if we actually changed anything.
     */

    if (changed) {
	if (isInstanceExport) {
	    oPtr->epoch++;
	} else {
	    BumpGlobalEpoch(interp, clsPtr);
	}
    }
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODefineForwardObjCmd --
 *
 *	Implementation of the "forward" subcommand of the "oo::define" and
 *	"oo::objdefine" commands.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefineForwardObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    int isInstanceForward = (clientData != NULL);
    Object *oPtr;
    Method *mPtr;







|




















|







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

    /*
     * Bump the right epoch if we actually changed anything.
     */

    if (changed) {
	if (isInstanceExport) {
	    BumpInstanceEpoch(oPtr);
	} else {
	    BumpGlobalEpoch(interp, clsPtr);
	}
    }
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODefineForwardObjCmd --
 *
 *	Implementation of the "forward" subcommand of the "oo::define" and
 *	"oo::objdefine" commands.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefineForwardObjCmd(
    void *clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    int isInstanceForward = (clientData != NULL);
    Object *oPtr;
    Method *mPtr;
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
 *	"oo::objdefine" commands.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefineMethodObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    /*
     * Table of export modes for methods and their corresponding enum.
     */







|







2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
 *	"oo::objdefine" commands.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefineMethodObjCmd(
    void *clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    /*
     * Table of export modes for methods and their corresponding enum.
     */
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
 *	and "oo::objdefine" commands.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefineRenameMethodObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    int isInstanceRenameMethod = (clientData != NULL);
    Object *oPtr;








|







2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
 *	and "oo::objdefine" commands.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefineRenameMethodObjCmd(
    void *clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    int isInstanceRenameMethod = (clientData != NULL);
    Object *oPtr;

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

    if (RenameDeleteMethod(interp, oPtr, !isInstanceRenameMethod,
	    objv[1], objv[2]) != TCL_OK) {
	return TCL_ERROR;
    }

    if (isInstanceRenameMethod) {
	oPtr->epoch++;
    } else {
	BumpGlobalEpoch(interp, oPtr->classPtr);
    }
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODefineUnexportObjCmd --
 *
 *	Implementation of the "unexport" subcommand of the "oo::define" and
 *	"oo::objdefine" commands.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefineUnexportObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    int isInstanceUnexport = (clientData != NULL);
    Object *oPtr;
    Method *mPtr;







|



















|







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

    if (RenameDeleteMethod(interp, oPtr, !isInstanceRenameMethod,
	    objv[1], objv[2]) != TCL_OK) {
	return TCL_ERROR;
    }

    if (isInstanceRenameMethod) {
	BumpInstanceEpoch(oPtr);
    } else {
	BumpGlobalEpoch(interp, oPtr->classPtr);
    }
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODefineUnexportObjCmd --
 *
 *	Implementation of the "unexport" subcommand of the "oo::define" and
 *	"oo::objdefine" commands.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefineUnexportObjCmd(
    void *clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    int isInstanceUnexport = (clientData != NULL);
    Object *oPtr;
    Method *mPtr;
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199

    /*
     * Bump the right epoch if we actually changed anything.
     */

    if (changed) {
	if (isInstanceUnexport) {
	    oPtr->epoch++;
	} else {
	    BumpGlobalEpoch(interp, clsPtr);
	}
    }
    return TCL_OK;
}








|







2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253

    /*
     * Bump the right epoch if we actually changed anything.
     */

    if (changed) {
	if (isInstanceUnexport) {
	    BumpInstanceEpoch(oPtr);
	} else {
	    BumpGlobalEpoch(interp, clsPtr);
	}
    }
    return TCL_OK;
}

2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
    const struct DeclaredSlot *slotInfoPtr;
    Tcl_Obj *getName = Tcl_NewStringObj("Get", -1);
    Tcl_Obj *setName = Tcl_NewStringObj("Set", -1);
    Tcl_Obj *resolveName = Tcl_NewStringObj("Resolve", -1);
    Class *slotCls;

    slotCls = ((Object *) Tcl_NewObjectInstance(fPtr->interp, (Tcl_Class)
	    fPtr->classCls, "::oo::Slot", NULL, -1, NULL, 0))->classPtr;
    if (slotCls == NULL) {
	return TCL_ERROR;
    }
    Tcl_IncrRefCount(getName);
    Tcl_IncrRefCount(setName);
    Tcl_IncrRefCount(resolveName);
    for (slotInfoPtr = slots ; slotInfoPtr->name ; slotInfoPtr++) {
	Tcl_Object slotObject = Tcl_NewObjectInstance(fPtr->interp,
		(Tcl_Class) slotCls, slotInfoPtr->name, NULL, -1, NULL, 0);

	if (slotObject == NULL) {
	    continue;
	}
	TclNewInstanceMethod(fPtr->interp, slotObject, getName, 0,
		&slotInfoPtr->getterType, NULL);
	TclNewInstanceMethod(fPtr->interp, slotObject, setName, 0,







|








|







2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
    const struct DeclaredSlot *slotInfoPtr;
    Tcl_Obj *getName = Tcl_NewStringObj("Get", -1);
    Tcl_Obj *setName = Tcl_NewStringObj("Set", -1);
    Tcl_Obj *resolveName = Tcl_NewStringObj("Resolve", -1);
    Class *slotCls;

    slotCls = ((Object *) Tcl_NewObjectInstance(fPtr->interp, (Tcl_Class)
	    fPtr->classCls, "::oo::Slot", NULL, TCL_INDEX_NONE, NULL, 0))->classPtr;
    if (slotCls == NULL) {
	return TCL_ERROR;
    }
    Tcl_IncrRefCount(getName);
    Tcl_IncrRefCount(setName);
    Tcl_IncrRefCount(resolveName);
    for (slotInfoPtr = slots ; slotInfoPtr->name ; slotInfoPtr++) {
	Tcl_Object slotObject = Tcl_NewObjectInstance(fPtr->interp,
		(Tcl_Class) slotCls, slotInfoPtr->name, NULL, TCL_INDEX_NONE, NULL, 0);

	if (slotObject == NULL) {
	    continue;
	}
	TclNewInstanceMethod(fPtr->interp, slotObject, getName, 0,
		&slotInfoPtr->getterType, NULL);
	TclNewInstanceMethod(fPtr->interp, slotObject, setName, 0,
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Obj *resultObj, *filterObj;
    size_t i;

    if (Tcl_ObjectContextSkippedArgs(context) != (size_t)objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		NULL);
	return TCL_ERROR;
    }
    if (oPtr == NULL) {
	return TCL_ERROR;
    } else if (!oPtr->classPtr) {







|

|







2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Obj *resultObj, *filterObj;
    Tcl_Size i;

    if (Tcl_ObjectContextSkippedArgs(context) != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		NULL);
	return TCL_ERROR;
    }
    if (oPtr == NULL) {
	return TCL_ERROR;
    } else if (!oPtr->classPtr) {
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    size_t filterc;
    Tcl_Obj **filterv;

    if (Tcl_ObjectContextSkippedArgs(context) + 1 != (size_t)objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"filterList");
	return TCL_ERROR;
    }
    objv += Tcl_ObjectContextSkippedArgs(context);

    if (oPtr == NULL) {







|


|







2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Size filterc;
    Tcl_Obj **filterv;

    if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"filterList");
	return TCL_ERROR;
    }
    objv += Tcl_ObjectContextSkippedArgs(context);

    if (oPtr == NULL) {
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Obj *resultObj;
    Class *mixinPtr;
    size_t i;

    if (Tcl_ObjectContextSkippedArgs(context) != (size_t)objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		NULL);
	return TCL_ERROR;
    }
    if (oPtr == NULL) {
	return TCL_ERROR;
    } else if (!oPtr->classPtr) {







|

|







2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Obj *resultObj;
    Class *mixinPtr;
    Tcl_Size i;

    if (Tcl_ObjectContextSkippedArgs(context) != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		NULL);
	return TCL_ERROR;
    }
    if (oPtr == NULL) {
	return TCL_ERROR;
    } else if (!oPtr->classPtr) {
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    size_t mixinc, i;
    Tcl_Obj **mixinv;
    Class **mixins;

    if (Tcl_ObjectContextSkippedArgs(context) + 1 != (size_t)objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"mixinList");
	return TCL_ERROR;
    }
    objv += Tcl_ObjectContextSkippedArgs(context);

    if (oPtr == NULL) {







|



|







2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Size mixinc, i;
    Tcl_Obj **mixinv;
    Class **mixins;

    if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"mixinList");
	return TCL_ERROR;
    }
    objv += Tcl_ObjectContextSkippedArgs(context);

    if (oPtr == NULL) {
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Obj *resultObj;
    Class *superPtr;
    size_t i;

    if (Tcl_ObjectContextSkippedArgs(context) != (size_t)objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		NULL);
	return TCL_ERROR;
    }
    if (oPtr == NULL) {
	return TCL_ERROR;
    } else if (!oPtr->classPtr) {







|

|







2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Obj *resultObj;
    Class *superPtr;
    Tcl_Size i;

    if (Tcl_ObjectContextSkippedArgs(context) != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		NULL);
	return TCL_ERROR;
    }
    if (oPtr == NULL) {
	return TCL_ERROR;
    } else if (!oPtr->classPtr) {
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    size_t superc, j;
    size_t i;
    Tcl_Obj **superv;
    Class **superclasses, *superPtr;

    if (Tcl_ObjectContextSkippedArgs(context) + 1 != (size_t)objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"superclassList");
	return TCL_ERROR;
    }
    objv += Tcl_ObjectContextSkippedArgs(context);

    if (oPtr == NULL) {







|
|



|







2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Size superc, j;
    Tcl_Size i;
    Tcl_Obj **superv;
    Class **superclasses, *superPtr;

    if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"superclassList");
	return TCL_ERROR;
    }
    objv += Tcl_ObjectContextSkippedArgs(context);

    if (oPtr == NULL) {
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Obj *resultObj;
    size_t i;

    if (Tcl_ObjectContextSkippedArgs(context) != (size_t)objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		NULL);
	return TCL_ERROR;
    }
    if (oPtr == NULL) {
	return TCL_ERROR;
    } else if (!oPtr->classPtr) {







|

|







2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Obj *resultObj;
    Tcl_Size i;

    if (Tcl_ObjectContextSkippedArgs(context) != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		NULL);
	return TCL_ERROR;
    }
    if (oPtr == NULL) {
	return TCL_ERROR;
    } else if (!oPtr->classPtr) {
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    size_t i;
    size_t varc;
    Tcl_Obj **varv;

    if (Tcl_ObjectContextSkippedArgs(context) + 1 != (size_t)objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"filterList");
	return TCL_ERROR;
    }
    objv += Tcl_ObjectContextSkippedArgs(context);

    if (oPtr == NULL) {







|
|


|







2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Size i;
    Tcl_Size varc;
    Tcl_Obj **varv;

    if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"filterList");
	return TCL_ERROR;
    }
    objv += Tcl_ObjectContextSkippedArgs(context);

    if (oPtr == NULL) {
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Obj *resultObj, *filterObj;
    size_t i;

    if (Tcl_ObjectContextSkippedArgs(context) != (size_t)objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		NULL);
	return TCL_ERROR;
    } else if (oPtr == NULL) {
	return TCL_ERROR;
    }








|

|







2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Obj *resultObj, *filterObj;
    Tcl_Size i;

    if (Tcl_ObjectContextSkippedArgs(context) != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		NULL);
	return TCL_ERROR;
    } else if (oPtr == NULL) {
	return TCL_ERROR;
    }

2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    size_t filterc;
    Tcl_Obj **filterv;

    if (Tcl_ObjectContextSkippedArgs(context) + 1 != (size_t)objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"filterList");
	return TCL_ERROR;
    } else if (oPtr == NULL) {
	return TCL_ERROR;
    }
    objv += Tcl_ObjectContextSkippedArgs(context);







|


|







2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Size filterc;
    Tcl_Obj **filterv;

    if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"filterList");
	return TCL_ERROR;
    } else if (oPtr == NULL) {
	return TCL_ERROR;
    }
    objv += Tcl_ObjectContextSkippedArgs(context);
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Obj *resultObj;
    Class *mixinPtr;
    size_t i;

    if (Tcl_ObjectContextSkippedArgs(context) != (size_t)objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		NULL);
	return TCL_ERROR;
    } else if (oPtr == NULL) {
	return TCL_ERROR;
    }








|

|







2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Obj *resultObj;
    Class *mixinPtr;
    Tcl_Size i;

    if (Tcl_ObjectContextSkippedArgs(context) != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		NULL);
	return TCL_ERROR;
    } else if (oPtr == NULL) {
	return TCL_ERROR;
    }

2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    size_t i;
    size_t mixinc;
    Tcl_Obj **mixinv;
    Class **mixins;

    if (Tcl_ObjectContextSkippedArgs(context) + 1 != (size_t)objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"mixinList");
	return TCL_ERROR;
    } else if (oPtr == NULL) {
	return TCL_ERROR;
    }
    objv += Tcl_ObjectContextSkippedArgs(context);







|
|



|







2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Size i;
    Tcl_Size mixinc;
    Tcl_Obj **mixinv;
    Class **mixins;

    if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"mixinList");
	return TCL_ERROR;
    } else if (oPtr == NULL) {
	return TCL_ERROR;
    }
    objv += Tcl_ObjectContextSkippedArgs(context);
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Obj *resultObj;
    size_t i;

    if (Tcl_ObjectContextSkippedArgs(context) != (size_t)objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		NULL);
	return TCL_ERROR;
    } else if (oPtr == NULL) {
	return TCL_ERROR;
    }








|

|







2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Obj *resultObj;
    Tcl_Size i;

    if (Tcl_ObjectContextSkippedArgs(context) != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		NULL);
	return TCL_ERROR;
    } else if (oPtr == NULL) {
	return TCL_ERROR;
    }

2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    size_t varc, i;
    Tcl_Obj **varv;

    if (Tcl_ObjectContextSkippedArgs(context) + 1 != (size_t)objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"variableList");
	return TCL_ERROR;
    } else if (oPtr == NULL) {
	return TCL_ERROR;
    }
    objv += Tcl_ObjectContextSkippedArgs(context);







|


|







3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Size varc, i;
    Tcl_Obj **varv;

    if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"variableList");
	return TCL_ERROR;
    } else if (oPtr == NULL) {
	return TCL_ERROR;
    }
    objv += Tcl_ObjectContextSkippedArgs(context);
3076
3077
3078
3079
3080
3081
3082










































































































































































































































































































































































































3083
3084
3085
3086
3087
3088
3089
3090
	Tcl_SetObjResult(interp, objv[idx]);
    } else {
	Tcl_SetObjResult(interp, TclOOObjectName(interp, clsPtr->thisPtr));
    }

    return TCL_OK;
}











































































































































































































































































































































































































/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







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








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
	Tcl_SetObjResult(interp, objv[idx]);
    } else {
	Tcl_SetObjResult(interp, TclOOObjectName(interp, clsPtr->thisPtr));
    }

    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * ClassRPropsGet, ClassRPropsSet, ObjRPropsGet, ObjRPropsSet --
 *
 *	Implementations of the "readableproperties" slot accessors for classes
 *	and instances.
 *
 * ----------------------------------------------------------------------
 */

static void
InstallReadableProps(
    PropertyStorage *props,
    Tcl_Size objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *propObj;
    Tcl_Size i, n;
    int created;
    Tcl_HashTable uniqueTable;

    if (props->allReadableCache) {
	Tcl_DecrRefCount(props->allReadableCache);
	props->allReadableCache = NULL;
    }

    for (i=0 ; i<objc ; i++) {
	Tcl_IncrRefCount(objv[i]);
    }
    FOREACH(propObj, props->readable) {
	Tcl_DecrRefCount(propObj);
    }
    if (i != objc) {
	if (objc == 0) {
	    Tcl_Free(props->readable.list);
	} else if (i) {
	    props->readable.list = (Tcl_Obj **)Tcl_Realloc(props->readable.list,
		    sizeof(Tcl_Obj *) * objc);
	} else {
	    props->readable.list = (Tcl_Obj **)Tcl_Alloc(sizeof(Tcl_Obj *) * objc);
	}
    }
    props->readable.num = 0;
    if (objc > 0) {
	Tcl_InitObjHashTable(&uniqueTable);
	for (i=n=0 ; i<objc ; i++) {
	    Tcl_CreateHashEntry(&uniqueTable, objv[i], &created);
	    if (created) {
		props->readable.list[n++] = objv[i];
	    } else {
		Tcl_DecrRefCount(objv[i]);
	    }
	}
	props->readable.num = n;

	/*
	 * Shouldn't be necessary, but maintain num/list invariant.
	 */

	if (n != objc) {
	    props->readable.list = (Tcl_Obj **)Tcl_Realloc(props->readable.list,
		    sizeof(Tcl_Obj *) * n);
	}
	Tcl_DeleteHashTable(&uniqueTable);
    }
}

static int
ClassRPropsGet(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Obj *resultObj, *propNameObj;
    int i;

    if (Tcl_ObjectContextSkippedArgs(context) != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		NULL);
	return TCL_ERROR;
    }
    if (oPtr == NULL) {
	return TCL_ERROR;
    } else if (!oPtr->classPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to misuse API", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }

    TclNewObj(resultObj);
    FOREACH(propNameObj, oPtr->classPtr->properties.readable) {
	Tcl_ListObjAppendElement(NULL, resultObj, propNameObj);
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

static int
ClassRPropsSet(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Size varc;
    Tcl_Obj **varv;

    if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"filterList");
	return TCL_ERROR;
    }
    objv += Tcl_ObjectContextSkippedArgs(context);

    if (oPtr == NULL) {
	return TCL_ERROR;
    } else if (!oPtr->classPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to misuse API", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    } else if (Tcl_ListObjGetElements(interp, objv[0], &varc,
	    &varv) != TCL_OK) {
	return TCL_ERROR;
    }

    InstallReadableProps(&oPtr->classPtr->properties, varc, varv);
    BumpGlobalEpoch(interp, oPtr->classPtr);
    return TCL_OK;
}

static int
ObjRPropsGet(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Obj *resultObj, *propNameObj;
    int i;

    if (Tcl_ObjectContextSkippedArgs(context) != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		NULL);
	return TCL_ERROR;
    }
    if (oPtr == NULL) {
	return TCL_ERROR;
    }

    TclNewObj(resultObj);
    FOREACH(propNameObj, oPtr->properties.readable) {
	Tcl_ListObjAppendElement(NULL, resultObj, propNameObj);
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

static int
ObjRPropsSet(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Size varc;
    Tcl_Obj **varv;

    if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"filterList");
	return TCL_ERROR;
    }
    objv += Tcl_ObjectContextSkippedArgs(context);

    if (oPtr == NULL) {
	return TCL_ERROR;
    } else if (Tcl_ListObjGetElements(interp, objv[0], &varc,
	    &varv) != TCL_OK) {
	return TCL_ERROR;
    }

    InstallReadableProps(&oPtr->properties, varc, varv);
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * ClassWPropsGet, ClassWPropsSet, ObjWPropsGet, ObjWPropsSet --
 *
 *	Implementations of the "writableproperties" slot accessors for classes
 *	and instances.
 *
 * ----------------------------------------------------------------------
 */

static void
InstallWritableProps(
    PropertyStorage *props,
    Tcl_Size objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *propObj;
    Tcl_Size i, n;
    int created;
    Tcl_HashTable uniqueTable;

    if (props->allWritableCache) {
	Tcl_DecrRefCount(props->allWritableCache);
	props->allWritableCache = NULL;
    }

    for (i=0 ; i<objc ; i++) {
	Tcl_IncrRefCount(objv[i]);
    }
    FOREACH(propObj, props->writable) {
	Tcl_DecrRefCount(propObj);
    }
    if (i != objc) {
	if (objc == 0) {
	    Tcl_Free(props->writable.list);
	} else if (i) {
	    props->writable.list = (Tcl_Obj **)Tcl_Realloc(props->writable.list,
		    sizeof(Tcl_Obj *) * objc);
	} else {
	    props->writable.list = (Tcl_Obj **)Tcl_Alloc(sizeof(Tcl_Obj *) * objc);
	}
    }
    props->writable.num = 0;
    if (objc > 0) {
	Tcl_InitObjHashTable(&uniqueTable);
	for (i=n=0 ; i<objc ; i++) {
	    Tcl_CreateHashEntry(&uniqueTable, objv[i], &created);
	    if (created) {
		props->writable.list[n++] = objv[i];
	    } else {
		Tcl_DecrRefCount(objv[i]);
	    }
	}
	props->writable.num = n;

	/*
	 * Shouldn't be necessary, but maintain num/list invariant.
	 */

	if (n != objc) {
	    props->writable.list = (Tcl_Obj **)Tcl_Realloc(props->writable.list,
		    sizeof(Tcl_Obj *) * n);
	}
	Tcl_DeleteHashTable(&uniqueTable);
    }
}

static int
ClassWPropsGet(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Obj *resultObj, *propNameObj;
    int i;

    if (Tcl_ObjectContextSkippedArgs(context) != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		NULL);
	return TCL_ERROR;
    }
    if (oPtr == NULL) {
	return TCL_ERROR;
    } else if (!oPtr->classPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to misuse API", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }

    TclNewObj(resultObj);
    FOREACH(propNameObj, oPtr->classPtr->properties.writable) {
	Tcl_ListObjAppendElement(NULL, resultObj, propNameObj);
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

static int
ClassWPropsSet(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Size varc;
    Tcl_Obj **varv;

    if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"propertyList");
	return TCL_ERROR;
    }
    objv += Tcl_ObjectContextSkippedArgs(context);

    if (oPtr == NULL) {
	return TCL_ERROR;
    } else if (!oPtr->classPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to misuse API", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    } else if (Tcl_ListObjGetElements(interp, objv[0], &varc,
	    &varv) != TCL_OK) {
	return TCL_ERROR;
    }

    InstallWritableProps(&oPtr->classPtr->properties, varc, varv);
    BumpGlobalEpoch(interp, oPtr->classPtr);
    return TCL_OK;
}

static int
ObjWPropsGet(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Obj *resultObj, *propNameObj;
    int i;

    if (Tcl_ObjectContextSkippedArgs(context) != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		NULL);
	return TCL_ERROR;
    }
    if (oPtr == NULL) {
	return TCL_ERROR;
    }

    TclNewObj(resultObj);
    FOREACH(propNameObj, oPtr->properties.writable) {
	Tcl_ListObjAppendElement(NULL, resultObj, propNameObj);
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

static int
ObjWPropsSet(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Size varc;
    Tcl_Obj **varv;

    if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"propertyList");
	return TCL_ERROR;
    }
    objv += Tcl_ObjectContextSkippedArgs(context);

    if (oPtr == NULL) {
	return TCL_ERROR;
    } else if (Tcl_ListObjGetElements(interp, objv[0], &varc,
	    &varv) != TCL_OK) {
	return TCL_ERROR;
    }

    InstallWritableProps(&oPtr->properties, varc, varv);
    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclOOInfo.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
/*
 * tclOODefineCmds.c --
 *
 *	This file contains the implementation of the ::oo-related [info]
 *	subcommands.
 *
 * Copyright © 2006-2011 Donal K. Fellows
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include "tclInt.h"
#include "tclOOInt.h"

static inline Class *	GetClassFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr);

static Tcl_ObjCmdProc InfoObjectCallCmd;
static Tcl_ObjCmdProc InfoObjectClassCmd;
static Tcl_ObjCmdProc InfoObjectDefnCmd;
static Tcl_ObjCmdProc InfoObjectFiltersCmd;
static Tcl_ObjCmdProc InfoObjectForwardCmd;
static Tcl_ObjCmdProc InfoObjectIdCmd;
static Tcl_ObjCmdProc InfoObjectIsACmd;
static Tcl_ObjCmdProc InfoObjectMethodsCmd;
static Tcl_ObjCmdProc InfoObjectMethodTypeCmd;
static Tcl_ObjCmdProc InfoObjectMixinsCmd;
static Tcl_ObjCmdProc InfoObjectNsCmd;

static Tcl_ObjCmdProc InfoObjectVarsCmd;
static Tcl_ObjCmdProc InfoObjectVariablesCmd;
static Tcl_ObjCmdProc InfoClassCallCmd;
static Tcl_ObjCmdProc InfoClassConstrCmd;
static Tcl_ObjCmdProc InfoClassDefnCmd;
static Tcl_ObjCmdProc InfoClassDefnNsCmd;
static Tcl_ObjCmdProc InfoClassDestrCmd;
static Tcl_ObjCmdProc InfoClassFiltersCmd;
static Tcl_ObjCmdProc InfoClassForwardCmd;
static Tcl_ObjCmdProc InfoClassInstancesCmd;
static Tcl_ObjCmdProc InfoClassMethodsCmd;
static Tcl_ObjCmdProc InfoClassMethodTypeCmd;
static Tcl_ObjCmdProc InfoClassMixinsCmd;

static Tcl_ObjCmdProc InfoClassSubsCmd;
static Tcl_ObjCmdProc InfoClassSupersCmd;
static Tcl_ObjCmdProc InfoClassVariablesCmd;

/*
 * List of commands that are used to implement the [info object] subcommands.
 */

static const EnsembleImplMap infoObjectCmds[] = {
    {"call",	   InfoObjectCallCmd,	    TclCompileBasic2ArgCmd, NULL, NULL, 0},
    {"class",	   InfoObjectClassCmd,	    TclCompileInfoObjectClassCmd, NULL, NULL, 0},
    {"creationid", InfoObjectIdCmd,	    TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"definition", InfoObjectDefnCmd,	    TclCompileBasic2ArgCmd, NULL, NULL, 0},
    {"filters",	   InfoObjectFiltersCmd,    TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"forward",	   InfoObjectForwardCmd,    TclCompileBasic2ArgCmd, NULL, NULL, 0},
    {"isa",	   InfoObjectIsACmd,	    TclCompileInfoObjectIsACmd, NULL, NULL, 0},
    {"methods",	   InfoObjectMethodsCmd,    TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
    {"methodtype", InfoObjectMethodTypeCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
    {"mixins",	   InfoObjectMixinsCmd,	    TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"namespace",  InfoObjectNsCmd,	    TclCompileInfoObjectNamespaceCmd, NULL, NULL, 0},

    {"variables",  InfoObjectVariablesCmd,  TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
    {"vars",	   InfoObjectVarsCmd,	    TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
    {NULL, NULL, NULL, NULL, NULL, 0}
};

/*
 * List of commands that are used to implement the [info class] subcommands.






|












>











>













>




















>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
/*
 * tclOODefineCmds.c --
 *
 *	This file contains the implementation of the ::oo-related [info]
 *	subcommands.
 *
 * Copyright © 2006-2019 Donal K. Fellows
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include "tclInt.h"
#include "tclOOInt.h"

static inline Class *	GetClassFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void		SortPropList(Tcl_Obj *list);
static Tcl_ObjCmdProc InfoObjectCallCmd;
static Tcl_ObjCmdProc InfoObjectClassCmd;
static Tcl_ObjCmdProc InfoObjectDefnCmd;
static Tcl_ObjCmdProc InfoObjectFiltersCmd;
static Tcl_ObjCmdProc InfoObjectForwardCmd;
static Tcl_ObjCmdProc InfoObjectIdCmd;
static Tcl_ObjCmdProc InfoObjectIsACmd;
static Tcl_ObjCmdProc InfoObjectMethodsCmd;
static Tcl_ObjCmdProc InfoObjectMethodTypeCmd;
static Tcl_ObjCmdProc InfoObjectMixinsCmd;
static Tcl_ObjCmdProc InfoObjectNsCmd;
static Tcl_ObjCmdProc InfoObjectPropCmd;
static Tcl_ObjCmdProc InfoObjectVarsCmd;
static Tcl_ObjCmdProc InfoObjectVariablesCmd;
static Tcl_ObjCmdProc InfoClassCallCmd;
static Tcl_ObjCmdProc InfoClassConstrCmd;
static Tcl_ObjCmdProc InfoClassDefnCmd;
static Tcl_ObjCmdProc InfoClassDefnNsCmd;
static Tcl_ObjCmdProc InfoClassDestrCmd;
static Tcl_ObjCmdProc InfoClassFiltersCmd;
static Tcl_ObjCmdProc InfoClassForwardCmd;
static Tcl_ObjCmdProc InfoClassInstancesCmd;
static Tcl_ObjCmdProc InfoClassMethodsCmd;
static Tcl_ObjCmdProc InfoClassMethodTypeCmd;
static Tcl_ObjCmdProc InfoClassMixinsCmd;
static Tcl_ObjCmdProc InfoClassPropCmd;
static Tcl_ObjCmdProc InfoClassSubsCmd;
static Tcl_ObjCmdProc InfoClassSupersCmd;
static Tcl_ObjCmdProc InfoClassVariablesCmd;

/*
 * List of commands that are used to implement the [info object] subcommands.
 */

static const EnsembleImplMap infoObjectCmds[] = {
    {"call",	   InfoObjectCallCmd,	    TclCompileBasic2ArgCmd, NULL, NULL, 0},
    {"class",	   InfoObjectClassCmd,	    TclCompileInfoObjectClassCmd, NULL, NULL, 0},
    {"creationid", InfoObjectIdCmd,	    TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"definition", InfoObjectDefnCmd,	    TclCompileBasic2ArgCmd, NULL, NULL, 0},
    {"filters",	   InfoObjectFiltersCmd,    TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"forward",	   InfoObjectForwardCmd,    TclCompileBasic2ArgCmd, NULL, NULL, 0},
    {"isa",	   InfoObjectIsACmd,	    TclCompileInfoObjectIsACmd, NULL, NULL, 0},
    {"methods",	   InfoObjectMethodsCmd,    TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
    {"methodtype", InfoObjectMethodTypeCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
    {"mixins",	   InfoObjectMixinsCmd,	    TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"namespace",  InfoObjectNsCmd,	    TclCompileInfoObjectNamespaceCmd, NULL, NULL, 0},
    {"properties", InfoObjectPropCmd,	    TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
    {"variables",  InfoObjectVariablesCmd,  TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
    {"vars",	   InfoObjectVarsCmd,	    TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
    {NULL, NULL, NULL, NULL, NULL, 0}
};

/*
 * List of commands that are used to implement the [info class] subcommands.
78
79
80
81
82
83
84

85
86
87
88
89
90
91
    {"destructor",   InfoClassDestrCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"filters",	     InfoClassFiltersCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"forward",	     InfoClassForwardCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
    {"instances",    InfoClassInstancesCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
    {"methods",	     InfoClassMethodsCmd,	TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
    {"methodtype",   InfoClassMethodTypeCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
    {"mixins",	     InfoClassMixinsCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},

    {"subclasses",   InfoClassSubsCmd,		TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
    {"superclasses", InfoClassSupersCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"variables",    InfoClassVariablesCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
    {NULL, NULL, NULL, NULL, NULL, 0}
};

/*







>







82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
    {"destructor",   InfoClassDestrCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"filters",	     InfoClassFiltersCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"forward",	     InfoClassForwardCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
    {"instances",    InfoClassInstancesCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
    {"methods",	     InfoClassMethodsCmd,	TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
    {"methodtype",   InfoClassMethodTypeCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
    {"mixins",	     InfoClassMixinsCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"properties",   InfoClassPropCmd,		TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
    {"subclasses",   InfoClassSubsCmd,		TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
    {"superclasses", InfoClassSupersCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"variables",    InfoClassVariablesCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
    {NULL, NULL, NULL, NULL, NULL, 0}
};

/*
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204

    if (objc == 2) {
	Tcl_SetObjResult(interp,
		TclOOObjectName(interp, oPtr->selfCls->thisPtr));
	return TCL_OK;
    } else {
	Class *mixinPtr, *o2clsPtr;
	size_t i;

	o2clsPtr = GetClassFromObj(interp, objv[2]);
	if (o2clsPtr == NULL) {
	    return TCL_ERROR;
	}

	FOREACH(mixinPtr, oPtr->mixins) {







|







195
196
197
198
199
200
201
202
203
204
205
206
207
208
209

    if (objc == 2) {
	Tcl_SetObjResult(interp,
		TclOOObjectName(interp, oPtr->selfCls->thisPtr));
	return TCL_OK;
    } else {
	Class *mixinPtr, *o2clsPtr;
	Tcl_Size i;

	o2clsPtr = GetClassFromObj(interp, objv[2]);
	if (o2clsPtr == NULL) {
	    return TCL_ERROR;
	}

	FOREACH(mixinPtr, oPtr->mixins) {
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
static int
InfoObjectFiltersCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    size_t i;
    Tcl_Obj *filterObj, *resultObj;
    Object *oPtr;

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







|







308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
static int
InfoObjectFiltersCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Size i;
    Tcl_Obj *filterObj, *resultObj;
    Object *oPtr;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "objName");
	return TCL_ERROR;
    }
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
	"class", "metaclass", "mixin", "object", "typeof", NULL
    };
    enum IsACats {
	IsClass, IsMetaclass, IsMixin, IsObject, IsType
    } idx;
    Object *oPtr, *o2Ptr;
    int result = 0;
    size_t i;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "category objName ?arg ...?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], categories, "category", 0,
	    &idx) != TCL_OK) {







|







412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
	"class", "metaclass", "mixin", "object", "typeof", NULL
    };
    enum IsACats {
	IsClass, IsMetaclass, IsMixin, IsObject, IsType
    } idx;
    Object *oPtr, *o2Ptr;
    int result = 0;
    Tcl_Size i;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "category objName ?arg ...?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], categories, "category", 0,
	    &idx) != TCL_OK) {
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Class *mixinPtr;
    Object *oPtr;
    Tcl_Obj *resultObj;
    size_t i;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "objName");
	return TCL_ERROR;
    }
    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
    if (oPtr == NULL) {







|







704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Class *mixinPtr;
    Object *oPtr;
    Tcl_Obj *resultObj;
    Tcl_Size i;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "objName");
	return TCL_ERROR;
    }
    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
    if (oPtr == NULL) {
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Object *oPtr;
    Tcl_Obj *resultObj;
    size_t i;
    int isPrivate = 0;

    if (objc != 2 && objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "objName ?-private?");
	return TCL_ERROR;
    }
    if (objc == 3) {







|







811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Object *oPtr;
    Tcl_Obj *resultObj;
    Tcl_Size i;
    int isPrivate = 0;

    if (objc != 2 && objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "objName ?-private?");
	return TCL_ERROR;
    }
    if (objc == 3) {
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
static int
InfoClassFiltersCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    size_t i;
    Tcl_Obj *filterObj, *resultObj;
    Class *clsPtr;

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







|







1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
static int
InfoClassFiltersCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Size i;
    Tcl_Obj *filterObj, *resultObj;
    Class *clsPtr;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "className");
	return TCL_ERROR;
    }
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Object *oPtr;
    Class *clsPtr;
    size_t i;
    const char *pattern = NULL;
    Tcl_Obj *resultObj;

    if (objc != 2 && objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "className ?pattern?");
	return TCL_ERROR;
    }







|







1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Object *oPtr;
    Class *clsPtr;
    Tcl_Size i;
    const char *pattern = NULL;
    Tcl_Obj *resultObj;

    if (objc != 2 && objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "className ?pattern?");
	return TCL_ERROR;
    }
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
	    break;
	}
    }

    TclNewObj(resultObj);
    if (recurse) {
	const char **names;
	size_t i, numNames = TclOOGetSortedClassMethodList(clsPtr, flag, &names);

	for (i=0 ; i<numNames ; i++) {
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    Tcl_NewStringObj(names[i], -1));
	}
	if (numNames > 0) {
	    Tcl_Free((void *)names);







|







1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
	    break;
	}
    }

    TclNewObj(resultObj);
    if (recurse) {
	const char **names;
	Tcl_Size i, numNames = TclOOGetSortedClassMethodList(clsPtr, flag, &names);

	for (i=0 ; i<numNames ; i++) {
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    Tcl_NewStringObj(names[i], -1));
	}
	if (numNames > 0) {
	    Tcl_Free((void *)names);
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Class *clsPtr, *mixinPtr;
    Tcl_Obj *resultObj;
    size_t i;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "className");
	return TCL_ERROR;
    }
    clsPtr = GetClassFromObj(interp, objv[1]);
    if (clsPtr == NULL) {







|







1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Class *clsPtr, *mixinPtr;
    Tcl_Obj *resultObj;
    Tcl_Size i;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "className");
	return TCL_ERROR;
    }
    clsPtr = GetClassFromObj(interp, objv[1]);
    if (clsPtr == NULL) {
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Class *clsPtr, *subclassPtr;
    Tcl_Obj *resultObj;
    size_t i;
    const char *pattern = NULL;

    if (objc != 2 && objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "className ?pattern?");
	return TCL_ERROR;
    }
    clsPtr = GetClassFromObj(interp, objv[1]);







|







1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Class *clsPtr, *subclassPtr;
    Tcl_Obj *resultObj;
    Tcl_Size i;
    const char *pattern = NULL;

    if (objc != 2 && objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "className ?pattern?");
	return TCL_ERROR;
    }
    clsPtr = GetClassFromObj(interp, objv[1]);
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Class *clsPtr, *superPtr;
    Tcl_Obj *resultObj;
    size_t i;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "className");
	return TCL_ERROR;
    }
    clsPtr = GetClassFromObj(interp, objv[1]);
    if (clsPtr == NULL) {







|







1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Class *clsPtr, *superPtr;
    Tcl_Obj *resultObj;
    Tcl_Size i;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "className");
	return TCL_ERROR;
    }
    clsPtr = GetClassFromObj(interp, objv[1]);
    if (clsPtr == NULL) {
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Class *clsPtr;
    Tcl_Obj *resultObj;
    size_t i;
    int isPrivate = 0;

    if (objc != 2 && objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "className ?-private?");
	return TCL_ERROR;
    }
    if (objc == 3) {







|







1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Class *clsPtr;
    Tcl_Obj *resultObj;
    Tcl_Size i;
    int isPrivate = 0;

    if (objc != 2 && objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "className ?-private?");
	return TCL_ERROR;
    }
    if (objc == 3) {
1711
1712
1713
1714
1715
1716
1717


















































































































































































1718
1719
1720
1721
1722
1723
1724
1725
		"cannot construct any call chain", -1));
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, TclOORenderCallChain(interp, callPtr));
    TclOODeleteChain(callPtr);
    return TCL_OK;
}



















































































































































































/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







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








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
		"cannot construct any call chain", -1));
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, TclOORenderCallChain(interp, callPtr));
    TclOODeleteChain(callPtr);
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * InfoClassPropCmd, InfoObjectPropCmd --
 *
 *	Implements [info class properties $clsName ?$option...?] and
 *	[info object properties $objName ?$option...?]
 *
 * ----------------------------------------------------------------------
 */

enum PropOpt {
    PROP_ALL, PROP_READABLE, PROP_WRITABLE
};
static const char *const propOptNames[] = {
    "-all", "-readable", "-writable",
    NULL
};

static int
InfoClassPropCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Class *clsPtr;
    int i, idx, all = 0, writable = 0, allocated = 0;
    Tcl_Obj *result, *propObj;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "className ?options...?");
	return TCL_ERROR;
    }
    clsPtr = GetClassFromObj(interp, objv[1]);
    if (clsPtr == NULL) {
	return TCL_ERROR;
    }
    for (i = 2; i < objc; i++) {
	if (Tcl_GetIndexFromObj(interp, objv[i], propOptNames, "option", 0,
		&idx) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (idx) {
	case PROP_ALL:
	    all = 1;
	    break;
	case PROP_READABLE:
	    writable = 0;
	    break;
	case PROP_WRITABLE:
	    writable = 1;
	    break;
	}
    }

    /*
     * Get the properties.
     */

    if (all) {
	result = TclOOGetAllClassProperties(clsPtr, writable, &allocated);
	if (allocated) {
	    SortPropList(result);
	}
    } else {
	TclNewObj(result);
	if (writable) {
	    FOREACH(propObj, clsPtr->properties.writable) {
		Tcl_ListObjAppendElement(NULL, result, propObj);
	    }
	} else {
	    FOREACH(propObj, clsPtr->properties.readable) {
		Tcl_ListObjAppendElement(NULL, result, propObj);
	    }
	}
	SortPropList(result);
    }
    Tcl_SetObjResult(interp, result);
    return TCL_OK;
}

static int
InfoObjectPropCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Object *oPtr;
    int i, idx, all = 0, writable = 0, allocated = 0;
    Tcl_Obj *result, *propObj;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "objName ?options...?");
	return TCL_ERROR;
    }
    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    for (i = 2; i < objc; i++) {
	if (Tcl_GetIndexFromObj(interp, objv[i], propOptNames, "option", 0,
		&idx) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (idx) {
	case PROP_ALL:
	    all = 1;
	    break;
	case PROP_READABLE:
	    writable = 0;
	    break;
	case PROP_WRITABLE:
	    writable = 1;
	    break;
	}
    }

    /*
     * Get the properties.
     */

    if (all) {
	result = TclOOGetAllObjectProperties(oPtr, writable, &allocated);
	if (allocated) {
	    SortPropList(result);
	}
    } else {
	TclNewObj(result);
	if (writable) {
	    FOREACH(propObj, oPtr->properties.writable) {
		Tcl_ListObjAppendElement(NULL, result, propObj);
	    }
	} else {
	    FOREACH(propObj, oPtr->properties.readable) {
		Tcl_ListObjAppendElement(NULL, result, propObj);
	    }
	}
	SortPropList(result);
    }
    Tcl_SetObjResult(interp, result);
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * SortPropList --
 *	Sort a list of names of properties. Simple support function. Assumes
 *	that the list Tcl_Obj is unshared and doesn't have a string
 *	representation.
 *
 * ----------------------------------------------------------------------
 */

static int
PropNameCompare(
    const void *a,
    const void *b)
{
    Tcl_Obj *first = *(Tcl_Obj **) a;
    Tcl_Obj *second = *(Tcl_Obj **) b;

    return strcmp(Tcl_GetString(first), Tcl_GetString(second));
}

static void
SortPropList(
    Tcl_Obj *list)
{
    Tcl_Size ec;
    Tcl_Obj **ev;

    Tcl_ListObjGetElements(NULL, list, &ec, &ev);
    qsort(ev, ec, sizeof(Tcl_Obj *), PropNameCompare);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclOOInt.h.

42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
 */

typedef struct Method {
    const Tcl_MethodType *typePtr;
				/* The type of method. If NULL, this is a
				 * special flag record which is just used for
				 * the setting of the flags field. */
    size_t refCount;
    void *clientData;	/* Type-specific data. */
    Tcl_Obj *namePtr;		/* Name of the method. */
    struct Object *declaringObjectPtr;
				/* The object that declares this method, or
				 * NULL if it was declared by a class. */
    struct Class *declaringClassPtr;
				/* The class that declares this method, or







|







42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
 */

typedef struct Method {
    const Tcl_MethodType *typePtr;
				/* The type of method. If NULL, this is a
				 * special flag record which is just used for
				 * the setting of the flags field. */
    Tcl_Size refCount;
    void *clientData;	/* Type-specific data. */
    Tcl_Obj *namePtr;		/* Name of the method. */
    struct Object *declaringObjectPtr;
				/* The object that declares this method, or
				 * NULL if it was declared by a class. */
    struct Class *declaringClassPtr;
				/* The class that declares this method, or
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
typedef struct ProcedureMethod {
    int version;		/* Version of this structure. Currently must
				 * be 0. */
    Proc *procPtr;		/* Core of the implementation of the method;
				 * includes the argument definition and the
				 * body bytecodes. */
    int flags;			/* Flags to control features. */
    size_t refCount;
    void *clientData;
    TclOO_PmCDDeleteProc *deleteClientdataProc;
    TclOO_PmCDCloneProc *cloneClientdataProc;
    ProcErrorProc *errProc;	/* Replacement error handler. */
    TclOO_PreCallProc *preCallProc;
				/* Callback to allow for additional setup
				 * before the method executes. */







|







79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
typedef struct ProcedureMethod {
    int version;		/* Version of this structure. Currently must
				 * be 0. */
    Proc *procPtr;		/* Core of the implementation of the method;
				 * includes the argument definition and the
				 * body bytecodes. */
    int flags;			/* Flags to control features. */
    Tcl_Size refCount;
    void *clientData;
    TclOO_PmCDDeleteProc *deleteClientdataProc;
    TclOO_PmCDCloneProc *cloneClientdataProc;
    ProcErrorProc *errProc;	/* Replacement error handler. */
    TclOO_PreCallProc *preCallProc;
				/* Callback to allow for additional setup
				 * before the method executes. */
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
 *
 * The "num" field always counts the number of listType_t elements used in the
 * "list" field. When a "size" field exists, it describes how many elements
 * are present in the list; when absent, exactly "num" elements are present.
 */

#define LIST_STATIC(listType_t) \
    struct { size_t num; listType_t *list; }
#define LIST_DYNAMIC(listType_t) \
    struct { size_t num, size; listType_t *list; }

/*
 * These types are needed in function arguments.
 */

typedef LIST_STATIC(Tcl_Obj *) VariableNameList;
typedef LIST_STATIC(PrivateVariableMapping) PrivateVariableList;





















/*
 * Now, the definition of what an object actually is.
 */

typedef struct Object {
    struct Foundation *fPtr;	/* The basis for the object system. Putting
				 * this here allows the avoidance of quite a







|

|








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







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
 *
 * The "num" field always counts the number of listType_t elements used in the
 * "list" field. When a "size" field exists, it describes how many elements
 * are present in the list; when absent, exactly "num" elements are present.
 */

#define LIST_STATIC(listType_t) \
    struct { Tcl_Size num; listType_t *list; }
#define LIST_DYNAMIC(listType_t) \
    struct { Tcl_Size num, size; listType_t *list; }

/*
 * These types are needed in function arguments.
 */

typedef LIST_STATIC(Tcl_Obj *) VariableNameList;
typedef LIST_STATIC(PrivateVariableMapping) PrivateVariableList;

/*
 * This type is used in various places.
 */

typedef struct {
    LIST_STATIC(Tcl_Obj *) readable;
				/* The readable properties slot. */
    LIST_STATIC(Tcl_Obj *) writable;
				/* The writable properties slot. */
    Tcl_Obj *allReadableCache;	/* The cache of all readable properties
				 * exposed by this object or class (in its
				 * stereotypical instancs). Contains a sorted
				 * unique list if not NULL. */
    Tcl_Obj *allWritableCache;	/* The cache of all writable properties
				 * exposed by this object or class (in its
				 * stereotypical instances). Contains a sorted
				 * unique list if not NULL. */
    int epoch;			/* The epoch that the caches are valid for. */
} PropertyStorage;

/*
 * Now, the definition of what an object actually is.
 */

typedef struct Object {
    struct Foundation *fPtr;	/* The basis for the object system. Putting
				 * this here allows the avoidance of quite a
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
    Tcl_HashTable *methodsPtr;	/* Object-local Tcl_Obj (method name) to
				 * Method* mapping. */
    LIST_STATIC(struct Class *) mixins;
				/* Classes mixed into this object. */
    LIST_STATIC(Tcl_Obj *) filters;
				/* List of filter names. */
    struct Class *classPtr;	/* This is non-NULL for all classes, and NULL
				 *  for everything else. It points to the class
				 *  structure. */
    size_t refCount;		/* Number of strong references to this object.
				 * Note that there may be many more weak
				 * references; this mechanism exists to
				 * avoid Tcl_Preserve. */
    int flags;
    size_t creationEpoch;		/* Unique value to make comparisons of objects
				 * easier. */
    size_t epoch;			/* Per-object epoch, incremented when the way
				 * an object should resolve call chains is
				 * changed. */
    Tcl_HashTable *metadataPtr;	/* Mapping from pointers to metadata type to
				 * the void *values that are the values
				 * of each piece of attached metadata. This
				 * field starts out as NULL and is only
				 * allocated if metadata is attached. */
    Tcl_Obj *cachedNameObj;	/* Cache of the name of the object. */
    Tcl_HashTable *chainCache;	/* Place to keep unused contexts. This table
				 * is indexed by method name as Tcl_Obj. */
    Tcl_ObjectMapMethodNameProc *mapMethodNameProc;
				/* Function to allow remapping of method
				 * names. For itcl-ng. */
    VariableNameList variables;
    PrivateVariableList privateVariables;
				/* Configurations for the variable resolver
				 * used inside methods. */
    Tcl_Command myclassCommand;	/* Reference to this object's class dispatcher
				 * command. */



} Object;

#define OBJECT_DESTRUCTING	1	/* Indicates that an object is being or has
								 *  been destroyed  */
#define DESTRUCTOR_CALLED 2	/* Indicates that evaluation of destructor script for the
							   object has began */
#define OO_UNUSED_4	4	/* No longer used.  */
#define ROOT_OBJECT 0x1000	/* Flag to say that this object is the root of
				 * the class hierarchy and should be treated
				 * specially during teardown. */
#define FILTER_HANDLING 0x2000	/* Flag set when the object is processing a
				 * filter; when set, filters are *not*
				 * processed on the object, preventing nasty







|
|
|




|

|



















>
>
>


|
|
|
|







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
    Tcl_HashTable *methodsPtr;	/* Object-local Tcl_Obj (method name) to
				 * Method* mapping. */
    LIST_STATIC(struct Class *) mixins;
				/* Classes mixed into this object. */
    LIST_STATIC(Tcl_Obj *) filters;
				/* List of filter names. */
    struct Class *classPtr;	/* This is non-NULL for all classes, and NULL
				 * for everything else. It points to the class
				 * structure. */
    Tcl_Size refCount;		/* Number of strong references to this object.
				 * Note that there may be many more weak
				 * references; this mechanism exists to
				 * avoid Tcl_Preserve. */
    int flags;
    Tcl_Size creationEpoch;		/* Unique value to make comparisons of objects
				 * easier. */
    Tcl_Size epoch;			/* Per-object epoch, incremented when the way
				 * an object should resolve call chains is
				 * changed. */
    Tcl_HashTable *metadataPtr;	/* Mapping from pointers to metadata type to
				 * the void *values that are the values
				 * of each piece of attached metadata. This
				 * field starts out as NULL and is only
				 * allocated if metadata is attached. */
    Tcl_Obj *cachedNameObj;	/* Cache of the name of the object. */
    Tcl_HashTable *chainCache;	/* Place to keep unused contexts. This table
				 * is indexed by method name as Tcl_Obj. */
    Tcl_ObjectMapMethodNameProc *mapMethodNameProc;
				/* Function to allow remapping of method
				 * names. For itcl-ng. */
    VariableNameList variables;
    PrivateVariableList privateVariables;
				/* Configurations for the variable resolver
				 * used inside methods. */
    Tcl_Command myclassCommand;	/* Reference to this object's class dispatcher
				 * command. */
    PropertyStorage properties;	/* Information relating to the lists of
				 * properties that this object *claims* to
				 * support. */
} Object;

#define OBJECT_DESTRUCTING 1	/* Indicates that an object is being or has
				 *  been destroyed  */
#define DESTRUCTOR_CALLED 2	/* Indicates that evaluation of destructor
				 * script for the object has began */
#define OO_UNUSED_4	4	/* No longer used.  */
#define ROOT_OBJECT 0x1000	/* Flag to say that this object is the root of
				 * the class hierarchy and should be treated
				 * specially during teardown. */
#define FILTER_HANDLING 0x2000	/* Flag set when the object is processing a
				 * filter; when set, filters are *not*
				 * processed on the object, preventing nasty
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
				 * class in when those instances are defined
				 * as instances. If NULL, use the value from
				 * the class hierarchy. It's an error at
				 * [oo::objdefine]/[self] call time if this
				 * namespace is defined but doesn't exist; we
				 * also check at setting time but don't check
				 * between times. */



} Class;

/*
 * The foundation of the object system within an interpreter contains
 * references to the key classes and namespaces, together with a few other
 * useful bits and pieces. Probably ought to eventually go in the Interp
 * structure itself.
 */

typedef struct ThreadLocalData {
    size_t nsCount;		/* Epoch counter is used for keeping
				 * the values used in Tcl_Obj internal
				 * representations sane. Must be thread-local
				 * because Tcl_Objs can cross interpreter
				 * boundaries within a thread (objects don't
				 * generally cross threads). */
} ThreadLocalData;








>
>
>










|







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
				 * class in when those instances are defined
				 * as instances. If NULL, use the value from
				 * the class hierarchy. It's an error at
				 * [oo::objdefine]/[self] call time if this
				 * namespace is defined but doesn't exist; we
				 * also check at setting time but don't check
				 * between times. */
    PropertyStorage properties;	/* Information relating to the lists of
				 * properties that this class *claims* to
				 * support. */
} Class;

/*
 * The foundation of the object system within an interpreter contains
 * references to the key classes and namespaces, together with a few other
 * useful bits and pieces. Probably ought to eventually go in the Interp
 * structure itself.
 */

typedef struct ThreadLocalData {
    Tcl_Size nsCount;		/* Epoch counter is used for keeping
				 * the values used in Tcl_Obj internal
				 * representations sane. Must be thread-local
				 * because Tcl_Objs can cross interpreter
				 * boundaries within a thread (objects don't
				 * generally cross threads). */
} ThreadLocalData;

349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
    Tcl_Namespace *objdefNs;	/* Namespace containing special commands for
				 * manipulating objects and classes. The
				 * "oo::objdefine" command acts as a special
				 * kind of ensemble for this namespace. */
    Tcl_Namespace *helpersNs;	/* Namespace containing the commands that are
				 * only valid when executing inside a
				 * procedural method. */
    size_t epoch;			/* Used to invalidate method chains when the
				 * class structure changes. */
    ThreadLocalData *tsdPtr;	/* Counter so we can allocate a unique
				 * namespace to each object. */
    Tcl_Obj *unknownMethodNameObj;
				/* Shared object containing the name of the
				 * unknown method handler method. */
    Tcl_Obj *constructorName;	/* Shared object containing the "name" of a







|







375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
    Tcl_Namespace *objdefNs;	/* Namespace containing special commands for
				 * manipulating objects and classes. The
				 * "oo::objdefine" command acts as a special
				 * kind of ensemble for this namespace. */
    Tcl_Namespace *helpersNs;	/* Namespace containing the commands that are
				 * only valid when executing inside a
				 * procedural method. */
    Tcl_Size epoch;		/* Used to invalidate method chains when the
				 * class structure changes. */
    ThreadLocalData *tsdPtr;	/* Counter so we can allocate a unique
				 * namespace to each object. */
    Tcl_Obj *unknownMethodNameObj;
				/* Shared object containing the name of the
				 * unknown method handler method. */
    Tcl_Obj *constructorName;	/* Shared object containing the "name" of a
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
				 * record. */
    int isFilter;		/* Whether this is a filter invocation. */
    Class *filterDeclarer;	/* What class decided to add the filter; if
				 * NULL, it was added by the object. */
};

typedef struct CallChain {
    size_t objectCreationEpoch;	/* The object's creation epoch. Note that the
				 * object reference is not stored in the call
				 * chain; it is in the call context. */
    size_t objectEpoch;		/* Local (object structure) epoch counter
				 * snapshot. */
    size_t epoch;			/* Global (class structure) epoch counter
				 * snapshot. */
    int flags;			/* Assorted flags, see below. */
    size_t refCount;		/* Reference count. */
    size_t numChain;		/* Size of the call chain. */
    struct MInvoke *chain;	/* Array of call chain entries. May point to
				 * staticChain if the number of entries is
				 * small. */
    struct MInvoke staticChain[CALL_CHAIN_STATIC_SIZE];
} CallChain;

typedef struct CallContext {
    Object *oPtr;		/* The object associated with this call. */
    size_t index;			/* Index into the call chain of the currently
				 * executing method implementation. */
    size_t skip;			/* Current number of arguments to skip; can
				 * vary depending on whether it is a direct
				 * method call or a continuation via the
				 * [next] command. */
    CallChain *callPtr;		/* The actual call chain. */
} CallContext;

/*







|


|

|


|
|








|

|







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
				 * record. */
    int isFilter;		/* Whether this is a filter invocation. */
    Class *filterDeclarer;	/* What class decided to add the filter; if
				 * NULL, it was added by the object. */
};

typedef struct CallChain {
    Tcl_Size objectCreationEpoch;/* The object's creation epoch. Note that the
				 * object reference is not stored in the call
				 * chain; it is in the call context. */
    Tcl_Size objectEpoch;	/* Local (object structure) epoch counter
				 * snapshot. */
    Tcl_Size epoch;		/* Global (class structure) epoch counter
				 * snapshot. */
    int flags;			/* Assorted flags, see below. */
    Tcl_Size refCount;		/* Reference count. */
    Tcl_Size numChain;		/* Size of the call chain. */
    struct MInvoke *chain;	/* Array of call chain entries. May point to
				 * staticChain if the number of entries is
				 * small. */
    struct MInvoke staticChain[CALL_CHAIN_STATIC_SIZE];
} CallChain;

typedef struct CallContext {
    Object *oPtr;		/* The object associated with this call. */
    Tcl_Size index;		/* Index into the call chain of the currently
				 * executing method implementation. */
    Tcl_Size skip;		/* Current number of arguments to skip; can
				 * vary depending on whether it is a direct
				 * method call or a continuation via the
				 * [next] command. */
    CallChain *callPtr;		/* The actual call chain. */
} CallContext;

/*
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
                        void *clientData);
MODULE_SCOPE Tcl_Method TclNewMethod(Tcl_Interp *interp, Tcl_Class cls,
                        Tcl_Obj *nameObj, int flags,
                        const Tcl_MethodType *typePtr,
                        void *clientData);
MODULE_SCOPE int	TclNRNewObjectInstance(Tcl_Interp *interp,
			    Tcl_Class cls, const char *nameStr,
			    const char *nsNameStr, size_t objc,
			    Tcl_Obj *const *objv, size_t skip,
			    Tcl_Object *objectPtr);
MODULE_SCOPE Object *	TclNewObjectInstanceCommon(Tcl_Interp *interp,
			    Class *classPtr,
			    const char *nameStr,
			    const char *nsNameStr);
MODULE_SCOPE int	TclOODecrRefCount(Object *oPtr);
MODULE_SCOPE int	TclOOObjectDestroyed(Object *oPtr);
MODULE_SCOPE int	TclOODefineSlots(Foundation *fPtr);
MODULE_SCOPE void	TclOODeleteChain(CallChain *callPtr);
MODULE_SCOPE void	TclOODeleteChainCache(Tcl_HashTable *tablePtr);
MODULE_SCOPE void	TclOODeleteContext(CallContext *contextPtr);
MODULE_SCOPE void	TclOODeleteDescendants(Tcl_Interp *interp,
			    Object *oPtr);
MODULE_SCOPE void	TclOODelMethodRef(Method *method);




MODULE_SCOPE CallContext *TclOOGetCallContext(Object *oPtr,
			    Tcl_Obj *methodNameObj, int flags,
			    Object *contextObjPtr, Class *contextClsPtr,
			    Tcl_Obj *cacheInThisObj);
MODULE_SCOPE Tcl_Namespace *TclOOGetDefineContextNamespace(
			    Tcl_Interp *interp, Object *oPtr, int forClass);
MODULE_SCOPE CallChain *TclOOGetStereotypeCallChain(Class *clsPtr,







|
|














>
>
>
>







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
                        void *clientData);
MODULE_SCOPE Tcl_Method TclNewMethod(Tcl_Interp *interp, Tcl_Class cls,
                        Tcl_Obj *nameObj, int flags,
                        const Tcl_MethodType *typePtr,
                        void *clientData);
MODULE_SCOPE int	TclNRNewObjectInstance(Tcl_Interp *interp,
			    Tcl_Class cls, const char *nameStr,
			    const char *nsNameStr, Tcl_Size objc,
			    Tcl_Obj *const *objv, Tcl_Size skip,
			    Tcl_Object *objectPtr);
MODULE_SCOPE Object *	TclNewObjectInstanceCommon(Tcl_Interp *interp,
			    Class *classPtr,
			    const char *nameStr,
			    const char *nsNameStr);
MODULE_SCOPE int	TclOODecrRefCount(Object *oPtr);
MODULE_SCOPE int	TclOOObjectDestroyed(Object *oPtr);
MODULE_SCOPE int	TclOODefineSlots(Foundation *fPtr);
MODULE_SCOPE void	TclOODeleteChain(CallChain *callPtr);
MODULE_SCOPE void	TclOODeleteChainCache(Tcl_HashTable *tablePtr);
MODULE_SCOPE void	TclOODeleteContext(CallContext *contextPtr);
MODULE_SCOPE void	TclOODeleteDescendants(Tcl_Interp *interp,
			    Object *oPtr);
MODULE_SCOPE void	TclOODelMethodRef(Method *method);
MODULE_SCOPE Tcl_Obj *	TclOOGetAllClassProperties(Class *clsPtr,
			    int writable, int *allocated);
MODULE_SCOPE Tcl_Obj *	TclOOGetAllObjectProperties(Object *oPtr,
			    int writable, int *allocated);
MODULE_SCOPE CallContext *TclOOGetCallContext(Object *oPtr,
			    Tcl_Obj *methodNameObj, int flags,
			    Object *contextObjPtr, Class *contextClsPtr,
			    Tcl_Obj *cacheInThisObj);
MODULE_SCOPE Tcl_Namespace *TclOOGetDefineContextNamespace(
			    Tcl_Interp *interp, Object *oPtr, int forClass);
MODULE_SCOPE CallChain *TclOOGetStereotypeCallChain(Class *clsPtr,
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
			    const char ***stringsPtr);
MODULE_SCOPE int	TclOOInit(Tcl_Interp *interp);
MODULE_SCOPE void	TclOOInitInfo(Tcl_Interp *interp);
MODULE_SCOPE int	TclOOInvokeContext(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclNRObjectContextInvokeNext(Tcl_Interp *interp,
			    Tcl_ObjectContext context, size_t objc,
			    Tcl_Obj *const *objv, size_t skip);
MODULE_SCOPE void	TclOONewBasicMethod(Tcl_Interp *interp, Class *clsPtr,
			    const DeclaredClassMethod *dcm);
MODULE_SCOPE Tcl_Obj *	TclOOObjectName(Tcl_Interp *interp, Object *oPtr);
MODULE_SCOPE void	TclOOReleaseClassContents(Tcl_Interp *interp,
			    Object *oPtr);
MODULE_SCOPE int	TclOORemoveFromInstances(Object *oPtr, Class *clsPtr);
MODULE_SCOPE int	TclOORemoveFromMixins(Class *mixinPtr, Object *oPtr);







|
|







570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
			    const char ***stringsPtr);
MODULE_SCOPE int	TclOOInit(Tcl_Interp *interp);
MODULE_SCOPE void	TclOOInitInfo(Tcl_Interp *interp);
MODULE_SCOPE int	TclOOInvokeContext(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclNRObjectContextInvokeNext(Tcl_Interp *interp,
			    Tcl_ObjectContext context, Tcl_Size objc,
			    Tcl_Obj *const *objv, Tcl_Size skip);
MODULE_SCOPE void	TclOONewBasicMethod(Tcl_Interp *interp, Class *clsPtr,
			    const DeclaredClassMethod *dcm);
MODULE_SCOPE Tcl_Obj *	TclOOObjectName(Tcl_Interp *interp, Object *oPtr);
MODULE_SCOPE void	TclOOReleaseClassContents(Tcl_Interp *interp,
			    Object *oPtr);
MODULE_SCOPE int	TclOORemoveFromInstances(Object *oPtr, Class *clsPtr);
MODULE_SCOPE int	TclOORemoveFromMixins(Class *mixinPtr, Object *oPtr);
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
 */

#define AddRef(ptr) ((ptr)->refCount++)

/*
 * A convenience macro for iterating through the lists used in the internal
 * memory management of objects.
 * REQUIRES DECLARATION: size_t i;
 */

#define FOREACH(var,ary) \
    for(i=0 ; i<(ary).num; i++) if ((ary).list[i] == NULL) { \
	continue; \
    } else if ((var) = (ary).list[i], 1)

/*
 * A variation where the array is an array of structs. There's no issue with
 * possible NULLs; every element of the array will be iterated over and the
 * varable set to a pointer to each of those elements in turn.
 * REQUIRES DECLARATION: size_t i;
 */

#define FOREACH_STRUCT(var,ary) \
    for(i=0 ; var=&((ary).list[i]), i<(ary).num; i++)

/*
 * Convenience macros for iterating through hash tables. FOREACH_HASH_DECLS
 * sets up the declarations needed for the main macro, FOREACH_HASH, which
 * does the actual iteration. FOREACH_HASH_VALUE is a restricted version that
 * only iterates over values.
 * REQUIRES DECLARATION: FOREACH_HASH_DECLS;







|










|
|



|







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

#define AddRef(ptr) ((ptr)->refCount++)

/*
 * A convenience macro for iterating through the lists used in the internal
 * memory management of objects.
 * REQUIRES DECLARATION: Tcl_Size i;
 */

#define FOREACH(var,ary) \
    for(i=0 ; i<(ary).num; i++) if ((ary).list[i] == NULL) { \
	continue; \
    } else if ((var) = (ary).list[i], 1)

/*
 * A variation where the array is an array of structs. There's no issue with
 * possible NULLs; every element of the array will be iterated over and the
 * variable set to a pointer to each of those elements in turn.
 * REQUIRES DECLARATION: Tcl_Size i; See [96551aca55] for more FOREACH_STRUCT details.
 */

#define FOREACH_STRUCT(var,ary) \
    if (i=0, (ary).num>0) for(; var=&((ary).list[i]), i<(ary).num; i++)

/*
 * Convenience macros for iterating through hash tables. FOREACH_HASH_DECLS
 * sets up the declarations needed for the main macro, FOREACH_HASH, which
 * does the actual iteration. FOREACH_HASH_VALUE is a restricted version that
 * only iterates over values.
 * REQUIRES DECLARATION: FOREACH_HASH_DECLS;

Changes to generic/tclOOIntDecls.h.

38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
/* 4 */
TCLAPI Method *		TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr,
				int flags, Tcl_Obj *nameObj,
				Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
				ProcedureMethod **pmPtrPtr);
/* 5 */
TCLAPI int		TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp,
				size_t objc, Tcl_Obj *const *objv,
				int publicOnly, Class *startCls);
/* 6 */
TCLAPI int		TclOOIsReachable(Class *targetPtr, Class *startPtr);
/* 7 */
TCLAPI Method *		TclOONewForwardMethod(Tcl_Interp *interp,
				Class *clsPtr, int isPublic,
				Tcl_Obj *nameObj, Tcl_Obj *prefixObj);







|







38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
/* 4 */
TCLAPI Method *		TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr,
				int flags, Tcl_Obj *nameObj,
				Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
				ProcedureMethod **pmPtrPtr);
/* 5 */
TCLAPI int		TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp,
				Tcl_Size objc, Tcl_Obj *const *objv,
				int publicOnly, Class *startCls);
/* 6 */
TCLAPI int		TclOOIsReachable(Class *targetPtr, Class *startPtr);
/* 7 */
TCLAPI Method *		TclOONewForwardMethod(Tcl_Interp *interp,
				Class *clsPtr, int isPublic,
				Tcl_Obj *nameObj, Tcl_Obj *prefixObj);
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
				ProcErrorProc *errProc, void *clientData,
				Tcl_Obj *nameObj, Tcl_Obj *argsObj,
				Tcl_Obj *bodyObj, int flags,
				void **internalTokenPtr);
/* 11 */
TCLAPI int		TclOOInvokeObject(Tcl_Interp *interp,
				Tcl_Object object, Tcl_Class startCls,
				int publicPrivate, size_t objc,
				Tcl_Obj *const *objv);
/* 12 */
TCLAPI void		TclOOObjectSetFilters(Object *oPtr,
				size_t numFilters, Tcl_Obj *const *filters);
/* 13 */
TCLAPI void		TclOOClassSetFilters(Tcl_Interp *interp,
				Class *classPtr, size_t numFilters,
				Tcl_Obj *const *filters);
/* 14 */
TCLAPI void		TclOOObjectSetMixins(Object *oPtr, size_t numMixins,
				Class *const *mixins);
/* 15 */
TCLAPI void		TclOOClassSetMixins(Tcl_Interp *interp,
				Class *classPtr, size_t numMixins,
				Class *const *mixins);

typedef struct TclOOIntStubs {
    int magic;
    void *hooks;

    Tcl_Object (*tclOOGetDefineCmdContext) (Tcl_Interp *interp); /* 0 */
    Tcl_Method (*tclOOMakeProcInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, void *clientData, Proc **procPtrPtr); /* 1 */
    Tcl_Method (*tclOOMakeProcMethod) (Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, const char *namePtr, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, void *clientData, Proc **procPtrPtr); /* 2 */
    Method * (*tclOONewProcInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 3 */
    Method * (*tclOONewProcMethod) (Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 4 */
    int (*tclOOObjectCmdCore) (Object *oPtr, Tcl_Interp *interp, size_t objc, Tcl_Obj *const *objv, int publicOnly, Class *startCls); /* 5 */
    int (*tclOOIsReachable) (Class *targetPtr, Class *startPtr); /* 6 */
    Method * (*tclOONewForwardMethod) (Tcl_Interp *interp, Class *clsPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 7 */
    Method * (*tclOONewForwardInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 8 */
    Tcl_Method (*tclOONewProcInstanceMethodEx) (Tcl_Interp *interp, Tcl_Object oPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 9 */
    Tcl_Method (*tclOONewProcMethodEx) (Tcl_Interp *interp, Tcl_Class clsPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 10 */
    int (*tclOOInvokeObject) (Tcl_Interp *interp, Tcl_Object object, Tcl_Class startCls, int publicPrivate, size_t objc, Tcl_Obj *const *objv); /* 11 */
    void (*tclOOObjectSetFilters) (Object *oPtr, size_t numFilters, Tcl_Obj *const *filters); /* 12 */
    void (*tclOOClassSetFilters) (Tcl_Interp *interp, Class *classPtr, size_t numFilters, Tcl_Obj *const *filters); /* 13 */
    void (*tclOOObjectSetMixins) (Object *oPtr, size_t numMixins, Class *const *mixins); /* 14 */
    void (*tclOOClassSetMixins) (Tcl_Interp *interp, Class *classPtr, size_t numMixins, Class *const *mixins); /* 15 */
} TclOOIntStubs;

extern const TclOOIntStubs *tclOOIntStubsPtr;

#ifdef __cplusplus
}
#endif







|



|


|


|
|


|











|





|
|
|
|
|







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
				ProcErrorProc *errProc, void *clientData,
				Tcl_Obj *nameObj, Tcl_Obj *argsObj,
				Tcl_Obj *bodyObj, int flags,
				void **internalTokenPtr);
/* 11 */
TCLAPI int		TclOOInvokeObject(Tcl_Interp *interp,
				Tcl_Object object, Tcl_Class startCls,
				int publicPrivate, Tcl_Size objc,
				Tcl_Obj *const *objv);
/* 12 */
TCLAPI void		TclOOObjectSetFilters(Object *oPtr,
				Tcl_Size numFilters, Tcl_Obj *const *filters);
/* 13 */
TCLAPI void		TclOOClassSetFilters(Tcl_Interp *interp,
				Class *classPtr, Tcl_Size numFilters,
				Tcl_Obj *const *filters);
/* 14 */
TCLAPI void		TclOOObjectSetMixins(Object *oPtr,
				Tcl_Size numMixins, Class *const *mixins);
/* 15 */
TCLAPI void		TclOOClassSetMixins(Tcl_Interp *interp,
				Class *classPtr, Tcl_Size numMixins,
				Class *const *mixins);

typedef struct TclOOIntStubs {
    int magic;
    void *hooks;

    Tcl_Object (*tclOOGetDefineCmdContext) (Tcl_Interp *interp); /* 0 */
    Tcl_Method (*tclOOMakeProcInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, void *clientData, Proc **procPtrPtr); /* 1 */
    Tcl_Method (*tclOOMakeProcMethod) (Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, const char *namePtr, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, void *clientData, Proc **procPtrPtr); /* 2 */
    Method * (*tclOONewProcInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 3 */
    Method * (*tclOONewProcMethod) (Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 4 */
    int (*tclOOObjectCmdCore) (Object *oPtr, Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const *objv, int publicOnly, Class *startCls); /* 5 */
    int (*tclOOIsReachable) (Class *targetPtr, Class *startPtr); /* 6 */
    Method * (*tclOONewForwardMethod) (Tcl_Interp *interp, Class *clsPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 7 */
    Method * (*tclOONewForwardInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 8 */
    Tcl_Method (*tclOONewProcInstanceMethodEx) (Tcl_Interp *interp, Tcl_Object oPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 9 */
    Tcl_Method (*tclOONewProcMethodEx) (Tcl_Interp *interp, Tcl_Class clsPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 10 */
    int (*tclOOInvokeObject) (Tcl_Interp *interp, Tcl_Object object, Tcl_Class startCls, int publicPrivate, Tcl_Size objc, Tcl_Obj *const *objv); /* 11 */
    void (*tclOOObjectSetFilters) (Object *oPtr, Tcl_Size numFilters, Tcl_Obj *const *filters); /* 12 */
    void (*tclOOClassSetFilters) (Tcl_Interp *interp, Class *classPtr, Tcl_Size numFilters, Tcl_Obj *const *filters); /* 13 */
    void (*tclOOObjectSetMixins) (Object *oPtr, Tcl_Size numMixins, Class *const *mixins); /* 14 */
    void (*tclOOClassSetMixins) (Tcl_Interp *interp, Class *classPtr, Tcl_Size numMixins, Class *const *mixins); /* 15 */
} TclOOIntStubs;

extern const TclOOIntStubs *tclOOIntStubsPtr;

#ifdef __cplusplus
}
#endif

Changes to generic/tclOOMethod.c.

14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
#endif
#include "tclInt.h"
#include "tclOOInt.h"
#include "tclCompile.h"

/*
 * Structure used to help delay computing names of objects or classes for
 * [info frame] until needed, making invokation faster in the normal case.
 */

struct PNI {
    Tcl_Interp *interp;		/* Interpreter in which to compute the name of
				 * a method. */
    Tcl_Method method;		/* Method to compute the name of. */
};







|







14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
#endif
#include "tclInt.h"
#include "tclOOInt.h"
#include "tclCompile.h"

/*
 * Structure used to help delay computing names of objects or classes for
 * [info frame] until needed, making invocation faster in the normal case.
 */

struct PNI {
    Tcl_Interp *interp;		/* Interpreter in which to compute the name of
				 * a method. */
    Tcl_Method method;		/* Method to compute the name of. */
};
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
    Tcl_Obj *bodyObj,		/* The body of the method, which must not be
				 * NULL. */
    ProcedureMethod **pmPtrPtr)	/* Place to write pointer to procedure method
				 * structure to allow for deeper tuning of the
				 * structure's contents. NULL if caller is not
				 * interested. */
{
    size_t argsLen;
    ProcedureMethod *pmPtr;
    Tcl_Method method;

    if (TclListObjLengthM(interp, argsObj, &argsLen) != TCL_OK) {
	return NULL;
    }
    pmPtr = (ProcedureMethod *)Tcl_Alloc(sizeof(ProcedureMethod));







|







417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
    Tcl_Obj *bodyObj,		/* The body of the method, which must not be
				 * NULL. */
    ProcedureMethod **pmPtrPtr)	/* Place to write pointer to procedure method
				 * structure to allow for deeper tuning of the
				 * structure's contents. NULL if caller is not
				 * interested. */
{
    Tcl_Size argsLen;
    ProcedureMethod *pmPtr;
    Tcl_Method method;

    if (TclListObjLengthM(interp, argsObj, &argsLen) != TCL_OK) {
	return NULL;
    }
    pmPtr = (ProcedureMethod *)Tcl_Alloc(sizeof(ProcedureMethod));
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
    Tcl_Obj *bodyObj,		/* The body of the method, which must not be
				 * NULL. */
    ProcedureMethod **pmPtrPtr)	/* Place to write pointer to procedure method
				 * structure to allow for deeper tuning of the
				 * structure's contents. NULL if caller is not
				 * interested. */
{
    size_t argsLen;		/* TCL_INDEX_NONE => delete argsObj before exit */
    ProcedureMethod *pmPtr;
    const char *procName;
    Tcl_Method method;

    if (argsObj == NULL) {
	argsLen = TCL_INDEX_NONE;
	TclNewObj(argsObj);







|







469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
    Tcl_Obj *bodyObj,		/* The body of the method, which must not be
				 * NULL. */
    ProcedureMethod **pmPtrPtr)	/* Place to write pointer to procedure method
				 * structure to allow for deeper tuning of the
				 * structure's contents. NULL if caller is not
				 * interested. */
{
    Tcl_Size argsLen;		/* TCL_INDEX_NONE => delete argsObj before exit */
    ProcedureMethod *pmPtr;
    const char *procName;
    Tcl_Method method;

    if (argsObj == NULL) {
	argsLen = TCL_INDEX_NONE;
	TclNewObj(argsObj);
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
    Interp *iPtr = (Interp *) interp;
    CallFrame *framePtr = iPtr->varFramePtr;
    CallContext *contextPtr;
    Tcl_Obj *variableObj;
    PrivateVariableMapping *privateVar;
    Tcl_HashEntry *hPtr;
    int isNew, cacheIt;
    size_t i, varLen, len;
    const char *match, *varName;

    /*
     * Check that the variable is being requested in a context that is also a
     * method call; if not (i.e. we're evaluating in the object's namespace or
     * in a procedure of that namespace) then we do nothing.
     */







|







1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
    Interp *iPtr = (Interp *) interp;
    CallFrame *framePtr = iPtr->varFramePtr;
    CallContext *contextPtr;
    Tcl_Obj *variableObj;
    PrivateVariableMapping *privateVar;
    Tcl_HashEntry *hPtr;
    int isNew, cacheIt;
    Tcl_Size i, varLen, len;
    const char *match, *varName;

    /*
     * Check that the variable is being requested in a context that is also a
     * method call; if not (i.e. we're evaluating in the object's namespace or
     * in a procedure of that namespace) then we do nothing.
     */
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
    Tcl_Free(infoPtr);
}

static int
ProcedureMethodCompiledVarResolver(
    TCL_UNUSED(Tcl_Interp *),
    const char *varName,
    size_t length,
    TCL_UNUSED(Tcl_Namespace *),
    Tcl_ResolvedVarInfo **rPtrPtr)
{
    OOResVarInfo *infoPtr;
    Tcl_Obj *variableObj = Tcl_NewStringObj(varName, length);

    /*







|







1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
    Tcl_Free(infoPtr);
}

static int
ProcedureMethodCompiledVarResolver(
    TCL_UNUSED(Tcl_Interp *),
    const char *varName,
    Tcl_Size length,
    TCL_UNUSED(Tcl_Namespace *),
    Tcl_ResolvedVarInfo **rPtrPtr)
{
    OOResVarInfo *infoPtr;
    Tcl_Obj *variableObj = Tcl_NewStringObj(varName, length);

    /*
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279

static void
MethodErrorHandler(
    Tcl_Interp *interp,
    TCL_UNUSED(Tcl_Obj *) /*methodNameObj*/)
	/* We pull the method name out of context instead of from argument */
{
    size_t nameLen, objectNameLen;
    CallContext *contextPtr = (CallContext *)((Interp *) interp)->varFramePtr->clientData;
    Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
    const char *objectName, *kindName, *methodName =
	    Tcl_GetStringFromObj(mPtr->namePtr, &nameLen);
    Object *declarerPtr;

    if (mPtr->declaringObjectPtr != NULL) {







|







1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279

static void
MethodErrorHandler(
    Tcl_Interp *interp,
    TCL_UNUSED(Tcl_Obj *) /*methodNameObj*/)
	/* We pull the method name out of context instead of from argument */
{
    Tcl_Size nameLen, objectNameLen;
    CallContext *contextPtr = (CallContext *)((Interp *) interp)->varFramePtr->clientData;
    Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
    const char *objectName, *kindName, *methodName =
	    Tcl_GetStringFromObj(mPtr->namePtr, &nameLen);
    Object *declarerPtr;

    if (mPtr->declaringObjectPtr != NULL) {
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
    TCL_UNUSED(Tcl_Obj *) /*methodNameObj*/)
		/* Ignore. We know it is the constructor. */
{
    CallContext *contextPtr = (CallContext *)((Interp *) interp)->varFramePtr->clientData;
    Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
    Object *declarerPtr;
    const char *objectName, *kindName;
    size_t objectNameLen;

    if (mPtr->declaringObjectPtr != NULL) {
	declarerPtr = mPtr->declaringObjectPtr;
	kindName = "object";
    } else {
	if (mPtr->declaringClassPtr == NULL) {
	    Tcl_Panic("method not declared in class or object");







|







1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
    TCL_UNUSED(Tcl_Obj *) /*methodNameObj*/)
		/* Ignore. We know it is the constructor. */
{
    CallContext *contextPtr = (CallContext *)((Interp *) interp)->varFramePtr->clientData;
    Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
    Object *declarerPtr;
    const char *objectName, *kindName;
    Tcl_Size objectNameLen;

    if (mPtr->declaringObjectPtr != NULL) {
	declarerPtr = mPtr->declaringObjectPtr;
	kindName = "object";
    } else {
	if (mPtr->declaringClassPtr == NULL) {
	    Tcl_Panic("method not declared in class or object");
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
    TCL_UNUSED(Tcl_Obj *) /*methodNameObj*/)
		/* Ignore. We know it is the destructor. */
{
    CallContext *contextPtr = (CallContext *)((Interp *) interp)->varFramePtr->clientData;
    Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
    Object *declarerPtr;
    const char *objectName, *kindName;
    size_t objectNameLen;

    if (mPtr->declaringObjectPtr != NULL) {
	declarerPtr = mPtr->declaringObjectPtr;
	kindName = "object";
    } else {
	if (mPtr->declaringClassPtr == NULL) {
	    Tcl_Panic("method not declared in class or object");







|







1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
    TCL_UNUSED(Tcl_Obj *) /*methodNameObj*/)
		/* Ignore. We know it is the destructor. */
{
    CallContext *contextPtr = (CallContext *)((Interp *) interp)->varFramePtr->clientData;
    Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
    Object *declarerPtr;
    const char *objectName, *kindName;
    Tcl_Size objectNameLen;

    if (mPtr->declaringObjectPtr != NULL) {
	declarerPtr = mPtr->declaringObjectPtr;
	kindName = "object";
    } else {
	if (mPtr->declaringClassPtr == NULL) {
	    Tcl_Panic("method not declared in class or object");
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
    Tcl_Interp *interp,		/* Interpreter for error reporting. */
    Object *oPtr,		/* The object to attach the method to. */
    int flags,			/* Whether the method is public or not. */
    Tcl_Obj *nameObj,		/* The name of the method. */
    Tcl_Obj *prefixObj)		/* List of arguments that form the command
				 * prefix to forward to. */
{
    size_t prefixLen;
    ForwardMethod *fmPtr;

    if (TclListObjLengthM(interp, prefixObj, &prefixLen) != TCL_OK) {
	return NULL;
    }
    if (prefixLen < 1) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(







|







1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
    Tcl_Interp *interp,		/* Interpreter for error reporting. */
    Object *oPtr,		/* The object to attach the method to. */
    int flags,			/* Whether the method is public or not. */
    Tcl_Obj *nameObj,		/* The name of the method. */
    Tcl_Obj *prefixObj)		/* List of arguments that form the command
				 * prefix to forward to. */
{
    Tcl_Size prefixLen;
    ForwardMethod *fmPtr;

    if (TclListObjLengthM(interp, prefixObj, &prefixLen) != TCL_OK) {
	return NULL;
    }
    if (prefixLen < 1) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
    Tcl_Interp *interp,		/* Interpreter for error reporting. */
    Class *clsPtr,		/* The class to attach the method to. */
    int flags,			/* Whether the method is public or not. */
    Tcl_Obj *nameObj,		/* The name of the method. */
    Tcl_Obj *prefixObj)		/* List of arguments that form the command
				 * prefix to forward to. */
{
    size_t prefixLen;
    ForwardMethod *fmPtr;

    if (TclListObjLengthM(interp, prefixObj, &prefixLen) != TCL_OK) {
	return NULL;
    }
    if (prefixLen < 1) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(







|







1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
    Tcl_Interp *interp,		/* Interpreter for error reporting. */
    Class *clsPtr,		/* The class to attach the method to. */
    int flags,			/* Whether the method is public or not. */
    Tcl_Obj *nameObj,		/* The name of the method. */
    Tcl_Obj *prefixObj)		/* List of arguments that form the command
				 * prefix to forward to. */
{
    Tcl_Size prefixLen;
    ForwardMethod *fmPtr;

    if (TclListObjLengthM(interp, prefixObj, &prefixLen) != TCL_OK) {
	return NULL;
    }
    if (prefixLen < 1) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
    Tcl_ObjectContext context,	/* The method calling context. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Arguments as actually seen. */
{
    CallContext *contextPtr = (CallContext *) context;
    ForwardMethod *fmPtr = (ForwardMethod *)clientData;
    Tcl_Obj **argObjs, **prefixObjs;
    size_t numPrefixes, skip = contextPtr->skip;
    int len;

    /*
     * Build the real list of arguments to use. Note that we know that the
     * prefixObj field of the ForwardMethod structure holds a reference to a
     * non-empty list, so there's a whole class of failures ("not a list") we
     * can ignore here.







|







1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
    Tcl_ObjectContext context,	/* The method calling context. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Arguments as actually seen. */
{
    CallContext *contextPtr = (CallContext *) context;
    ForwardMethod *fmPtr = (ForwardMethod *)clientData;
    Tcl_Obj **argObjs, **prefixObjs;
    Tcl_Size numPrefixes, skip = contextPtr->skip;
    int len;

    /*
     * Build the real list of arguments to use. Note that we know that the
     * prefixObj field of the ForwardMethod structure holds a reference to a
     * non-empty list, so there's a whole class of failures ("not a list") we
     * can ignore here.
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
    Tcl_Obj *const *objv,	/* The real arguments. */
    int toRewrite,		/* Number of real arguments to replace. */
    int rewriteLength,		/* Number of arguments to insert instead. */
    Tcl_Obj *const *rewriteObjs,/* Arguments to insert instead. */
    int *lengthPtr)		/* Where to write the resulting length of the
				 * array of rewritten arguments. */
{
    unsigned len = rewriteLength + objc - toRewrite;
    Tcl_Obj **argObjs = (Tcl_Obj **)TclStackAlloc(interp, sizeof(Tcl_Obj *) * len);

    memcpy(argObjs, rewriteObjs, rewriteLength * sizeof(Tcl_Obj *));
    memcpy(argObjs + rewriteLength, objv + toRewrite,
	    sizeof(Tcl_Obj *) * (objc - toRewrite));

    /*







|







1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
    Tcl_Obj *const *objv,	/* The real arguments. */
    int toRewrite,		/* Number of real arguments to replace. */
    int rewriteLength,		/* Number of arguments to insert instead. */
    Tcl_Obj *const *rewriteObjs,/* Arguments to insert instead. */
    int *lengthPtr)		/* Where to write the resulting length of the
				 * array of rewritten arguments. */
{
    size_t len = rewriteLength + objc - toRewrite;
    Tcl_Obj **argObjs = (Tcl_Obj **)TclStackAlloc(interp, sizeof(Tcl_Obj *) * len);

    memcpy(argObjs, rewriteObjs, rewriteLength * sizeof(Tcl_Obj *));
    memcpy(argObjs + rewriteLength, objv + toRewrite,
	    sizeof(Tcl_Obj *) * (objc - toRewrite));

    /*

Changes to generic/tclOOScript.h.

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

#ifndef TCL_OO_SCRIPT_H
#define TCL_OO_SCRIPT_H

/*
 * The scripted part of the definitions of TclOO.
 *
 * Compiled from generic/tclOOScript.tcl by tools/makeHeader.tcl, which
 * contains the commented version of everything; *this* file is automatically
 * generated.
 */

static const char *tclOOSetupScript =
/* !BEGIN!: Do not edit below this line. */
"::namespace eval ::oo {\n"
"\t::namespace path {}\n"
"\tnamespace eval Helpers {\n"
"\t\t::namespace path {}\n"
"\t\tproc callback {method args} {\n"
"\t\t\tlist [uplevel 1 {::namespace which my}] $method {*}$args\n"
"\t\t}\n"
"\t\tnamespace export callback\n"
"\t\tnamespace eval tmp {namespace import ::oo::Helpers::callback}\n"
"\t\tnamespace export -clear\n"
"\t\trename tmp::callback mymethod\n"







|









|







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

#ifndef TCL_OO_SCRIPT_H
#define TCL_OO_SCRIPT_H

/*
 * The scripted part of the definitions of TclOO.
 *
 * Compiled from tools/tclOOScript.tcl by tools/makeHeader.tcl, which
 * contains the commented version of everything; *this* file is automatically
 * generated.
 */

static const char *tclOOSetupScript =
/* !BEGIN!: Do not edit below this line. */
"::namespace eval ::oo {\n"
"\t::namespace path {}\n"
"\tnamespace eval Helpers {\n"
"\t\tnamespace path {}\n"
"\t\tproc callback {method args} {\n"
"\t\t\tlist [uplevel 1 {::namespace which my}] $method {*}$args\n"
"\t\t}\n"
"\t\tnamespace export callback\n"
"\t\tnamespace eval tmp {namespace import ::oo::Helpers::callback}\n"
"\t\tnamespace export -clear\n"
"\t\trename tmp::callback mymethod\n"
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
"\t\t\treturn\n"
"\t\t}\n"
"\t\tforeach c [info class superclass $class] {\n"
"\t\t\tset d [DelegateName $c]\n"
"\t\t\tif {![info object isa class $d]} {\n"
"\t\t\t\tcontinue\n"
"\t\t\t}\n"
"\t\t\tdefine $delegate ::oo::define::superclass -append $d\n"
"\t\t}\n"
"\t\tobjdefine $class ::oo::objdefine::mixin -append $delegate\n"
"\t}\n"
"\tproc UpdateClassDelegatesAfterClone {originObject targetObject} {\n"
"\t\tset originDelegate [DelegateName $originObject]\n"
"\t\tset targetDelegate [DelegateName $targetObject]\n"
"\t\tif {\n"
"\t\t\t[info object isa class $originDelegate]\n"
"\t\t\t&& ![info object isa class $targetDelegate]\n"







|

|







94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
"\t\t\treturn\n"
"\t\t}\n"
"\t\tforeach c [info class superclass $class] {\n"
"\t\t\tset d [DelegateName $c]\n"
"\t\t\tif {![info object isa class $d]} {\n"
"\t\t\t\tcontinue\n"
"\t\t\t}\n"
"\t\t\tdefine $delegate ::oo::define::superclass -appendifnew $d\n"
"\t\t}\n"
"\t\tobjdefine $class ::oo::objdefine::mixin -appendifnew $delegate\n"
"\t}\n"
"\tproc UpdateClassDelegatesAfterClone {originObject targetObject} {\n"
"\t\tset originDelegate [DelegateName $originObject]\n"
"\t\tset targetDelegate [DelegateName $targetObject]\n"
"\t\tif {\n"
"\t\t\t[info object isa class $originDelegate]\n"
"\t\t\t&& ![info object isa class $targetDelegate]\n"
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
"\t\t::namespace export initialise\n"
"\t\t::namespace eval tmp {::namespace import ::oo::define::initialise}\n"
"\t\t::namespace export -clear\n"
"\t\t::rename tmp::initialise initialize\n"
"\t\t::namespace delete tmp\n"
"\t}\n"
"\tdefine Slot {\n"
"\t\tmethod Get {} {\n"
"\t\t\treturn -code error -errorcode {TCLOO ABSTRACT_SLOT} \"unimplemented\"\n"
"\t\t}\n"
"\t\tmethod Set list {\n"
"\t\t\treturn -code error -errorcode {TCLOO ABSTRACT_SLOT} \"unimplemented\"\n"
"\t\t}\n"
"\t\tmethod Resolve list {\n"
"\t\t\treturn $list\n"
"\t\t}\n"
"\t\tmethod -set args {\n"
"\t\t\tset my [namespace which my]\n"
"\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
"\t\t\ttailcall my Set $args\n"
"\t\t}\n"
"\t\tmethod -append args {\n"
"\t\t\tset my [namespace which my]\n"
"\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
"\t\t\tset current [uplevel 1 [list $my Get]]\n"
"\t\t\ttailcall my Set [list {*}$current {*}$args]\n"
"\t\t}\n"











"\t\tmethod -clear {} {tailcall my Set {}}\n"
"\t\tmethod -prepend args {\n"
"\t\t\tset my [namespace which my]\n"
"\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
"\t\t\tset current [uplevel 1 [list $my Get]]\n"
"\t\t\ttailcall my Set [list {*}$args {*}$current]\n"
"\t\t}\n"
"\t\tmethod -remove args {\n"
"\t\t\tset my [namespace which my]\n"
"\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
"\t\t\tset current [uplevel 1 [list $my Get]]\n"
"\t\t\ttailcall my Set [lmap val $current {\n"
"\t\t\t\tif {$val in $args} continue else {set val}\n"
"\t\t\t}]\n"
"\t\t}\n"
"\t\tforward --default-operation my -append\n"
"\t\tmethod unknown {args} {\n"
"\t\t\tset def --default-operation\n"
"\t\t\tif {[llength $args] == 0} {\n"
"\t\t\t\ttailcall my $def\n"
"\t\t\t} elseif {![string match -* [lindex $args 0]]} {\n"
"\t\t\t\ttailcall my $def {*}$args\n"
"\t\t\t}\n"
"\t\t\tnext {*}$args\n"
"\t\t}\n"
"\t\texport -set -append -clear -prepend -remove\n"
"\t\tunexport unknown destroy\n"
"\t}\n"
"\tobjdefine define::superclass forward --default-operation my -set\n"
"\tobjdefine define::mixin forward --default-operation my -set\n"
"\tobjdefine objdefine::mixin forward --default-operation my -set\n"
"\tdefine object method <cloned> {originObject} {\n"
"\t\tforeach p [info procs [info object namespace $originObject]::*] {\n"
"\t\t\tset args [info args $p]\n"
"\t\t\tset idx -1\n"
"\t\t\tforeach a $args {\n"
"\t\t\t\tif {[info default $p $a d]} {\n"
"\t\t\t\t\tlset args [incr idx] [list $a $d]\n"
"\t\t\t\t} else {\n"







|


|


|


|




|





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





|








|








<
|




|







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
"\t\t::namespace export initialise\n"
"\t\t::namespace eval tmp {::namespace import ::oo::define::initialise}\n"
"\t\t::namespace export -clear\n"
"\t\t::rename tmp::initialise initialize\n"
"\t\t::namespace delete tmp\n"
"\t}\n"
"\tdefine Slot {\n"
"\t\tmethod Get -unexport {} {\n"
"\t\t\treturn -code error -errorcode {TCLOO ABSTRACT_SLOT} \"unimplemented\"\n"
"\t\t}\n"
"\t\tmethod Set -unexport list {\n"
"\t\t\treturn -code error -errorcode {TCLOO ABSTRACT_SLOT} \"unimplemented\"\n"
"\t\t}\n"
"\t\tmethod Resolve -unexport list {\n"
"\t\t\treturn $list\n"
"\t\t}\n"
"\t\tmethod -set -export args {\n"
"\t\t\tset my [namespace which my]\n"
"\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
"\t\t\ttailcall my Set $args\n"
"\t\t}\n"
"\t\tmethod -append -export args {\n"
"\t\t\tset my [namespace which my]\n"
"\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
"\t\t\tset current [uplevel 1 [list $my Get]]\n"
"\t\t\ttailcall my Set [list {*}$current {*}$args]\n"
"\t\t}\n"
"\t\tmethod -appendifnew -export args {\n"
"\t\t\tset my [namespace which my]\n"
"\t\t\tset current [uplevel 1 [list $my Get]]\n"
"\t\t\tforeach a $args {\n"
"\t\t\t\tset a [uplevel 1 [list $my Resolve $a]]\n"
"\t\t\t\tif {$a ni $current} {\n"
"\t\t\t\t\tlappend current $a\n"
"\t\t\t\t}\n"
"\t\t\t}\n"
"\t\t\ttailcall my Set $current\n"
"\t\t}\n"
"\t\tmethod -clear -export {} {tailcall my Set {}}\n"
"\t\tmethod -prepend -export args {\n"
"\t\t\tset my [namespace which my]\n"
"\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
"\t\t\tset current [uplevel 1 [list $my Get]]\n"
"\t\t\ttailcall my Set [list {*}$args {*}$current]\n"
"\t\t}\n"
"\t\tmethod -remove -export args {\n"
"\t\t\tset my [namespace which my]\n"
"\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
"\t\t\tset current [uplevel 1 [list $my Get]]\n"
"\t\t\ttailcall my Set [lmap val $current {\n"
"\t\t\t\tif {$val in $args} continue else {set val}\n"
"\t\t\t}]\n"
"\t\t}\n"
"\t\tforward --default-operation my -append\n"
"\t\tmethod unknown -unexport {args} {\n"
"\t\t\tset def --default-operation\n"
"\t\t\tif {[llength $args] == 0} {\n"
"\t\t\t\ttailcall my $def\n"
"\t\t\t} elseif {![string match -* [lindex $args 0]]} {\n"
"\t\t\t\ttailcall my $def {*}$args\n"
"\t\t\t}\n"
"\t\t\tnext {*}$args\n"
"\t\t}\n"

"\t\tunexport destroy\n"
"\t}\n"
"\tobjdefine define::superclass forward --default-operation my -set\n"
"\tobjdefine define::mixin forward --default-operation my -set\n"
"\tobjdefine objdefine::mixin forward --default-operation my -set\n"
"\tdefine object method <cloned> -unexport {originObject} {\n"
"\t\tforeach p [info procs [info object namespace $originObject]::*] {\n"
"\t\t\tset args [info args $p]\n"
"\t\t\tset idx -1\n"
"\t\t\tforeach a $args {\n"
"\t\t\t\tif {[info default $p $a d]} {\n"
"\t\t\t\t\tlset args [incr idx] [list $a $d]\n"
"\t\t\t\t} else {\n"
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
"\t\t\t\t\tarray set vNew [array get vOrigin]\n"
"\t\t\t\t} else {\n"
"\t\t\t\t\tset vNew $vOrigin\n"
"\t\t\t\t}\n"
"\t\t\t}\n"
"\t\t}\n"
"\t}\n"
"\tdefine class method <cloned> {originObject} {\n"
"\t\tnext $originObject\n"
"\t\t::oo::UpdateClassDelegatesAfterClone $originObject [self]\n"
"\t}\n"
"\tclass create singleton {\n"
"\t\tsuperclass class\n"
"\t\tvariable object\n"
"\t\tunexport create createWithNamespace\n"
"\t\tmethod new args {\n"
"\t\t\tif {![info exists object] || ![info object isa object $object]} {\n"
"\t\t\t\tset object [next {*}$args]\n"
"\t\t\t\t::oo::objdefine $object {\n"
"\t\t\t\t\tmethod destroy {} {\n"
"\t\t\t\t\t\t::return -code error -errorcode {TCLOO SINGLETON} \\\n"
"\t\t\t\t\t\t\t\"may not destroy a singleton object\"\n"
"\t\t\t\t\t}\n"
"\t\t\t\t\tmethod <cloned> {originObject} {\n"
"\t\t\t\t\t\t::return -code error -errorcode {TCLOO SINGLETON} \\\n"
"\t\t\t\t\t\t\t\"may not clone a singleton object\"\n"
"\t\t\t\t\t}\n"
"\t\t\t\t}\n"
"\t\t\t}\n"
"\t\t\treturn $object\n"
"\t\t}\n"
"\t}\n"
"\tclass create abstract {\n"
"\t\tsuperclass class\n"
"\t\tunexport create createWithNamespace new\n"
"\t}\n"




























































































































































































































"}\n"
/* !END!: Do not edit above this line. */
;

#endif /* TCL_OO_SCRIPT_H */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|















|












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













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
"\t\t\t\t\tarray set vNew [array get vOrigin]\n"
"\t\t\t\t} else {\n"
"\t\t\t\t\tset vNew $vOrigin\n"
"\t\t\t\t}\n"
"\t\t\t}\n"
"\t\t}\n"
"\t}\n"
"\tdefine class method <cloned> -unexport {originObject} {\n"
"\t\tnext $originObject\n"
"\t\t::oo::UpdateClassDelegatesAfterClone $originObject [self]\n"
"\t}\n"
"\tclass create singleton {\n"
"\t\tsuperclass class\n"
"\t\tvariable object\n"
"\t\tunexport create createWithNamespace\n"
"\t\tmethod new args {\n"
"\t\t\tif {![info exists object] || ![info object isa object $object]} {\n"
"\t\t\t\tset object [next {*}$args]\n"
"\t\t\t\t::oo::objdefine $object {\n"
"\t\t\t\t\tmethod destroy {} {\n"
"\t\t\t\t\t\t::return -code error -errorcode {TCLOO SINGLETON} \\\n"
"\t\t\t\t\t\t\t\"may not destroy a singleton object\"\n"
"\t\t\t\t\t}\n"
"\t\t\t\t\tmethod <cloned> -unexport {originObject} {\n"
"\t\t\t\t\t\t::return -code error -errorcode {TCLOO SINGLETON} \\\n"
"\t\t\t\t\t\t\t\"may not clone a singleton object\"\n"
"\t\t\t\t\t}\n"
"\t\t\t\t}\n"
"\t\t\t}\n"
"\t\t\treturn $object\n"
"\t\t}\n"
"\t}\n"
"\tclass create abstract {\n"
"\t\tsuperclass class\n"
"\t\tunexport create createWithNamespace new\n"
"\t}\n"
"\t::namespace eval configuresupport {\n"
"\t\tnamespace path ::tcl\n"
"\t\tproc PropertyImpl {readslot writeslot args} {\n"
"\t\t\tfor {set i 0} {$i < [llength $args]} {incr i} {\n"
"\t\t\t\tset prop [lindex $args $i]\n"
"\t\t\t\tif {[string match \"-*\" $prop]} {\n"
"\t\t\t\t\treturn -code error -level 2 \\\n"
"\t\t\t\t\t\t-errorcode {TCLOO PROPERTY_FORMAT} \\\n"
"\t\t\t\t\t\t\"bad property name \\\"$prop\\\": must not begin with -\"\n"
"\t\t\t\t}\n"
"\t\t\t\tif {$prop ne [list $prop]} {\n"
"\t\t\t\t\treturn -code error -level 2 \\\n"
"\t\t\t\t\t\t-errorcode {TCLOO PROPERTY_FORMAT} \\\n"
"\t\t\t\t\t\t\"bad property name \\\"$prop\\\": must be a simple word\"\n"
"\t\t\t\t}\n"
"\t\t\t\tif {[string first \"::\" $prop] != -1} {\n"
"\t\t\t\t\treturn -code error -level 2 \\\n"
"\t\t\t\t\t\t-errorcode {TCLOO PROPERTY_FORMAT} \\\n"
"\t\t\t\t\t\t\"bad property name \\\"$prop\\\": must not contain namespace separators\"\n"
"\t\t\t\t}\n"
"\t\t\t\tif {[string match {*[()]*} $prop]} {\n"
"\t\t\t\t\treturn -code error -level 2 \\\n"
"\t\t\t\t\t\t-errorcode {TCLOO PROPERTY_FORMAT} \\\n"
"\t\t\t\t\t\t\"bad property name \\\"$prop\\\": must not contain parentheses\"\n"
"\t\t\t\t}\n"
"\t\t\t\tset realprop [string cat \"-\" $prop]\n"
"\t\t\t\tset getter [format {::set [my varname %s]} $prop]\n"
"\t\t\t\tset setter [format {::set [my varname %s] $value} $prop]\n"
"\t\t\t\tset kind readwrite\n"
"\t\t\t\twhile {[set next [lindex $args [expr {$i + 1}]]\n"
"\t\t\t\t\t\tstring match \"-*\" $next]} {\n"
"\t\t\t\t\tset arg [lindex $args [incr i 2]]\n"
"\t\t\t\t\tswitch [prefix match -error [list -level 2 -errorcode \\\n"
"\t\t\t\t\t\t\t[list TCL LOOKUP INDEX option $next]] {-get -kind -set} $next] {\n"
"\t\t\t\t\t\t-get {\n"
"\t\t\t\t\t\t\tif {$i >= [llength $args]} {\n"
"\t\t\t\t\t\t\t\treturn -code error -level 2 \\\n"
"\t\t\t\t\t\t\t\t\t-errorcode {TCL WRONGARGS} \\\n"
"\t\t\t\t\t\t\t\t\t\"missing body to go with -get option\"\n"
"\t\t\t\t\t\t\t}\n"
"\t\t\t\t\t\t\tset getter $arg\n"
"\t\t\t\t\t\t}\n"
"\t\t\t\t\t\t-set {\n"
"\t\t\t\t\t\t\tif {$i >= [llength $args]} {\n"
"\t\t\t\t\t\t\t\treturn -code error -level 2 \\\n"
"\t\t\t\t\t\t\t\t\t-errorcode {TCL WRONGARGS} \\\n"
"\t\t\t\t\t\t\t\t\t\"missing body to go with -set option\"\n"
"\t\t\t\t\t\t\t}\n"
"\t\t\t\t\t\t\tset setter $arg\n"
"\t\t\t\t\t\t}\n"
"\t\t\t\t\t\t-kind {\n"
"\t\t\t\t\t\t\tif {$i >= [llength $args]} {\n"
"\t\t\t\t\t\t\t\treturn -code error -level 2\\\n"
"\t\t\t\t\t\t\t\t\t-errorcode {TCL WRONGARGS} \\\n"
"\t\t\t\t\t\t\t\t\t\"missing kind value to go with -kind option\"\n"
"\t\t\t\t\t\t\t}\n"
"\t\t\t\t\t\t\tset kind [prefix match -message \"kind\" -error [list \\\n"
"\t\t\t\t\t\t\t\t\t-level 2 \\\n"
"\t\t\t\t\t\t\t\t\t-errorcode [list TCL LOOKUP INDEX kind $arg]] {\n"
"\t\t\t\t\t\t\t\treadable readwrite writable\n"
"\t\t\t\t\t\t\t} $arg]\n"
"\t\t\t\t\t\t}\n"
"\t\t\t\t\t}\n"
"\t\t\t\t}\n"
"\t\t\t\tset reader <ReadProp$realprop>\n"
"\t\t\t\tset writer <WriteProp$realprop>\n"
"\t\t\t\tswitch $kind {\n"
"\t\t\t\t\treadable {\n"
"\t\t\t\t\t\tuplevel 2 [list $readslot -append $realprop]\n"
"\t\t\t\t\t\tuplevel 2 [list $writeslot -remove $realprop]\n"
"\t\t\t\t\t\tuplevel 2 [list method $reader -unexport {} $getter]\n"
"\t\t\t\t\t}\n"
"\t\t\t\t\twritable {\n"
"\t\t\t\t\t\tuplevel 2 [list $readslot -remove $realprop]\n"
"\t\t\t\t\t\tuplevel 2 [list $writeslot -append $realprop]\n"
"\t\t\t\t\t\tuplevel 2 [list method $writer -unexport {value} $setter]\n"
"\t\t\t\t\t}\n"
"\t\t\t\t\treadwrite {\n"
"\t\t\t\t\t\tuplevel 2 [list $readslot -append $realprop]\n"
"\t\t\t\t\t\tuplevel 2 [list $writeslot -append $realprop]\n"
"\t\t\t\t\t\tuplevel 2 [list method $reader -unexport {} $getter]\n"
"\t\t\t\t\t\tuplevel 2 [list method $writer -unexport {value} $setter]\n"
"\t\t\t\t\t}\n"
"\t\t\t\t}\n"
"\t\t\t}\n"
"\t\t}\n"
"\t\tnamespace eval configurableclass {\n"
"\t\t\t::proc property args {\n"
"\t\t\t\t::oo::configuresupport::PropertyImpl \\\n"
"\t\t\t\t\t::oo::configuresupport::readableproperties \\\n"
"\t\t\t\t\t::oo::configuresupport::writableproperties {*}$args\n"
"\t\t\t}\n"
"\t\t\t::proc properties args {::tailcall property {*}$args}\n"
"\t\t\t::namespace path ::oo::define\n"
"\t\t\t::namespace export property\n"
"\t\t}\n"
"\t\tnamespace eval configurableobject {\n"
"\t\t\t::proc property args {\n"
"\t\t\t\t::oo::configuresupport::PropertyImpl \\\n"
"\t\t\t\t\t::oo::configuresupport::objreadableproperties \\\n"
"\t\t\t\t\t::oo::configuresupport::objwritableproperties {*}$args\n"
"\t\t\t}\n"
"\t\t\t::proc properties args {::tailcall property {*}$args}\n"
"\t\t\t::namespace path ::oo::objdefine\n"
"\t\t\t::namespace export property\n"
"\t\t}\n"
"\t\tproc ReadAll {object my} {\n"
"\t\t\tset result {}\n"
"\t\t\tforeach prop [info object properties $object -all -readable] {\n"
"\t\t\t\ttry {\n"
"\t\t\t\t\tdict set result $prop [$my <ReadProp$prop>]\n"
"\t\t\t\t} on error {msg opt} {\n"
"\t\t\t\t\tdict set opt -level 2\n"
"\t\t\t\t\treturn -options $opt $msg\n"
"\t\t\t\t} on return {msg opt} {\n"
"\t\t\t\t\tdict incr opt -level 2\n"
"\t\t\t\t\treturn -options $opt $msg\n"
"\t\t\t\t} on break {} {\n"
"\t\t\t\t\treturn -code error -level 2 -errorcode {TCLOO SHENANIGANS} \\\n"
"\t\t\t\t\t\t\"property getter for $prop did a break\"\n"
"\t\t\t\t} on continue {} {\n"
"\t\t\t\t\treturn -code error -level 2 -errorcode {TCLOO SHENANIGANS} \\\n"
"\t\t\t\t\t\t\"property getter for $prop did a continue\"\n"
"\t\t\t\t}\n"
"\t\t\t}\n"
"\t\t\treturn $result\n"
"\t\t}\n"
"\t\tproc ReadOne {object my propertyName} {\n"
"\t\t\tset props [info object properties $object -all -readable]\n"
"\t\t\ttry {\n"
"\t\t\t\tset prop [prefix match -message \"property\" $props $propertyName]\n"
"\t\t\t} on error {msg} {\n"
"\t\t\t\tcatch {\n"
"\t\t\t\t\tset wps [info object properties $object -all -writable]\n"
"\t\t\t\t\tset wprop [prefix match $wps $propertyName]\n"
"\t\t\t\t\tset msg \"property \\\"$wprop\\\" is write only\"\n"
"\t\t\t\t}\n"
"\t\t\t\treturn -code error -level 2 -errorcode [list \\\n"
"\t\t\t\t\t\tTCL LOOKUP INDEX property $propertyName] $msg\n"
"\t\t\t}\n"
"\t\t\ttry {\n"
"\t\t\t\tset value [$my <ReadProp$prop>]\n"
"\t\t\t} on error {msg opt} {\n"
"\t\t\t\tdict set opt -level 2\n"
"\t\t\t\treturn -options $opt $msg\n"
"\t\t\t} on return {msg opt} {\n"
"\t\t\t\tdict incr opt -level 2\n"
"\t\t\t\treturn -options $opt $msg\n"
"\t\t\t} on break {} {\n"
"\t\t\t\treturn -code error -level 2 -errorcode {TCLOO SHENANIGANS} \\\n"
"\t\t\t\t\t\"property getter for $prop did a break\"\n"
"\t\t\t} on continue {} {\n"
"\t\t\t\treturn -code error -level 2 -errorcode {TCLOO SHENANIGANS} \\\n"
"\t\t\t\t\t\"property getter for $prop did a continue\"\n"
"\t\t\t}\n"
"\t\t\treturn $value\n"
"\t\t}\n"
"\t\tproc WriteMany {object my setterMap} {\n"
"\t\t\tset props [info object properties $object -all -writable]\n"
"\t\t\tforeach {prop value} $setterMap {\n"
"\t\t\t\ttry {\n"
"\t\t\t\t\tset prop [prefix match -message \"property\" $props $prop]\n"
"\t\t\t\t} on error {msg} {\n"
"\t\t\t\t\tcatch {\n"
"\t\t\t\t\t\tset rps [info object properties $object -all -readable]\n"
"\t\t\t\t\t\tset rprop [prefix match $rps $prop]\n"
"\t\t\t\t\t\tset msg \"property \\\"$rprop\\\" is read only\"\n"
"\t\t\t\t\t}\n"
"\t\t\t\t\treturn -code error -level 2 -errorcode [list \\\n"
"\t\t\t\t\t\t\tTCL LOOKUP INDEX property $prop] $msg\n"
"\t\t\t\t}\n"
"\t\t\t\ttry {\n"
"\t\t\t\t\t$my <WriteProp$prop> $value\n"
"\t\t\t\t} on error {msg opt} {\n"
"\t\t\t\t\tdict set opt -level 2\n"
"\t\t\t\t\treturn -options $opt $msg\n"
"\t\t\t\t} on return {msg opt} {\n"
"\t\t\t\t\tdict incr opt -level 2\n"
"\t\t\t\t\treturn -options $opt $msg\n"
"\t\t\t\t} on break {} {\n"
"\t\t\t\t\treturn -code error -level 2 -errorcode {TCLOO SHENANIGANS} \\\n"
"\t\t\t\t\t\t\"property setter for $prop did a break\"\n"
"\t\t\t\t} on continue {} {\n"
"\t\t\t\t\treturn -code error -level 2 -errorcode {TCLOO SHENANIGANS} \\\n"
"\t\t\t\t\t\t\"property setter for $prop did a continue\"\n"
"\t\t\t\t}\n"
"\t\t\t}\n"
"\t\t\treturn\n"
"\t\t}\n"
"\t\t::oo::class create configurable {\n"
"\t\t\tprivate variable my\n"
"\t\t\tmethod configure -export args {\n"
"\t\t\t\t::if {![::info exists my]} {\n"
"\t\t\t\t\t::set my [::namespace which my]\n"
"\t\t\t\t}\n"
"\t\t\t\t::if {[::llength $args] == 0} {\n"
"\t\t\t\t\t::oo::configuresupport::ReadAll [self] $my\n"
"\t\t\t\t} elseif {[::llength $args] == 1} {\n"
"\t\t\t\t\t::oo::configuresupport::ReadOne [self] $my \\\n"
"\t\t\t\t\t\t[::lindex $args 0]\n"
"\t\t\t\t} elseif {[::llength $args] % 2 == 0} {\n"
"\t\t\t\t\t::oo::configuresupport::WriteMany [self] $my $args\n"
"\t\t\t\t} else {\n"
"\t\t\t\t\t::return -code error -errorcode {TCL WRONGARGS} \\\n"
"\t\t\t\t\t\t[::format {wrong # args: should be \"%s\"} \\\n"
"\t\t\t\t\t\t\t\"[self] configure \?-option value ...\?\"]\n"
"\t\t\t\t}\n"
"\t\t\t}\n"
"\t\t\tdefinitionnamespace -instance configurableobject\n"
"\t\t\tdefinitionnamespace -class configurableclass\n"
"\t\t}\n"
"\t}\n"
"\tclass create configurable {\n"
"\t\tsuperclass class\n"
"\t\tconstructor {{definitionScript \"\"}} {\n"
"\t\t\tnext {mixin ::oo::configuresupport::configurable}\n"
"\t\t\tnext $definitionScript\n"
"\t\t}\n"
"\t\tdefinitionnamespace -class configuresupport::configurableclass\n"
"\t}\n"
"}\n"
/* !END!: Do not edit above this line. */
;

#endif /* TCL_OO_SCRIPT_H */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclObj.c.

12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclTomMath.h"
#include "tclAbstractList.h"
#include <math.h>
#include <assert.h>

/*
 * Table of all object types.
 */








<







12
13
14
15
16
17
18

19
20
21
22
23
24
25
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

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

#include <math.h>
#include <assert.h>

/*
 * Table of all object types.
 */

77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
 * The structure defined below is used in this file only.
 */

typedef struct {
    Tcl_HashTable *lineCLPtr;   /* This table remembers for each Tcl_Obj
                                 * generated by a call to the function
                                 * TclSubstTokens() from a literal text
                                 * where bs+nl sequences occured in it, if
                                 * any. I.e. this table keeps track of
                                 * invisible and stripped continuation lines.
                                 * Its keys are Tcl_Obj pointers, the values
                                 * are ContLineLoc pointers. See the file
                                 * tclCompile.h for the definition of this
                                 * structure, and for references to all
                                 * related places in the core. */







|







76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
 * The structure defined below is used in this file only.
 */

typedef struct {
    Tcl_HashTable *lineCLPtr;   /* This table remembers for each Tcl_Obj
                                 * generated by a call to the function
                                 * TclSubstTokens() from a literal text
                                 * where bs+nl sequences occurred in it, if
                                 * any. I.e. this table keeps track of
                                 * invisible and stripped continuation lines.
                                 * Its keys are Tcl_Obj pointers, the values
                                 * are ContLineLoc pointers. See the file
                                 * tclCompile.h for the definition of this
                                 * structure, and for references to all
                                 * related places in the core. */
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
 * structure; every thread will have its own structure instance. The purpose
 * of this structure is to allow deeply nested collections of Tcl_Objs to be
 * freed without taking a vast depth of C stack (which could cause all sorts
 * of breakage.)
 */

typedef struct PendingObjData {
    int deletionCount;		/* Count of the number of invokations of
				 * TclFreeObj() are on the stack (at least
				 * conceptually; many are actually expanded
				 * macros). */
    Tcl_Obj *deletionStack;	/* Stack of objects that have had TclFreeObj()
				 * invoked upon them but which can't be
				 * deleted yet because they are in a nested
				 * invokation of TclFreeObj(). By postponing
				 * this way, we limit the maximum overall C
				 * stack depth when deleting a complex object.
				 * The down-side is that we alter the overall
				 * behaviour by altering the order in which
				 * objects are deleted, and we change the
				 * order in which the string rep and the
				 * internal rep of an object are deleted. Note







|






|







107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
 * structure; every thread will have its own structure instance. The purpose
 * of this structure is to allow deeply nested collections of Tcl_Objs to be
 * freed without taking a vast depth of C stack (which could cause all sorts
 * of breakage.)
 */

typedef struct PendingObjData {
    int deletionCount;		/* Count of the number of invocations of
				 * TclFreeObj() are on the stack (at least
				 * conceptually; many are actually expanded
				 * macros). */
    Tcl_Obj *deletionStack;	/* Stack of objects that have had TclFreeObj()
				 * invoked upon them but which can't be
				 * deleted yet because they are in a nested
				 * invocation of TclFreeObj(). By postponing
				 * this way, we limit the maximum overall C
				 * stack depth when deleting a complex object.
				 * The down-side is that we alter the overall
				 * behaviour by altering the order in which
				 * objects are deleted, and we change the
				 * order in which the string rep and the
				 * internal rep of an object are deleted. Note
199
200
201
202
203
204
205



206
207
208
209
210
211
212
static void		UpdateStringOfDouble(Tcl_Obj *objPtr);
static void		UpdateStringOfInt(Tcl_Obj *objPtr);
static void		FreeBignum(Tcl_Obj *objPtr);
static void		DupBignum(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
static void		UpdateStringOfBignum(Tcl_Obj *objPtr);
static int		GetBignumFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    int copy, mp_int *bignumValue);




/*
 * Prototypes for the array hash key methods.
 */

static Tcl_HashEntry *	AllocObjEntry(Tcl_HashTable *tablePtr, void *keyPtr);








>
>
>







198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
static void		UpdateStringOfDouble(Tcl_Obj *objPtr);
static void		UpdateStringOfInt(Tcl_Obj *objPtr);
static void		FreeBignum(Tcl_Obj *objPtr);
static void		DupBignum(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
static void		UpdateStringOfBignum(Tcl_Obj *objPtr);
static int		GetBignumFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    int copy, mp_int *bignumValue);
static int		SetDuplicatePureObj(Tcl_Interp *interp,
			    Tcl_Obj *dupPtr, Tcl_Obj *objPtr,
			    const Tcl_ObjType *typePtr);

/*
 * Prototypes for the array hash key methods.
 */

static Tcl_HashEntry *	AllocObjEntry(Tcl_HashTable *tablePtr, void *keyPtr);

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
/*
 * The structures below defines the Tcl object types defined in this file by
 * means of functions that can be invoked by generic object code. See also
 * tclStringObj.c, tclListObj.c, tclByteCode.c for other type manager
 * implementations.
 */

const Tcl_ObjType tclBooleanType = {
    "boolean",			/* name */
    NULL,			/* freeIntRepProc */
    NULL,			/* dupIntRepProc */
    NULL,			/* updateStringProc */
    TclSetBooleanFromAny		/* setFromAnyProc */

};
const Tcl_ObjType tclDoubleType = {
    "double",			/* name */
    NULL,			/* freeIntRepProc */
    NULL,			/* dupIntRepProc */
    UpdateStringOfDouble,	/* updateStringProc */
    SetDoubleFromAny		/* setFromAnyProc */

};
const Tcl_ObjType tclIntType = {
    "int",			/* name */
    NULL,			/* freeIntRepProc */
    NULL,			/* dupIntRepProc */
    UpdateStringOfInt,		/* updateStringProc */
    SetIntFromAny		/* setFromAnyProc */

};
const Tcl_ObjType tclBignumType = {
    "bignum",			/* name */
    FreeBignum,			/* freeIntRepProc */
    DupBignum,			/* dupIntRepProc */
    UpdateStringOfBignum,	/* updateStringProc */
    NULL			/* setFromAnyProc */

};

/*
 * The structure below defines the Tcl obj hash key type.
 */

const Tcl_HashKeyType tclObjHashKeyType = {







|




|
>

|




|
>






|
>






|
>







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
/*
 * The structures below defines the Tcl object types defined in this file by
 * means of functions that can be invoked by generic object code. See also
 * tclStringObj.c, tclListObj.c, tclByteCode.c for other type manager
 * implementations.
 */

const Tcl_ObjType tclBooleanType= {
    "boolean",			/* name */
    NULL,			/* freeIntRepProc */
    NULL,			/* dupIntRepProc */
    NULL,			/* updateStringProc */
    TclSetBooleanFromAny,	/* setFromAnyProc */
    TCL_OBJTYPE_V1(TclLengthOne)
};
const Tcl_ObjType tclDoubleType= {
    "double",			/* name */
    NULL,			/* freeIntRepProc */
    NULL,			/* dupIntRepProc */
    UpdateStringOfDouble,	/* updateStringProc */
    SetDoubleFromAny,		/* setFromAnyProc */
    TCL_OBJTYPE_V1(TclLengthOne)
};
const Tcl_ObjType tclIntType = {
    "int",			/* name */
    NULL,			/* freeIntRepProc */
    NULL,			/* dupIntRepProc */
    UpdateStringOfInt,		/* updateStringProc */
    SetIntFromAny,		/* setFromAnyProc */
    TCL_OBJTYPE_V1(TclLengthOne)
};
const Tcl_ObjType tclBignumType = {
    "bignum",			/* name */
    FreeBignum,			/* freeIntRepProc */
    DupBignum,			/* dupIntRepProc */
    UpdateStringOfBignum,	/* updateStringProc */
    NULL,			/* setFromAnyProc */
    TCL_OBJTYPE_V1(TclLengthOne)
};

/*
 * The structure below defines the Tcl obj hash key type.
 */

const Tcl_HashKeyType tclObjHashKeyType = {
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
 */

Tcl_ObjType tclCmdNameType = {
    "cmdName",			/* name */
    FreeCmdNameInternalRep,	/* freeIntRepProc */
    DupCmdNameInternalRep,	/* dupIntRepProc */
    NULL,			/* updateStringProc */
    SetCmdNameFromAny		/* setFromAnyProc */

};

/*
 * Structure containing a cached pointer to a command that is the result of
 * resolving the command's name in some namespace. It is the internal
 * representation for a cmdName object. It contains the pointer along with
 * some information that is used to check the pointer's validity.
 */

typedef struct ResolvedCmdName {
    Command *cmdPtr;		/* A cached Command pointer. */
    Namespace *refNsPtr;	/* Points to the namespace containing the
				 * reference (not the namespace that contains
				 * the referenced command). NULL if the name
				 * is fully qualified.*/
    size_t refNsId;		/* refNsPtr's unique namespace id. Used to
				 * verify that refNsPtr is still valid (e.g.,
				 * it's possible that the cmd's containing
				 * namespace was deleted and a new one created
				 * at the same address). */
    size_t refNsCmdEpoch;	/* Value of the referencing namespace's
				 * cmdRefEpoch when the pointer was cached.
				 * Before using the cached pointer, we check
				 * if the namespace's epoch was incremented;
				 * if so, this cached pointer is invalid. */
    size_t cmdEpoch;		/* Value of the command's cmdEpoch when this
				 * pointer was cached. Before using the cached
				 * pointer, we check if the cmd's epoch was
				 * incremented; if so, the cmd was renamed,
				 * deleted, hidden, or exposed, and so the
				 * pointer is invalid. */
    size_t refCount;		/* Reference count: 1 for each cmdName object
				 * that has a pointer to this ResolvedCmdName
				 * structure as its internal rep. This
				 * structure can be freed when refCount
				 * becomes zero. */
} ResolvedCmdName;













/*
 *-------------------------------------------------------------------------
 *
 * TclInitObjectSubsystem --
 *
 *	This function is invoked to perform once-only initialization of the







|
>




















|




|











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







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

Tcl_ObjType tclCmdNameType = {
    "cmdName",			/* name */
    FreeCmdNameInternalRep,	/* freeIntRepProc */
    DupCmdNameInternalRep,	/* dupIntRepProc */
    NULL,			/* updateStringProc */
    SetCmdNameFromAny,		/* setFromAnyProc */
    TCL_OBJTYPE_V0
};

/*
 * Structure containing a cached pointer to a command that is the result of
 * resolving the command's name in some namespace. It is the internal
 * representation for a cmdName object. It contains the pointer along with
 * some information that is used to check the pointer's validity.
 */

typedef struct ResolvedCmdName {
    Command *cmdPtr;		/* A cached Command pointer. */
    Namespace *refNsPtr;	/* Points to the namespace containing the
				 * reference (not the namespace that contains
				 * the referenced command). NULL if the name
				 * is fully qualified.*/
    size_t refNsId;		/* refNsPtr's unique namespace id. Used to
				 * verify that refNsPtr is still valid (e.g.,
				 * it's possible that the cmd's containing
				 * namespace was deleted and a new one created
				 * at the same address). */
    Tcl_Size refNsCmdEpoch;	/* Value of the referencing namespace's
				 * cmdRefEpoch when the pointer was cached.
				 * Before using the cached pointer, we check
				 * if the namespace's epoch was incremented;
				 * if so, this cached pointer is invalid. */
    Tcl_Size cmdEpoch;		/* Value of the command's cmdEpoch when this
				 * pointer was cached. Before using the cached
				 * pointer, we check if the cmd's epoch was
				 * incremented; if so, the cmd was renamed,
				 * deleted, hidden, or exposed, and so the
				 * pointer is invalid. */
    size_t refCount;		/* Reference count: 1 for each cmdName object
				 * that has a pointer to this ResolvedCmdName
				 * structure as its internal rep. This
				 * structure can be freed when refCount
				 * becomes zero. */
} ResolvedCmdName;

#ifdef TCL_MEM_DEBUG
/*
 * Filler matches the value used for filling freed memory in tclCkalloc.
 * On 32-bit systems, the ref counts do not cross 0x7fffffff. On 64-bit
 * implementations, ref counts will never reach this value (unless explicitly
 * incremented without actual references!)
 */
#define FREEDREFCOUNTFILLER \
    (Tcl_Size)(sizeof(objPtr->refCount) == 4 ? 0xe8e8e8e8 : 0xe8e8e8e8e8e8e8e8)
#endif


/*
 *-------------------------------------------------------------------------
 *
 * TclInitObjectSubsystem --
 *
 *	This function is invoked to perform once-only initialization of the
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
    Tcl_RegisterObjType(&tclIntType);
#if !defined(TCL_WIDE_INT_IS_LONG)
    Tcl_RegisterObjType(&oldIntType);
#endif
    Tcl_RegisterObjType(&oldBooleanType);
#endif

    Tcl_RegisterObjType(&tclAbstractListType);

#ifdef TCL_COMPILE_STATS
    Tcl_MutexLock(&tclObjMutex);
    tclObjsAlloced = 0;
    tclObjsFreed = 0;
    {
	int i;








<
<







394
395
396
397
398
399
400


401
402
403
404
405
406
407
    Tcl_RegisterObjType(&tclIntType);
#if !defined(TCL_WIDE_INT_IS_LONG)
    Tcl_RegisterObjType(&oldIntType);
#endif
    Tcl_RegisterObjType(&oldBooleanType);
#endif



#ifdef TCL_COMPILE_STATS
    Tcl_MutexLock(&tclObjMutex);
    tclObjsAlloced = 0;
    tclObjsFreed = 0;
    {
	int i;

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

ContLineLoc *
TclContinuationsEnter(
    Tcl_Obj *objPtr,
    size_t num,
    int *loc)
{
    int newEntry;
    ThreadSpecificData *tsdPtr = TclGetContLineTable();
    Tcl_HashEntry *hPtr =
	    Tcl_CreateHashEntry(tsdPtr->lineCLPtr, objPtr, &newEntry);
    ContLineLoc *clLocPtr = (ContLineLoc *)Tcl_Alloc(offsetof(ContLineLoc, loc) + (num + 1U) *sizeof(int));

    if (!newEntry) {
	/*
	 * We're entering ContLineLoc data for the same value more than one
	 * time. Taking care not to leak the old entry.
	 *
	 * This can happen when literals in a proc body are shared. See for
	 * example test info-30.19 where the action (code) for all branches of
	 * the switch command is identical, mapping them all to the same
	 * literal. An interesting result of this is that the number and
	 * locations (offset) of invisible continuation lines in the literal
	 * are the same for all occurences.
	 *
	 * Note that while reusing the existing entry is possible it requires
	 * the same actions as for a new entry because we have to copy the
	 * incoming num/loc data even so. Because we are called from
	 * TclContinuationsEnterDerived for this case, which modified the
	 * stored locations (Rebased to the proper relative offset). Just
	 * returning the stored entry would rebase them a second time, or







|


















|







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

ContLineLoc *
TclContinuationsEnter(
    Tcl_Obj *objPtr,
    Tcl_Size num,
    int *loc)
{
    int newEntry;
    ThreadSpecificData *tsdPtr = TclGetContLineTable();
    Tcl_HashEntry *hPtr =
	    Tcl_CreateHashEntry(tsdPtr->lineCLPtr, objPtr, &newEntry);
    ContLineLoc *clLocPtr = (ContLineLoc *)Tcl_Alloc(offsetof(ContLineLoc, loc) + (num + 1U) *sizeof(int));

    if (!newEntry) {
	/*
	 * We're entering ContLineLoc data for the same value more than one
	 * time. Taking care not to leak the old entry.
	 *
	 * This can happen when literals in a proc body are shared. See for
	 * example test info-30.19 where the action (code) for all branches of
	 * the switch command is identical, mapping them all to the same
	 * literal. An interesting result of this is that the number and
	 * locations (offset) of invisible continuation lines in the literal
	 * are the same for all occurrences.
	 *
	 * Note that while reusing the existing entry is possible it requires
	 * the same actions as for a new entry because we have to copy the
	 * incoming num/loc data even so. Because we are called from
	 * TclContinuationsEnterDerived for this case, which modified the
	 * stored locations (Rebased to the proper relative offset). Just
	 * returning the stored entry would rebase them a second time, or
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614

void
TclContinuationsEnterDerived(
    Tcl_Obj *objPtr,
    int start,
    int *clNext)
{
    size_t length;
    int end, num;
    int *wordCLLast = clNext;

    /*
     * We have to handle invisible continuations lines here as well, despite
     * the code we have in TclSubstTokens (TST) for that. Why ?  Nesting. If
     * our script is the sole argument to an 'eval' command, for example, the







|







617
618
619
620
621
622
623
624
625
626
627
628
629
630
631

void
TclContinuationsEnterDerived(
    Tcl_Obj *objPtr,
    int start,
    int *clNext)
{
    Tcl_Size length;
    int end, num;
    int *wordCLLast = clNext;

    /*
     * We have to handle invisible continuations lines here as well, despite
     * the code we have in TclSubstTokens (TST) for that. Why ?  Nesting. If
     * our script is the sole argument to an 'eval' command, for example, the
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
    Tcl_Interp *interp,		/* Interpreter used for error reporting. */
    Tcl_Obj *objPtr)		/* Points to the Tcl object onto which the
				 * name of each registered type is appended as
				 * a list element. */
{
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    size_t numElems;

    /*
     * Get the test for a valid list out of the way first.
     */

    if (TclListObjLengthM(interp, objPtr, &numElems) != TCL_OK) {
	return TCL_ERROR;







|







860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
    Tcl_Interp *interp,		/* Interpreter used for error reporting. */
    Tcl_Obj *objPtr)		/* Points to the Tcl object onto which the
				 * name of each registered type is appended as
				 * a list element. */
{
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    Tcl_Size numElems;

    /*
     * Get the test for a valid list out of the way first.
     */

    if (TclListObjLengthM(interp, objPtr, &numElems) != TCL_OK) {
	return TCL_ERROR;
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
    Tcl_HashEntry *hPtr;
    Tcl_HashTable *tablePtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    tablePtr = tsdPtr->objThreadMap;

    if (tablePtr != NULL) {
	fprintf(outFile, "total objects: %" TCL_Z_MODIFIER "u\n", tablePtr->numEntries);
	for (hPtr = Tcl_FirstHashEntry(tablePtr, &hSearch); hPtr != NULL;
		hPtr = Tcl_NextHashEntry(&hSearch)) {
	    ObjData *objData = (ObjData *)Tcl_GetHashValue(hPtr);

	    if (objData != NULL) {
		fprintf(outFile,
			"key = 0x%p, objPtr = 0x%p, file = %s, line = %d\n",







|







996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
    Tcl_HashEntry *hPtr;
    Tcl_HashTable *tablePtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    tablePtr = tsdPtr->objThreadMap;

    if (tablePtr != NULL) {
	fprintf(outFile, "total objects: %" TCL_SIZE_MODIFIER "d\n", tablePtr->numEntries);
	for (hPtr = Tcl_FirstHashEntry(tablePtr, &hSearch); hPtr != NULL;
		hPtr = Tcl_NextHashEntry(&hSearch)) {
	    ObjData *objData = (ObjData *)Tcl_GetHashValue(hPtr);

	    if (objData != NULL) {
		fprintf(outFile,
			"key = 0x%p, objPtr = 0x%p, file = %s, line = %d\n",
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
/*
 *----------------------------------------------------------------------
 *
 * TclDbInitNewObj --
 *
 *	Called via the TclNewObj or TclDbNewObj macros when TCL_MEM_DEBUG is
 *	enabled. This function will initialize the members of a Tcl_Obj
 *	struct. Initilization would be done inline via the TclNewObj macro
 *	when compiling without TCL_MEM_DEBUG.
 *
 * Results:
 *	The Tcl_Obj struct members are initialized.
 *
 * Side effects:
 *	None.







|







1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
/*
 *----------------------------------------------------------------------
 *
 * TclDbInitNewObj --
 *
 *	Called via the TclNewObj or TclDbNewObj macros when TCL_MEM_DEBUG is
 *	enabled. This function will initialize the members of a Tcl_Obj
 *	struct. Initialization would be done inline via the TclNewObj macro
 *	when compiling without TCL_MEM_DEBUG.
 *
 * Results:
 *	The Tcl_Obj struct members are initialized.
 *
 * Side effects:
 *	None.
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
    const char *file,	/* The name of the source file calling this
				 * function; used for debugging. */
    int line)		/* Line number in the source file; used for
				 * debugging. */
{
    objPtr->refCount = 0;
    objPtr->typePtr = NULL;
    TclInitStringRep(objPtr, NULL, 0);

#if TCL_THREADS
    /*
     * Add entry to a thread local map used to check if a Tcl_Obj was
     * allocated by the currently executing thread.
     */








|







1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
    const char *file,	/* The name of the source file calling this
				 * function; used for debugging. */
    int line)		/* Line number in the source file; used for
				 * debugging. */
{
    objPtr->refCount = 0;
    objPtr->typePtr = NULL;
    TclInitEmptyStringRep(objPtr);

#if TCL_THREADS
    /*
     * Add entry to a thread local map used to check if a Tcl_Obj was
     * allocated by the currently executing thread.
     */

1175
1176
1177
1178
1179
1180
1181


1182
1183
1184
1185
1186
1187
1188
1189
#else /* if not TCL_MEM_DEBUG */

Tcl_Obj *
Tcl_DbNewObj(
    TCL_UNUSED(const char *) /*file*/,
    TCL_UNUSED(int) /*line*/)
{


    return Tcl_NewObj();
}
#endif /* TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------------
 *
 * TclAllocateFreeObjects --







>
>
|







1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
#else /* if not TCL_MEM_DEBUG */

Tcl_Obj *
Tcl_DbNewObj(
    TCL_UNUSED(const char *) /*file*/,
    TCL_UNUSED(int) /*line*/)
{
    Tcl_Obj *objPtr;
    TclNewObj(objPtr);
    return objPtr;
}
#endif /* TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------------
 *
 * TclAllocateFreeObjects --
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322

    /*
     * Check for a double free of the same value.  This is slightly tricky
     * because it is customary to free a Tcl_Obj when its refcount falls
     * either from 1 to 0, or from 0 to -1.  Falling from -1 to -2, though,
     * and so on, is always a sign of a botch in the caller.
     */
    if (objPtr->refCount == (size_t)-2) {
	Tcl_Panic("Reference count for %p was negative", objPtr);
    }
    /*
     * Now, in case we just approved drop from 1 to 0 as acceptable, make
     * sure we do not accept a second free when falling from 0 to -1.
     * Skip that possibility so any double free will trigger the panic.
     */







|







1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341

    /*
     * Check for a double free of the same value.  This is slightly tricky
     * because it is customary to free a Tcl_Obj when its refcount falls
     * either from 1 to 0, or from 0 to -1.  Falling from -1 to -2, though,
     * and so on, is always a sign of a botch in the caller.
     */
    if (objPtr->refCount == (Tcl_Size)-2) {
	Tcl_Panic("Reference count for %p was negative", objPtr);
    }
    /*
     * Now, in case we just approved drop from 1 to 0 as acceptable, make
     * sure we do not accept a second free when falling from 0 to -1.
     * Skip that possibility so any double free will trigger the panic.
     */
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377

    /*
     * We cannot use TclGetContinuationTable() here, because that may
     * re-initialize the thread-data for calls coming after the finalization.
     * We have to access it using the low-level call and then check for
     * validity. This function can be called after TclFinalizeThreadData() has
     * already killed the thread-global data structures. Performing
     * TCL_TSD_INIT will leave us with an un-initialized memory block upon
     * which we crash (if we where to access the uninitialized hashtable).
     */

    {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
        Tcl_HashEntry *hPtr;








|







1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396

    /*
     * We cannot use TclGetContinuationTable() here, because that may
     * re-initialize the thread-data for calls coming after the finalization.
     * We have to access it using the low-level call and then check for
     * validity. This function can be called after TclFinalizeThreadData() has
     * already killed the thread-global data structures. Performing
     * TCL_TSD_INIT will leave us with an uninitialized memory block upon
     * which we crash (if we where to access the uninitialized hashtable).
     */

    {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
        Tcl_HashEntry *hPtr;

1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468

    /*
     * We cannot use TclGetContinuationTable() here, because that may
     * re-initialize the thread-data for calls coming after the finalization.
     * We have to access it using the low-level call and then check for
     * validity. This function can be called after TclFinalizeThreadData() has
     * already killed the thread-global data structures. Performing
     * TCL_TSD_INIT will leave us with an un-initialized memory block upon
     * which we crash (if we where to access the uninitialized hashtable).
     */

    {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
        Tcl_HashEntry *hPtr;








|







1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487

    /*
     * We cannot use TclGetContinuationTable() here, because that may
     * re-initialize the thread-data for calls coming after the finalization.
     * We have to access it using the low-level call and then check for
     * validity. This function can be called after TclFinalizeThreadData() has
     * already killed the thread-global data structures. Performing
     * TCL_TSD_INIT will leave us with an uninitialized memory block upon
     * which we crash (if we where to access the uninitialized hashtable).
     */

    {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
        Tcl_HashEntry *hPtr;

1505
1506
1507
1508
1509
1510
1511








1512
1513
1514
1515
1516
1517
1518
/*
 *----------------------------------------------------------------------
 *
 * Tcl_DuplicateObj --
 *
 *	Create and return a new object that is a duplicate of the argument
 *	object.








 *
 * Results:
 *	The return value is a pointer to a newly created Tcl_Obj. This object
 *	has reference count 0 and the same type, if any, as the source object
 *	objPtr. Also:
 *	  1) If the source object has a valid string rep, we copy it;
 *	     otherwise, the duplicate's string rep is set NULL to mark it







>
>
>
>
>
>
>
>







1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
/*
 *----------------------------------------------------------------------
 *
 * Tcl_DuplicateObj --
 *
 *	Create and return a new object that is a duplicate of the argument
 *	object.
 *
 * TclDuplicatePureObj --
 *	Like Tcl_DuplicateObj, except that it converts the duplicate to the
 *	specifid typ, does not duplicate the 'bytes'
 *	field unless it is necessary, i.e. the duplicated Tcl_Obj provides no
 *	updateStringProc.  This can avoid an expensive memory allocation since
 *	the data in the 'bytes' field of each Tcl_Obj must reside in allocated
 *	memory.
 *
 * Results:
 *	The return value is a pointer to a newly created Tcl_Obj. This object
 *	has reference count 0 and the same type, if any, as the source object
 *	objPtr. Also:
 *	  1) If the source object has a valid string rep, we copy it;
 *	     otherwise, the duplicate's string rep is set NULL to mark it
1556
1557
1558
1559
1560
1561
1562











































































































1563
1564
1565
1566
1567
1568
1569
{
    Tcl_Obj *dupPtr;

    TclNewObj(dupPtr);
    SetDuplicateObj(dupPtr, objPtr);
    return dupPtr;
}












































































































void
TclSetDuplicateObj(
    Tcl_Obj *dupPtr,
    Tcl_Obj *objPtr)
{
    if (Tcl_IsShared(dupPtr)) {







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







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
{
    Tcl_Obj *dupPtr;

    TclNewObj(dupPtr);
    SetDuplicateObj(dupPtr, objPtr);
    return dupPtr;
}


/*
 *----------------------------------------------------------------------
 *
 * TclDuplicatePureObj --
 *
 *	Duplicates a Tcl_Obj and converts the internal representation of the
 *	duplicate to the given type, changing neither the 'bytes' field
 *	nor the internal representation of the original object, and without
 *	duplicating the bytes field unless necessary, i.e. unless the
 *	duplicate provides no updateStringProc after conversion.  This can
 *	avoid an expensive memory allocation since the data in the 'bytes'
 *	field of each Tcl_Obj must reside in allocated memory.
 *
 * Results:
 *	A pointer to a newly-created Tcl_Obj or NULL if there was an error.
 *	This object has reference count 0.  Also:
 *
 *----------------------------------------------------------------------
 */
int SetDuplicatePureObj(
    Tcl_Interp *interp,
    Tcl_Obj *dupPtr,
    Tcl_Obj *objPtr,
    const Tcl_ObjType *typePtr)
{
    char *bytes = objPtr->bytes;
    int status = TCL_OK;
    const Tcl_ObjType *useTypePtr =
        objPtr->typePtr ? objPtr->typePtr : typePtr;

    TclInvalidateStringRep(dupPtr);
    assert(dupPtr->typePtr == NULL);

    if (objPtr->typePtr && objPtr->typePtr->dupIntRepProc) {
	objPtr->typePtr->dupIntRepProc(objPtr, dupPtr);
    } else {
	dupPtr->internalRep = objPtr->internalRep;
	dupPtr->typePtr = objPtr->typePtr;
    }

    if (typePtr != NULL && dupPtr->typePtr != useTypePtr) {
	if (bytes) {
	    dupPtr->bytes = bytes;
	    dupPtr->length = objPtr->length;
	}
	/* borrow bytes from original object */
	status = Tcl_ConvertToType(interp, dupPtr, useTypePtr);
	if (bytes) {
	    dupPtr->bytes = NULL;
	    dupPtr->length = 0;
	}
	if (status != TCL_OK) {
	    return status;
	}
    }

    /* tclStringType is treated as a special case because a Tcl_Obj having this
     * type can not always update the string representation.  This happens, for
     * example, when Tcl_GetCharLength() converts the internal representation
     * to tclStringType in order to store the number of characters, but does
     * not store enough information to generate the string representation.
     *
     * Perhaps in the future this can be remedied and this special treatment
     * removed.
     */


    if (bytes && (dupPtr->typePtr == NULL
	|| dupPtr->typePtr->updateStringProc == NULL
	|| useTypePtr == &tclStringType
	)
    ) {
	if (!TclAttemptInitStringRep(dupPtr, bytes, objPtr->length)) {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"insufficient memory to initialize string", -1));
		Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	    }
	    status = TCL_ERROR;
	}
    }
    return status;
}

Tcl_Obj *
TclDuplicatePureObj(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,
    const Tcl_ObjType *typePtr
)		/* The object to duplicate. */
{
    int status;
    Tcl_Obj *dupPtr;

    TclNewObj(dupPtr);
    status = SetDuplicatePureObj(interp, dupPtr, objPtr, typePtr);
    if (status == TCL_OK) {
	return dupPtr;
    } else {
	Tcl_DecrRefCount(dupPtr);
	return NULL;
    }
}



void
TclSetDuplicateObj(
    Tcl_Obj *dupPtr,
    Tcl_Obj *objPtr)
{
    if (Tcl_IsShared(dupPtr)) {
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
 * Side effects:
 *	May call the object's updateStringProc to update the string
 *	representation from the internal representation.
 *
 *----------------------------------------------------------------------
 */

#undef TclGetStringFromObj
char *
TclGetStringFromObj(
    Tcl_Obj *objPtr,	/* Object whose string rep byte pointer should
				 * be returned. */
    int *lengthPtr)	/* If non-NULL, the location where the string
				 * rep's byte array length should * be stored.
				 * If NULL, no length is stored. */
{
    if (objPtr->bytes == NULL) {
	/*
	 * Note we do not check for objPtr->typePtr == NULL.  An invariant
	 * of a properly maintained Tcl_Obj is that at least  one of







|




|







1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
 * Side effects:
 *	May call the object's updateStringProc to update the string
 *	representation from the internal representation.
 *
 *----------------------------------------------------------------------
 */

#if !defined(TCL_NO_DEPRECATED)
char *
TclGetStringFromObj(
    Tcl_Obj *objPtr,	/* Object whose string rep byte pointer should
				 * be returned. */
    void *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
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
		    "failed to create a valid string rep",
		    objPtr->typePtr->name);
	}
    }
    if (lengthPtr != NULL) {
	if (objPtr->length > INT_MAX) {
	    Tcl_Panic("Tcl_GetStringFromObj with 'int' lengthPtr"
		    "cannot handle such long strings. Please use 'size_t'");
	}
	*lengthPtr = (int)objPtr->length;
    }
    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







|

|



>






|







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
		    "failed to create a valid string rep",
		    objPtr->typePtr->name);
	}
    }
    if (lengthPtr != NULL) {
	if (objPtr->length > INT_MAX) {
	    Tcl_Panic("Tcl_GetStringFromObj with 'int' lengthPtr"
		    " cannot handle such long strings. Please use 'Tcl_Size'");
	}
	*(int *)lengthPtr = (int)objPtr->length;
    }
    return objPtr->bytes;
}
#endif /* !defined(TCL_NO_DEPRECATED) */

#undef Tcl_GetStringFromObj
char *
Tcl_GetStringFromObj(
    Tcl_Obj *objPtr,	/* Object whose string rep byte pointer should
				 * be returned. */
    Tcl_Size *lengthPtr)	/* If non-NULL, the location where the string
				 * rep's byte array length should * be stored.
				 * If NULL, no length is stored. */
{
    if (objPtr->bytes == NULL) {
	/*
	 * Note we do not check for objPtr->typePtr == NULL.  An invariant
	 * of a properly maintained Tcl_Obj is that at least  one of
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
    size_t numBytes)
{
    assert(objPtr->bytes == NULL || bytes == NULL);

    if (objPtr->bytes == NULL) {
	/* Start with no string rep */
	if (numBytes == 0) {
	    TclInitStringRep(objPtr, NULL, 0);
	    return objPtr->bytes;
	} else {
	    objPtr->bytes = (char *)Tcl_AttemptAlloc(numBytes + 1);
	    if (objPtr->bytes) {
		objPtr->length = numBytes;
		if (bytes) {
		    memcpy(objPtr->bytes, bytes, numBytes);







|







1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
    size_t numBytes)
{
    assert(objPtr->bytes == NULL || bytes == NULL);

    if (objPtr->bytes == NULL) {
	/* Start with no string rep */
	if (numBytes == 0) {
	    TclInitEmptyStringRep(objPtr);
	    return objPtr->bytes;
	} else {
	    objPtr->bytes = (char *)Tcl_AttemptAlloc(numBytes + 1);
	    if (objPtr->bytes) {
		objPtr->length = numBytes;
		if (bytes) {
		    memcpy(objPtr->bytes, bytes, numBytes);
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
		objPtr->bytes[objPtr->length] = '\0';
	    }
	}
    } else {
	/* Start with non-empty string rep (allocated) */
	if (numBytes == 0) {
	    Tcl_Free(objPtr->bytes);
	    TclInitStringRep(objPtr, NULL, 0);
	    return objPtr->bytes;
	} else {
	    objPtr->bytes = (char *)Tcl_AttemptRealloc(objPtr->bytes,
		    numBytes + 1);
	    if (objPtr->bytes) {
		objPtr->length = numBytes;
		objPtr->bytes[objPtr->length] = '\0';







|







1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
		objPtr->bytes[objPtr->length] = '\0';
	    }
	}
    } else {
	/* Start with non-empty string rep (allocated) */
	if (numBytes == 0) {
	    Tcl_Free(objPtr->bytes);
	    TclInitEmptyStringRep(objPtr);
	    return objPtr->bytes;
	} else {
	    objPtr->bytes = (char *)Tcl_AttemptRealloc(objPtr->bytes,
		    numBytes + 1);
	    if (objPtr->bytes) {
		objPtr->length = numBytes;
		objPtr->bytes[objPtr->length] = '\0';
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
 *----------------------------------------------------------------------
 *
 * Tcl_StoreInternalRep --
 *
 *	Called to set the object's internal representation to match a
 *	particular type.
 *
 *	It is the caller's resonsibility to ensure that the given IntRep is

 *	appropriate for the existing string.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Calls the freeIntRepProc of the current Tcl_ObjType, if any.
 *	Sets the internalRep and typePtr fields to the submitted values.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_StoreInternalRep(
    Tcl_Obj *objPtr,		/* Object whose internal rep should be set. */
    const Tcl_ObjType *typePtr,	/* New type for the object */
    const Tcl_ObjInternalRep *irPtr)	/* New IntRep for the object */
{
    /* Clear out any existing IntRep.  This is the point where shimmering, i.e.
     * repeated alteration of the type of the internal representation, may
     * occur. */
    TclFreeInternalRep(objPtr);

    /* When irPtr == NULL, just leave objPtr with no IntRep for typePtr */
    if (irPtr) {
	/* Copy the new IntRep into place */
	objPtr->internalRep = *irPtr;

	/* Set the type to match */
	objPtr->typePtr = typePtr;
    }
}








|
>
|















|

|
<
<


|

|







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
 *----------------------------------------------------------------------
 *
 * Tcl_StoreInternalRep --
 *
 *	Called to set the object's internal representation to match a
 *	particular type.
 *
 *	It is the caller's responsibility to guarantee that
 *	the value of the submitted internalrep is in agreement with
 *	the value of any existing string rep.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Calls the freeIntRepProc of the current Tcl_ObjType, if any.
 *	Sets the internalRep and typePtr fields to the submitted values.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_StoreInternalRep(
    Tcl_Obj *objPtr,		/* Object whose internal rep should be set. */
    const Tcl_ObjType *typePtr,	/* New type for the object */
    const Tcl_ObjInternalRep *irPtr)	/* New internalrep for the object */
{
    /* Clear out any existing internalrep ( "shimmer" ) */


    TclFreeInternalRep(objPtr);

    /* When irPtr == NULL, just leave objPtr with no internalrep for typePtr */
    if (irPtr) {
	/* Copy the new internalrep into place */
	objPtr->internalRep = *irPtr;

	/* Set the type to match */
	objPtr->typePtr = typePtr;
    }
}

2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
    if ((flags & TCL_NULL_OK) && (objPtr == NULL || Tcl_GetString(objPtr)[0] == '\0')) {
	result = -1;
	goto boolEnd;
    } else if (objPtr == NULL) {
	if (interp) {
	    TclNewObj(objPtr);
	    TclParseNumber(interp, objPtr, (flags & TCL_NULL_OK)
		    ? "boolean value or \"\"" : "boolean value", NULL, -1, NULL, 0);
	    Tcl_DecrRefCount(objPtr);
	}
	return TCL_ERROR;
    }
    do {
	if (objPtr->typePtr == &tclIntType || objPtr->typePtr == &tclBooleanType) {
	    result = (objPtr->internalRep.wideValue != 0);







|







2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
    if ((flags & TCL_NULL_OK) && (objPtr == NULL || Tcl_GetString(objPtr)[0] == '\0')) {
	result = -1;
	goto boolEnd;
    } else if (objPtr == NULL) {
	if (interp) {
	    TclNewObj(objPtr);
	    TclParseNumber(interp, objPtr, (flags & TCL_NULL_OK)
		    ? "boolean value or \"\"" : "boolean value", NULL, TCL_INDEX_NONE, NULL, 0);
	    Tcl_DecrRefCount(objPtr);
	}
	return TCL_ERROR;
    }
    do {
	if (objPtr->typePtr == &tclIntType || objPtr->typePtr == &tclBooleanType) {
	    result = (objPtr->internalRep.wideValue != 0);
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

    if (ParseBoolean(objPtr) == TCL_OK) {
	return TCL_OK;
    }

  badBoolean:
    if (interp != NULL) {
	size_t length;
	const char *str = Tcl_GetStringFromObj(objPtr, &length);
	Tcl_Obj *msg;

	TclNewLiteralStringObj(msg, "expected boolean value but got \"");
	Tcl_AppendLimitedToObj(msg, str, length, 50, "");
	Tcl_AppendToObj(msg, "\"", -1);
	Tcl_SetObjResult(interp, msg);
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "BOOLEAN", NULL);
    }
    return TCL_ERROR;
}

static int
ParseBoolean(
    Tcl_Obj *objPtr)	/* The object to parse/convert. */
{
    int newBool;
    char lowerCase[6];
    size_t i, length;
    const char *str = Tcl_GetStringFromObj(objPtr, &length);

    if ((length == 0) || (length > 5)) {
	/*
         * Longest valid boolean string rep. is "false".
         */

	return TCL_ERROR;
    }

    switch (str[0]) {
    case '0':
	if (length == 1) {







|


















|




|
|







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

    if (ParseBoolean(objPtr) == TCL_OK) {
	return TCL_OK;
    }

  badBoolean:
    if (interp != NULL) {
	Tcl_Size 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];
    Tcl_Size i, length;
    const char *str = Tcl_GetStringFromObj(objPtr, &length);

    if ((length == 0) || (length > 5)) {
	/*
	 * Longest valid boolean string rep. is "false".
	 */

	return TCL_ERROR;
    }

    switch (str[0]) {
    case '0':
	if (length == 1) {
2963
2964
2965
2966
2967
2968
2969




















































































2970
2971
2972
2973
2974
2975
2976
	    TCL_PARSE_INTEGER_ONLY)==TCL_OK);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *




















































































 * TclGetWideBitsFromObj --
 *
 *	Attempt to return a wide integer from the Tcl object "objPtr". If the
 *	object is not already a int, double or bignum, an attempt will be made
 *	to convert it to one of these. Out-of-range values don't result in an
 *	error, but only the least significant 64 bits will be returned.
 *







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







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
	    TCL_PARSE_INTEGER_ONLY)==TCL_OK);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetWideUIntFromObj --
 *
 *	Attempt to return a unsigned wide integer from the Tcl object "objPtr". If the
 *	object is not already a wide int object or a bignum object, an attempt will
 *	be made to convert it to one.
 *
 * Results:
 *	The return value is a standard Tcl object result. If an error occurs
 *	during conversion, an error message is left in the interpreter's
 *	result unless "interp" is NULL.
 *
 * Side effects:
 *	If the object is not already an int object, the conversion will free
 *	any old internal representation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetWideUIntFromObj(
    Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr,	/* Object from which to get a wide int. */
    Tcl_WideUInt *wideUIntPtr)
				/* Place to store resulting long. */
{
    do {
	if (objPtr->typePtr == &tclIntType) {
	    if (objPtr->internalRep.wideValue < 0) {
	wideUIntOutOfRange:
		if (interp != NULL) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "expected unsigned integer but got \"%s\"",
			    TclGetString(objPtr)));
		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
		}
		return TCL_ERROR;
	    }
	    *wideUIntPtr = (Tcl_WideUInt)objPtr->internalRep.wideValue;
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclDoubleType) {
	    goto wideUIntOutOfRange;
	}
	if (objPtr->typePtr == &tclBignumType) {
	    /*
	     * Must check for those bignum values that can fit in a
	     * Tcl_WideUInt, even when auto-narrowing is enabled.
	     */

	    mp_int big;
	    Tcl_WideUInt value = 0;
	    size_t numBytes;
	    Tcl_WideUInt scratch;
	    unsigned char *bytes = (unsigned char *) &scratch;

	    TclUnpackBignum(objPtr, big);
	    if (big.sign == MP_NEG) {
		goto wideUIntOutOfRange;
	    }
	    if (mp_to_ubin(&big, bytes, sizeof(Tcl_WideUInt), &numBytes) == MP_OKAY) {
		while (numBytes-- > 0) {
		    value = (value << CHAR_BIT) | *bytes++;
		}
		*wideUIntPtr = (Tcl_WideUInt)value;
		return TCL_OK;
	    }

	    if (interp != NULL) {
		const char *s = "integer value too large to represent";
		Tcl_Obj *msg = Tcl_NewStringObj(s, -1);

		Tcl_SetObjResult(interp, msg);
		Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
	    }
	    return TCL_ERROR;
	}
    } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL,
	    TCL_PARSE_INTEGER_ONLY)==TCL_OK);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetWideBitsFromObj --
 *
 *	Attempt to return a wide integer from the Tcl object "objPtr". If the
 *	object is not already a int, double or bignum, an attempt will be made
 *	to convert it to one of these. Out-of-range values don't result in an
 *	error, but only the least significant 64 bits will be returned.
 *
3033
3034
3035
3036
3037
3038
3039

























3040
3041
3042
3043
3044
3045
3046
	    TCL_PARSE_INTEGER_ONLY)==TCL_OK);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *

























 * FreeBignum --
 *
 *	This function frees the internal rep of a bignum.
 *
 * Results:
 *	None.
 *







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







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
	    TCL_PARSE_INTEGER_ONLY)==TCL_OK);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetSizeIntFromObj --
 *
 *	Attempt to return a Tcl_Size from the Tcl object "objPtr".
 *
 * Results:
 *  TCL_OK - the converted Tcl_Size value is stored in *sizePtr
 *  TCL_ERROR - the error message is stored in interp
 *
 * Side effects:
 *	The function may free up any existing internal representation.
 *
 *----------------------------------------------------------------------
 */
int
Tcl_GetSizeIntFromObj(
    Tcl_Interp *interp, /* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr,	/* The object from which to get a int. */
    Tcl_Size *sizePtr)  /* Place to store resulting int. */
{
    return TclGetSizeIntFromObj(interp, objPtr, sizePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * FreeBignum --
 *
 *	This function frees the internal rep of a bignum.
 *
 * Results:
 *	None.
 *
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
 *
 *	This function duplicates the internal rep of a bignum.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The destination object receies a copy of the source object
 *
 *----------------------------------------------------------------------
 */

static void
DupBignum(
    Tcl_Obj *srcPtr,







|







3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
 *
 *	This function duplicates the internal rep of a bignum.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The destination object receives a copy of the source object
 *
 *----------------------------------------------------------------------
 */

static void
DupBignum(
    Tcl_Obj *srcPtr,
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_NewBignumObj --
 *
 *	Creates an initializes a bignum object.
 *
 * Results:
 *	Returns the newly created object.
 *
 * Side effects:
 *	The bignum value is cleared, since ownership has transferred to Tcl.
 *







|







3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_NewBignumObj --
 *
 *	Creates and initializes a bignum object.
 *
 * Results:
 *	Returns the newly created object.
 *
 * Side effects:
 *	The bignum value is cleared, since ownership has transferred to Tcl.
 *
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
		objPtr->typePtr = NULL;
		/*
		 * TODO: If objPtr has a string rep, this leaves
		 * it undisturbed.  Not clear that's proper. Pure
		 * bignum values are converted to empty string.
		 */
		if (objPtr->bytes == NULL) {
		    TclInitStringRep(objPtr, NULL, 0);
		}
	    }
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclIntType) {
	    if (mp_init_i64(bignumValue,
		    objPtr->internalRep.wideValue) != MP_OKAY) {







|







3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
		objPtr->typePtr = NULL;
		/*
		 * TODO: If objPtr has a string rep, this leaves
		 * it undisturbed.  Not clear that's proper. Pure
		 * bignum values are converted to empty string.
		 */
		if (objPtr->bytes == NULL) {
		    TclInitEmptyStringRep(objPtr);
		}
	    }
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclIntType) {
	    if (mp_init_i64(bignumValue,
		    objPtr->internalRep.wideValue) != MP_OKAY) {
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
 *	the object if necessary.
 *
 * Results:
 *	Returns TCL_OK if the conversion is successful, TCL_ERROR otherwise.
 *
 * Side effects:
 *	A copy of bignum is stored in *bignumValue, which is expected to be
 *	uninitialized or cleared. If conversion fails, an the 'interp'
 *	argument is not NULL, an error message is stored in the interpreter
 *	result.
 *
 *	It is expected that the caller will NOT have invoked mp_init on the
 *	bignum value before passing it in. Tcl will initialize the mp_int as
 *	it sets the value. The value is transferred from the internals of
 *	objPtr to the caller, passing responsibility of the caller to call







|







3587
3588
3589
3590
3591
3592
3593
3594
3595
3596
3597
3598
3599
3600
3601
 *	the object if necessary.
 *
 * Results:
 *	Returns TCL_OK if the conversion is successful, TCL_ERROR otherwise.
 *
 * Side effects:
 *	A copy of bignum is stored in *bignumValue, which is expected to be
 *	uninitialized or cleared. If conversion fails and the 'interp'
 *	argument is not NULL, an error message is stored in the interpreter
 *	result.
 *
 *	It is expected that the caller will NOT have invoked mp_init on the
 *	bignum value before passing it in. Tcl will initialize the mp_int as
 *	it sets the value. The value is transferred from the internals of
 *	objPtr to the caller, passing responsibility of the caller to call
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
    return TCL_ERROR;
}

int
Tcl_GetNumber(
    Tcl_Interp *interp,
    const char *bytes,
    size_t numBytes,
    void **clientDataPtr,
    int *typePtr)
{
    static Tcl_ThreadDataKey numberCacheKey;
    Tcl_Obj *objPtr = (Tcl_Obj *)Tcl_GetThreadData(&numberCacheKey,
	    sizeof(Tcl_Obj));

    Tcl_FreeInternalRep(objPtr);

    if (bytes == NULL) {
	bytes = &tclEmptyString;
	numBytes = 0;
    }
    if (numBytes == (size_t)TCL_INDEX_NONE) {
	numBytes = strlen(bytes);
    }
    if (numBytes > INT_MAX) {
	if (interp) {
            Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                    "max size for a Tcl value (%d bytes) exceeded", INT_MAX));
	    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);







|













|







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

int
Tcl_GetNumber(
    Tcl_Interp *interp,
    const char *bytes,
    Tcl_Size numBytes,
    void **clientDataPtr,
    int *typePtr)
{
    static Tcl_ThreadDataKey numberCacheKey;
    Tcl_Obj *objPtr = (Tcl_Obj *)Tcl_GetThreadData(&numberCacheKey,
	    sizeof(Tcl_Obj));

    Tcl_FreeInternalRep(objPtr);

    if (bytes == NULL) {
	bytes = &tclEmptyString;
	numBytes = 0;
    }
    if (numBytes < 0) {
	numBytes = strlen(bytes);
    }
    if (numBytes > INT_MAX) {
	if (interp) {
            Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                    "max size for a Tcl value (%d bytes) exceeded", INT_MAX));
	    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
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
 *----------------------------------------------------------------------
 *
 * Tcl_DecrRefCount --
 *
 *	Decrements the reference count of the object.
 *
 * Results:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_DecrRefCount
void
Tcl_DecrRefCount(
    Tcl_Obj *objPtr)	/* The object we are releasing a reference to. */
{
    if (objPtr->refCount-- <= 1) {
	TclFreeObj(objPtr);
    }
}























/*
 *----------------------------------------------------------------------
 *
 * Tcl_IsShared --
 *
 *	Tests if the object has a ref count greater than one.
 *
 * Results:
 *	Boolean value that is the result of the test.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_IsShared
int
Tcl_IsShared(
    Tcl_Obj *objPtr)	/* The object to test for being shared. */
{
    return ((objPtr)->refCount + 1 > 2);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DbIncrRefCount --
 *







|













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



















|







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
 *----------------------------------------------------------------------
 *
 * Tcl_DecrRefCount --
 *
 *	Decrements the reference count of the object.
 *
 * Results:
 *	The storage for objPtr may be freed.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_DecrRefCount
void
Tcl_DecrRefCount(
    Tcl_Obj *objPtr)	/* The object we are releasing a reference to. */
{
    if (objPtr->refCount-- <= 1) {
	TclFreeObj(objPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclUndoRefCount --
 *
 *	Decrement the refCount of objPtr without causing it to be freed if it
 *	drops from 1 to 0.  This allows a function increment a refCount but
 *	then decrement it and still be able to pass return it to a caller,
 *	possibly with a refCount of 0.  The caller must have previously
 *	incremented the refCount.
 *
 *----------------------------------------------------------------------
 */
void
TclUndoRefCount(
    Tcl_Obj *objPtr)	/* The object we are releasing a reference to. */
{
    if (objPtr->refCount > 0) {
	--objPtr->refCount;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_IsShared --
 *
 *	Tests if the object has a ref count greater than one.
 *
 * Results:
 *	Boolean value that is the result of the test.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_IsShared
int
Tcl_IsShared(
    Tcl_Obj *objPtr)	/* The object to test for being shared. */
{
    return ((objPtr)->refCount > 1);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DbIncrRefCount --
 *
3647
3648
3649
3650
3651
3652
3653
3654
3655
3656
3657
3658
3659
3660
3661
    Tcl_Obj *objPtr,	/* The object we are registering a reference
				 * to. */
    const char *file,		/* The name of the source file calling this
				 * function; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
    if (objPtr->refCount == 0x61616161) {
	fprintf(stderr, "file = %s, line = %d\n", file, line);
	fflush(stderr);
	Tcl_Panic("incrementing refCount of previously disposed object");
    }

#if TCL_THREADS
    /*







|







3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925
3926
    Tcl_Obj *objPtr,	/* The object we are registering a reference
				 * to. */
    const char *file,		/* The name of the source file calling this
				 * function; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
    if (objPtr->refCount == FREEDREFCOUNTFILLER) {
	fprintf(stderr, "file = %s, line = %d\n", file, line);
	fflush(stderr);
	Tcl_Panic("incrementing refCount of previously disposed object");
    }

#if TCL_THREADS
    /*
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732
3733
3734
    Tcl_Obj *objPtr,	/* The object we are releasing a reference
				 * to. */
    const char *file,		/* The name of the source file calling this
				 * function; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
    if (objPtr->refCount == 0x61616161) {
	fprintf(stderr, "file = %s, line = %d\n", file, line);
	fflush(stderr);
	Tcl_Panic("decrementing refCount of previously disposed object");
    }

#if TCL_THREADS
    /*







|







3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999
    Tcl_Obj *objPtr,	/* The object we are releasing a reference
				 * to. */
    const char *file,		/* The name of the source file calling this
				 * function; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
    if (objPtr->refCount == FREEDREFCOUNTFILLER) {
	fprintf(stderr, "file = %s, line = %d\n", file, line);
	fflush(stderr);
	Tcl_Panic("decrementing refCount of previously disposed object");
    }

#if TCL_THREADS
    /*
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
				 * debugging. */
#else
    TCL_UNUSED(const char *) /*file*/,
    TCL_UNUSED(int) /*line*/)
#endif
{
#ifdef TCL_MEM_DEBUG
    if (objPtr->refCount == 0x61616161) {
	fprintf(stderr, "file = %s, line = %d\n", file, line);
	fflush(stderr);
	Tcl_Panic("checking whether previously disposed object is shared");
    }

#if TCL_THREADS
    /*







|







4067
4068
4069
4070
4071
4072
4073
4074
4075
4076
4077
4078
4079
4080
4081
				 * debugging. */
#else
    TCL_UNUSED(const char *) /*file*/,
    TCL_UNUSED(int) /*line*/)
#endif
{
#ifdef TCL_MEM_DEBUG
    if (objPtr->refCount == FREEDREFCOUNTFILLER) {
	fprintf(stderr, "file = %s, line = %d\n", file, line);
	fflush(stderr);
	Tcl_Panic("checking whether previously disposed object is shared");
    }

#if TCL_THREADS
    /*
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
4029
4030
4031
4032

TCL_HASH_TYPE
TclHashObjKey(
    TCL_UNUSED(Tcl_HashTable *),
    void *keyPtr)		/* Key from which to compute hash value. */
{
    Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr;
    size_t length;
    const char *string = Tcl_GetStringFromObj(objPtr, &length);
    TCL_HASH_TYPE result = 0;

    /*
     * I tried a zillion different hash functions and asked many other people
     * for advice. Many people had their own favorite functions, all
     * different, but no-one had much idea why they were good ones. I chose







|







4283
4284
4285
4286
4287
4288
4289
4290
4291
4292
4293
4294
4295
4296
4297

TCL_HASH_TYPE
TclHashObjKey(
    TCL_UNUSED(Tcl_HashTable *),
    void *keyPtr)		/* Key from which to compute hash value. */
{
    Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr;
    Tcl_Size 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
4056
4057
4058
4059
4060
4061
4062
4063
4064
4065
4066
4067
4068
4069
4070
     *
     * See also HashStringKey in tclHash.c.
     * See also HashString in tclLiteral.c.
     *
     * See [tcl-Feature Request #2958832]
     */

    if (length) {
	result = UCHAR(*string);
	while (--length) {
	    result += (result << 3) + UCHAR(*++string);
	}
    }
    return result;
}







|







4321
4322
4323
4324
4325
4326
4327
4328
4329
4330
4331
4332
4333
4334
4335
     *
     * See also HashStringKey in tclHash.c.
     * See also HashString in tclLiteral.c.
     *
     * See [tcl-Feature Request #2958832]
     */

    if (length > 0) {
	result = UCHAR(*string);
	while (--length) {
	    result += (result << 3) + UCHAR(*++string);
	}
    }
    return result;
}
4159
4160
4161
4162
4163
4164
4165
4166
4167
4168
4169
4170
4171
4172
4173
 *	Modify an object to be an CmdName object that refers to the argument
 *	Command structure.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The object's old internal rep is freed. It's string rep is not
 *	changed. The refcount in the Command structure is incremented to keep
 *	it from being freed if the command is later deleted until
 *	TclNRExecuteByteCode has a chance to recognize that it was deleted.
 *
 *----------------------------------------------------------------------
 */








|







4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
 *	Modify an object to be an CmdName object that refers to the argument
 *	Command structure.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The object's old internal rep is freed. Its string rep is not
 *	changed. The refcount in the Command structure is incremented to keep
 *	it from being freed if the command is later deleted until
 *	TclNRExecuteByteCode has a chance to recognize that it was deleted.
 *
 *----------------------------------------------------------------------
 */

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
Tcl_RepresentationCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *descObj;
    const char *typeName;

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

    typeName = (TclHasInternalRep(objv[1],&tclAbstractListType)
                ? Tcl_AbstractListTypeName(objv[1])
                : (objv[1]->typePtr
                   ? objv[1]->typePtr->name
                   : "pure string"));

    /*
     * Value is a bignum with a refcount of 14, object pointer at 0x12345678,
     * internal representation 0x45671234:0x98765432, string representation
     * "1872361827361287"
     */

    descObj = Tcl_ObjPrintf("value is a %s with a refcount of %" TCL_Z_MODIFIER "u,"
	    " object pointer at %p",
	    objv[1]->typePtr ? typeName : "pure string",
	    objv[1]->refCount, objv[1]);

    if (objv[1]->typePtr) {
	if (objv[1]->typePtr == &tclDoubleType) {
	    Tcl_AppendPrintfToObj(descObj, ", internal representation %g",
		    objv[1]->internalRep.doubleValue);
	} else {







<






<
<
<
<
<
<








|







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
Tcl_RepresentationCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *descObj;


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







    /*
     * Value is a bignum with a refcount of 14, object pointer at 0x12345678,
     * internal representation 0x45671234:0x98765432, string representation
     * "1872361827361287"
     */

    descObj = Tcl_ObjPrintf("value is a %s with a refcount of %" TCL_Z_MODIFIER "u,"
	    " object pointer at %p",
	    objv[1]->typePtr ? objv[1]->typePtr->name : "pure string",
	    objv[1]->refCount, objv[1]);

    if (objv[1]->typePtr) {
	if (objv[1]->typePtr == &tclDoubleType) {
	    Tcl_AppendPrintfToObj(descObj, ", internal representation %g",
		    objv[1]->internalRep.doubleValue);
	} else {

Changes to generic/tclOptimize.c.

51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
static void
LocateTargetAddresses(
    CompileEnv *envPtr,
    Tcl_HashTable *tablePtr)
{
    unsigned char *currentInstPtr, *targetInstPtr;
    int isNew;
    size_t i;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch hSearch;

    Tcl_InitHashTable(tablePtr, TCL_ONE_WORD_KEYS);

    /*
     * The starts of commands represent target addresses.







|







51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
static void
LocateTargetAddresses(
    CompileEnv *envPtr,
    Tcl_HashTable *tablePtr)
{
    unsigned char *currentInstPtr, *targetInstPtr;
    int isNew;
    Tcl_Size i;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch hSearch;

    Tcl_InitHashTable(tablePtr, TCL_ONE_WORD_KEYS);

    /*
     * The starts of commands represent target addresses.
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
	case INST_PUSH1:
	    if (nextInst == INST_POP) {
		blank = size + InstLength(nextInst);
	    } else if (nextInst == INST_STR_CONCAT1
		    && TclGetUInt1AtPtr(currentInstPtr + size + 1) == 2) {
		Tcl_Obj *litPtr = TclFetchLiteral(envPtr,
			TclGetUInt1AtPtr(currentInstPtr + 1));
		size_t numBytes;

		(void) Tcl_GetStringFromObj(litPtr, &numBytes);
		if (numBytes == 0) {
		    blank = size + InstLength(nextInst);
		}
	    }
	    break;
	case INST_PUSH4:
	    if (nextInst == INST_POP) {
		blank = size + 1;
	    } else if (nextInst == INST_STR_CONCAT1
		    && TclGetUInt1AtPtr(currentInstPtr + size + 1) == 2) {
		Tcl_Obj *litPtr = TclFetchLiteral(envPtr,
			TclGetUInt4AtPtr(currentInstPtr + 1));
		size_t numBytes;

		(void) Tcl_GetStringFromObj(litPtr, &numBytes);
		if (numBytes == 0) {
		    blank = size + InstLength(nextInst);
		}
	    }
	    break;







|














|







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
	case INST_PUSH1:
	    if (nextInst == INST_POP) {
		blank = size + InstLength(nextInst);
	    } else if (nextInst == INST_STR_CONCAT1
		    && TclGetUInt1AtPtr(currentInstPtr + size + 1) == 2) {
		Tcl_Obj *litPtr = TclFetchLiteral(envPtr,
			TclGetUInt1AtPtr(currentInstPtr + 1));
		Tcl_Size 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));
		Tcl_Size numBytes;

		(void) Tcl_GetStringFromObj(litPtr, &numBytes);
		if (numBytes == 0) {
		    blank = size + InstLength(nextInst);
		}
	    }
	    break;

Changes to generic/tclPanic.c.

62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
 * Side effects:
 *	The process dies, entering the debugger if possible.
 *
 *----------------------------------------------------------------------
 */

/*
 * The following comment is here so that Coverity's static analizer knows that
 * a Tcl_Panic() call can never return and avoids lots of false positives.
 */

/* coverity[+kill] */
void
Tcl_Panic(
    const char *format,







|







62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
 * Side effects:
 *	The process dies, entering the debugger if possible.
 *
 *----------------------------------------------------------------------
 */

/*
 * The following comment is here so that Coverity's static analyzer knows that
 * a Tcl_Panic() call can never return and avoids lots of false positives.
 */

/* coverity[+kill] */
void
Tcl_Panic(
    const char *format,

Changes to generic/tclParse.c.

35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
 * TYPE_QUOTE -		Character is a double quote.
 * TYPE_OPEN_PAREN -	Character is a left parenthesis.
 * TYPE_CLOSE_PAREN -	Character is a right parenthesis.
 * TYPE_CLOSE_BRACK -	Character is a right square bracket.
 * TYPE_BRACE -		Character is a curly brace (either left or right).
 */

const char tclCharTypeTable[] = {

    /*
     * Positive character values, from 0-127:
     */

    TYPE_SUBS,        TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,







|







35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
 * TYPE_QUOTE -		Character is a double quote.
 * TYPE_OPEN_PAREN -	Character is a left parenthesis.
 * TYPE_CLOSE_PAREN -	Character is a right parenthesis.
 * TYPE_CLOSE_BRACK -	Character is a right square bracket.
 * TYPE_BRACE -		Character is a curly brace (either left or right).
 */

const unsigned char tclCharTypeTable[] = {

    /*
     * Positive character values, from 0-127:
     */

    TYPE_SUBS,        TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
};

/*
 * Prototypes for local functions defined in this file:
 */

static int	CommandComplete(const char *script, size_t numBytes);
static size_t		ParseComment(const char *src, size_t numBytes,
			    Tcl_Parse *parsePtr);
static int		ParseTokens(const char *src, size_t numBytes, int mask,
			    int flags, Tcl_Parse *parsePtr);
static size_t		ParseWhiteSpace(const char *src, size_t numBytes,
			    int *incompletePtr, char *typePtr);
static size_t		ParseAllWhiteSpace(const char *src, size_t numBytes,
			    int *incompletePtr);
static int		ParseHex(const char *src, size_t numBytes,
			    int *resultPtr);

/*
 *----------------------------------------------------------------------
 *
 * TclParseInit --
 *







|
|

|

|

|

|







116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
};

/*
 * Prototypes for local functions defined in this file:
 */

static int	CommandComplete(const char *script, Tcl_Size numBytes);
static Tcl_Size		ParseComment(const char *src, Tcl_Size numBytes,
			    Tcl_Parse *parsePtr);
static int		ParseTokens(const char *src, Tcl_Size numBytes, int mask,
			    int flags, Tcl_Parse *parsePtr);
static Tcl_Size		ParseWhiteSpace(const char *src, Tcl_Size numBytes,
			    int *incompletePtr, char *typePtr);
static Tcl_Size		ParseAllWhiteSpace(const char *src, Tcl_Size numBytes,
			    int *incompletePtr);
static int		ParseHex(const char *src, Tcl_Size numBytes,
			    int *resultPtr);

/*
 *----------------------------------------------------------------------
 *
 * TclParseInit --
 *
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
 *----------------------------------------------------------------------
 */

void
TclParseInit(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting */
    const char *start,		/* Start of string to be parsed. */
    size_t numBytes,		/* Total number of bytes in string. If -1,
				 * the script consists of all bytes up to the
				 * first null character. */
    Tcl_Parse *parsePtr)	/* Points to struct to initialize */
{
    parsePtr->numWords = 0;
    parsePtr->tokenPtr = parsePtr->staticTokens;
    parsePtr->numTokens = 0;







|







148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
 *----------------------------------------------------------------------
 */

void
TclParseInit(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting */
    const char *start,		/* Start of string to be parsed. */
    Tcl_Size numBytes,		/* Total number of bytes in string. If -1,
				 * the script consists of all bytes up to the
				 * first null character. */
    Tcl_Parse *parsePtr)	/* Points to struct to initialize */
{
    parsePtr->numWords = 0;
    parsePtr->tokenPtr = parsePtr->staticTokens;
    parsePtr->numTokens = 0;
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

int
Tcl_ParseCommand(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting; if
				 * NULL, then no error message is provided. */
    const char *start,		/* First character of string containing one or
				 * more Tcl commands. */
    size_t numBytes,		/* Total number of bytes in string. If -1,
				 * the script consists of all bytes up to the
				 * first null character. */
    int nested,			/* Non-zero means this is a nested command:
				 * close bracket should be considered a
				 * command terminator. If zero, then close
				 * bracket has no special meaning. */
    Tcl_Parse *parsePtr)
				/* Structure to fill in with information about
				 * the parsed command; any previous
				 * information in the structure is ignored. */
{
    const char *src;		/* Points to current character in the
				 * command. */
    char type;			/* Result returned by CHAR_TYPE(*src). */
    Tcl_Token *tokenPtr;	/* Pointer to token being filled in. */
    int wordIndex;		/* Index of word token for current word. */
    int terminators;		/* CHAR_TYPE bits that indicate the end of a
				 * command. */
    const char *termPtr;	/* Set by Tcl_ParseBraces/QuotedString to
				 * point to char after terminating one. */
    size_t scanned;

    if (numBytes == TCL_INDEX_NONE && start) {
	numBytes = strlen(start);
    }
    TclParseInit(interp, start, numBytes, parsePtr);
    if ((start == NULL) && (numBytes != 0)) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "can't parse a NULL pointer", -1));







|















|




|

|







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

int
Tcl_ParseCommand(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting; if
				 * NULL, then no error message is provided. */
    const char *start,		/* First character of string containing one or
				 * more Tcl commands. */
    Tcl_Size numBytes,		/* Total number of bytes in string. If -1,
				 * the script consists of all bytes up to the
				 * first null character. */
    int nested,			/* Non-zero means this is a nested command:
				 * close bracket should be considered a
				 * command terminator. If zero, then close
				 * bracket has no special meaning. */
    Tcl_Parse *parsePtr)
				/* Structure to fill in with information about
				 * the parsed command; any previous
				 * information in the structure is ignored. */
{
    const char *src;		/* Points to current character in the
				 * command. */
    char type;			/* Result returned by CHAR_TYPE(*src). */
    Tcl_Token *tokenPtr;	/* Pointer to token being filled in. */
    Tcl_Size wordIndex;		/* Index of word token for current word. */
    int terminators;		/* CHAR_TYPE bits that indicate the end of a
				 * command. */
    const char *termPtr;	/* Set by Tcl_ParseBraces/QuotedString to
				 * point to char after terminating one. */
    Tcl_Size scanned;

    if (numBytes < 0 && start) {
	numBytes = strlen(start);
    }
    TclParseInit(interp, start, numBytes, parsePtr);
    if ((start == NULL) && (numBytes != 0)) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "can't parse a NULL pointer", -1));
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
	    if (Tcl_ParseQuotedString(interp, src, numBytes, parsePtr, 1,
		    &termPtr) != TCL_OK) {
		goto error;
	    }
	    src = termPtr;
	    numBytes = parsePtr->end - src;
	} else if (*src == '{') {
	    int expIdx = wordIndex + 1;
	    Tcl_Token *expPtr;

	    if (Tcl_ParseBraces(interp, src, numBytes, parsePtr, 1,
		    &termPtr) != TCL_OK) {
		goto error;
	    }
	    src = termPtr;
	    numBytes = parsePtr->end - src;

	    /*
	     * Check whether the braces contained the word expansion prefix
	     * {*}
	     */

	    expPtr = &parsePtr->tokenPtr[expIdx];
	    if ((0 == expandWord)
		    /* Haven't seen prefix already */
		    && (expIdx + 1 == (int)parsePtr->numTokens)
		    /* Only one token */
		    && (((1 == expPtr->size)
			    /* Same length as prefix */
			    && (expPtr->start[0] == '*')))
			    /* Is the prefix */
		    && (numBytes > 0) && (0 == ParseWhiteSpace(termPtr,
			    numBytes, &parsePtr->incomplete, &type))







|

















|







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
	    if (Tcl_ParseQuotedString(interp, src, numBytes, parsePtr, 1,
		    &termPtr) != TCL_OK) {
		goto error;
	    }
	    src = termPtr;
	    numBytes = parsePtr->end - src;
	} else if (*src == '{') {
	    Tcl_Size expIdx = wordIndex + 1;
	    Tcl_Token *expPtr;

	    if (Tcl_ParseBraces(interp, src, numBytes, parsePtr, 1,
		    &termPtr) != TCL_OK) {
		goto error;
	    }
	    src = termPtr;
	    numBytes = parsePtr->end - src;

	    /*
	     * Check whether the braces contained the word expansion prefix
	     * {*}
	     */

	    expPtr = &parsePtr->tokenPtr[expIdx];
	    if ((0 == expandWord)
		    /* Haven't seen prefix already */
		    && (expIdx + 1 == parsePtr->numTokens)
		    /* Only one token */
		    && (((1 == expPtr->size)
			    /* Same length as prefix */
			    && (expPtr->start[0] == '*')))
			    /* Is the prefix */
		    && (numBytes > 0) && (0 == ParseWhiteSpace(termPtr,
			    numBytes, &parsePtr->incomplete, &type))
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
	/*
	 * Finish filling in the token for the word and check for the special
	 * case of a word consisting of a single range of literal text.
	 */

	tokenPtr = &parsePtr->tokenPtr[wordIndex];
	tokenPtr->size = src - tokenPtr->start;
	tokenPtr->numComponents = (int)parsePtr->numTokens - (wordIndex + 1);
	if (expandWord) {
	    size_t i;
	    int isLiteral = 1;

	    /*
	     * When a command includes a word that is an expanded literal; for
	     * example, {*}{1 2 3}, the parser performs that expansion
	     * immediately, generating several TCL_TOKEN_SIMPLE_WORDs instead
	     * of a single TCL_TOKEN_EXPAND_WORD that the Tcl_ParseCommand()







|

|







376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
	/*
	 * Finish filling in the token for the word and check for the special
	 * case of a word consisting of a single range of literal text.
	 */

	tokenPtr = &parsePtr->tokenPtr[wordIndex];
	tokenPtr->size = src - tokenPtr->start;
	tokenPtr->numComponents = parsePtr->numTokens - (wordIndex + 1);
	if (expandWord) {
	    Tcl_Size i;
	    int isLiteral = 1;

	    /*
	     * When a command includes a word that is an expanded literal; for
	     * example, {*}{1 2 3}, the parser performs that expansion
	     * immediately, generating several TCL_TOKEN_SIMPLE_WORDs instead
	     * of a single TCL_TOKEN_EXPAND_WORD that the Tcl_ParseCommand()
403
404
405
406
407
408
409

410
411
412
413
414
415
416
417
		if (tokenPtr[i].type != TCL_TOKEN_TEXT) {
		    isLiteral = 0;
		    break;
		}
	    }

	    if (isLiteral) {

		int elemCount = 0, code = TCL_OK, literal = 1;
		const char *nextElem, *listEnd, *elemStart;

		/*
		 * The word to be expanded is a literal, so determine the
		 * boundaries of the literal string to be treated as a list
		 * and expanded. That literal string starts at
		 * tokenPtr[1].start, and includes all bytes up to, but not







>
|







403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
		if (tokenPtr[i].type != TCL_TOKEN_TEXT) {
		    isLiteral = 0;
		    break;
		}
	    }

	    if (isLiteral) {
		Tcl_Size elemCount = 0;
		int code = TCL_OK, literal = 1;
		const char *nextElem, *listEnd, *elemStart;

		/*
		 * The word to be expanded is a literal, so determine the
		 * boundaries of the literal string to be treated as a list
		 * and expanded. That literal string starts at
		 * tokenPtr[1].start, and includes all bytes up to, but not
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439

		/*
		 * Step through the literal string, parsing and counting list
		 * elements.
		 */

		while (nextElem < listEnd) {
		    size_t size;

		    code = TclFindElement(NULL, nextElem, listEnd - nextElem,
			    &elemStart, &nextElem, &size, &literal);
		    if ((code != TCL_OK) || !literal) {
			break;
		    }
		    if (elemStart < listEnd) {







|







426
427
428
429
430
431
432
433
434
435
436
437
438
439
440

		/*
		 * Step through the literal string, parsing and counting list
		 * elements.
		 */

		while (nextElem < listEnd) {
		    Tcl_Size size;

		    code = TclFindElement(NULL, nextElem, listEnd - nextElem,
			    &elemStart, &nextElem, &size, &literal);
		    if ((code != TCL_OK) || !literal) {
			break;
		    }
		    if (elemStart < listEnd) {
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
		} else {
		    /*
		     * Recalculate the number of Tcl_Tokens needed to store
		     * tokens representing the expanded list.
		     */

		    const char *listStart;
		    int growthNeeded = wordIndex + 2*elemCount
			    - (int)parsePtr->numTokens;

		    parsePtr->numWords += elemCount - 1;
		    if (growthNeeded > 0) {
			TclGrowParseTokenArray(parsePtr, growthNeeded);
			tokenPtr = &parsePtr->tokenPtr[wordIndex];
		    }
		    parsePtr->numTokens = wordIndex + 2*elemCount;







|
|







468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
		} else {
		    /*
		     * Recalculate the number of Tcl_Tokens needed to store
		     * tokens representing the expanded list.
		     */

		    const char *listStart;
		    Tcl_Size growthNeeded = wordIndex + 2*elemCount
			    - parsePtr->numTokens;

		    parsePtr->numWords += elemCount - 1;
		    if (growthNeeded > 0) {
			TclGrowParseTokenArray(parsePtr, growthNeeded);
			tokenPtr = &parsePtr->tokenPtr[wordIndex];
		    }
		    parsePtr->numTokens = wordIndex + 2*elemCount;
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static size_t
ParseWhiteSpace(
    const char *src,		/* First character to parse. */
    size_t numBytes,		/* Max number of bytes to scan. */
    int *incompletePtr,		/* Set this boolean memory to true if parsing
				 * indicates an incomplete command. */
    char *typePtr)		/* Points to location to store character type
				 * of character that ends run of whitespace */
{
    char type = TYPE_NORMAL;
    const char *p = src;







|


|







618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Size
ParseWhiteSpace(
    const char *src,		/* First character to parse. */
    Tcl_Size numBytes,		/* Max number of bytes to scan. */
    int *incompletePtr,		/* Set this boolean memory to true if parsing
				 * indicates an incomplete command. */
    char *typePtr)		/* Points to location to store character type
				 * of character that ends run of whitespace */
{
    char type = TYPE_NORMAL;
    const char *p = src;
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
 *
 * Results:
 *	Returns the number of bytes recognized as white space.
 *
 *----------------------------------------------------------------------
 */

static size_t
ParseAllWhiteSpace(
    const char *src,		/* First character to parse. */
    size_t numBytes,		/* Max number of byes to scan */
    int *incompletePtr)		/* Set true if parse is incomplete. */
{
    char type;
    const char *p = src;

    do {
	size_t scanned = ParseWhiteSpace(p, numBytes, incompletePtr, &type);

	p += scanned;
	numBytes -= scanned;
    } while (numBytes && (*p == '\n') && (p++, --numBytes));
    return (p-src);
}

size_t
TclParseAllWhiteSpace(
    const char *src,		/* First character to parse. */
    size_t numBytes)		/* Max number of byes to scan */
{
    int dummy;
    return ParseAllWhiteSpace(src, numBytes, &dummy);
}

/*
 *----------------------------------------------------------------------







|


|






|







|


|







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
 *
 * Results:
 *	Returns the number of bytes recognized as white space.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Size
ParseAllWhiteSpace(
    const char *src,		/* First character to parse. */
    Tcl_Size numBytes,		/* Max number of byes to scan */
    int *incompletePtr)		/* Set true if parse is incomplete. */
{
    char type;
    const char *p = src;

    do {
	Tcl_Size scanned = ParseWhiteSpace(p, numBytes, incompletePtr, &type);

	p += scanned;
	numBytes -= scanned;
    } while (numBytes && (*p == '\n') && (p++, --numBytes));
    return (p-src);
}

Tcl_Size
TclParseAllWhiteSpace(
    const char *src,		/* First character to parse. */
    Tcl_Size numBytes)		/* Max number of byes to scan */
{
    int dummy;
    return ParseAllWhiteSpace(src, numBytes, &dummy);
}

/*
 *----------------------------------------------------------------------
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
 *
 *----------------------------------------------------------------------
 */

int
ParseHex(
    const char *src,		/* First character to parse. */
    size_t numBytes,		/* Max number of byes to scan */
    int *resultPtr)		/* Points to storage provided by caller where
				 * the character resulting from the
				 * conversion is to be written. */
{
    int result = 0;
    const char *p = src;








|







724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
 *
 *----------------------------------------------------------------------
 */

int
ParseHex(
    const char *src,		/* First character to parse. */
    Tcl_Size numBytes,		/* Max number of byes to scan */
    int *resultPtr)		/* Points to storage provided by caller where
				 * the character resulting from the
				 * conversion is to be written. */
{
    int result = 0;
    const char *p = src;

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

int
TclParseBackslash(
    const char *src,		/* Points to the backslash character of a a
				 * backslash sequence. */
    size_t numBytes,		/* Max number of bytes to scan. */
    size_t *readPtr,		/* NULL, or points to storage where the number
				 * of bytes scanned should be written. */
    char *dst)			/* NULL, or points to buffer where the UTF-8
				 * encoding of the backslash sequence is to be
				 * written. At most 4 bytes will be written there. */
{
    const char *p = src+1;
    int unichar;
    int result;
    size_t count;
    char buf[4] = "";

    if (numBytes == 0) {
	if (readPtr != NULL) {
	    *readPtr = 0;
	}
	return 0;







|

|
|








|







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

int
TclParseBackslash(
    const char *src,		/* Points to the backslash character of a
				 * backslash sequence. */
    Tcl_Size numBytes,		/* Max number of bytes to scan. */
    Tcl_Size *readPtr,		/* NULL, or points to storage where the number
				 * of bytes scanned should be written. */
    char *dst)			/* NULL, or points to buffer where the UTF-8
				 * encoding of the backslash sequence is to be
				 * written. At most 4 bytes will be written there. */
{
    const char *p = src+1;
    int unichar;
    int result;
    Tcl_Size count;
    char buf[4] = "";

    if (numBytes == 0) {
	if (readPtr != NULL) {
	    *readPtr = 0;
	}
	return 0;
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
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static size_t
ParseComment(
    const char *src,		/* First character to parse. */
    size_t numBytes,		/* Max number of bytes to scan. */
    Tcl_Parse *parsePtr)	/* Information about parse in progress.
				 * Updated if parsing indicates an incomplete
				 * command. */
{
    const char *p = src;
    int incomplete = parsePtr->incomplete;

    while (numBytes) {
	size_t scanned = ParseAllWhiteSpace(p, numBytes, &incomplete);
	p += scanned;
	numBytes -= scanned;

	if ((numBytes == 0) || (*p != '#')) {
	    break;
	}
	if (parsePtr->commentStart == NULL) {







|


|








|







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

static Tcl_Size
ParseComment(
    const char *src,		/* First character to parse. */
    Tcl_Size numBytes,		/* Max number of bytes to scan. */
    Tcl_Parse *parsePtr)	/* Information about parse in progress.
				 * Updated if parsing indicates an incomplete
				 * command. */
{
    const char *p = src;
    int incomplete = parsePtr->incomplete;

    while (numBytes) {
	Tcl_Size scanned = ParseAllWhiteSpace(p, numBytes, &incomplete);
	p += scanned;
	numBytes -= scanned;

	if ((numBytes == 0) || (*p != '#')) {
	    break;
	}
	if (parsePtr->commentStart == NULL) {
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
 *
 *----------------------------------------------------------------------
 */

static int
ParseTokens(
    const char *src,	/* First character to parse. */
    size_t numBytes,		/* Max number of bytes to scan. */
    int mask,			/* Specifies when to stop parsing. The parse
				 * stops at the first unquoted character whose
				 * CHAR_TYPE contains any of the bits in
				 * mask. */
    int flags,			/* OR-ed bits indicating what substitutions to
				 * perform: TCL_SUBST_COMMANDS,
				 * TCL_SUBST_VARIABLES, and







|







1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
 *
 *----------------------------------------------------------------------
 */

static int
ParseTokens(
    const char *src,	/* First character to parse. */
    Tcl_Size numBytes,		/* Max number of bytes to scan. */
    int mask,			/* Specifies when to stop parsing. The parse
				 * stops at the first unquoted character whose
				 * CHAR_TYPE contains any of the bits in
				 * mask. */
    int flags,			/* OR-ed bits indicating what substitutions to
				 * perform: TCL_SUBST_COMMANDS,
				 * TCL_SUBST_VARIABLES, and
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

int
Tcl_ParseVarName(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting; if
				 * NULL, then no error message is provided. */
    const char *start,		/* Start of variable substitution string.
				 * First character must be "$". */
    size_t numBytes,		/* Total number of bytes in string. If -1,
				 * the string consists of all bytes up to the
				 * first null character. */
    Tcl_Parse *parsePtr,	/* Structure to fill in with information about
				 * the variable name. */
    int append)			/* Non-zero means append tokens to existing
				 * information in parsePtr; zero means ignore
				 * existing tokens in parsePtr and
				 * reinitialize it. */
{
    Tcl_Token *tokenPtr;
    const char *src;
    int varIndex;
    unsigned array;

    if (numBytes == TCL_INDEX_NONE && start) {
	numBytes = strlen(start);
    }
    if (!append) {
	TclParseInit(interp, start, numBytes, parsePtr);
    }
    if ((numBytes == 0) || (start == NULL)) {
	return TCL_ERROR;







|














|







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

int
Tcl_ParseVarName(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting; if
				 * NULL, then no error message is provided. */
    const char *start,		/* Start of variable substitution string.
				 * First character must be "$". */
    Tcl_Size numBytes,		/* Total number of bytes in string. If -1,
				 * the string consists of all bytes up to the
				 * first null character. */
    Tcl_Parse *parsePtr,	/* Structure to fill in with information about
				 * the variable name. */
    int append)			/* Non-zero means append tokens to existing
				 * information in parsePtr; zero means ignore
				 * existing tokens in parsePtr and
				 * reinitialize it. */
{
    Tcl_Token *tokenPtr;
    const char *src;
    int varIndex;
    unsigned array;

    if (numBytes < 0 && start) {
	numBytes = strlen(start);
    }
    if (!append) {
	TclParseInit(interp, start, numBytes, parsePtr);
    }
    if ((numBytes == 0) || (start == NULL)) {
	return TCL_ERROR;
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
				 * character just after last one in the
				 * variable specifier. */
{
    Tcl_Obj *objPtr;
    int code;
    Tcl_Parse *parsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse));

    if (Tcl_ParseVarName(interp, start, -1, parsePtr, 0) != TCL_OK) {
	TclStackFree(interp, parsePtr);
	return NULL;
    }

    if (termPtr != NULL) {
	*termPtr = start + parsePtr->tokenPtr->size;
    }







|







1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
				 * character just after last one in the
				 * variable specifier. */
{
    Tcl_Obj *objPtr;
    int code;
    Tcl_Parse *parsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse));

    if (Tcl_ParseVarName(interp, start, TCL_INDEX_NONE, parsePtr, 0) != TCL_OK) {
	TclStackFree(interp, parsePtr);
	return NULL;
    }

    if (termPtr != NULL) {
	*termPtr = start + parsePtr->tokenPtr->size;
    }
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

int
Tcl_ParseBraces(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting; if
				 * NULL, then no error message is provided. */
    const char *start,		/* Start of string enclosed in braces. The
				 * first character must be {'. */
    size_t numBytes,		/* Total number of bytes in string. If -1,
				 * the string consists of all bytes up to the
				 * first null character. */
    Tcl_Parse *parsePtr,
				/* Structure to fill in with information about
				 * the string. */
    int append,			/* Non-zero means append tokens to existing
				 * information in parsePtr; zero means ignore
				 * existing tokens in parsePtr and
				 * reinitialize it. */
    const char **termPtr)	/* If non-NULL, points to word in which to
				 * store a pointer to the character just after
				 * the terminating '}' if the parse was
				 * successful. */
{
    Tcl_Token *tokenPtr;
    const char *src;
    int startIndex, level;
    size_t length;

    if (numBytes == TCL_INDEX_NONE && start) {
	numBytes = strlen(start);
    }
    if (!append) {
	TclParseInit(interp, start, numBytes, parsePtr);
    }
    if ((numBytes == 0) || (start == NULL)) {
	return TCL_ERROR;







|

















|

|







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

int
Tcl_ParseBraces(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting; if
				 * NULL, then no error message is provided. */
    const char *start,		/* Start of string enclosed in braces. The
				 * first character must be {'. */
    Tcl_Size numBytes,		/* Total number of bytes in string. If -1,
				 * the string consists of all bytes up to the
				 * first null character. */
    Tcl_Parse *parsePtr,
				/* Structure to fill in with information about
				 * the string. */
    int append,			/* Non-zero means append tokens to existing
				 * information in parsePtr; zero means ignore
				 * existing tokens in parsePtr and
				 * reinitialize it. */
    const char **termPtr)	/* If non-NULL, points to word in which to
				 * store a pointer to the character just after
				 * the terminating '}' if the parse was
				 * successful. */
{
    Tcl_Token *tokenPtr;
    const char *src;
    int startIndex, level;
    Tcl_Size length;

    if (numBytes < 0 && start) {
	numBytes = strlen(start);
    }
    if (!append) {
	TclParseInit(interp, start, numBytes, parsePtr);
    }
    if ((numBytes == 0) || (start == NULL)) {
	return TCL_ERROR;
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

int
Tcl_ParseQuotedString(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting; if
				 * NULL, then no error message is provided. */
    const char *start,		/* Start of the quoted string. The first
				 * character must be '"'. */
    size_t numBytes,		/* Total number of bytes in string. If -1,
				 * the string consists of all bytes up to the
				 * first null character. */
    Tcl_Parse *parsePtr,
				/* Structure to fill in with information about
				 * the string. */
    int append,			/* Non-zero means append tokens to existing
				 * information in parsePtr; zero means ignore
				 * existing tokens in parsePtr and
				 * reinitialize it. */
    const char **termPtr)	/* If non-NULL, points to word in which to
				 * store a pointer to the character just after
				 * the quoted string's terminating close-quote
				 * if the parse succeeds. */
{
    if (numBytes == TCL_INDEX_NONE && start) {
	numBytes = strlen(start);
    }
    if (!append) {
	TclParseInit(interp, start, numBytes, parsePtr);
    }
    if ((numBytes == 0) || (start == NULL)) {
	return TCL_ERROR;







|














|







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
Tcl_ParseQuotedString(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting; if
				 * NULL, then no error message is provided. */
    const char *start,		/* Start of the quoted string. The first
				 * character must be '"'. */
    Tcl_Size numBytes,		/* Total number of bytes in string. If -1,
				 * the string consists of all bytes up to the
				 * first null character. */
    Tcl_Parse *parsePtr,
				/* Structure to fill in with information about
				 * the string. */
    int append,			/* Non-zero means append tokens to existing
				 * information in parsePtr; zero means ignore
				 * existing tokens in parsePtr and
				 * reinitialize it. */
    const char **termPtr)	/* If non-NULL, points to word in which to
				 * store a pointer to the character just after
				 * the quoted string's terminating close-quote
				 * if the parse succeeds. */
{
    if (numBytes < 0 && start) {
	numBytes = strlen(start);
    }
    if (!append) {
	TclParseInit(interp, start, numBytes, parsePtr);
    }
    if ((numBytes == 0) || (start == NULL)) {
	return TCL_ERROR;
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
 *----------------------------------------------------------------------
 */

void
TclSubstParse(
    Tcl_Interp *interp,
    const char *bytes,
    size_t numBytes,
    int flags,
    Tcl_Parse *parsePtr,
    Tcl_InterpState *statePtr)
{
    size_t length = numBytes;
    const char *p = bytes;

    TclParseInit(interp, p, length, parsePtr);

    /*
     * First parse the string rep of objPtr, as if it were enclosed as a
     * "-quoted word in a normal Tcl command. Honor flags that selectively







|




|







1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
 *----------------------------------------------------------------------
 */

void
TclSubstParse(
    Tcl_Interp *interp,
    const char *bytes,
    Tcl_Size numBytes,
    int flags,
    Tcl_Parse *parsePtr,
    Tcl_InterpState *statePtr)
{
    Tcl_Size length = numBytes;
    const char *p = bytes;

    TclParseInit(interp, p, length, parsePtr);

    /*
     * First parse the string rep of objPtr, as if it were enclosed as a
     * "-quoted word in a normal Tcl command. Honor flags that selectively
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
int
TclSubstTokens(
    Tcl_Interp *interp,		/* Interpreter in which to lookup variables,
				 * execute nested commands, and report
				 * errors. */
    Tcl_Token *tokenPtr,	/* Pointer to first in an array of tokens to
				 * evaluate and concatenate. */
    size_t count,			/* Number of tokens to consider at tokenPtr.
				 * Must be at least 1. */
    int *tokensLeftPtr,		/* If not NULL, points to memory where an
				 * integer representing the number of tokens
				 * left to be substituted will be written */
    size_t line,			/* The line the script starts on. */
    int *clNextOuter,		/* Information about an outer context for */
    const char *outerScript)	/* continuation line data. This is set by
				 * EvalEx() to properly handle [...]-nested
				 * commands. The 'outerScript' refers to the
				 * most-outer script containing the embedded
				 * command, which is refered to by 'script'.
				 * The 'clNextOuter' refers to the current







|




|







2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
int
TclSubstTokens(
    Tcl_Interp *interp,		/* Interpreter in which to lookup variables,
				 * execute nested commands, and report
				 * errors. */
    Tcl_Token *tokenPtr,	/* Pointer to first in an array of tokens to
				 * evaluate and concatenate. */
    Tcl_Size count,		/* Number of tokens to consider at tokenPtr.
				 * Must be at least 1. */
    int *tokensLeftPtr,		/* If not NULL, points to memory where an
				 * integer representing the number of tokens
				 * left to be substituted will be written */
    Tcl_Size line,		/* The line the script starts on. */
    int *clNextOuter,		/* Information about an outer context for */
    const char *outerScript)	/* continuation line data. This is set by
				 * EvalEx() to properly handle [...]-nested
				 * commands. The 'outerScript' refers to the
				 * most-outer script containing the embedded
				 * command, which is refered to by 'script'.
				 * The 'clNextOuter' refers to the current
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
				 * for the places generating arguments for
				 * which this is true. */
{
    Tcl_Obj *result;
    int code = TCL_OK;
#define NUM_STATIC_POS 20
    int isLiteral;
    size_t i, maxNumCL, numCL, adjust;
    int *clPosition = NULL;
    Interp *iPtr = (Interp *) interp;
    int inFile = iPtr->evalFlags & TCL_EVAL_FILE;

    /*
     * Each pass through this loop will substitute one token, and its
     * components, if any. The only thing tricky here is that we go to some
     * effort to pass Tcl_Obj's through untouched, to avoid string copying and
     * Tcl_Obj creation if possible, to aid performance and limit shimmering.
     *
     * Further optimization opportunities might be to check for the equivalent
     * of Tcl_SetObjResult(interp, Tcl_GetObjResult(interp)) and omit them.
     */

    /*
     * For the handling of continuation lines in literals we first check if
     * this is actually a literal. For if not we can forego the additional
     * processing. Otherwise we pre-allocate a small table to store the
     * locations of all continuation lines we find in this literal, if any.
     * The table is extended if needed.
     */

    numCL = 0;
    maxNumCL = 0;
    isLiteral = 1;







|















|
|
|







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
				 * for the places generating arguments for
				 * which this is true. */
{
    Tcl_Obj *result;
    int code = TCL_OK;
#define NUM_STATIC_POS 20
    int isLiteral;
    Tcl_Size i, maxNumCL, numCL, adjust;
    int *clPosition = NULL;
    Interp *iPtr = (Interp *) interp;
    int inFile = iPtr->evalFlags & TCL_EVAL_FILE;

    /*
     * Each pass through this loop will substitute one token, and its
     * components, if any. The only thing tricky here is that we go to some
     * effort to pass Tcl_Obj's through untouched, to avoid string copying and
     * Tcl_Obj creation if possible, to aid performance and limit shimmering.
     *
     * Further optimization opportunities might be to check for the equivalent
     * of Tcl_SetObjResult(interp, Tcl_GetObjResult(interp)) and omit them.
     */

    /*
     * For the handling of continuation lines in literals, first check if
     * this is actually a literal. If not then forego the additional
     * processing. Otherwise preallocate a small table to store the
     * locations of all continuation lines we find in this literal, if any.
     * The table is extended if needed.
     */

    numCL = 0;
    maxNumCL = 0;
    isLiteral = 1;
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
	     * everything, just the number of lines we have to add as
	     * correction.
	     */

	    if ((appendByteLength == 1) && (utfCharBytes[0] == ' ')
		    && (tokenPtr->start[1] == '\n')) {
		if (isLiteral) {
		    size_t clPos;

		    if (result == 0) {
			clPos = 0;
		    } else {
			(void)Tcl_GetStringFromObj(result, &clPos);
		    }








|







2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
	     * everything, just the number of lines we have to add as
	     * correction.
	     */

	    if ((appendByteLength == 1) && (utfCharBytes[0] == ' ')
		    && (tokenPtr->start[1] == '\n')) {
		if (isLiteral) {
		    Tcl_Size clPos;

		    if (result == 0) {
			clPos = 0;
		    } else {
			(void)Tcl_GetStringFromObj(result, &clPos);
		    }

2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
	    iPtr->numLevels++;
	    code = TclInterpReady(interp);
	    if (code == TCL_OK) {
		/*
		 * Test cases: info-30.{6,8,9}
		 */

		size_t theline;

		TclAdvanceContinuations(&line, &clNextOuter,
			tokenPtr->start - outerScript);
		theline = line + adjust;
		code = TclEvalEx(interp, tokenPtr->start+1, tokenPtr->size-2,
			0, theline, clNextOuter, outerScript);








|







2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
	    iPtr->numLevels++;
	    code = TclInterpReady(interp);
	    if (code == TCL_OK) {
		/*
		 * Test cases: info-30.{6,8,9}
		 */

		Tcl_Size theline;

		TclAdvanceContinuations(&line, &clNextOuter,
			tokenPtr->start - outerScript);
		theline = line + adjust;
		code = TclEvalEx(interp, tokenPtr->start+1, tokenPtr->size-2,
			0, theline, clNextOuter, outerScript);

2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
 *
 *----------------------------------------------------------------------
 */

static int
CommandComplete(
    const char *script,		/* Script to check. */
    size_t numBytes)		/* Number of bytes in script. */
{
    Tcl_Parse parse;
    const char *p, *end;
    int result;

    p = script;
    end = p + numBytes;







|







2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
 *
 *----------------------------------------------------------------------
 */

static int
CommandComplete(
    const char *script,		/* Script to check. */
    Tcl_Size numBytes)		/* Number of bytes in script. */
{
    Tcl_Parse parse;
    const char *p, *end;
    int result;

    p = script;
    end = p + numBytes;
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
 */

int
TclObjCommandComplete(
    Tcl_Obj *objPtr)		/* Points to object holding script to
				 * check. */
{
    size_t length;
    const char *script = Tcl_GetStringFromObj(objPtr, &length);

    return CommandComplete(script, length);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|












2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
 */

int
TclObjCommandComplete(
    Tcl_Obj *objPtr)		/* Points to object holding script to
				 * check. */
{
    Tcl_Size 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/tclParse.h.

12
13
14
15
16
17
18
19
#define TYPE_CLOSE_BRACK	0x20
#define TYPE_BRACE		0x40
#define TYPE_OPEN_PAREN		0x80
#define TYPE_BAD_ARRAY_INDEX	(TYPE_OPEN_PAREN|TYPE_CLOSE_PAREN|TYPE_QUOTE|TYPE_BRACE)

#define CHAR_TYPE(c) tclCharTypeTable[(unsigned char)(c)]

MODULE_SCOPE const char tclCharTypeTable[];







|
12
13
14
15
16
17
18
19
#define TYPE_CLOSE_BRACK	0x20
#define TYPE_BRACE		0x40
#define TYPE_OPEN_PAREN		0x80
#define TYPE_BAD_ARRAY_INDEX	(TYPE_OPEN_PAREN|TYPE_CLOSE_PAREN|TYPE_QUOTE|TYPE_BRACE)

#define CHAR_TYPE(c) tclCharTypeTable[(unsigned char)(c)]

MODULE_SCOPE const unsigned char tclCharTypeTable[];

Changes to generic/tclPathObj.c.

21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44

45
46
47
48
49
50
51

static Tcl_Obj *	AppendPath(Tcl_Obj *head, Tcl_Obj *tail);
static void		DupFsPathInternalRep(Tcl_Obj *srcPtr,
			    Tcl_Obj *copyPtr);
static void		FreeFsPathInternalRep(Tcl_Obj *pathPtr);
static void		UpdateStringOfFsPath(Tcl_Obj *pathPtr);
static int		SetFsPathFromAny(Tcl_Interp *interp, Tcl_Obj *pathPtr);
static size_t		FindSplitPos(const char *path, int separator);
static int		IsSeparatorOrNull(int ch);
static Tcl_Obj *	GetExtension(Tcl_Obj *pathPtr);
static int		MakePathFromNormalized(Tcl_Interp *interp,
			    Tcl_Obj *pathPtr);

/*
 * Define the 'path' object type, which Tcl uses to represent file paths
 * internally.
 */

static const Tcl_ObjType fsPathType = {
    "path",				/* name */
    FreeFsPathInternalRep,		/* freeIntRepProc */
    DupFsPathInternalRep,		/* dupIntRepProc */
    UpdateStringOfFsPath,		/* updateStringProc */
    SetFsPathFromAny			/* setFromAnyProc */

};

/*
 * struct FsPath --
 *
 * Internal representation of a Tcl_Obj of fsPathType
 */







|















|
>







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

static Tcl_Obj *	AppendPath(Tcl_Obj *head, Tcl_Obj *tail);
static void		DupFsPathInternalRep(Tcl_Obj *srcPtr,
			    Tcl_Obj *copyPtr);
static void		FreeFsPathInternalRep(Tcl_Obj *pathPtr);
static void		UpdateStringOfFsPath(Tcl_Obj *pathPtr);
static int		SetFsPathFromAny(Tcl_Interp *interp, Tcl_Obj *pathPtr);
static Tcl_Size		FindSplitPos(const char *path, int separator);
static int		IsSeparatorOrNull(int ch);
static Tcl_Obj *	GetExtension(Tcl_Obj *pathPtr);
static int		MakePathFromNormalized(Tcl_Interp *interp,
			    Tcl_Obj *pathPtr);

/*
 * Define the 'path' object type, which Tcl uses to represent file paths
 * internally.
 */

static const Tcl_ObjType fsPathType = {
    "path",				/* name */
    FreeFsPathInternalRep,		/* freeIntRepProc */
    DupFsPathInternalRep,		/* dupIntRepProc */
    UpdateStringOfFsPath,		/* updateStringProc */
    SetFsPathFromAny,			/* setFromAnyProc */
    TCL_OBJTYPE_V0
};

/*
 * struct FsPath --
 *
 * Internal representation of a Tcl_Obj of fsPathType
 */
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
				 *  or ~user components.  Otherwise it is a
				 *  path, possibly absolute, to normalize
				 *  relative to cwdPtr. */
    Tcl_Obj *cwdPtr;		/*  If NULL, either translatedPtr exists or
				 *  normPathPtr exists and is absolute. */
    int flags;			/* Flags to describe interpretation - see
				 * below. */
    ClientData nativePathPtr;	/* Native representation of this path, which
				 * is filesystem dependent. */
    size_t filesystemEpoch;	/* Used to ensure the path representation was
				 * generated during the correct filesystem
				 * epoch. The epoch changes when
				 * filesystem-mounts are changed. */
    const Tcl_Filesystem *fsPtr;/* The Tcl_Filesystem that claims this path */
} FsPath;







|







61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
				 *  or ~user components.  Otherwise it is a
				 *  path, possibly absolute, to normalize
				 *  relative to cwdPtr. */
    Tcl_Obj *cwdPtr;		/*  If NULL, either translatedPtr exists or
				 *  normPathPtr exists and is absolute. */
    int flags;			/* Flags to describe interpretation - see
				 * below. */
    void *nativePathPtr;	/* Native representation of this path, which
				 * is filesystem dependent. */
    size_t filesystemEpoch;	/* Used to ensure the path representation was
				 * generated during the correct filesystem
				 * epoch. The epoch changes when
				 * filesystem-mounts are changed. */
    const Tcl_Filesystem *fsPtr;/* The Tcl_Filesystem that claims this path */
} FsPath;
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
		oldDirSep = dirSep;
	    }
	again:
	    if (IsSeparatorOrNull(dirSep[2])) {
		/*
		 * Need to skip '.' in the path.
		 */
		size_t curLen;

		if (retVal == NULL) {
		    const char *path = TclGetString(pathPtr);
		    retVal = Tcl_NewStringObj(path, dirSep - path);
		    Tcl_IncrRefCount(retVal);
		}
		(void)Tcl_GetStringFromObj(retVal, &curLen);
		if (curLen == 0) {
		    Tcl_AppendToObj(retVal, dirSep, 1);
		}
		dirSep += 2;
		oldDirSep = dirSep;
		if (dirSep[0] != 0 && dirSep[1] == '.') {
		    goto again;
		}
		continue;
	    }
	    if (dirSep[2] == '.' && IsSeparatorOrNull(dirSep[3])) {
		Tcl_Obj *linkObj;
		size_t curLen;
		char *linkStr;

		/*
		 * Have '..' so need to skip previous directory.
		 */

		if (retVal == NULL) {







|



















|







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
		oldDirSep = dirSep;
	    }
	again:
	    if (IsSeparatorOrNull(dirSep[2])) {
		/*
		 * Need to skip '.' in the path.
		 */
		Tcl_Size curLen;

		if (retVal == NULL) {
		    const char *path = TclGetString(pathPtr);
		    retVal = Tcl_NewStringObj(path, dirSep - path);
		    Tcl_IncrRefCount(retVal);
		}
		(void)Tcl_GetStringFromObj(retVal, &curLen);
		if (curLen == 0) {
		    Tcl_AppendToObj(retVal, dirSep, 1);
		}
		dirSep += 2;
		oldDirSep = dirSep;
		if (dirSep[0] != 0 && dirSep[1] == '.') {
		    goto again;
		}
		continue;
	    }
	    if (dirSep[2] == '.' && IsSeparatorOrNull(dirSep[3])) {
		Tcl_Obj *linkObj;
		Tcl_Size curLen;
		char *linkStr;

		/*
		 * Have '..' so need to skip previous directory.
		 */

		if (retVal == NULL) {
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
			    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] = '/';
				    }
				}
			    }







|







301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
			    linkStr = Tcl_GetStringFromObj(retVal, &curLen);

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

			    if (tclPlatform == TCL_PLATFORM_WINDOWS) {
				Tcl_Size i;

				for (i = 0; i < curLen; i++) {
				    if (linkStr[i] == '\\') {
					linkStr[i] = '/';
				    }
				}
			    }
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
    }

    /*
     * Ensure a windows drive like C:/ has a trailing separator.
     */

    if (tclPlatform == TCL_PLATFORM_WINDOWS) {
	size_t len;
	const char *path = Tcl_GetStringFromObj(retVal, &len);

	if (len == 2 && path[0] != 0 && path[1] == ':') {
	    if (Tcl_IsShared(retVal)) {
		TclDecrRefCount(retVal);
		retVal = Tcl_DuplicateObj(retVal);
		Tcl_IncrRefCount(retVal);







|







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) {
	Tcl_Size 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);
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
 *----------------------------------------------------------------------
 */

Tcl_PathType
TclFSGetPathType(
    Tcl_Obj *pathPtr,
    const Tcl_Filesystem **filesystemPtrPtr,
    size_t *driveNameLengthPtr)
{
    FsPath *fsPathPtr;

    if (Tcl_FSConvertToPathType(NULL, pathPtr) != TCL_OK) {
	return TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr,
		NULL);
    }







|







473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
 *----------------------------------------------------------------------
 */

Tcl_PathType
TclFSGetPathType(
    Tcl_Obj *pathPtr,
    const Tcl_Filesystem **filesystemPtrPtr,
    Tcl_Size *driveNameLengthPtr)
{
    FsPath *fsPathPtr;

    if (Tcl_FSConvertToPathType(NULL, pathPtr) != TCL_OK) {
	return TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr,
		NULL);
    }
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
		 * Check if the joined-on bit has any directory delimiters in
		 * it. If so, the 'dirname' would be a joining of the main
		 * part with the dirname of the joined-on bit. We could handle
		 * that special case here, but we don't, and instead just use
		 * the standardPath code.
		 */

		size_t numBytes;
		const char *rest = Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &numBytes);

		if (strchr(rest, '/') != NULL) {
		    goto standardPath;
		}
		/*
		 * If the joined-on bit is empty, then [file dirname] is







|







555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
		 * Check if the joined-on bit has any directory delimiters in
		 * 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.
		 */

		Tcl_Size 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
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
		/*
		 * Check if the joined-on bit has any directory delimiters in
		 * it. If so, the 'tail' would be only the part following the
		 * last delimiter. We could handle that special case here, but
		 * we don't, and instead just use the standardPath code.
		 */

		size_t numBytes;
		const char *rest = Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &numBytes);

		if (strchr(rest, '/') != NULL) {
		    goto standardPath;
		}
		/*
		 * If the joined-on bit is empty, then [file tail] is







|







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

		Tcl_Size 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
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
		Tcl_IncrRefCount(fsPathPtr->normPathPtr);
		return fsPathPtr->normPathPtr;
	    }
	    case TCL_PATH_EXTENSION:
		return GetExtension(fsPathPtr->normPathPtr);
	    case TCL_PATH_ROOT: {
		const char *fileName, *extension;
		size_t length;

		fileName = Tcl_GetStringFromObj(fsPathPtr->normPathPtr,
			&length);
		extension = TclGetExtension(fileName);
		if (extension == NULL) {
		    /*
		     * There is no extension so the root is the same as the







|







620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
		Tcl_IncrRefCount(fsPathPtr->normPathPtr);
		return fsPathPtr->normPathPtr;
	    }
	    case TCL_PATH_EXTENSION:
		return GetExtension(fsPathPtr->normPathPtr);
	    case TCL_PATH_ROOT: {
		const char *fileName, *extension;
		Tcl_Size length;

		fileName = Tcl_GetStringFromObj(fsPathPtr->normPathPtr,
			&length);
		extension = TclGetExtension(fileName);
		if (extension == NULL) {
		    /*
		     * There is no extension so the root is the same as the
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
	    /* Relative path */
	    goto standardPath;
	} else {
	    /* Absolute path */
	    goto standardPath;
	}
    } else {
	size_t splitElements;
	Tcl_Obj *splitPtr, *resultPtr;

    standardPath:
	resultPtr = NULL;
	if (portion == TCL_PATH_EXTENSION) {
	    return GetExtension(pathPtr);
	} else if (portion == TCL_PATH_ROOT) {
	    size_t length;
	    const char *fileName, *extension;

	    fileName = Tcl_GetStringFromObj(pathPtr, &length);
	    extension = TclGetExtension(fileName);
	    if (extension == NULL) {
		Tcl_IncrRefCount(pathPtr);
		return pathPtr;







|







|







663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
	    /* Relative path */
	    goto standardPath;
	} else {
	    /* Absolute path */
	    goto standardPath;
	}
    } else {
	Tcl_Size splitElements;
	Tcl_Obj *splitPtr, *resultPtr;

    standardPath:
	resultPtr = NULL;
	if (portion == TCL_PATH_EXTENSION) {
	    return GetExtension(pathPtr);
	} else if (portion == TCL_PATH_ROOT) {
	    Tcl_Size length;
	    const char *fileName, *extension;

	    fileName = Tcl_GetStringFromObj(pathPtr, &length);
	    extension = TclGetExtension(fileName);
	    if (extension == NULL) {
		Tcl_IncrRefCount(pathPtr);
		return pathPtr;
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
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_FSJoinPath(
    Tcl_Obj *listObj,		/* Path elements to join, may have a zero
				 * reference count. */
    size_t elements)		/* Number of elements to use (-1 = all) */
{
    Tcl_Obj *res;
    size_t objc;
    Tcl_Obj **objv;

    if (TclListObjLengthM(NULL, listObj, &objc) != TCL_OK) {
	return NULL;
    }

    elements = ((elements != TCL_INDEX_NONE) && (elements <= objc)) ? elements : objc;
    TclListObjGetElementsM(NULL, listObj, &objc, &objv);
    res = TclJoinPath(elements, objv, 0);
    return res;
}

Tcl_Obj *
TclJoinPath(
    size_t elements,		/* Number of elements to use */
    Tcl_Obj * const objv[],	/* Path elements to join */
    int forceRelative)		/* If non-zero, assume all more paths are
				 * relative (e. g. simple normalization) */
{
    Tcl_Obj *res = NULL;
    size_t i;
    const Tcl_Filesystem *fsPtr = NULL;

    if (elements == 0) {
	TclNewObj(res);
	return res;
    }








|


|






|







|


|


|







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

Tcl_Obj *
Tcl_FSJoinPath(
    Tcl_Obj *listObj,		/* Path elements to join, may have a zero
				 * reference count. */
    Tcl_Size elements)		/* Number of elements to use (-1 = all) */
{
    Tcl_Obj *res;
    Tcl_Size objc;
    Tcl_Obj **objv;

    if (TclListObjLengthM(NULL, listObj, &objc) != TCL_OK) {
	return NULL;
    }

    elements = ((elements >= 0) && (elements <= objc)) ? elements : objc;
    TclListObjGetElementsM(NULL, listObj, &objc, &objv);
    res = TclJoinPath(elements, objv, 0);
    return res;
}

Tcl_Obj *
TclJoinPath(
    Tcl_Size elements,		/* Number of elements to use */
    Tcl_Obj * const objv[],	/* Path elements to join */
    int forceRelative)		/* If non-zero, assume all more paths are
				 * relative (e.g. simple normalization) */
{
    Tcl_Obj *res = NULL;
    Tcl_Size i;
    const Tcl_Filesystem *fsPtr = NULL;

    if (elements == 0) {
	TclNewObj(res);
	return res;
    }

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

	    /* if forceRelative - second path is relative */
	    type = forceRelative ? TCL_PATH_RELATIVE :
		    TclGetPathType(tailObj, NULL, NULL, NULL);
	    if (type == TCL_PATH_RELATIVE) {
		const char *str;
		size_t len;

		str = Tcl_GetStringFromObj(tailObj, &len);
		if (len == 0) {
		    /*
		     * This happens if we try to handle the root volume '/'.
		     * There's no need to return a special path object, when
		     * the base itself is just fine!
		     */

		    return elt;
		}

		/*
		 * If it doesn't begin with '.' and is a unix path or it a
		 * windows path without backslashes, then we can be very
		 * efficient here. (In fact even a windows path with
		 * backslashes can be joined efficiently, but the path object
		 * would not have forward slashes only, and this would
		 * therefore contradict our 'file join' documentation).
		 */








|













|







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

	    /* if forceRelative - second path is relative */
	    type = forceRelative ? TCL_PATH_RELATIVE :
		    TclGetPathType(tailObj, NULL, NULL, NULL);
	    if (type == TCL_PATH_RELATIVE) {
		const char *str;
		Tcl_Size 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!
		     */

		    return elt;
		}

		/*
		 * If it doesn't begin with '.' and is a Unix path or it a
		 * windows path without backslashes, then we can be very
		 * efficient here. (In fact even a windows path with
		 * backslashes can be joined efficiently, but the path object
		 * would not have forward slashes only, and this would
		 * therefore contradict our 'file join' documentation).
		 */

918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
	    }
	}
    }

    assert ( res == NULL );

    for (i = 0; i < elements; i++) {
	size_t driveNameLength;
	size_t strEltLen, length;
	Tcl_PathType type;
	char *strElt, *ptr;
	Tcl_Obj *driveName = NULL;
	Tcl_Obj *elt = objv[i];

	strElt = Tcl_GetStringFromObj(elt, &strEltLen);
	driveNameLength = 0;







|
|







919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
	    }
	}
    }

    assert ( res == NULL );

    for (i = 0; i < elements; i++) {
	Tcl_Size driveNameLength;
	Tcl_Size strEltLen, length;
	Tcl_PathType type;
	char *strElt, *ptr;
	Tcl_Obj *driveName = NULL;
	Tcl_Obj *elt = objv[i];

	strElt = Tcl_GetStringFromObj(elt, &strEltLen);
	driveNameLength = 0;
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175

/*
 * Helper function for SetFsPathFromAny. Returns position of first directory
 * delimiter in the path. If no separator is found, then returns the position
 * of the end of the string.
 */

static size_t
FindSplitPos(
    const char *path,
    int separator)
{
    int count = 0;
    switch (tclPlatform) {
    case TCL_PLATFORM_UNIX:







|







1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176

/*
 * Helper function for SetFsPathFromAny. Returns position of first directory
 * delimiter in the path. If no separator is found, then returns the position
 * of the end of the string.
 */

static Tcl_Size
FindSplitPos(
    const char *path,
    int separator)
{
    int count = 0;
    switch (tclPlatform) {
    case TCL_PLATFORM_UNIX:
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
TclNewFSPathObj(
    Tcl_Obj *dirPtr,
    const char *addStrRep,
    size_t len)
{
    FsPath *fsPathPtr;
    Tcl_Obj *pathPtr;
    const char *p;
    int state = 0, count = 0;

    /*







|







1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
TclNewFSPathObj(
    Tcl_Obj *dirPtr,
    const char *addStrRep,
    Tcl_Size len)
{
    FsPath *fsPathPtr;
    Tcl_Obj *pathPtr;
    const char *p;
    int state = 0, count = 0;

    /*
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282

    /*
     * Look for path components made up of only "."
     * This is overly conservative analysis to keep simple. It may mark some
     * things as needing more aggressive normalization that don't actually
     * need it. No harm done.
     */
    for (p = addStrRep; len+1 > 1; p++, len--) {
	switch (state) {
	case 0:		/* So far only "." since last dirsep or start */
	    switch (*p) {
	    case '.':
		count = 1;
		break;
	    case '/':







|







1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283

    /*
     * Look for path components made up of only "."
     * This is overly conservative analysis to keep simple. It may mark some
     * things as needing more aggressive normalization that don't actually
     * need it. No harm done.
     */
    for (p = addStrRep; len > 0; p++, len--) {
	switch (state) {
	case 0:		/* So far only "." since last dirsep or start */
	    switch (*p) {
	    case '.':
		count = 1;
		break;
	    case '/':
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
static Tcl_Obj *
AppendPath(
    Tcl_Obj *head,
    Tcl_Obj *tail)
{
    const char *bytes;
    Tcl_Obj *copy = Tcl_DuplicateObj(head);
    size_t length;

    /*
     * This is likely buggy when dealing with virtual filesystem drivers
     * that use some character other than "/" as a path separator.  I know
     * of no evidence that such a foolish thing exists.  This solution was
     * chosen so that "JoinPath" operations that pass through either path
     * internalrep produce the same results; that is, bugward compatibility.  If







|







1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
static Tcl_Obj *
AppendPath(
    Tcl_Obj *head,
    Tcl_Obj *tail)
{
    const char *bytes;
    Tcl_Obj *copy = Tcl_DuplicateObj(head);
    Tcl_Size length;

    /*
     * This is likely buggy when dealing with virtual filesystem drivers
     * that use some character other than "/" as a path separator.  I know
     * of no evidence that such a foolish thing exists.  This solution was
     * chosen so that "JoinPath" operations that pass through either path
     * internalrep produce the same results; that is, bugward compatibility.  If
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373

Tcl_Obj *
TclFSMakePathRelative(
    TCL_UNUSED(Tcl_Interp *),
    Tcl_Obj *pathPtr,		/* The path we have. */
    Tcl_Obj *cwdPtr)		/* Make it relative to this. */
{
    size_t cwdLen, len;
    const char *tempStr;
    Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(pathPtr, &fsPathType);

    if (irPtr) {
	FsPath *fsPathPtr = PATHOBJ(pathPtr);

	if (PATHFLAGS(pathPtr) != 0 && fsPathPtr->cwdPtr == cwdPtr) {







|







1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374

Tcl_Obj *
TclFSMakePathRelative(
    TCL_UNUSED(Tcl_Interp *),
    Tcl_Obj *pathPtr,		/* The path we have. */
    Tcl_Obj *cwdPtr)		/* Make it relative to this. */
{
    Tcl_Size cwdLen, len;
    const char *tempStr;
    Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(pathPtr, &fsPathType);

    if (irPtr) {
	FsPath *fsPathPtr = PATHOBJ(pathPtr);

	if (PATHFLAGS(pathPtr) != 0 && fsPathPtr->cwdPtr == cwdPtr) {
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_FSNewNativePath(
    const Tcl_Filesystem *fromFilesystem,
    ClientData clientData)
{
    Tcl_Obj *pathPtr = NULL;
    FsPath *fsPathPtr;


    if (fromFilesystem->internalToNormalizedProc != NULL) {
	pathPtr = (*fromFilesystem->internalToNormalizedProc)(clientData);







|







1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_FSNewNativePath(
    const Tcl_Filesystem *fromFilesystem,
    void *clientData)
{
    Tcl_Obj *pathPtr = NULL;
    FsPath *fsPathPtr;


    if (fromFilesystem->internalToNormalizedProc != NULL) {
	pathPtr = (*fromFilesystem->internalToNormalizedProc)(clientData);
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
Tcl_FSGetTranslatedStringPath(
    Tcl_Interp *interp,
    Tcl_Obj *pathPtr)
{
    Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr);

    if (transPtr != NULL) {
	size_t len;
	const char *orig = Tcl_GetStringFromObj(transPtr, &len);
	char *result = (char *)Tcl_Alloc(len+1);

	memcpy(result, orig, len+1);
	TclDecrRefCount(transPtr);
	return result;
    }







|







1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
Tcl_FSGetTranslatedStringPath(
    Tcl_Interp *interp,
    Tcl_Obj *pathPtr)
{
    Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr);

    if (transPtr != NULL) {
	Tcl_Size len;
	const char *orig = Tcl_GetStringFromObj(transPtr, &len);
	char *result = (char *)Tcl_Alloc(len+1);

	memcpy(result, orig, len+1);
	TclDecrRefCount(transPtr);
	return result;
    }
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
    if (PATHFLAGS(pathPtr) != 0) {
	/*
	 * This is a special path object which is the result of something like
	 * 'file join'
	 */

	Tcl_Obj *dir, *copy;
	size_t tailLen, cwdLen;
	int pathType;

	pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr);
	dir = Tcl_FSGetNormalizedPath(interp, fsPathPtr->cwdPtr);
	if (dir == NULL) {
	    return NULL;
	}







|







1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
    if (PATHFLAGS(pathPtr) != 0) {
	/*
	 * This is a special path object which is the result of something like
	 * 'file join'
	 */

	Tcl_Obj *dir, *copy;
	Tcl_Size tailLen, cwdLen;
	int pathType;

	pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr);
	dir = Tcl_FSGetNormalizedPath(interp, fsPathPtr->cwdPtr);
	if (dir == NULL) {
	    return NULL;
	}
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
	    TclGetString(pathPtr);
	    Tcl_StoreInternalRep(pathPtr, &fsPathType, NULL);
	    if (SetFsPathFromAny(interp, pathPtr) != TCL_OK) {
		return NULL;
	    }
	    fsPathPtr = PATHOBJ(pathPtr);
	} else if (fsPathPtr->normPathPtr == NULL) {
	    size_t cwdLen;
	    Tcl_Obj *copy;

	    copy = AppendPath(fsPathPtr->cwdPtr, pathPtr);

	    (void) Tcl_GetStringFromObj(fsPathPtr->cwdPtr, &cwdLen);
	    cwdLen += (TclGetString(copy)[cwdLen] == '/');








|







1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
	    TclGetString(pathPtr);
	    Tcl_StoreInternalRep(pathPtr, &fsPathType, NULL);
	    if (SetFsPathFromAny(interp, pathPtr) != TCL_OK) {
		return NULL;
	    }
	    fsPathPtr = PATHOBJ(pathPtr);
	} else if (fsPathPtr->normPathPtr == NULL) {
	    Tcl_Size cwdLen;
	    Tcl_Obj *copy;

	    copy = AppendPath(fsPathPtr->cwdPtr, pathPtr);

	    (void) Tcl_GetStringFromObj(fsPathPtr->cwdPtr, &cwdLen);
	    cwdLen += (TclGetString(copy)[cwdLen] == '/');

1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
 *
 *	Tcl_FSCreateInternalRepProc if needed to produce the native
 *	handle, which is then stored in the internal representation of pathPtr.
 *
 *---------------------------------------------------------------------------
 */

ClientData
Tcl_FSGetInternalRep(
    Tcl_Obj *pathPtr,
    const Tcl_Filesystem *fsPtr)
{
    FsPath *srcFsPathPtr;

    if (Tcl_FSConvertToPathType(NULL, pathPtr) != TCL_OK) {







|







1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
 *
 *	Tcl_FSCreateInternalRepProc if needed to produce the native
 *	handle, which is then stored in the internal representation of pathPtr.
 *
 *---------------------------------------------------------------------------
 */

void *
Tcl_FSGetInternalRep(
    Tcl_Obj *pathPtr,
    const Tcl_Filesystem *fsPtr)
{
    FsPath *srcFsPathPtr;

    if (Tcl_FSConvertToPathType(NULL, pathPtr) != TCL_OK) {
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
 *---------------------------------------------------------------------------
 */

void
TclFSSetPathDetails(
    Tcl_Obj *pathPtr,
    const Tcl_Filesystem *fsPtr,
    ClientData clientData)
{
    FsPath *srcFsPathPtr;

    /*
     * Make sure pathPtr is of the correct type.
     */








|







2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
 *---------------------------------------------------------------------------
 */

void
TclFSSetPathDetails(
    Tcl_Obj *pathPtr,
    const Tcl_Filesystem *fsPtr,
    void *clientData)
{
    FsPath *srcFsPathPtr;

    /*
     * Make sure pathPtr is of the correct type.
     */

2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126

int
Tcl_FSEqualPaths(
    Tcl_Obj *firstPtr,
    Tcl_Obj *secondPtr)
{
    const char *firstStr, *secondStr;
    size_t firstLen, secondLen;
    int tempErrno;

    if (firstPtr == secondPtr) {
	return 1;
    }

    if (firstPtr == NULL || secondPtr == NULL) {







|







2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127

int
Tcl_FSEqualPaths(
    Tcl_Obj *firstPtr,
    Tcl_Obj *secondPtr)
{
    const char *firstStr, *secondStr;
    Tcl_Size firstLen, secondLen;
    int tempErrno;

    if (firstPtr == secondPtr) {
	return 1;
    }

    if (firstPtr == NULL || secondPtr == NULL) {
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
 */

static int
SetFsPathFromAny(
    TCL_UNUSED(Tcl_Interp *),	/* Used for error reporting if not NULL. */
    Tcl_Obj *pathPtr)		/* The object to convert. */
{
    size_t len;
    FsPath *fsPathPtr;
    Tcl_Obj *transPtr;

    if (TclHasInternalRep(pathPtr, &fsPathType)) {
	return TCL_OK;
    }








|







2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
 */

static int
SetFsPathFromAny(
    TCL_UNUSED(Tcl_Interp *),	/* Used for error reporting if not NULL. */
    Tcl_Obj *pathPtr)		/* The object to convert. */
{
    Tcl_Size len;
    FsPath *fsPathPtr;
    Tcl_Obj *transPtr;

    if (TclHasInternalRep(pathPtr, &fsPathType)) {
	return TCL_OK;
    }

2202
2203
2204
2205
2206
2207
2208


2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
     * Now we have a translated filename in 'transPtr'. This will have forward
     * slashes on Windows, and will not contain any ~user sequences.
     */

    fsPathPtr = (FsPath *)Tcl_Alloc(sizeof(FsPath));

    if (transPtr == pathPtr) {


        transPtr = Tcl_DuplicateObj(pathPtr);
        fsPathPtr->filesystemEpoch = 0;
    } else {
        fsPathPtr->filesystemEpoch = TclFSEpoch();
    }
    Tcl_IncrRefCount(transPtr);
    fsPathPtr->translatedPathPtr = transPtr;
    fsPathPtr->normPathPtr = NULL;
    fsPathPtr->cwdPtr = NULL;
    fsPathPtr->nativePathPtr = NULL;
    fsPathPtr->fsPtr = NULL;







>
>
|
|

|







2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
     * Now we have a translated filename in 'transPtr'. This will have forward
     * slashes on Windows, and will not contain any ~user sequences.
     */

    fsPathPtr = (FsPath *)Tcl_Alloc(sizeof(FsPath));

    if (transPtr == pathPtr) {
	(void) Tcl_GetString(pathPtr);
	TclFreeInternalRep(pathPtr);
	transPtr = Tcl_DuplicateObj(pathPtr);
	fsPathPtr->filesystemEpoch = 0;
    } else {
	fsPathPtr->filesystemEpoch = TclFSEpoch();
    }
    Tcl_IncrRefCount(transPtr);
    fsPathPtr->translatedPathPtr = transPtr;
    fsPathPtr->normPathPtr = NULL;
    fsPathPtr->cwdPtr = NULL;
    fsPathPtr->nativePathPtr = NULL;
    fsPathPtr->fsPtr = NULL;
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
 */

static void
UpdateStringOfFsPath(
    Tcl_Obj *pathPtr)	/* path obj with string rep to update. */
{
    FsPath *fsPathPtr = PATHOBJ(pathPtr);
    size_t cwdLen;
    Tcl_Obj *copy;

    if (PATHFLAGS(pathPtr) == 0 || fsPathPtr->cwdPtr == NULL) {

	Tcl_Panic("Called UpdateStringOfFsPath with invalid object");


    }

    copy = AppendPath(fsPathPtr->cwdPtr, fsPathPtr->normPathPtr);


    if (Tcl_IsShared(copy)) {
	copy = Tcl_DuplicateObj(copy);
    }

    Tcl_IncrRefCount(copy);
    /* Steal copy's string rep */
    pathPtr->bytes = Tcl_GetStringFromObj(copy, &cwdLen);
    pathPtr->length = cwdLen;
    TclInitStringRep(copy, NULL, 0);
    TclDecrRefCount(copy);
}

/*
 *---------------------------------------------------------------------------
 *
 * TclNativePathInFilesystem --







|



>
|
>
>
|
|
|
>
>








|







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

static void
UpdateStringOfFsPath(
    Tcl_Obj *pathPtr)	/* path obj with string rep to update. */
{
    FsPath *fsPathPtr = PATHOBJ(pathPtr);
    Tcl_Size cwdLen;
    Tcl_Obj *copy;

    if (PATHFLAGS(pathPtr) == 0 || fsPathPtr->cwdPtr == NULL) {
	if (fsPathPtr->translatedPathPtr == NULL) {
	    Tcl_Panic("Called UpdateStringOfFsPath with invalid object");
	} else {
	    copy = Tcl_DuplicateObj(fsPathPtr->translatedPathPtr);
	}
    } else {
	    copy = AppendPath(fsPathPtr->cwdPtr, fsPathPtr->normPathPtr);
    }

    if (Tcl_IsShared(copy)) {
	copy = Tcl_DuplicateObj(copy);
    }

    Tcl_IncrRefCount(copy);
    /* Steal copy's string rep */
    pathPtr->bytes = Tcl_GetStringFromObj(copy, &cwdLen);
    pathPtr->length = cwdLen;
    TclInitEmptyStringRep(copy);
    TclDecrRefCount(copy);
}

/*
 *---------------------------------------------------------------------------
 *
 * TclNativePathInFilesystem --
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
 *
 *---------------------------------------------------------------------------
 */

int
TclNativePathInFilesystem(
    Tcl_Obj *pathPtr,
    TCL_UNUSED(ClientData *))
{
    /*
     * A special case is required to handle the empty path "". This is a valid
     * path (i.e. the user should be able to do 'file exists ""' without
     * throwing an error), but equally the path doesn't exist. Those are the
     * semantics of Tcl (at present anyway), so we have to abide by them here.
     */







|







2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
 *
 *---------------------------------------------------------------------------
 */

int
TclNativePathInFilesystem(
    Tcl_Obj *pathPtr,
    TCL_UNUSED(void **))
{
    /*
     * A special case is required to handle the empty path "". This is a valid
     * path (i.e. the user should be able to do 'file exists ""' without
     * throwing an error), but equally the path doesn't exist. Those are the
     * semantics of Tcl (at present anyway), so we have to abide by them here.
     */
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
    } else {
	/*
	 * It is somewhat unusual to reach this code path without the object
	 * being of fsPathType. However, we do our best to deal with the
	 * situation.
	 */

	size_t len;

	(void) Tcl_GetStringFromObj(pathPtr, &len);
	if (len == 0) {
	    /*
	     * We reject the empty path "".
	     */








|







2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
    } else {
	/*
	 * 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.
	 */

	Tcl_Size len;

	(void) Tcl_GetStringFromObj(pathPtr, &len);
	if (len == 0) {
	    /*
	     * We reject the empty path "".
	     */

2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
    const char *user)   /* User name. NULL -> current user */
{
    Tcl_DString dirString;

    if (MakeTildeRelativePath(interp, user, NULL, &dirString) != TCL_OK) {
	return NULL;
    }
    return TclDStringToObj(&dirString);
}

/*
 *----------------------------------------------------------------------
 *
 * TclResolveTildePath --
 *







|







2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
    const char *user)   /* User name. NULL -> current user */
{
    Tcl_DString dirString;

    if (MakeTildeRelativePath(interp, user, NULL, &dirString) != TCL_OK) {
	return NULL;
    }
    return Tcl_DStringToObj(&dirString);
}

/*
 *----------------------------------------------------------------------
 *
 * TclResolveTildePath --
 *
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
 */
Tcl_Obj *
TclResolveTildePath(
    Tcl_Interp *interp, /* May be NULL. Only used for error messages */
    Tcl_Obj *pathObj)
{
    const char *path;
    size_t len;
    size_t split;
    Tcl_DString resolvedPath;

    path = Tcl_GetStringFromObj(pathObj, &len);
    if (path[0] != '~') {
	return pathObj;
    }








|
|







2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
 */
Tcl_Obj *
TclResolveTildePath(
    Tcl_Interp *interp, /* May be NULL. Only used for error messages */
    Tcl_Obj *pathObj)
{
    const char *path;
    Tcl_Size len;
    Tcl_Size split;
    Tcl_DString resolvedPath;

    path = Tcl_GetStringFromObj(pathObj, &len);
    if (path[0] != '~') {
	return pathObj;
    }

2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
				  &resolvedPath)
	    != TCL_OK) {
	    Tcl_DStringFree(&userName);
	    return NULL;
	}
	Tcl_DStringFree(&userName);
    }
    return TclDStringToObj(&resolvedPath);
}

/*
 *----------------------------------------------------------------------
 *
 * TclResolveTildePathList --
 *







|







2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
				  &resolvedPath)
	    != TCL_OK) {
	    Tcl_DStringFree(&userName);
	    return NULL;
	}
	Tcl_DStringFree(&userName);
    }
    return Tcl_DStringToObj(&resolvedPath);
}

/*
 *----------------------------------------------------------------------
 *
 * TclResolveTildePathList --
 *
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
 *----------------------------------------------------------------------
 */
Tcl_Obj *
TclResolveTildePathList(
    Tcl_Obj *pathsObj)
{
    Tcl_Obj **objv;
    size_t objc;
    size_t i;
    Tcl_Obj *resolvedPaths;
    const char *path;

    if (pathsObj == NULL) {
        return NULL;
    }
    if (Tcl_ListObjGetElements(NULL, pathsObj, &objc, &objv) != TCL_OK) {







|
|







2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
 *----------------------------------------------------------------------
 */
Tcl_Obj *
TclResolveTildePathList(
    Tcl_Obj *pathsObj)
{
    Tcl_Obj **objv;
    Tcl_Size objc;
    Tcl_Size i;
    Tcl_Obj *resolvedPaths;
    const char *path;

    if (pathsObj == NULL) {
        return NULL;
    }
    if (Tcl_ListObjGetElements(NULL, pathsObj, &objc, &objv) != TCL_OK) {

Changes to generic/tclPipe.c.

175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_DetachPids(
    size_t numPids,		/* Number of pids to detach: gives size of
				 * array pointed to by pidPtr. */
    Tcl_Pid *pidPtr)		/* Array of pids to detach. */
{
    Detached *detPtr;
    size_t i;

    Tcl_MutexLock(&pipeMutex);
    for (i = 0; i < numPids; i++) {
	detPtr = (Detached *)Tcl_Alloc(sizeof(Detached));
	detPtr->pid = pidPtr[i];
	detPtr->nextPtr = detList;
	detList = detPtr;







|




|







175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_DetachPids(
    Tcl_Size numPids,		/* Number of pids to detach: gives size of
				 * array pointed to by pidPtr. */
    Tcl_Pid *pidPtr)		/* Array of pids to detach. */
{
    Detached *detPtr;
    Tcl_Size i;

    Tcl_MutexLock(&pipeMutex);
    for (i = 0; i < numPids; i++) {
	detPtr = (Detached *)Tcl_Alloc(sizeof(Detached));
	detPtr->pid = pidPtr[i];
	detPtr->nextPtr = detList;
	detList = detPtr;
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
 *
 *----------------------------------------------------------------------
 */

int
TclCleanupChildren(
    Tcl_Interp *interp,		/* Used for error messages. */
    size_t numPids,		/* Number of entries in pidPtr array. */
    Tcl_Pid *pidPtr,		/* Array of process ids of children. */
    Tcl_Channel errorChan)	/* Channel for file containing stderr output
				 * from pipeline. NULL means there isn't any
				 * stderr output. */
{
    int result = TCL_OK;
    int code, abnormalExit, anyErrorInfo;
    TclProcessWaitStatus waitStatus;
    size_t i;
    Tcl_Obj *msg, *error;

    abnormalExit = 0;
    for (i = 0; i < numPids; i++) {
	waitStatus = TclProcessWait(pidPtr[i], 0, &code, &msg, &error);
	if (waitStatus == TCL_PROCESS_ERROR) {
	    result = TCL_ERROR;







|








|







265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
 *
 *----------------------------------------------------------------------
 */

int
TclCleanupChildren(
    Tcl_Interp *interp,		/* Used for error messages. */
    Tcl_Size numPids,		/* Number of entries in pidPtr array. */
    Tcl_Pid *pidPtr,		/* Array of process ids of children. */
    Tcl_Channel errorChan)	/* Channel for file containing stderr output
				 * from pipeline. NULL means there isn't any
				 * stderr output. */
{
    int result = TCL_OK;
    int code, abnormalExit, anyErrorInfo;
    TclProcessWaitStatus waitStatus;
    Tcl_Size i;
    Tcl_Obj *msg, *error;

    abnormalExit = 0;
    for (i = 0; i < numPids; i++) {
	waitStatus = TclProcessWait(pidPtr[i], 0, &code, &msg, &error);
	if (waitStatus == TCL_PROCESS_ERROR) {
	    result = TCL_ERROR;
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345

	if (interp != NULL) {
	    int count;
	    Tcl_Obj *objPtr;

	    Tcl_Seek(errorChan, 0, SEEK_SET);
	    TclNewObj(objPtr);
	    count = Tcl_ReadChars(errorChan, objPtr, -1, 0);
	    if (count == -1) {
		result = TCL_ERROR;
		Tcl_DecrRefCount(objPtr);
		Tcl_ResetResult(interp);
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"error reading stderr output file: %s",
			Tcl_PosixError(interp)));







|







331
332
333
334
335
336
337
338
339
340
341
342
343
344
345

	if (interp != NULL) {
	    int count;
	    Tcl_Obj *objPtr;

	    Tcl_Seek(errorChan, 0, SEEK_SET);
	    TclNewObj(objPtr);
	    count = Tcl_ReadChars(errorChan, objPtr, TCL_INDEX_NONE, 0);
	    if (count == -1) {
		result = TCL_ERROR;
		Tcl_DecrRefCount(objPtr);
		Tcl_ResetResult(interp);
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"error reading stderr output file: %s",
			Tcl_PosixError(interp)));
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
 *
 * Side effects:
 *	Processes and pipes are created.
 *
 *----------------------------------------------------------------------
 */

size_t
TclCreatePipeline(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting. */
    size_t argc,			/* Number of entries in argv. */
    const char **argv,		/* Array of strings describing commands in
				 * pipeline plus I/O redirection with <, <<,
				 * >, etc. Argv[argc] must be NULL. */
    Tcl_Pid **pidArrayPtr,	/* Word at *pidArrayPtr gets filled in with
				 * address of array of pids for processes in
				 * pipeline (first pid is first process in
				 * pipeline). */
    TclFile *inPipePtr,		/* If non-NULL, input to the pipeline comes
				 * from a pipe (unless overridden by
				 * redirection in the command). The file id
				 * with which to write to this pipe is stored
				 * at *inPipePtr. NULL means command specified
				 * its own input source. */
    TclFile *outPipePtr,	/* If non-NULL, output to the pipeline goes to
				 * a pipe, unless overridden by redirection in
				 * the command. The file id with which to read
				 * frome this pipe is stored at *outPipePtr.
				 * NULL means command specified its own output
				 * sink. */
    TclFile *errFilePtr)	/* If non-NULL, all stderr output from the
				 * pipeline will go to a temporary file
				 * created here, and a descriptor to read the
				 * file will be left at *errFilePtr. The file
				 * will be removed already, so closing this
				 * descriptor will be the end of the file. If
				 * this is NULL, then all stderr output goes
				 * to our stderr. If the pipeline specifies
				 * redirection then the file will still be
				 * created but it will never get any data. */
{
    Tcl_Pid *pidPtr = NULL;	/* Points to malloc-ed array holding all the
				 * pids of child processes. */
    size_t numPids;		/* Actual number of processes that exist at
				 * *pidPtr right now. */
    size_t cmdCount;		/* Count of number of distinct commands found
				 * in argc/argv. */
    const char *inputLiteral = NULL;
				/* If non-null, then this points to a string
				 * containing input data (specified via <<) to
				 * be piped to the first process in the
				 * pipeline. */
    TclFile inputFile = NULL;	/* If != NULL, gives file to use as input for







|


|
















|















|

|







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
 *
 * Side effects:
 *	Processes and pipes are created.
 *
 *----------------------------------------------------------------------
 */

Tcl_Size
TclCreatePipeline(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting. */
    Tcl_Size argc,		/* Number of entries in argv. */
    const char **argv,		/* Array of strings describing commands in
				 * pipeline plus I/O redirection with <, <<,
				 * >, etc. Argv[argc] must be NULL. */
    Tcl_Pid **pidArrayPtr,	/* Word at *pidArrayPtr gets filled in with
				 * address of array of pids for processes in
				 * pipeline (first pid is first process in
				 * pipeline). */
    TclFile *inPipePtr,		/* If non-NULL, input to the pipeline comes
				 * from a pipe (unless overridden by
				 * redirection in the command). The file id
				 * with which to write to this pipe is stored
				 * at *inPipePtr. NULL means command specified
				 * its own input source. */
    TclFile *outPipePtr,	/* If non-NULL, output to the pipeline goes to
				 * a pipe, unless overridden by redirection in
				 * the command. The file id with which to read
				 * from this pipe is stored at *outPipePtr.
				 * NULL means command specified its own output
				 * sink. */
    TclFile *errFilePtr)	/* If non-NULL, all stderr output from the
				 * pipeline will go to a temporary file
				 * created here, and a descriptor to read the
				 * file will be left at *errFilePtr. The file
				 * will be removed already, so closing this
				 * descriptor will be the end of the file. If
				 * this is NULL, then all stderr output goes
				 * to our stderr. If the pipeline specifies
				 * redirection then the file will still be
				 * created but it will never get any data. */
{
    Tcl_Pid *pidPtr = NULL;	/* Points to malloc-ed array holding all the
				 * pids of child processes. */
    Tcl_Size numPids;		/* Actual number of processes that exist at
				 * *pidPtr right now. */
    Tcl_Size cmdCount;		/* Count of number of distinct commands found
				 * in argc/argv. */
    const char *inputLiteral = NULL;
				/* If non-null, then this points to a string
				 * containing input data (specified via <<) to
				 * be piped to the first process in the
				 * pipeline. */
    TclFile inputFile = NULL;	/* If != NULL, gives file to use as input for
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
				 * stderr. */
    int errorClose = 0;		/* If non-zero, then errorFile should be
				 * closed when cleaning up. */
    int errorRelease = 0;
    const char *p;
    const char *nextArg;
    int skip, atOK, flags, needCmd, errorToOutput = 0;
    size_t i, j, lastArg, lastBar;
    Tcl_DString execBuffer;
    TclFile pipeIn;
    TclFile curInFile, curOutFile, curErrFile;
    Tcl_Channel channel;

    if (inPipePtr != NULL) {
	*inPipePtr = NULL;







|







457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
				 * stderr. */
    int errorClose = 0;		/* If non-zero, then errorFile should be
				 * closed when cleaning up. */
    int errorRelease = 0;
    const char *p;
    const char *nextArg;
    int skip, atOK, flags, needCmd, errorToOutput = 0;
    Tcl_Size i, j, lastArg, lastBar;
    Tcl_DString execBuffer;
    TclFile pipeIn;
    TclFile curInFile, curOutFile, curErrFile;
    Tcl_Channel channel;

    if (inPipePtr != NULL) {
	*inPipePtr = NULL;
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507

    /*
     * First, scan through all the arguments to figure out the structure of
     * the pipeline. Process all of the input and output redirection arguments
     * and remove them from the argument list in the pipeline. Count the
     * number of distinct processes (it's the number of "|" arguments plus
     * one) but don't remove the "|" arguments because they'll be used in the
     * second pass to seperate the individual child processes. Cannot start
     * the child processes in this pass because the redirection symbols may
     * appear anywhere in the command line - e.g., the '<' that specifies the
     * input to the entire pipe may appear at the very end of the argument
     * list.
     */

    lastBar = TCL_INDEX_NONE;
    cmdCount = 1;
    needCmd = 1;
    for (i = 0; i < argc; i++) {
	errorToOutput = 0;
	skip = 0;
	p = argv[i];
	switch (*p++) {







|






|







486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507

    /*
     * First, scan through all the arguments to figure out the structure of
     * the pipeline. Process all of the input and output redirection arguments
     * and remove them from the argument list in the pipeline. Count the
     * number of distinct processes (it's the number of "|" arguments plus
     * one) but don't remove the "|" arguments because they'll be used in the
     * second pass to separate the individual child processes. Cannot start
     * the child processes in this pass because the redirection symbols may
     * appear anywhere in the command line - e.g., the '<' that specifies the
     * input to the entire pipe may appear at the very end of the argument
     * list.
     */

    lastBar = -1;
    cmdCount = 1;
    needCmd = 1;
    for (i = 0; i < argc; i++) {
	errorToOutput = 0;
	skip = 0;
	p = argv[i];
	switch (*p++) {
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
 *----------------------------------------------------------------------
 */

Tcl_Channel
Tcl_OpenCommandChannel(
    Tcl_Interp *interp,		/* Interpreter for error reporting. Can NOT be
				 * NULL. */
    size_t argc,			/* How many arguments. */
    const char **argv,		/* Array of arguments for command pipe. */
    int flags)			/* Or'ed combination of TCL_STDIN, TCL_STDOUT,
				 * TCL_STDERR, and TCL_ENFORCE_MODE. */
{
    TclFile *inPipePtr, *outPipePtr, *errFilePtr;
    TclFile inPipe, outPipe, errFile;
    size_t numPids;
    Tcl_Pid *pidPtr = NULL;
    Tcl_Channel channel;

    inPipe = outPipe = errFile = NULL;

    inPipePtr = (flags & TCL_STDIN) ? &inPipe : NULL;
    outPipePtr = (flags & TCL_STDOUT) ? &outPipe : NULL;
    errFilePtr = (flags & TCL_STDERR) ? &errFile : NULL;

    numPids = TclCreatePipeline(interp, argc, argv, &pidPtr, inPipePtr,
	    outPipePtr, errFilePtr);

    if (numPids == TCL_INDEX_NONE) {
	goto error;
    }

    /*
     * Verify that the pipes that were created satisfy the readable/writable
     * constraints.
     */







|






|












|







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

Tcl_Channel
Tcl_OpenCommandChannel(
    Tcl_Interp *interp,		/* Interpreter for error reporting. Can NOT be
				 * NULL. */
    Tcl_Size argc,			/* How many arguments. */
    const char **argv,		/* Array of arguments for command pipe. */
    int flags)			/* Or'ed combination of TCL_STDIN, TCL_STDOUT,
				 * TCL_STDERR, and TCL_ENFORCE_MODE. */
{
    TclFile *inPipePtr, *outPipePtr, *errFilePtr;
    TclFile inPipe, outPipe, errFile;
    Tcl_Size numPids;
    Tcl_Pid *pidPtr = NULL;
    Tcl_Channel channel;

    inPipe = outPipe = errFile = NULL;

    inPipePtr = (flags & TCL_STDIN) ? &inPipe : NULL;
    outPipePtr = (flags & TCL_STDOUT) ? &outPipe : NULL;
    errFilePtr = (flags & TCL_STDERR) ? &errFile : NULL;

    numPids = TclCreatePipeline(interp, argc, argv, &pidPtr, inPipePtr,
	    outPipePtr, errFilePtr);

    if (numPids < 0) {
	goto error;
    }

    /*
     * Verify that the pipes that were created satisfy the readable/writable
     * constraints.
     */

Changes to generic/tclPkg.c.

36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
    struct PkgAvail *nextPtr;	/* Next in list of available versions of the
				 * same package. */
} PkgAvail;

typedef struct PkgName {
    struct PkgName *nextPtr;	/* Next in list of package names being
				 * initialized. */
    char name[1];
} PkgName;

typedef struct PkgFiles {
    PkgName *names;		/* Package names being initialized. Must be
				 * first field. */
    Tcl_HashTable table;	/* Table which contains files for each
				 * package. */







|







36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
    struct PkgAvail *nextPtr;	/* Next in list of available versions of the
				 * same package. */
} PkgAvail;

typedef struct PkgName {
    struct PkgName *nextPtr;	/* Next in list of package names being
				 * initialized. */
    char name[TCLFLEXARRAY];
} PkgName;

typedef struct PkgFiles {
    PkgName *names;		/* Package names being initialized. Must be
				 * first field. */
    Tcl_HashTable table;	/* Table which contains files for each
				 * package. */
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
static int		SomeRequirementSatisfied(char *havei, int reqc,
			    Tcl_Obj *const reqv[]);
static void		AddRequirementsToResult(Tcl_Interp *interp, int reqc,
			    Tcl_Obj *const reqv[]);
static void		AddRequirementsToDString(Tcl_DString *dstring,
			    int reqc, Tcl_Obj *const reqv[]);
static Package *	FindPackage(Tcl_Interp *interp, const char *name);
static int		PkgRequireCore(ClientData data[], Tcl_Interp *interp, int result);
static int		PkgRequireCoreFinal(ClientData data[], Tcl_Interp *interp, int result);
static int		PkgRequireCoreCleanup(ClientData data[], Tcl_Interp *interp, int result);
static int		PkgRequireCoreStep1(ClientData data[], Tcl_Interp *interp, int result);
static int		PkgRequireCoreStep2(ClientData data[], Tcl_Interp *interp, int result);
static int		TclNRPkgRequireProc(ClientData clientData, Tcl_Interp *interp, int reqc, Tcl_Obj *const reqv[]);
static int		SelectPackage(ClientData data[], Tcl_Interp *interp, int result);
static int		SelectPackageFinal(ClientData data[], Tcl_Interp *interp, int result);
static int		TclNRPackageObjCmdCleanup(ClientData data[], Tcl_Interp *interp, int result);

/*
 * Helper macros.
 */

#define DupBlock(v,s,len) \
    ((v) = (char *)Tcl_Alloc(len), memcpy((v),(s),(len)))







|
|
|
|
|
|
|
|
|







92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
static int		SomeRequirementSatisfied(char *havei, int reqc,
			    Tcl_Obj *const reqv[]);
static void		AddRequirementsToResult(Tcl_Interp *interp, int reqc,
			    Tcl_Obj *const reqv[]);
static void		AddRequirementsToDString(Tcl_DString *dstring,
			    int reqc, Tcl_Obj *const reqv[]);
static Package *	FindPackage(Tcl_Interp *interp, const char *name);
static int		PkgRequireCore(void *data[], Tcl_Interp *interp, int result);
static int		PkgRequireCoreFinal(void *data[], Tcl_Interp *interp, int result);
static int		PkgRequireCoreCleanup(void *data[], Tcl_Interp *interp, int result);
static int		PkgRequireCoreStep1(void *data[], Tcl_Interp *interp, int result);
static int		PkgRequireCoreStep2(void *data[], Tcl_Interp *interp, int result);
static int		TclNRPkgRequireProc(void *clientData, Tcl_Interp *interp, int reqc, Tcl_Obj *const reqv[]);
static int		SelectPackage(void *data[], Tcl_Interp *interp, int result);
static int		SelectPackageFinal(void *data[], Tcl_Interp *interp, int result);
static int		TclNRPackageObjCmdCleanup(void *data[], Tcl_Interp *interp, int result);

/*
 * Helper macros.
 */

#define DupBlock(v,s,len) \
    ((v) = (char *)Tcl_Alloc(len), memcpy((v),(s),(len)))
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
 *	invoked to provide the package.
 *
 *----------------------------------------------------------------------
 */

static void
PkgFilesCleanupProc(
    ClientData clientData,
    TCL_UNUSED(Tcl_Interp *))
{
    PkgFiles *pkgFiles = (PkgFiles *) clientData;
    Tcl_HashSearch search;
    Tcl_HashEntry *entry;

    while (pkgFiles->names) {







|







221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
 *	invoked to provide the package.
 *
 *----------------------------------------------------------------------
 */

static void
PkgFilesCleanupProc(
    void *clientData,
    TCL_UNUSED(Tcl_Interp *))
{
    PkgFiles *pkgFiles = (PkgFiles *) clientData;
    Tcl_HashSearch search;
    Tcl_HashEntry *entry;

    while (pkgFiles->names) {
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

    /*
     * Translate between old and new API, and defer to the new function.
     */

    if (version == NULL) {
	if (Tcl_PkgRequireProc(interp, name, 0, NULL, clientDataPtr) == TCL_OK) {
	    result = Tcl_GetString(Tcl_GetObjResult(interp));
	    Tcl_ResetResult(interp);
	}
    } else {
	if (exact && TCL_OK
		!= CheckVersionAndConvert(interp, version, NULL, NULL)) {
	    return NULL;
	}
	ov = Tcl_NewStringObj(version, -1);
	if (exact) {
	    Tcl_AppendStringsToObj(ov, "-", version, NULL);
	}
	Tcl_IncrRefCount(ov);
	if (Tcl_PkgRequireProc(interp, name, 1, &ov, clientDataPtr) == TCL_OK) {
	    result = Tcl_GetString(Tcl_GetObjResult(interp));
	    Tcl_ResetResult(interp);
	}
	TclDecrRefCount(ov);
    }
    return result;
}

int
Tcl_PkgRequireProc(
    Tcl_Interp *interp,		/* Interpreter in which package is now
				 * available. */
    const char *name,		/* Name of desired package. */
    size_t reqc,			/* Requirements constraining the desired
				 * version. */
    Tcl_Obj *const reqv[],	/* 0 means to use the latest version
				 * available. */
    void *clientDataPtr)
{
    RequireProcArgs args;

    args.name = name;
    args.clientDataPtr = clientDataPtr;
    return Tcl_NRCallObjProc(interp,
	    TclNRPkgRequireProc, (void *) &args, reqc, reqv);
}

static int
TclNRPkgRequireProc(
    ClientData clientData,
    Tcl_Interp *interp,
    int reqc,
    Tcl_Obj *const reqv[])
{
    RequireProcArgs *args = (RequireProcArgs *)clientData;

    Tcl_NRAddCallback(interp,
	    PkgRequireCore, (void *) args->name, INT2PTR(reqc), (void *) reqv,
	    args->clientDataPtr);
    return TCL_OK;
}

static int
PkgRequireCore(
    ClientData data[],
    Tcl_Interp *interp,
    TCL_UNUSED(int))
{
    const char *name = (const char *)data[0];
    int reqc = PTR2INT(data[1]);
    Tcl_Obj **reqv = (Tcl_Obj **)data[2];
    int code = CheckAllRequirements(interp, reqc, reqv);
    Require *reqPtr;

    if (code != TCL_OK) {
	return code;
    }







|













|












|















|














|




|







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

    /*
     * Translate between old and new API, and defer to the new function.
     */

    if (version == NULL) {
	if (Tcl_PkgRequireProc(interp, name, 0, NULL, clientDataPtr) == TCL_OK) {
	    result = Tcl_GetStringResult(interp);
	    Tcl_ResetResult(interp);
	}
    } else {
	if (exact && TCL_OK
		!= CheckVersionAndConvert(interp, version, NULL, NULL)) {
	    return NULL;
	}
	ov = Tcl_NewStringObj(version, -1);
	if (exact) {
	    Tcl_AppendStringsToObj(ov, "-", version, NULL);
	}
	Tcl_IncrRefCount(ov);
	if (Tcl_PkgRequireProc(interp, name, 1, &ov, clientDataPtr) == TCL_OK) {
	    result = Tcl_GetStringResult(interp);
	    Tcl_ResetResult(interp);
	}
	TclDecrRefCount(ov);
    }
    return result;
}

int
Tcl_PkgRequireProc(
    Tcl_Interp *interp,		/* Interpreter in which package is now
				 * available. */
    const char *name,		/* Name of desired package. */
    Tcl_Size reqc,		/* Requirements constraining the desired
				 * version. */
    Tcl_Obj *const reqv[],	/* 0 means to use the latest version
				 * available. */
    void *clientDataPtr)
{
    RequireProcArgs args;

    args.name = name;
    args.clientDataPtr = clientDataPtr;
    return Tcl_NRCallObjProc(interp,
	    TclNRPkgRequireProc, (void *) &args, reqc, reqv);
}

static int
TclNRPkgRequireProc(
    void *clientData,
    Tcl_Interp *interp,
    int reqc,
    Tcl_Obj *const reqv[])
{
    RequireProcArgs *args = (RequireProcArgs *)clientData;

    Tcl_NRAddCallback(interp,
	    PkgRequireCore, (void *) args->name, INT2PTR(reqc), (void *) reqv,
	    args->clientDataPtr);
    return TCL_OK;
}

static int
PkgRequireCore(
    void *data[],
    Tcl_Interp *interp,
    TCL_UNUSED(int))
{
    const char *name = (const char *)data[0];
    int reqc = (int)PTR2INT(data[1]);
    Tcl_Obj **reqv = (Tcl_Obj **)data[2];
    int code = CheckAllRequirements(interp, reqc, reqv);
    Require *reqPtr;

    if (code != TCL_OK) {
	return code;
    }
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
		PkgRequireCoreFinal, reqPtr, INT2PTR(reqc), reqv, NULL);
    }
    return TCL_OK;
}

static int
PkgRequireCoreStep1(
    ClientData data[],
    Tcl_Interp *interp,
    TCL_UNUSED(int))
{
    Tcl_DString command;
    char *script;
    Require *reqPtr = (Require *)data[0];
    int reqc = PTR2INT(data[1]);
    Tcl_Obj **const reqv = (Tcl_Obj **)data[2];
    const char *name = reqPtr->name /* Name of desired package. */;

    /*
     * If we've got the package in the DB already, go on to actually loading
     * it.
     */







|






|







484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
		PkgRequireCoreFinal, reqPtr, INT2PTR(reqc), reqv, NULL);
    }
    return TCL_OK;
}

static int
PkgRequireCoreStep1(
    void *data[],
    Tcl_Interp *interp,
    TCL_UNUSED(int))
{
    Tcl_DString command;
    char *script;
    Require *reqPtr = (Require *)data[0];
    int reqc = (int)PTR2INT(data[1]);
    Tcl_Obj **const reqv = (Tcl_Obj **)data[2];
    const char *name = reqPtr->name /* Name of desired package. */;

    /*
     * If we've got the package in the DB already, go on to actually loading
     * it.
     */
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
	    TCL_EVAL_GLOBAL);
    Tcl_DStringFree(&command);
    return TCL_OK;
}

static int
PkgRequireCoreStep2(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Require *reqPtr = (Require *)data[0];
    int reqc = PTR2INT(data[1]);
    Tcl_Obj **const reqv = (Tcl_Obj **)data[2];
    const char *name = reqPtr->name; /* Name of desired package. */

    if ((result != TCL_OK) && (result != TCL_ERROR)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"bad return code: %d", result));
	Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL);







|




|







543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
	    TCL_EVAL_GLOBAL);
    Tcl_DStringFree(&command);
    return TCL_OK;
}

static int
PkgRequireCoreStep2(
    void *data[],
    Tcl_Interp *interp,
    int result)
{
    Require *reqPtr = (Require *)data[0];
    int reqc = (int)PTR2INT(data[1]);
    Tcl_Obj **const reqv = (Tcl_Obj **)data[2];
    const char *name = reqPtr->name; /* Name of desired package. */

    if ((result != TCL_OK) && (result != TCL_ERROR)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"bad return code: %d", result));
	Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL);
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
	    SelectPackage, reqPtr, INT2PTR(reqc), reqv,
	    (void *)PkgRequireCoreFinal);
    return TCL_OK;
}

static int
PkgRequireCoreFinal(
    ClientData data[],
    Tcl_Interp *interp,
    TCL_UNUSED(int))
{
    Require *reqPtr = (Require *)data[0];
    int reqc = PTR2INT(data[1]), satisfies;
    Tcl_Obj **const reqv = (Tcl_Obj **)data[2];
    char *pkgVersionI;
    void *clientDataPtr = reqPtr->clientDataPtr;
    const char *name = reqPtr->name; /* Name of desired package. */

    if (reqPtr->pkgPtr->version == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(







|




|







578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
	    SelectPackage, reqPtr, INT2PTR(reqc), reqv,
	    (void *)PkgRequireCoreFinal);
    return TCL_OK;
}

static int
PkgRequireCoreFinal(
    void *data[],
    Tcl_Interp *interp,
    TCL_UNUSED(int))
{
    Require *reqPtr = (Require *)data[0];
    int reqc = (int)PTR2INT(data[1]), satisfies;
    Tcl_Obj **const reqv = (Tcl_Obj **)data[2];
    char *pkgVersionI;
    void *clientDataPtr = reqPtr->clientDataPtr;
    const char *name = reqPtr->name; /* Name of desired package. */

    if (reqPtr->pkgPtr->version == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
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
    }
    Tcl_SetObjResult(interp, reqPtr->pkgPtr->version);
    return TCL_OK;
}

static int
PkgRequireCoreCleanup(
    ClientData data[],
    TCL_UNUSED(Tcl_Interp *),
    int result)
{
    Tcl_Free(data[0]);
    return result;
}

static int
SelectPackage(
    ClientData data[],
    Tcl_Interp *interp,
    TCL_UNUSED(int))
{
    PkgAvail *availPtr, *bestPtr, *bestStablePtr;
    char *availVersion, *bestVersion, *bestStableVersion;
				/* Internal rep. of versions */
    int availStable, satisfies;
    Require *reqPtr = (Require *)data[0];
    int reqc = PTR2INT(data[1]);
    Tcl_Obj **const reqv = (Tcl_Obj **)data[2];
    const char *name = reqPtr->name;
    Package *pkgPtr = reqPtr->pkgPtr;
    Interp *iPtr = (Interp *) interp;

    /*
     * Check whether we're already attempting to load some version of this







|









|








|







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
    }
    Tcl_SetObjResult(interp, reqPtr->pkgPtr->version);
    return TCL_OK;
}

static int
PkgRequireCoreCleanup(
    void *data[],
    TCL_UNUSED(Tcl_Interp *),
    int result)
{
    Tcl_Free(data[0]);
    return result;
}

static int
SelectPackage(
    void *data[],
    Tcl_Interp *interp,
    TCL_UNUSED(int))
{
    PkgAvail *availPtr, *bestPtr, *bestStablePtr;
    char *availVersion, *bestVersion, *bestStableVersion;
				/* Internal rep. of versions */
    int availStable, satisfies;
    Require *reqPtr = (Require *)data[0];
    int reqc = (int)PTR2INT(data[1]);
    Tcl_Obj **const reqv = (Tcl_Obj **)data[2];
    const char *name = reqPtr->name;
    Package *pkgPtr = reqPtr->pkgPtr;
    Interp *iPtr = (Interp *) interp;

    /*
     * Check whether we're already attempting to load some version of this
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

	pkgFiles = (PkgFiles *)TclInitPkgFiles(interp);

	/*
	 * Push "ifneeded" package name in "tclPkgFiles" assocdata.
	 */

	pkgName = (PkgName *)Tcl_Alloc(sizeof(PkgName) + strlen(name));
	pkgName->nextPtr = pkgFiles->names;
	strcpy(pkgName->name, name);
	pkgFiles->names = pkgName;
	if (bestPtr->pkgIndex) {
	    TclPkgFileSeen(interp, bestPtr->pkgIndex);
	}
	reqPtr->versionToProvide = versionToProvide;
	Tcl_NRAddCallback(interp,
		SelectPackageFinal, reqPtr, INT2PTR(reqc), (void *)reqv,
		data[3]);
	Tcl_NREvalObj(interp, Tcl_NewStringObj(bestPtr->script, -1),
		TCL_EVAL_GLOBAL);
    }
    return TCL_OK;
}

static int
SelectPackageFinal(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Require *reqPtr = (Require *)data[0];
    int reqc = PTR2INT(data[1]);
    Tcl_Obj **const reqv = (Tcl_Obj **)data[2];
    const char *name = reqPtr->name;
    char *versionToProvide = reqPtr->versionToProvide;

    /*
     * Pop the "ifneeded" package name from "tclPkgFiles" assocdata
     */







|


















|




|







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

	pkgFiles = (PkgFiles *)TclInitPkgFiles(interp);

	/*
	 * Push "ifneeded" package name in "tclPkgFiles" assocdata.
	 */

	pkgName = (PkgName *)Tcl_Alloc(offsetof(PkgName, name) + 1 + strlen(name));
	pkgName->nextPtr = pkgFiles->names;
	strcpy(pkgName->name, name);
	pkgFiles->names = pkgName;
	if (bestPtr->pkgIndex) {
	    TclPkgFileSeen(interp, bestPtr->pkgIndex);
	}
	reqPtr->versionToProvide = versionToProvide;
	Tcl_NRAddCallback(interp,
		SelectPackageFinal, reqPtr, INT2PTR(reqc), (void *)reqv,
		data[3]);
	Tcl_NREvalObj(interp, Tcl_NewStringObj(bestPtr->script, -1),
		TCL_EVAL_GLOBAL);
    }
    return TCL_OK;
}

static int
SelectPackageFinal(
    void *data[],
    Tcl_Interp *interp,
    int result)
{
    Require *reqPtr = (Require *)data[0];
    int reqc = (int)PTR2INT(data[1]);
    Tcl_Obj **const reqv = (Tcl_Obj **)data[2];
    const char *name = reqPtr->name;
    char *versionToProvide = reqPtr->versionToProvide;

    /*
     * Pop the "ifneeded" package name from "tclPkgFiles" assocdata
     */
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */
int
Tcl_PackageObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, TclNRPackageObjCmd, clientData, objc, objv);
}








|







1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */
int
Tcl_PackageObjCmd(
    void *clientData,
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, TclNRPackageObjCmd, clientData, objc, objv);
}

1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
    enum pkgOptionsEnum {
	PKG_FILES,  PKG_FORGET,  PKG_IFNEEDED, PKG_NAMES,   PKG_PREFER,
	PKG_PRESENT, PKG_PROVIDE, PKG_REQUIRE,  PKG_UNKNOWN, PKG_VCOMPARE,
	PKG_VERSIONS, PKG_VSATISFIES
    } optionIndex;
    Interp *iPtr = (Interp *) interp;
    int exact, satisfies;
    size_t i, newobjc;
    PkgAvail *availPtr, *prevPtr;
    Package *pkgPtr;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    Tcl_HashTable *tablePtr;
    const char *version;
    const char *argv2, *argv3, *argv4;







|







1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
    enum pkgOptionsEnum {
	PKG_FILES,  PKG_FORGET,  PKG_IFNEEDED, PKG_NAMES,   PKG_PREFER,
	PKG_PRESENT, PKG_PROVIDE, PKG_REQUIRE,  PKG_UNKNOWN, PKG_VCOMPARE,
	PKG_VERSIONS, PKG_VSATISFIES
    } optionIndex;
    Interp *iPtr = (Interp *) interp;
    int exact, satisfies;
    Tcl_Size i, newobjc;
    PkgAvail *availPtr, *prevPtr;
    Package *pkgPtr;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    Tcl_HashTable *tablePtr;
    const char *version;
    const char *argv2, *argv3, *argv4;
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
	break;
    }
    case PKG_FORGET: {
	const char *keyString;
	PkgFiles *pkgFiles = (PkgFiles *)
		Tcl_GetAssocData(interp, "tclPkgFiles", NULL);

	for (i = 2; i < (size_t)objc; i++) {
	    keyString = TclGetString(objv[i]);
	    if (pkgFiles) {
		hPtr = Tcl_FindHashEntry(&pkgFiles->table, keyString);
		if (hPtr) {
		    Tcl_Obj *obj = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
		    Tcl_DeleteHashEntry(hPtr);
		    Tcl_DecrRefCount(obj);







|







1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
	break;
    }
    case PKG_FORGET: {
	const char *keyString;
	PkgFiles *pkgFiles = (PkgFiles *)
		Tcl_GetAssocData(interp, "tclPkgFiles", NULL);

	for (i = 2; i < objc; i++) {
	    keyString = TclGetString(objv[i]);
	    if (pkgFiles) {
		hPtr = Tcl_FindHashEntry(&pkgFiles->table, keyString);
		if (hPtr) {
		    Tcl_Obj *obj = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
		    Tcl_DeleteHashEntry(hPtr);
		    Tcl_DecrRefCount(obj);
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
		Tcl_Free(availPtr);
	    }
	    Tcl_Free(pkgPtr);
	}
	break;
    }
    case PKG_IFNEEDED: {
	size_t length;
	int res;
	char *argv3i, *avi;

	if ((objc != 4) && (objc != 5)) {
	    Tcl_WrongNumArgs(interp, 2, objv, "package version ?script?");
	    return TCL_ERROR;
	}







|







1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
		Tcl_Free(availPtr);
	    }
	    Tcl_Free(pkgPtr);
	}
	break;
    }
    case PKG_IFNEEDED: {
	Tcl_Size length;
	int res;
	char *argv3i, *avi;

	if ((objc != 4) && (objc != 5)) {
	    Tcl_WrongNumArgs(interp, 2, objv, "package version ?script?");
	    return TCL_ERROR;
	}
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
	    Tcl_NRAddCallback(interp,
		    PkgRequireCore, (void *) argv2, INT2PTR(newobjc),
		    newObjvPtr, NULL);
	    return TCL_OK;
	}
	break;
    case PKG_UNKNOWN: {
	size_t length;

	if (objc == 2) {
	    if (iPtr->packageUnknown != NULL) {
		Tcl_SetObjResult(interp,
			Tcl_NewStringObj(iPtr->packageUnknown, -1));
	    }
	} else if (objc == 3) {







|







1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
	    Tcl_NRAddCallback(interp,
		    PkgRequireCore, (void *) argv2, INT2PTR(newobjc),
		    newObjvPtr, NULL);
	    return TCL_OK;
	}
	break;
    case PKG_UNKNOWN: {
	Tcl_Size length;

	if (objc == 2) {
	    if (iPtr->packageUnknown != NULL) {
		Tcl_SetObjResult(interp,
			Tcl_NewStringObj(iPtr->packageUnknown, -1));
	    }
	} else if (objc == 3) {
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
	Tcl_Panic("Tcl_PackageObjCmd: bad option index to pkgOptions");
    }
    return TCL_OK;
}

static int
TclNRPackageObjCmdCleanup(
    ClientData data[],
    TCL_UNUSED(Tcl_Interp *),
    int result)
{
    TclDecrRefCount((Tcl_Obj *) data[0]);
    TclDecrRefCount((Tcl_Obj *) data[1]);
    return result;
}







|







1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
	Tcl_Panic("Tcl_PackageObjCmd: bad option index to pkgOptions");
    }
    return TCL_OK;
}

static int
TclNRPackageObjCmdCleanup(
    void *data[],
    TCL_UNUSED(Tcl_Interp *),
    int result)
{
    TclDecrRefCount((Tcl_Obj *) data[0]);
    TclDecrRefCount((Tcl_Obj *) data[1]);
    return result;
}
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795

static int
CompareVersions(
    char *v1, char *v2,		/* Versions strings, of form 2.1.3 (any number
				 * of version numbers). */
    int *isMajorPtr)		/* If non-null, the word pointed to is filled
				 * in with a 0/1 value. 1 means that the
				 * difference occured in the first element. */
{
    int thisIsMajor, res, flip;
    char *s1, *e1, *s2, *e2, o1, o2;

    /*
     * Each iteration of the following loop processes one number from each
     * string, terminated by a " " (space). If those numbers don't match then







|







1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795

static int
CompareVersions(
    char *v1, char *v2,		/* Versions strings, of form 2.1.3 (any number
				 * of version numbers). */
    int *isMajorPtr)		/* If non-null, the word pointed to is filled
				 * in with a 0/1 value. 1 means that the
				 * difference occurred in the first element. */
{
    int thisIsMajor, res, flip;
    char *s1, *e1, *s2, *e2, o1, o2;

    /*
     * Each iteration of the following loop processes one number from each
     * string, terminated by a " " (space). If those numbers don't match then
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
    int reqc,			/* Requirements constraining the desired
				 * version. */
    Tcl_Obj *const reqv[])	/* 0 means to use the latest version
				 * available. */
{
    Tcl_Obj *result = Tcl_GetObjResult(interp);
    int i;
    size_t length;

    for (i = 0; i < reqc; i++) {
	const char *v = Tcl_GetStringFromObj(reqv[i], &length);

	if ((length & 0x1) && (v[length/2] == '-')
		&& (strncmp(v, v+((length+1)/2), length/2) == 0)) {
	    Tcl_AppendPrintfToObj(result, " exactly %s", v+((length+1)/2));







|







2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
    int reqc,			/* Requirements constraining the desired
				 * version. */
    Tcl_Obj *const reqv[])	/* 0 means to use the latest version
				 * available. */
{
    Tcl_Obj *result = Tcl_GetObjResult(interp);
    int i;
    Tcl_Size length;

    for (i = 0; i < reqc; i++) {
	const char *v = Tcl_GetStringFromObj(reqv[i], &length);

	if ((length & 0x1) && (v[length/2] == '-')
		&& (strncmp(v, v+((length+1)/2), length/2) == 0)) {
	    Tcl_AppendPrintfToObj(result, " exactly %s", v+((length+1)/2));
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
	Tcl_Free(min);
	Tcl_Free(buf);
	return satisfied;
    }

    /*
     * We have both min and max, and generate their internal reps. When
     * identical we compare as is, otherwise we pad with 'a0' to ove the range
     * a bit.
     */

    CheckVersionAndConvert(NULL, buf, &min, NULL);
    CheckVersionAndConvert(NULL, dash, &max, NULL);

    if (CompareVersions(min, max, NULL) == 0) {







|







2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
	Tcl_Free(min);
	Tcl_Free(buf);
	return satisfied;
    }

    /*
     * We have both min and max, and generate their internal reps. When
     * identical we compare as is, otherwise we pad with 'a0' to over the range
     * a bit.
     */

    CheckVersionAndConvert(NULL, buf, &min, NULL);
    CheckVersionAndConvert(NULL, dash, &max, NULL);

    if (CompareVersions(min, max, NULL) == 0) {

Changes to generic/tclPlatDecls.h.

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

/* Slot 0 is reserved */
/* 1 */
EXTERN int		Tcl_MacOSXOpenVersionedBundleResources(
				Tcl_Interp *interp, const char *bundleName,
				const char *bundleVersion,
				int hasResourceFile, size_t maxPathLen,
				char *libraryPath);
/* 2 */
EXTERN void		Tcl_MacOSXNotifierAddRunLoopMode(
				const void *runLoopMode);
/* 3 */
EXTERN void		Tcl_WinConvertError(unsigned errCode);

typedef struct TclPlatStubs {
    int magic;
    void *hooks;

    void (*reserved0)(void);
    int (*tcl_MacOSXOpenVersionedBundleResources) (Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, size_t maxPathLen, char *libraryPath); /* 1 */
    void (*tcl_MacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 2 */
    void (*tcl_WinConvertError) (unsigned errCode); /* 3 */
} TclPlatStubs;

extern const TclPlatStubs *tclPlatStubsPtr;

#ifdef __cplusplus







|












|







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

/* Slot 0 is reserved */
/* 1 */
EXTERN int		Tcl_MacOSXOpenVersionedBundleResources(
				Tcl_Interp *interp, const char *bundleName,
				const char *bundleVersion,
				int hasResourceFile, Tcl_Size maxPathLen,
				char *libraryPath);
/* 2 */
EXTERN void		Tcl_MacOSXNotifierAddRunLoopMode(
				const void *runLoopMode);
/* 3 */
EXTERN void		Tcl_WinConvertError(unsigned errCode);

typedef struct TclPlatStubs {
    int magic;
    void *hooks;

    void (*reserved0)(void);
    int (*tcl_MacOSXOpenVersionedBundleResources) (Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, Tcl_Size maxPathLen, char *libraryPath); /* 1 */
    void (*tcl_MacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 2 */
    void (*tcl_WinConvertError) (unsigned errCode); /* 3 */
} TclPlatStubs;

extern const TclPlatStubs *tclPlatStubsPtr;

#ifdef __cplusplus

Changes to generic/tclPosixStr.c.

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
#endif
#ifdef EALIGN
    case EALIGN: return "EALIGN";
#endif
#if defined(EALREADY) && (!defined(EBUSY) || (EALREADY != EBUSY))
    case EALREADY: return "EALREADY";
#endif



#ifdef EBADE
    case EBADE: return "EBADE";
#endif
#ifdef EBADF
    case EBADF: return "EBADF";
#endif
#ifdef EBADFD
    case EBADFD: return "EBADFD";
#endif
#ifdef EBADMSG
    case EBADMSG: return "EBADMSG";
#endif
#ifdef ECANCELED
    case ECANCELED: return "ECANCELED";
#endif
#ifdef EBADR
    case EBADR: return "EBADR";
#endif
#ifdef EBADRPC
    case EBADRPC: return "EBADRPC";
#endif
#ifdef EBADRQC
    case EBADRQC: return "EBADRQC";
#endif
#ifdef EBADSLT
    case EBADSLT: return "EBADSLT";
#endif
#ifdef EBFONT
    case EBFONT: return "EBFONT";
#endif
#ifdef EBUSY
    case EBUSY: return "EBUSY";
#endif






#ifdef ECHILD
    case ECHILD: return "ECHILD";
#endif
#ifdef ECHRNG
    case ECHRNG: return "ECHRNG";
#endif
#ifdef ECOMM







>
>
>












<
<
<


















>
>
>
>
>
>







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
#endif
#ifdef EALIGN
    case EALIGN: return "EALIGN";
#endif
#if defined(EALREADY) && (!defined(EBUSY) || (EALREADY != EBUSY))
    case EALREADY: return "EALREADY";
#endif
#ifdef EBADCAT
    case EBADCAT: return "EBADCAT";
#endif
#ifdef EBADE
    case EBADE: return "EBADE";
#endif
#ifdef EBADF
    case EBADF: return "EBADF";
#endif
#ifdef EBADFD
    case EBADFD: return "EBADFD";
#endif
#ifdef EBADMSG
    case EBADMSG: return "EBADMSG";
#endif



#ifdef EBADR
    case EBADR: return "EBADR";
#endif
#ifdef EBADRPC
    case EBADRPC: return "EBADRPC";
#endif
#ifdef EBADRQC
    case EBADRQC: return "EBADRQC";
#endif
#ifdef EBADSLT
    case EBADSLT: return "EBADSLT";
#endif
#ifdef EBFONT
    case EBFONT: return "EBFONT";
#endif
#ifdef EBUSY
    case EBUSY: return "EBUSY";
#endif
#ifdef ECANCELED
    case ECANCELED: return "ECANCELED";
#endif
#ifdef ECASECLASH
    case ECASECLASH: return "ECASECLASH";
#endif
#ifdef ECHILD
    case ECHILD: return "ECHILD";
#endif
#ifdef ECHRNG
    case ECHRNG: return "ECHRNG";
#endif
#ifdef ECOMM
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
#endif
#ifdef EDUPPKG
    case EDUPPKG: return "EDUPPKG";
#endif
#ifdef EEXIST
    case EEXIST: return "EEXIST";
#endif



#ifdef EFAULT
    case EFAULT: return "EFAULT";
#endif
#ifdef EFBIG
    case EFBIG: return "EFBIG";
#endif



#ifdef EHOSTDOWN
    case EHOSTDOWN: return "EHOSTDOWN";
#endif
#ifdef EHOSTUNREACH
    case EHOSTUNREACH: return "EHOSTUNREACH";
#endif
#if defined(EIDRM) && (!defined(EINPROGRESS) || (EIDRM != EINPROGRESS))
    case EIDRM: return "EIDRM";
#endif
#ifdef EINIT
    case EINIT: return "EINIT";
#endif
#ifdef EILSEQ
    case EILSEQ: return "EILSEQ";
#endif



#ifdef EINPROGRESS
    case EINPROGRESS: return "EINPROGRESS";
#endif
#ifdef EINTR
    case EINTR: return "EINTR";
#endif
#ifdef EINVAL
    case EINVAL: return "EINVAL";
#endif
#ifdef EIO
    case EIO: return "EIO";
#endif
#ifdef EISCONN
    case EISCONN: return "EISCONN";
#endif
#ifdef EISDIR
    case EISDIR: return "EISDIR";
#endif
#ifdef EISNAME
    case EISNAM: return "EISNAM";
#endif
#ifdef ELBIN
    case ELBIN: return "ELBIN";
#endif
#ifdef EL2HLT
    case EL2HLT: return "EL2HLT";
#endif
#ifdef EL2NSYNC
    case EL2NSYNC: return "EL2NSYNC";
#endif
#ifdef EL3HLT
    case EL3HLT: return "EL3HLT";
#endif
#ifdef EL3RST
    case EL3RST: return "EL3RST";
#endif



#ifdef ELIBACC
    case ELIBACC: return "ELIBACC";
#endif
#ifdef ELIBBAD
    case ELIBBAD: return "ELIBBAD";
#endif
#ifdef ELIBEXEC







>
>
>






>
>
>















>
>
>


















|


<
<
<












>
>
>







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
#endif
#ifdef EDUPPKG
    case EDUPPKG: return "EDUPPKG";
#endif
#ifdef EEXIST
    case EEXIST: return "EEXIST";
#endif
#ifdef EFAIL
    case EFAIL: return "EFAIL";
#endif
#ifdef EFAULT
    case EFAULT: return "EFAULT";
#endif
#ifdef EFBIG
    case EFBIG: return "EFBIG";
#endif
#ifdef EFTYPE
    case EFTYPE: return "EFTYPE";
#endif
#ifdef EHOSTDOWN
    case EHOSTDOWN: return "EHOSTDOWN";
#endif
#ifdef EHOSTUNREACH
    case EHOSTUNREACH: return "EHOSTUNREACH";
#endif
#if defined(EIDRM) && (!defined(EINPROGRESS) || (EIDRM != EINPROGRESS))
    case EIDRM: return "EIDRM";
#endif
#ifdef EINIT
    case EINIT: return "EINIT";
#endif
#ifdef EILSEQ
    case EILSEQ: return "EILSEQ";
#endif
#ifdef EINPROG
    case EINPROG: return "EINPROG";
#endif
#ifdef EINPROGRESS
    case EINPROGRESS: return "EINPROGRESS";
#endif
#ifdef EINTR
    case EINTR: return "EINTR";
#endif
#ifdef EINVAL
    case EINVAL: return "EINVAL";
#endif
#ifdef EIO
    case EIO: return "EIO";
#endif
#ifdef EISCONN
    case EISCONN: return "EISCONN";
#endif
#ifdef EISDIR
    case EISDIR: return "EISDIR";
#endif
#ifdef EISNAM
    case EISNAM: return "EISNAM";
#endif



#ifdef EL2HLT
    case EL2HLT: return "EL2HLT";
#endif
#ifdef EL2NSYNC
    case EL2NSYNC: return "EL2NSYNC";
#endif
#ifdef EL3HLT
    case EL3HLT: return "EL3HLT";
#endif
#ifdef EL3RST
    case EL3RST: return "EL3RST";
#endif
#ifdef ELBIN
    case ELBIN: return "ELBIN";
#endif
#ifdef ELIBACC
    case ELIBACC: return "ELIBACC";
#endif
#ifdef ELIBBAD
    case ELIBBAD: return "ELIBBAD";
#endif
#ifdef ELIBEXEC
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
#endif
#ifdef ELNRNG
    case ELNRNG: return "ELNRNG";
#endif
#if defined(ELOOP) && (!defined(ENOENT) || (ELOOP != ENOENT))
    case ELOOP: return "ELOOP";
#endif



#ifdef EMFILE
    case EMFILE: return "EMFILE";
#endif
#ifdef EMLINK
    case EMLINK: return "EMLINK";
#endif
#ifdef EMSGSIZE
    case EMSGSIZE: return "EMSGSIZE";
#endif
#ifdef EMULTIHOP
    case EMULTIHOP: return "EMULTIHOP";
#endif
#ifdef ENAMETOOLONG
    case ENAMETOOLONG: return "ENAMETOOLONG";
#endif
#ifdef ENAVAIL
    case ENAVAIL: return "ENAVAIL";
#endif
#ifdef ENET
    case ENET: return "ENET";
#endif
#ifdef ENETDOWN
    case ENETDOWN: return "ENETDOWN";
#endif
#ifdef ENETRESET
    case ENETRESET: return "ENETRESET";
#endif
#ifdef ENETUNREACH
    case ENETUNREACH: return "ENETUNREACH";
#endif
#ifdef ENFILE
    case ENFILE: return "ENFILE";
#endif



#ifdef ENOANO
    case ENOANO: return "ENOANO";
#endif
#if defined(ENOBUFS) && (!defined(ENOSR) || (ENOBUFS != ENOSR))
    case ENOBUFS: return "ENOBUFS";
#endif
#ifdef ENOCSI







>
>
>


















<
<
<












>
>
>







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
#endif
#ifdef ELNRNG
    case ELNRNG: return "ELNRNG";
#endif
#if defined(ELOOP) && (!defined(ENOENT) || (ELOOP != ENOENT))
    case ELOOP: return "ELOOP";
#endif
#ifdef EMEDIUMTYPE
    case EMEDIUMTYPE: return "EMEDIUMTYPE";
#endif
#ifdef EMFILE
    case EMFILE: return "EMFILE";
#endif
#ifdef EMLINK
    case EMLINK: return "EMLINK";
#endif
#ifdef EMSGSIZE
    case EMSGSIZE: return "EMSGSIZE";
#endif
#ifdef EMULTIHOP
    case EMULTIHOP: return "EMULTIHOP";
#endif
#ifdef ENAMETOOLONG
    case ENAMETOOLONG: return "ENAMETOOLONG";
#endif
#ifdef ENAVAIL
    case ENAVAIL: return "ENAVAIL";
#endif



#ifdef ENETDOWN
    case ENETDOWN: return "ENETDOWN";
#endif
#ifdef ENETRESET
    case ENETRESET: return "ENETRESET";
#endif
#ifdef ENETUNREACH
    case ENETUNREACH: return "ENETUNREACH";
#endif
#ifdef ENFILE
    case ENFILE: return "ENFILE";
#endif
#ifdef ENMFILE
    case ENMFILE: return "ENMFILE";
#endif
#ifdef ENOANO
    case ENOANO: return "ENOANO";
#endif
#if defined(ENOBUFS) && (!defined(ENOSR) || (ENOBUFS != ENOSR))
    case ENOBUFS: return "ENOBUFS";
#endif
#ifdef ENOCSI
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
#endif
#ifdef ENOLINK
    case ENOLINK: return "ENOLINK";
#endif
#ifdef ENOMEM
    case ENOMEM: return "ENOMEM";
#endif



#ifdef ENOMSG
    case ENOMSG: return "ENOMSG";
#endif
#ifdef ENONET
    case ENONET: return "ENONET";
#endif
#ifdef ENOPKG
    case ENOPKG: return "ENOPKG";
#endif
#ifdef ENOPROTOOPT
    case ENOPROTOOPT: return "ENOPROTOOPT";
#endif



#ifdef ENOSPC
    case ENOSPC: return "ENOSPC";
#endif
#if defined(ENOSR) && (!defined(ENAMETOOLONG) || (ENAMETOOLONG != ENOSR))
    case ENOSR: return "ENOSR";
#endif
#if defined(ENOSTR) && (!defined(ENOTTY) || (ENOTTY != ENOSTR))







>
>
>












>
>
>







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
#endif
#ifdef ENOLINK
    case ENOLINK: return "ENOLINK";
#endif
#ifdef ENOMEM
    case ENOMEM: return "ENOMEM";
#endif
#ifdef ENOMEDIUM
    case ENOMEDIUM: return "ENOMEDIUM";
#endif
#ifdef ENOMSG
    case ENOMSG: return "ENOMSG";
#endif
#ifdef ENONET
    case ENONET: return "ENONET";
#endif
#ifdef ENOPKG
    case ENOPKG: return "ENOPKG";
#endif
#ifdef ENOPROTOOPT
    case ENOPROTOOPT: return "ENOPROTOOPT";
#endif
#ifdef ENOSHARE
    case ENOSHARE: return "ENOSHARE";
#endif
#ifdef ENOSPC
    case ENOSPC: return "ENOSPC";
#endif
#if defined(ENOSR) && (!defined(ENAMETOOLONG) || (ENAMETOOLONG != ENOSR))
    case ENOSR: return "ENOSR";
#endif
#if defined(ENOSTR) && (!defined(ENOTTY) || (ENOTTY != ENOSTR))
334
335
336
337
338
339
340



341
342
343
344
345
346
347
#endif
#ifdef ENOTTY
    case ENOTTY: return "ENOTTY";
#endif
#ifdef ENOTUNIQ
    case ENOTUNIQ: return "ENOTUNIQ";
#endif



#ifdef ENXIO
    case ENXIO: return "ENXIO";
#endif
#if defined(EOPNOTSUPP) &&  (!defined(ENOTSUP) || (ENOTSUP != EOPNOTSUPP))
    case EOPNOTSUPP: return "EOPNOTSUPP";
#endif
#ifdef EOTHER







>
>
>







358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
#endif
#ifdef ENOTTY
    case ENOTTY: return "ENOTTY";
#endif
#ifdef ENOTUNIQ
    case ENOTUNIQ: return "ENOTUNIQ";
#endif
#ifdef ENWAIT
    case ENWAIT: return "ENWAIT";
#endif
#ifdef ENXIO
    case ENXIO: return "ENXIO";
#endif
#if defined(EOPNOTSUPP) &&  (!defined(ENOTSUP) || (ENOTSUP != EOPNOTSUPP))
    case EOPNOTSUPP: return "EOPNOTSUPP";
#endif
#ifdef EOTHER
400
401
402
403
404
405
406



407
408
409
410
411
412
413
#endif
#ifdef EREMOTEIO
    case EREMOTEIO: return "EREMOTEIO";
#endif
#ifdef EREMOTERELEASE
    case EREMOTERELEASE: return "EREMOTERELEASE";
#endif



#ifdef EROFS
    case EROFS: return "EROFS";
#endif
#ifdef ERPCMISMATCH
    case ERPCMISMATCH: return "ERPCMISMATCH";
#endif
#ifdef ERREMOTE







>
>
>







427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
#endif
#ifdef EREMOTEIO
    case EREMOTEIO: return "EREMOTEIO";
#endif
#ifdef EREMOTERELEASE
    case EREMOTERELEASE: return "EREMOTERELEASE";
#endif
#ifdef ERESTART
    case ERESTART: return "ERESTART";
#endif
#ifdef EROFS
    case EROFS: return "EROFS";
#endif
#ifdef ERPCMISMATCH
    case ERPCMISMATCH: return "ERPCMISMATCH";
#endif
#ifdef ERREMOTE
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
#ifdef EAFNOSUPPORT
    case EAFNOSUPPORT: return "address family not supported by protocol";
#endif
#ifdef EAGAIN
    case EAGAIN: return "resource temporarily unavailable";
#endif
#ifdef EALIGN
    case EALIGN: return "EALIGN";
#endif
#if defined(EALREADY) && (!defined(EBUSY) || (EALREADY != EBUSY))
    case EALREADY: return "operation already in progress";
#endif



#ifdef EBADE
    case EBADE: return "bad exchange descriptor";
#endif
#ifdef EBADF
    case EBADF: return "bad file number";
#endif
#ifdef EBADFD
    case EBADFD: return "file descriptor in bad state";
#endif
#ifdef EBADMSG
    case EBADMSG: return "not a data message";
#endif
#ifdef ECANCELED
    case ECANCELED: return "operation canceled";
#endif
#ifdef EBADR
    case EBADR: return "bad request descriptor";
#endif
#ifdef EBADRPC
    case EBADRPC: return "RPC structure is bad";
#endif
#ifdef EBADRQC
    case EBADRQC: return "bad request code";
#endif
#ifdef EBADSLT
    case EBADSLT: return "invalid slot";
#endif
#ifdef EBFONT
    case EBFONT: return "bad font file format";
#endif
#ifdef EBUSY
    case EBUSY: return "file busy";
#endif






#ifdef ECHILD
    case ECHILD: return "no children";
#endif
#ifdef ECHRNG
    case ECHRNG: return "channel number out of range";
#endif
#ifdef ECOMM
    case ECOMM: return "communication error on send";
#endif







|




>
>
>

|


|





|

<
<
<

|





|








|

>
>
>
>
>
>

|







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
#ifdef EAFNOSUPPORT
    case EAFNOSUPPORT: return "address family not supported by protocol";
#endif
#ifdef EAGAIN
    case EAGAIN: return "resource temporarily unavailable";
#endif
#ifdef EALIGN
    case EALIGN: return "alignment error";
#endif
#if defined(EALREADY) && (!defined(EBUSY) || (EALREADY != EBUSY))
    case EALREADY: return "operation already in progress";
#endif
#ifdef EBADCAT
    case EBADCAT: return "bad message catalogue format";
#endif
#ifdef EBADE
    case EBADE: return "invalid exchange";
#endif
#ifdef EBADF
    case EBADF: return "bad file descriptor";
#endif
#ifdef EBADFD
    case EBADFD: return "file descriptor in bad state";
#endif
#ifdef EBADMSG
    case EBADMSG: return "bad message";
#endif



#ifdef EBADR
    case EBADR: return "invalid request descriptor";
#endif
#ifdef EBADRPC
    case EBADRPC: return "RPC structure is bad";
#endif
#ifdef EBADRQC
    case EBADRQC: return "invalid request code";
#endif
#ifdef EBADSLT
    case EBADSLT: return "invalid slot";
#endif
#ifdef EBFONT
    case EBFONT: return "bad font file format";
#endif
#ifdef EBUSY
    case EBUSY: return "device or resource busy";
#endif
#ifdef ECANCELED
    case ECANCELED: return "operation canceled";
#endif
#ifdef ECASECLASH
    case ECASECLASH: return "filename exists with different case";
#endif
#ifdef ECHILD
    case ECHILD: return "no child processes";
#endif
#ifdef ECHRNG
    case ECHRNG: return "channel number out of range";
#endif
#ifdef ECOMM
    case ECOMM: return "communication error on send";
#endif
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
#ifdef EDESTADDRREQ
    case EDESTADDRREQ: return "destination address required";
#endif
#ifdef EDIRTY
    case EDIRTY: return "mounting a dirty fs w/o force";
#endif
#ifdef EDOM
    case EDOM: return "math argument out of range";
#endif
#ifdef EDOTDOT
    case EDOTDOT: return "cross mount point";
#endif
#ifdef EDQUOT
    case EDQUOT: return "disk quota exceeded";
#endif
#ifdef EDUPPKG
    case EDUPPKG: return "duplicate package name";
#endif
#ifdef EEXIST
    case EEXIST: return "file already exists";
#endif



#ifdef EFAULT
    case EFAULT: return "bad address in system call argument";
#endif
#ifdef EFBIG
    case EFBIG: return "file too large";
#endif



#ifdef EHOSTDOWN
    case EHOSTDOWN: return "host is down";
#endif
#ifdef EHOSTUNREACH
    case EHOSTUNREACH: return "host is unreachable";
#endif
#if defined(EIDRM) && (!defined(EINPROGRESS) || (EIDRM != EINPROGRESS))
    case EIDRM: return "identifier removed";
#endif
#ifdef EINIT
    case EINIT: return "initialization error";
#endif
#ifdef EILSEQ
    case EILSEQ: return "illegal byte sequence";



#endif
#ifdef EINPROGRESS
    case EINPROGRESS: return "operation now in progress";
#endif
#ifdef EINTR
    case EINTR: return "interrupted system call";
#endif
#ifdef EINVAL
    case EINVAL: return "invalid argument";
#endif
#ifdef EIO
    case EIO: return "I/O error";
#endif
#ifdef EISCONN
    case EISCONN: return "socket is already connected";
#endif
#ifdef EISDIR
    case EISDIR: return "illegal operation on a directory";
#endif
#ifdef EISNAME
    case EISNAM: return "is a name file";
#endif
#ifdef ELBIN
    case ELBIN: return "ELBIN";
#endif
#ifdef EL2HLT
    case EL2HLT: return "level 2 halted";
#endif
#ifdef EL2NSYNC
    case EL2NSYNC: return "level 2 not synchronized";
#endif
#ifdef EL3HLT
    case EL3HLT: return "level 3 halted";
#endif
#ifdef EL3RST
    case EL3RST: return "level 3 reset";
#endif



#ifdef ELIBACC
    case ELIBACC: return "cannot access a needed shared library";
#endif
#ifdef ELIBBAD
    case ELIBBAD: return "accessing a corrupted shared library";
#endif
#ifdef ELIBEXEC
    case ELIBEXEC: return "cannot exec a shared library directly";
#endif
#if defined(ELIBMAX) && (!defined(ECANCELED) || (ELIBMAX != ECANCELED))
    case ELIBMAX: return
	    "attempting to link in more shared libraries than system limit";
#endif
#ifdef ELIBSCN
    case ELIBSCN: return ".lib section in a.out corrupted";
#endif
#ifdef ELNRNG
    case ELNRNG: return "link number out of range";
#endif
#if defined(ELOOP) && (!defined(ENOENT) || (ELOOP != ENOENT))
    case ELOOP: return "too many levels of symbolic links";
#endif



#ifdef EMFILE
    case EMFILE: return "too many open files";
#endif
#ifdef EMLINK
    case EMLINK: return "too many links";
#endif
#ifdef EMSGSIZE
    case EMSGSIZE: return "message too long";
#endif
#ifdef EMULTIHOP
    case EMULTIHOP: return "multihop attempted";
#endif
#ifdef ENAMETOOLONG
    case ENAMETOOLONG: return "file name too long";
#endif
#ifdef ENAVAIL
    case ENAVAIL: return "not available";
#endif
#ifdef ENET
    case ENET: return "ENET";
#endif
#ifdef ENETDOWN
    case ENETDOWN: return "network is down";
#endif
#ifdef ENETRESET
    case ENETRESET: return "network dropped connection on reset";
#endif
#ifdef ENETUNREACH
    case ENETUNREACH: return "network is unreachable";
#endif
#ifdef ENFILE
    case ENFILE: return "file table overflow";
#endif



#ifdef ENOANO
    case ENOANO: return "anode table overflow";
#endif
#if defined(ENOBUFS) && (!defined(ENOSR) || (ENOBUFS != ENOSR))
    case ENOBUFS: return "no buffer space available";
#endif
#ifdef ENOCSI
    case ENOCSI: return "no CSI structure available";
#endif







|











|

>
>
>

|




>
>
>




|








|
>
>
>











|


|


|

|
|
<
<
<













>
>
>

|









|










>
>
>


















<
<
<










|

>
>
>

|







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
#ifdef EDESTADDRREQ
    case EDESTADDRREQ: return "destination address required";
#endif
#ifdef EDIRTY
    case EDIRTY: return "mounting a dirty fs w/o force";
#endif
#ifdef EDOM
    case EDOM: return "numerical argument out of domain";
#endif
#ifdef EDOTDOT
    case EDOTDOT: return "cross mount point";
#endif
#ifdef EDQUOT
    case EDQUOT: return "disk quota exceeded";
#endif
#ifdef EDUPPKG
    case EDUPPKG: return "duplicate package name";
#endif
#ifdef EEXIST
    case EEXIST: return "file exists";
#endif
#ifdef EFAIL
    case EFAIL: return "cannot start operation";
#endif
#ifdef EFAULT
    case EFAULT: return "bad address";
#endif
#ifdef EFBIG
    case EFBIG: return "file too large";
#endif
#ifdef EFTYPE
    case EFTYPE: return "inappropriate file type or format";
#endif
#ifdef EHOSTDOWN
    case EHOSTDOWN: return "host is down";
#endif
#ifdef EHOSTUNREACH
    case EHOSTUNREACH: return "no route to host";
#endif
#if defined(EIDRM) && (!defined(EINPROGRESS) || (EIDRM != EINPROGRESS))
    case EIDRM: return "identifier removed";
#endif
#ifdef EINIT
    case EINIT: return "initialization error";
#endif
#ifdef EILSEQ
    case EILSEQ: return "invalid or incomplete multibyte or wide character";
#endif
#ifdef EINPROG
    case EINPROG: return "asynchronous operation in progress";
#endif
#ifdef EINPROGRESS
    case EINPROGRESS: return "operation now in progress";
#endif
#ifdef EINTR
    case EINTR: return "interrupted system call";
#endif
#ifdef EINVAL
    case EINVAL: return "invalid argument";
#endif
#ifdef EIO
    case EIO: return "input/output error";
#endif
#ifdef EISCONN
    case EISCONN: return "transport endpoint is already connected";
#endif
#ifdef EISDIR
    case EISDIR: return "is a directory";
#endif
#ifdef EISNAM
    case EISNAM: return "is a named type file";



#endif
#ifdef EL2HLT
    case EL2HLT: return "level 2 halted";
#endif
#ifdef EL2NSYNC
    case EL2NSYNC: return "level 2 not synchronized";
#endif
#ifdef EL3HLT
    case EL3HLT: return "level 3 halted";
#endif
#ifdef EL3RST
    case EL3RST: return "level 3 reset";
#endif
#ifdef ELBIN
    case ELBIN: return "inode is remote";
#endif
#ifdef ELIBACC
    case ELIBACC: return "can not access a needed shared library";
#endif
#ifdef ELIBBAD
    case ELIBBAD: return "accessing a corrupted shared library";
#endif
#ifdef ELIBEXEC
    case ELIBEXEC: return "cannot exec a shared library directly";
#endif
#if defined(ELIBMAX) && (!defined(ECANCELED) || (ELIBMAX != ECANCELED))
    case ELIBMAX: return
	    "attempting to link in too many shared libraries";
#endif
#ifdef ELIBSCN
    case ELIBSCN: return ".lib section in a.out corrupted";
#endif
#ifdef ELNRNG
    case ELNRNG: return "link number out of range";
#endif
#if defined(ELOOP) && (!defined(ENOENT) || (ELOOP != ENOENT))
    case ELOOP: return "too many levels of symbolic links";
#endif
#ifdef EMEDIUMTYPE
    case EMEDIUMTYPE: return "wrong medium type";
#endif
#ifdef EMFILE
    case EMFILE: return "too many open files";
#endif
#ifdef EMLINK
    case EMLINK: return "too many links";
#endif
#ifdef EMSGSIZE
    case EMSGSIZE: return "message too long";
#endif
#ifdef EMULTIHOP
    case EMULTIHOP: return "multihop attempted";
#endif
#ifdef ENAMETOOLONG
    case ENAMETOOLONG: return "file name too long";
#endif
#ifdef ENAVAIL
    case ENAVAIL: return "not available";
#endif



#ifdef ENETDOWN
    case ENETDOWN: return "network is down";
#endif
#ifdef ENETRESET
    case ENETRESET: return "network dropped connection on reset";
#endif
#ifdef ENETUNREACH
    case ENETUNREACH: return "network is unreachable";
#endif
#ifdef ENFILE
    case ENFILE: return "too many open files in system";
#endif
#ifdef ENMFILE
    case ENMFILE: return "no more files";
#endif
#ifdef ENOANO
    case ENOANO: return "no anode";
#endif
#if defined(ENOBUFS) && (!defined(ENOSR) || (ENOBUFS != ENOSR))
    case ENOBUFS: return "no buffer space available";
#endif
#ifdef ENOCSI
    case ENOCSI: return "no CSI structure available";
#endif
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
#ifdef ENOLCK
    case ENOLCK: return "no locks available";
#endif
#ifdef ENOLINK
    case ENOLINK: return "link has been severed";
#endif
#ifdef ENOMEM
    case ENOMEM: return "not enough memory";



#endif
#ifdef ENOMSG
    case ENOMSG: return "no message of desired type";
#endif
#ifdef ENONET
    case ENONET: return "machine is not on the network";
#endif
#ifdef ENOPKG
    case ENOPKG: return "package not installed";
#endif
#ifdef ENOPROTOOPT
    case ENOPROTOOPT: return "bad protocol option";



#endif
#ifdef ENOSPC
    case ENOSPC: return "no space left on device";
#endif
#if defined(ENOSR) && (!defined(ENAMETOOLONG) || (ENAMETOOLONG != ENOSR))
    case ENOSR: return "out of stream resources";
#endif
#if defined(ENOSTR) && (!defined(ENOTTY) || (ENOTTY != ENOSTR))
    case ENOSTR: return "not a stream device";
#endif
#ifdef ENOSYM
    case ENOSYM: return "unresolved symbol name";
#endif
#ifdef ENOSYS
    case ENOSYS: return "function not implemented";
#endif
#ifdef ENOTBLK
    case ENOTBLK: return "block device required";
#endif
#ifdef ENOTCONN
    case ENOTCONN: return "socket is not connected";
#endif
#ifdef ENOTRECOVERABLE
    case ENOTRECOVERABLE: return "state not recoverable";
#endif
#ifdef ENOTDIR
    case ENOTDIR: return "not a directory";
#endif
#if defined(ENOTEMPTY) && (!defined(EEXIST) || (ENOTEMPTY != EEXIST))
    case ENOTEMPTY: return "directory not empty";
#endif
#ifdef ENOTNAM
    case ENOTNAM: return "not a name file";
#endif



#ifdef ENOTSOCK
    case ENOTSOCK: return "socket operation on non-socket";
#endif
#ifdef ENOTSUP
    case ENOTSUP: return "operation not supported";
#endif
#ifdef ENOTTY
    case ENOTTY: return "inappropriate device for ioctl";
#endif
#ifdef ENOTUNIQ
    case ENOTUNIQ: return "name not unique on network";
#endif



#ifdef ENXIO
    case ENXIO: return "no such device or address";
#endif
#if defined(EOPNOTSUPP) &&  (!defined(ENOTSUP) || (ENOTSUP != EOPNOTSUPP))
    case EOPNOTSUPP: return "operation not supported on socket";
#endif
#ifdef EOTHER
    case EOTHER: return "other error";
#endif
#if defined(EOVERFLOW) && (!defined(EFBIG) || (EOVERFLOW != EFBIG)) && (!defined(EINVAL) || (EOVERFLOW != EINVAL))
    case EOVERFLOW: return "file too big";
#endif
#ifdef EOWNERDEAD
    case EOWNERDEAD: return "owner died";
#endif
#ifdef EPERM
    case EPERM: return "not owner";
#endif
#if defined(EPFNOSUPPORT) && (!defined(ENOLCK) || (ENOLCK != EPFNOSUPPORT))
    case EPFNOSUPPORT: return "protocol family not supported";
#endif
#ifdef EPIPE
    case EPIPE: return "broken pipe";
#endif







|
>
>
>











|
>
>
>





|


|











|
<
<
<










>
>
>







|




>
>
>










|





|







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
#ifdef ENOLCK
    case ENOLCK: return "no locks available";
#endif
#ifdef ENOLINK
    case ENOLINK: return "link has been severed";
#endif
#ifdef ENOMEM
    case ENOMEM: return "cannot allocate memory";
#endif
#ifdef ENOMEDIUM
    case ENOMEDIUM: return "no medium found";
#endif
#ifdef ENOMSG
    case ENOMSG: return "no message of desired type";
#endif
#ifdef ENONET
    case ENONET: return "machine is not on the network";
#endif
#ifdef ENOPKG
    case ENOPKG: return "package not installed";
#endif
#ifdef ENOPROTOOPT
    case ENOPROTOOPT: return "protocol not available";
#endif
#ifdef ENOSHARE
    case ENOSHARE: return "no such host or network path";
#endif
#ifdef ENOSPC
    case ENOSPC: return "no space left on device";
#endif
#if defined(ENOSR) && (!defined(ENAMETOOLONG) || (ENAMETOOLONG != ENOSR))
    case ENOSR: return "out of streams resources";
#endif
#if defined(ENOSTR) && (!defined(ENOTTY) || (ENOTTY != ENOSTR))
    case ENOSTR: return "device not a stream";
#endif
#ifdef ENOSYM
    case ENOSYM: return "unresolved symbol name";
#endif
#ifdef ENOSYS
    case ENOSYS: return "function not implemented";
#endif
#ifdef ENOTBLK
    case ENOTBLK: return "block device required";
#endif
#ifdef ENOTCONN
    case ENOTCONN: return "transport endpoint is not connected";



#endif
#ifdef ENOTDIR
    case ENOTDIR: return "not a directory";
#endif
#if defined(ENOTEMPTY) && (!defined(EEXIST) || (ENOTEMPTY != EEXIST))
    case ENOTEMPTY: return "directory not empty";
#endif
#ifdef ENOTNAM
    case ENOTNAM: return "not a name file";
#endif
#ifdef ENOTRECOVERABLE
    case ENOTRECOVERABLE: return "state not recoverable";
#endif
#ifdef ENOTSOCK
    case ENOTSOCK: return "socket operation on non-socket";
#endif
#ifdef ENOTSUP
    case ENOTSUP: return "operation not supported";
#endif
#ifdef ENOTTY
    case ENOTTY: return "inappropriate ioctl for device";
#endif
#ifdef ENOTUNIQ
    case ENOTUNIQ: return "name not unique on network";
#endif
#ifdef ENWAIT
    case ENWAIT: return "No waiting processes";
#endif
#ifdef ENXIO
    case ENXIO: return "no such device or address";
#endif
#if defined(EOPNOTSUPP) &&  (!defined(ENOTSUP) || (ENOTSUP != EOPNOTSUPP))
    case EOPNOTSUPP: return "operation not supported on socket";
#endif
#ifdef EOTHER
    case EOTHER: return "other error";
#endif
#if defined(EOVERFLOW) && (!defined(EFBIG) || (EOVERFLOW != EFBIG)) && (!defined(EINVAL) || (EOVERFLOW != EINVAL))
    case EOVERFLOW: return "value too large for defined data type";
#endif
#ifdef EOWNERDEAD
    case EOWNERDEAD: return "owner died";
#endif
#ifdef EPERM
    case EPERM: return "operation not permitted";
#endif
#if defined(EPFNOSUPPORT) && (!defined(ENOLCK) || (ENOLCK != EPFNOSUPPORT))
    case EPFNOSUPPORT: return "protocol family not supported";
#endif
#ifdef EPIPE
    case EPIPE: return "broken pipe";
#endif
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
#ifdef EPROTONOSUPPORT
    case EPROTONOSUPPORT: return "protocol not supported";
#endif
#ifdef EPROTOTYPE
    case EPROTOTYPE: return "protocol wrong type for socket";
#endif
#ifdef ERANGE
    case ERANGE: return "math result unrepresentable";
#endif
#if defined(EREFUSED) && (!defined(ECONNREFUSED) || (EREFUSED != ECONNREFUSED))
    case EREFUSED: return "EREFUSED";
#endif
#ifdef EREMCHG
    case EREMCHG: return "remote address changed";
#endif
#ifdef EREMDEV
    case EREMDEV: return "remote device";
#endif
#ifdef EREMOTE
    case EREMOTE: return "pathname hit remote file system";
#endif
#ifdef EREMOTEIO
    case EREMOTEIO: return "remote i/o error";
#endif
#ifdef EREMOTERELEASE
    case EREMOTERELEASE: return "EREMOTERELEASE";



#endif
#ifdef EROFS
    case EROFS: return "read-only file system";
#endif
#ifdef ERPCMISMATCH
    case ERPCMISMATCH: return "RPC version is wrong";
#endif
#ifdef ERREMOTE
    case ERREMOTE: return "object is remote";
#endif
#ifdef ESHUTDOWN
    case ESHUTDOWN: return "cannot send after socket shutdown";
#endif
#ifdef ESOCKTNOSUPPORT
    case ESOCKTNOSUPPORT: return "socket type not supported";
#endif
#ifdef ESPIPE
    case ESPIPE: return "invalid seek";
#endif
#ifdef ESRCH
    case ESRCH: return "no such process";
#endif
#ifdef ESRMNT
    case ESRMNT: return "srmount error";
#endif
#ifdef ESTALE
    case ESTALE: return "stale remote file handle";
#endif



#ifdef ESUCCESS
    case ESUCCESS: return "Error 0";
#endif
#if defined(ETIME) && (!defined(ELOOP) || (ETIME != ELOOP))
    case ETIME: return "timer expired";
#endif
#if defined(ETIMEDOUT) && (!defined(ENOSTR) || (ETIMEDOUT != ENOSTR))
    case ETIMEDOUT: return "connection timed out";
#endif
#ifdef ETOOMANYREFS
    case ETOOMANYREFS: return "too many references: cannot splice";
#endif
#ifdef ETXTBSY
    case ETXTBSY: return "text file or pseudo-device busy";
#endif
#ifdef EUCLEAN
    case EUCLEAN: return "structure needs cleaning";
#endif
#ifdef EUNATCH
    case EUNATCH: return "protocol driver not attached";
#endif
#ifdef EUSERS
    case EUSERS: return "too many users";
#endif
#ifdef EVERSION
    case EVERSION: return "version mismatch";
#endif
#if defined(EWOULDBLOCK) && (!defined(EAGAIN) || (EWOULDBLOCK != EAGAIN))
    case EWOULDBLOCK: return "operation would block";
#endif
#ifdef EXDEV
    case EXDEV: return "cross-domain link";
#endif
#ifdef EXFULL
    case EXFULL: return "message tables full";
#endif
    default:
#ifdef NO_STRERROR
	return "unknown POSIX error";
#else
	return strerror(err);
#endif







|


|








|


|


|
>
>
>











|





|








|

>
>
>

|











|

















|


|







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
#ifdef EPROTONOSUPPORT
    case EPROTONOSUPPORT: return "protocol not supported";
#endif
#ifdef EPROTOTYPE
    case EPROTOTYPE: return "protocol wrong type for socket";
#endif
#ifdef ERANGE
    case ERANGE: return "numerical result out of range";
#endif
#if defined(EREFUSED) && (!defined(ECONNREFUSED) || (EREFUSED != ECONNREFUSED))
    case EREFUSED: return "connection refused";
#endif
#ifdef EREMCHG
    case EREMCHG: return "remote address changed";
#endif
#ifdef EREMDEV
    case EREMDEV: return "remote device";
#endif
#ifdef EREMOTE
    case EREMOTE: return "object is remote";
#endif
#ifdef EREMOTEIO
    case EREMOTEIO: return "remote I/O error";
#endif
#ifdef EREMOTERELEASE
    case EREMOTERELEASE: return "remote peer released connection";
#endif
#ifdef ERESTART
    case ERESTART: return "interrupted system call should be restarted";
#endif
#ifdef EROFS
    case EROFS: return "read-only file system";
#endif
#ifdef ERPCMISMATCH
    case ERPCMISMATCH: return "RPC version is wrong";
#endif
#ifdef ERREMOTE
    case ERREMOTE: return "object is remote";
#endif
#ifdef ESHUTDOWN
    case ESHUTDOWN: return "cannot send after transport endpoint shutdown";
#endif
#ifdef ESOCKTNOSUPPORT
    case ESOCKTNOSUPPORT: return "socket type not supported";
#endif
#ifdef ESPIPE
    case ESPIPE: return "illegal seek";
#endif
#ifdef ESRCH
    case ESRCH: return "no such process";
#endif
#ifdef ESRMNT
    case ESRMNT: return "srmount error";
#endif
#ifdef ESTALE
    case ESTALE: return "stale file handle";
#endif
#ifdef ESTRPIPE
    case ESTRPIPE: return "streams pipe error";
#endif
#ifdef ESUCCESS
    case ESUCCESS: return "success";
#endif
#if defined(ETIME) && (!defined(ELOOP) || (ETIME != ELOOP))
    case ETIME: return "timer expired";
#endif
#if defined(ETIMEDOUT) && (!defined(ENOSTR) || (ETIMEDOUT != ENOSTR))
    case ETIMEDOUT: return "connection timed out";
#endif
#ifdef ETOOMANYREFS
    case ETOOMANYREFS: return "too many references: cannot splice";
#endif
#ifdef ETXTBSY
    case ETXTBSY: return "text file busy";
#endif
#ifdef EUCLEAN
    case EUCLEAN: return "structure needs cleaning";
#endif
#ifdef EUNATCH
    case EUNATCH: return "protocol driver not attached";
#endif
#ifdef EUSERS
    case EUSERS: return "too many users";
#endif
#ifdef EVERSION
    case EVERSION: return "version mismatch";
#endif
#if defined(EWOULDBLOCK) && (!defined(EAGAIN) || (EWOULDBLOCK != EAGAIN))
    case EWOULDBLOCK: return "operation would block";
#endif
#ifdef EXDEV
    case EXDEV: return "invalid cross-device link";
#endif
#ifdef EXFULL
    case EXFULL: return "exchange full";
#endif
    default:
#ifdef NO_STRERROR
	return "unknown POSIX error";
#else
	return strerror(err);
#endif

Changes to generic/tclPreserve.c.

17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
/*
 * The following data structure is used to keep track of all the Tcl_Preserve
 * calls that are still in effect. It grows as needed to accommodate any
 * number of calls in effect.
 */

typedef struct {
    ClientData clientData;	/* Address of preserved block. */
    size_t refCount;		/* Number of Tcl_Preserve calls in effect for
				 * block. */
    int mustFree;		/* Non-zero means Tcl_EventuallyFree was
				 * called while a Tcl_Preserve call was in
				 * effect, so the structure must be freed when
				 * refCount becomes zero. */
    Tcl_FreeProc *freeProc;	/* Function to call to free. */







|







17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
/*
 * The following data structure is used to keep track of all the Tcl_Preserve
 * calls that are still in effect. It grows as needed to accommodate any
 * number of calls in effect.
 */

typedef struct {
    void *clientData;	/* Address of preserved block. */
    size_t refCount;		/* Number of Tcl_Preserve calls in effect for
				 * block. */
    int mustFree;		/* Non-zero means Tcl_EventuallyFree was
				 * called while a Tcl_Preserve call was in
				 * effect, so the structure must be freed when
				 * refCount becomes zero. */
    Tcl_FreeProc *freeProc;	/* Function to call to free. */
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
 *	until at least the matching call to Tcl_Release.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_Preserve(
    ClientData clientData)	/* Pointer to malloc'ed block of memory. */
{
    Reference *refPtr;
    size_t i;

    /*
     * See if there is already a reference for this pointer. If so, just
     * increment its reference count.







|







113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
 *	until at least the matching call to Tcl_Release.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_Preserve(
    void *clientData)	/* Pointer to malloc'ed block of memory. */
{
    Reference *refPtr;
    size_t i;

    /*
     * See if there is already a reference for this pointer. If so, just
     * increment its reference count.
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
 *	call to Tcl_Preserve is still in effect, the block of memory is freed.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_Release(
    ClientData clientData)	/* Pointer to malloc'ed block of memory. */
{
    Reference *refPtr;
    size_t i;

    Tcl_MutexLock(&preserveMutex);
    for (i=0, refPtr=refArray ; i<inUse ; i++, refPtr++) {
	int mustFree;







|







176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
 *	call to Tcl_Preserve is still in effect, the block of memory is freed.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_Release(
    void *clientData)	/* Pointer to malloc'ed block of memory. */
{
    Reference *refPtr;
    size_t i;

    Tcl_MutexLock(&preserveMutex);
    for (i=0, refPtr=refArray ; i<inUse ; i++, refPtr++) {
	int mustFree;
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
 *	Ptr may be released by calling free().
 *
 *----------------------------------------------------------------------
 */

void
Tcl_EventuallyFree(
    ClientData clientData,	/* Pointer to malloc'ed block of memory. */
    Tcl_FreeProc *freeProc)	/* Function to actually do free. */
{
    Reference *refPtr;
    size_t i;

    /*
     * See if there is a reference for this pointer. If so, set its "mustFree"







|







255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
 *	Ptr may be released by calling free().
 *
 *----------------------------------------------------------------------
 */

void
Tcl_EventuallyFree(
    void *clientData,	/* Pointer to malloc'ed block of memory. */
    Tcl_FreeProc *freeProc)	/* Function to actually do free. */
{
    Reference *refPtr;
    size_t i;

    /*
     * See if there is a reference for this pointer. If so, set its "mustFree"

Changes to generic/tclProc.c.

59
60
61
62
63
64
65
66
67

68
69
70
71
72
73
74
const Tcl_ObjType tclProcBodyType = {
    "procbody",			/* name for this type */
    ProcBodyFree,		/* FreeInternalRep function */
    ProcBodyDup,		/* DupInternalRep function */
    NULL,			/* UpdateString function; Tcl_GetString and
				 * Tcl_GetStringFromObj should panic
				 * instead. */
    NULL			/* SetFromAny function; Tcl_ConvertToType
				 * should panic instead. */

};

#define ProcSetInternalRep(objPtr, procPtr)					\
    do {								\
	Tcl_ObjInternalRep ir;						\
	(procPtr)->refCount++;						\
	ir.twoPtrValue.ptr1 = (procPtr);				\







|

>







59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
const Tcl_ObjType tclProcBodyType = {
    "procbody",			/* name for this type */
    ProcBodyFree,		/* FreeInternalRep function */
    ProcBodyDup,		/* DupInternalRep function */
    NULL,			/* UpdateString function; Tcl_GetString and
				 * Tcl_GetStringFromObj should panic
				 * instead. */
    NULL,			/* SetFromAny function; Tcl_ConvertToType
				 * should panic instead. */
    TCL_OBJTYPE_V0
};

#define ProcSetInternalRep(objPtr, procPtr)					\
    do {								\
	Tcl_ObjInternalRep ir;						\
	(procPtr)->refCount++;						\
	ir.twoPtrValue.ptr1 = (procPtr);				\
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
 *
 * Uses the default behaviour throughout, and never disposes of the string
 * rep; it's just a cache type.
 */

static const Tcl_ObjType levelReferenceType = {
    "levelReference",
    NULL, NULL, NULL, NULL
};

/*
 * The type of lambdas. Note that every lambda will *always* have a string
 * representation.
 *
 * Internally, ptr1 is a pointer to a Proc instance that is not bound to a
 * command name, and ptr2 is a pointer to the namespace that the Proc instance
 * will execute within. IF YOU CHANGE THIS, CHECK IN tclDisassemble.c TOO.
 */

static const Tcl_ObjType lambdaType = {
    "lambdaExpr",		/* name */
    FreeLambdaInternalRep,	/* freeIntRepProc */
    DupLambdaInternalRep,	/* dupIntRepProc */
    NULL,			/* updateStringProc */
    SetLambdaFromAny		/* setFromAnyProc */

};

#define LambdaSetInternalRep(objPtr, procPtr, nsObjPtr)			\
    do {								\
	Tcl_ObjInternalRep ir;						\
	ir.twoPtrValue.ptr1 = (procPtr);				\
	ir.twoPtrValue.ptr2 = (nsObjPtr);				\







|
















|
>







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
 *
 * Uses the default behaviour throughout, and never disposes of the string
 * rep; it's just a cache type.
 */

static const Tcl_ObjType levelReferenceType = {
    "levelReference",
    NULL, NULL, NULL, NULL, TCL_OBJTYPE_V0
};

/*
 * The type of lambdas. Note that every lambda will *always* have a string
 * representation.
 *
 * Internally, ptr1 is a pointer to a Proc instance that is not bound to a
 * command name, and ptr2 is a pointer to the namespace that the Proc instance
 * will execute within. IF YOU CHANGE THIS, CHECK IN tclDisassemble.c TOO.
 */

static const Tcl_ObjType lambdaType = {
    "lambdaExpr",		/* name */
    FreeLambdaInternalRep,	/* freeIntRepProc */
    DupLambdaInternalRep,	/* dupIntRepProc */
    NULL,			/* updateStringProc */
    SetLambdaFromAny,		/* setFromAnyProc */
    TCL_OBJTYPE_V0
};

#define LambdaSetInternalRep(objPtr, procPtr, nsObjPtr)			\
    do {								\
	Tcl_ObjInternalRep ir;						\
	ir.twoPtrValue.ptr1 = (procPtr);				\
	ir.twoPtrValue.ptr2 = (nsObjPtr);				\
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
    if (result != TCL_OK) {
	goto procError;
    }

    if (precompiled) {
	if (numArgs > procPtr->numArgs) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "procedure \"%s\": arg list contains %" TCL_Z_MODIFIER "u entries, "
		    "precompiled header expects %" TCL_Z_MODIFIER "u", procName, numArgs,
		    procPtr->numArgs));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
		    "BYTECODELIES", NULL);
	    goto procError;
	}
	localPtr = procPtr->firstLocalPtr;
    } else {







|
|







491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
    if (result != TCL_OK) {
	goto procError;
    }

    if (precompiled) {
	if (numArgs > procPtr->numArgs) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "procedure \"%s\": arg list contains %" TCL_SIZE_MODIFIER "u entries, "
		    "precompiled header expects %" TCL_SIZE_MODIFIER "u", procName, numArgs,
		    procPtr->numArgs));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
		    "BYTECODELIES", NULL);
	    goto procError;
	}
	localPtr = procPtr->firstLocalPtr;
    } else {
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
	    if ((localPtr->nameLength != nameLength)
		    || (memcmp(localPtr->name, argname, nameLength) != 0)
		    || (localPtr->frameIndex != i)
		    || !(localPtr->flags & VAR_ARGUMENT)
		    || (localPtr->defValuePtr == NULL && fieldCount == 2)
		    || (localPtr->defValuePtr != NULL && fieldCount != 2)) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"procedure \"%s\": formal parameter %" TCL_Z_MODIFIER "u is "
			"inconsistent with precompiled body", procName, i));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
			"BYTECODELIES", NULL);
		goto procError;
	    }

	    /*







|







586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
	    if ((localPtr->nameLength != nameLength)
		    || (memcmp(localPtr->name, argname, nameLength) != 0)
		    || (localPtr->frameIndex != i)
		    || !(localPtr->flags & VAR_ARGUMENT)
		    || (localPtr->defValuePtr == NULL && fieldCount == 2)
		    || (localPtr->defValuePtr != NULL && fieldCount != 2)) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"procedure \"%s\": formal parameter %" TCL_SIZE_MODIFIER "u is "
			"inconsistent with precompiled body", procName, i));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
			"BYTECODELIES", NULL);
		goto procError;
	    }

	    /*
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
static int
ProcWrongNumArgs(
    Tcl_Interp *interp,
    int skip)
{
    CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
    Proc *procPtr = framePtr->procPtr;
    int localCt = procPtr->numCompiledLocals, numArgs, i;
    Tcl_Obj **desiredObjs;
    const char *final = NULL;

    /*
     * Build up desired argument list for Tcl_WrongNumArgs
     */








|







1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
static int
ProcWrongNumArgs(
    Tcl_Interp *interp,
    int skip)
{
    CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
    Proc *procPtr = framePtr->procPtr;
    Tcl_Size localCt = procPtr->numCompiledLocals, numArgs, i;
    Tcl_Obj **desiredObjs;
    const char *final = NULL;

    /*
     * Build up desired argument list for Tcl_WrongNumArgs
     */

1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
    varPtr = (Var *) (namePtr + localCt);
    localPtr = procPtr->firstLocalPtr;
    while (localPtr) {
	if (TclIsVarTemporary(localPtr)) {
	    *namePtr = NULL;
	} else {
	    *namePtr = TclCreateLiteral(iPtr, localPtr->name,
		    localPtr->nameLength, /* hash */ (size_t) -1,
		    &isNew, /* nsPtr */ NULL, 0, NULL);
	    Tcl_IncrRefCount(*namePtr);
	}

	if (i < numArgs) {
	    varPtr->flags = (localPtr->flags & VAR_IS_ARGS);
	    varPtr->value.objPtr = localPtr->defValuePtr;







|







1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
    varPtr = (Var *) (namePtr + localCt);
    localPtr = procPtr->firstLocalPtr;
    while (localPtr) {
	if (TclIsVarTemporary(localPtr)) {
	    *namePtr = NULL;
	} else {
	    *namePtr = TclCreateLiteral(iPtr, localPtr->name,
		    localPtr->nameLength, /* hash */ TCL_INDEX_NONE,
		    &isNew, /* nsPtr */ NULL, 0, NULL);
	    Tcl_IncrRefCount(*namePtr);
	}

	if (i < numArgs) {
	    varPtr->flags = (localPtr->flags & VAR_IS_ARGS);
	    varPtr->value.objPtr = localPtr->defValuePtr;
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
    int skip)			/* Number of initial arguments to be skipped,
				 * i.e., words in the "command name". */
{
    CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
    Proc *procPtr = framePtr->procPtr;
    ByteCode *codePtr;
    Var *varPtr, *defPtr;
    int localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax;
    Tcl_Obj *const *argObjs;

    ByteCodeGetInternalRep(procPtr->bodyPtr, &tclByteCodeType, codePtr);

    /*
     * Make sure that the local cache of variable names and initial values has
     * been initialised properly .







|







1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
    int skip)			/* Number of initial arguments to be skipped,
				 * i.e., words in the "command name". */
{
    CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
    Proc *procPtr = framePtr->procPtr;
    ByteCode *codePtr;
    Var *varPtr, *defPtr;
    Tcl_Size localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax;
    Tcl_Obj *const *argObjs;

    ByteCodeGetInternalRep(procPtr->bodyPtr, &tclByteCodeType, codePtr);

    /*
     * Make sure that the local cache of variable names and initial values has
     * been initialised properly .
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515

int
TclPushProcCallFrame(
    void *clientData,	/* Record describing procedure to be
				 * interpreted. */
    Tcl_Interp *interp,/* Interpreter in which procedure was
				 * invoked. */
    Tcl_Size objc,			/* Count of number of arguments to this
				 * procedure. */
    Tcl_Obj *const objv[],	/* Argument value objects. */
    int isLambda)		/* 1 if this is a call by ApplyObjCmd: it
				 * needs special rules for error msg */
{
    Proc *procPtr = (Proc *)clientData;
    Namespace *nsPtr = procPtr->cmdPtr->nsPtr;







|







1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517

int
TclPushProcCallFrame(
    void *clientData,	/* Record describing procedure to be
				 * interpreted. */
    Tcl_Interp *interp,/* Interpreter in which procedure was
				 * invoked. */
    Tcl_Size objc,		/* Count of number of arguments to this
				 * procedure. */
    Tcl_Obj *const objv[],	/* Argument value objects. */
    int isLambda)		/* 1 if this is a call by ApplyObjCmd: it
				 * needs special rules for error msg */
{
    Proc *procPtr = (Proc *)clientData;
    Namespace *nsPtr = procPtr->cmdPtr->nsPtr;
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
	return TCL_ERROR;
    }
    return TclNRInterpProcCore(interp, objv[0], 1, &MakeProcError);
}

static int
NRInterpProc2(
    void *clientData,	/* Record describing procedure to be
				 * interpreted. */
    Tcl_Interp *interp,/* Interpreter in which procedure was
				 * invoked. */
    size_t objc,			/* Count of number of arguments to this
				 * procedure. */
    Tcl_Obj *const objv[])	/* Argument value objects. */
{
    int result = TclPushProcCallFrame(clientData, interp, objc, objv,
	    /*isLambda*/ 0);

    if (result != TCL_OK) {
	return TCL_ERROR;
    }
    return TclNRInterpProcCore(interp, objv[0], 1, &MakeProcError);
}

static int
ObjInterpProc2(
    void *clientData,	/* Record describing procedure to be
				 * interpreted. */
    Tcl_Interp *interp,/* Interpreter in which procedure was
				 * invoked. */
    size_t objc,			/* Count of number of arguments to this
				 * procedure. */
    Tcl_Obj *const objv[])	/* Argument value objects. */
{
    /*
     * Not used much in the core; external interface for iTcl
     */








|

|

|














|

|

|







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
	return TCL_ERROR;
    }
    return TclNRInterpProcCore(interp, objv[0], 1, &MakeProcError);
}

static int
NRInterpProc2(
    void *clientData,		/* Record describing procedure to be
				 * interpreted. */
    Tcl_Interp *interp, 	/* Interpreter in which procedure was
				 * invoked. */
    Tcl_Size objc,		/* Count of number of arguments to this
				 * procedure. */
    Tcl_Obj *const objv[])	/* Argument value objects. */
{
    int result = TclPushProcCallFrame(clientData, interp, objc, objv,
	    /*isLambda*/ 0);

    if (result != TCL_OK) {
	return TCL_ERROR;
    }
    return TclNRInterpProcCore(interp, objv[0], 1, &MakeProcError);
}

static int
ObjInterpProc2(
    void *clientData,		/* Record describing procedure to be
				 * interpreted. */
    Tcl_Interp *interp,		/* Interpreter in which procedure was
				 * invoked. */
    Tcl_Size objc,		/* Count of number of arguments to this
				 * procedure. */
    Tcl_Obj *const objv[])	/* Argument value objects. */
{
    /*
     * Not used much in the core; external interface for iTcl
     */

1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
	     */

	    Tcl_Obj *message;

	    TclNewLiteralStringObj(message, "Compiling ");
	    Tcl_IncrRefCount(message);
	    Tcl_AppendStringsToObj(message, description, " \"", NULL);
	    Tcl_AppendLimitedToObj(message, procName, -1, 50, NULL);
	    fprintf(stdout, "%s\"\n", TclGetString(message));
	    Tcl_DecrRefCount(message);
	}
#else
    (void)description;
    (void)procName;
#endif







|







1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
	     */

	    Tcl_Obj *message;

	    TclNewLiteralStringObj(message, "Compiling ");
	    Tcl_IncrRefCount(message);
	    Tcl_AppendStringsToObj(message, description, " \"", NULL);
	    Tcl_AppendLimitedToObj(message, procName, TCL_INDEX_NONE, 50, NULL);
	    fprintf(stdout, "%s\"\n", TclGetString(message));
	    Tcl_DecrRefCount(message);
	}
#else
    (void)description;
    (void)procName;
#endif
2450
2451
2452
2453
2454
2455
2456








2457
2458
2459
2460
2461
2462
2463
    }

    /*
     * Convert objPtr to list type first; if it cannot be converted, or if its
     * length is not 2, then it cannot be converted to lambdaType.
     */









    result = TclListObjGetElementsM(NULL, objPtr, &objc, &objv);
    if ((result != TCL_OK) || ((objc != 2) && (objc != 3))) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"can't interpret \"%s\" as a lambda expression",
		TclGetString(objPtr)));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "LAMBDA", NULL);
	return TCL_ERROR;







>
>
>
>
>
>
>
>







2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
    }

    /*
     * Convert objPtr to list type first; if it cannot be converted, or if its
     * length is not 2, then it cannot be converted to lambdaType.
     */

    result = TclListObjLengthM(NULL, objPtr, &objc);
    if ((result != TCL_OK) || ((objc != 2) && (objc != 3))) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"can't interpret \"%s\" as a lambda expression",
		Tcl_GetString(objPtr)));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "LAMBDA", NULL);
	return TCL_ERROR;
    }
    result = TclListObjGetElementsM(NULL, objPtr, &objc, &objv);
    if ((result != TCL_OK) || ((objc != 2) && (objc != 3))) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"can't interpret \"%s\" as a lambda expression",
		TclGetString(objPtr)));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "LAMBDA", NULL);
	return TCL_ERROR;

Changes to generic/tclProcess.c.

451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *dict;
    int options = WNOHANG;
    Tcl_HashEntry *entry;
    Tcl_HashSearch search;
    ProcessInfo *info;
    size_t i, numPids;
    Tcl_Obj **pidObjs;
    int result;
    int pid;
    Tcl_Obj *const *savedobjv = objv;
    static const char *const switches[] = {
	"-wait", "--", NULL
    };







|







451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *dict;
    int options = WNOHANG;
    Tcl_HashEntry *entry;
    Tcl_HashSearch search;
    ProcessInfo *info;
    Tcl_Size i, numPids;
    Tcl_Obj **pidObjs;
    int result;
    int pid;
    Tcl_Obj *const *savedobjv = objv;
    static const char *const switches[] = {
	"-wait", "--", NULL
    };
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_HashEntry *entry;
    Tcl_HashSearch search;
    ProcessInfo *info;
    size_t i, numPids;
    Tcl_Obj **pidObjs;
    int result, pid;

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







|







596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_HashEntry *entry;
    Tcl_HashSearch search;
    ProcessInfo *info;
    Tcl_Size i, numPids;
    Tcl_Obj **pidObjs;
    int result, pid;

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

Changes to generic/tclRegexp.c.

9
10
11
12
13
14
15

16
17
18
19
20
21
22
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

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







>







9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclRegexp.h"
#include "tclTomMath.h"
#include <assert.h>

/*
 *----------------------------------------------------------------------
 * The routines in this file use Henry Spencer's regular expression package
 * contained in the following additional source files:
 *
102
103
104
105
106
107
108
109

110
111
112
113
114
115
116
 */

const Tcl_ObjType tclRegexpType = {
    "regexp",				/* name */
    FreeRegexpInternalRep,		/* freeIntRepProc */
    DupRegexpInternalRep,		/* dupIntRepProc */
    NULL,				/* updateStringProc */
    SetRegexpFromAny			/* setFromAnyProc */

};

#define RegexpSetInternalRep(objPtr, rePtr)					\
    do {								\
	Tcl_ObjInternalRep ir;						\
	(rePtr)->refCount++;						\
	ir.twoPtrValue.ptr1 = (rePtr);					\







|
>







103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
 */

const Tcl_ObjType tclRegexpType = {
    "regexp",				/* name */
    FreeRegexpInternalRep,		/* freeIntRepProc */
    DupRegexpInternalRep,		/* dupIntRepProc */
    NULL,				/* updateStringProc */
    SetRegexpFromAny,			/* setFromAnyProc */
    TCL_OBJTYPE_V0
};

#define RegexpSetInternalRep(objPtr, rePtr)					\
    do {								\
	Tcl_ObjInternalRep ir;						\
	(rePtr)->refCount++;						\
	ir.twoPtrValue.ptr1 = (rePtr);					\
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
    regexp->objPtr = NULL;

    /*
     * Convert the string to Unicode and perform the match.
     */

    Tcl_DStringInit(&ds);
    ustr = Tcl_UtfToUniCharDString(text, -1, &ds);
    numChars = Tcl_DStringLength(&ds) / sizeof(Tcl_UniChar);
    result = RegExpExecUniChar(interp, re, ustr, numChars, -1 /* nmatches */,
	    flags);
    Tcl_DStringFree(&ds);

    return result;
}

/*







|

|







217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
    regexp->objPtr = NULL;

    /*
     * Convert the string to Unicode and perform the match.
     */

    Tcl_DStringInit(&ds);
    ustr = Tcl_UtfToUniCharDString(text, TCL_INDEX_NONE, &ds);
    numChars = Tcl_DStringLength(&ds) / sizeof(Tcl_UniChar);
    result = RegExpExecUniChar(interp, re, ustr, numChars, TCL_INDEX_NONE /* nmatches */,
	    flags);
    Tcl_DStringFree(&ds);

    return result;
}

/*
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
 *---------------------------------------------------------------------------
 */

void
Tcl_RegExpRange(
    Tcl_RegExp re,		/* Compiled regular expression that has been
				 * passed to Tcl_RegExpExec. */
    size_t index,			/* 0 means give the range of the entire match,
				 * > 0 means give the range of a matching
				 * subrange. */
    const char **startPtr,	/* Store address of first character in
				 * (sub-)range here. */
    const char **endPtr)	/* Store address of character just after last
				 * in (sub-)range here. */
{
    TclRegexp *regexpPtr = (TclRegexp *) re;
    const char *string;

    if (index > regexpPtr->re.re_nsub) {
	*startPtr = *endPtr = NULL;
    } else if (regexpPtr->matches[index].rm_so == TCL_INDEX_NONE) {
	*startPtr = *endPtr = NULL;
    } else {
	if (regexpPtr->objPtr) {
	    string = TclGetString(regexpPtr->objPtr);
	} else {
	    string = regexpPtr->string;
	}







|










|

|







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

void
Tcl_RegExpRange(
    Tcl_RegExp re,		/* Compiled regular expression that has been
				 * passed to Tcl_RegExpExec. */
    Tcl_Size index,		/* 0 means give the range of the entire match,
				 * > 0 means give the range of a matching
				 * subrange. */
    const char **startPtr,	/* Store address of first character in
				 * (sub-)range here. */
    const char **endPtr)	/* Store address of character just after last
				 * in (sub-)range here. */
{
    TclRegexp *regexpPtr = (TclRegexp *) re;
    const char *string;

    if (index < 0 || (size_t) index > regexpPtr->re.re_nsub) {
	*startPtr = *endPtr = NULL;
    } else if (regexpPtr->matches[index].rm_so == (size_t) -1) {
	*startPtr = *endPtr = NULL;
    } else {
	if (regexpPtr->objPtr) {
	    string = TclGetString(regexpPtr->objPtr);
	} else {
	    string = regexpPtr->string;
	}
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
 *---------------------------------------------------------------------------
 */

void
TclRegExpRangeUniChar(
    Tcl_RegExp re,		/* Compiled regular expression that has been
				 * passed to Tcl_RegExpExec. */
    size_t index,			/* 0 means give the range of the entire match,
				 * > 0 means give the range of a matching
				 * subrange, TCL_INDEX_NONE means the range of the
				 * rm_extend field. */
    size_t *startPtr,		/* Store address of first character in
				 * (sub-)range here. */
    size_t *endPtr)		/* Store address of character just after last
				 * in (sub-)range here. */
{
    TclRegexp *regexpPtr = (TclRegexp *) re;

    if ((regexpPtr->flags&REG_EXPECT) && (index == TCL_INDEX_NONE)) {
	*startPtr = regexpPtr->details.rm_extend.rm_so;
	*endPtr = regexpPtr->details.rm_extend.rm_eo;
    } else if (index + 1 > regexpPtr->re.re_nsub + 1) {
	*startPtr = TCL_INDEX_NONE;
	*endPtr = TCL_INDEX_NONE;
    } else {
	*startPtr = regexpPtr->matches[index].rm_so;
	*endPtr = regexpPtr->matches[index].rm_eo;
    }
}

/*







|

|

|

|




|


|
|
|







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

void
TclRegExpRangeUniChar(
    Tcl_RegExp re,		/* Compiled regular expression that has been
				 * passed to Tcl_RegExpExec. */
    Tcl_Size index,		/* 0 means give the range of the entire match,
				 * > 0 means give the range of a matching
				 * subrange, -1 means the range of the
				 * rm_extend field. */
    Tcl_Size *startPtr,	/* Store address of first character in
				 * (sub-)range here. */
    Tcl_Size *endPtr)	/* Store address of character just after last
				 * in (sub-)range here. */
{
    TclRegexp *regexpPtr = (TclRegexp *) re;

    if ((regexpPtr->flags&REG_EXPECT) && (index == -1)) {
	*startPtr = regexpPtr->details.rm_extend.rm_so;
	*endPtr = regexpPtr->details.rm_extend.rm_eo;
    } else if (index < 0 || (size_t) index > regexpPtr->re.re_nsub + 1) {
	*startPtr = -1;
	*endPtr = -1;
    } else {
	*startPtr = regexpPtr->matches[index].rm_so;
	*endPtr = regexpPtr->matches[index].rm_eo;
    }
}

/*
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
int
Tcl_RegExpExecObj(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting. */
    Tcl_RegExp re,		/* Compiled regular expression; must have been
				 * returned by previous call to
				 * Tcl_GetRegExpFromObj. */
    Tcl_Obj *textObj,		/* Text against which to match re. */
    size_t offset,			/* Character index that marks where matching
				 * should begin. */
    size_t nmatches,		/* How many subexpression matches (counting
				 * the whole match as subexpression 0) are of
				 * interest. -1 means all of them. */
    int flags)			/* Regular expression execution flags. */
{
    TclRegexp *regexpPtr = (TclRegexp *) re;
    Tcl_UniChar *udata;
    size_t length;
    int reflags = regexpPtr->flags;
#define TCL_REG_GLOBOK_FLAGS \
	(TCL_REG_ADVANCED | TCL_REG_NOSUB | TCL_REG_NOCASE)

    /*
     * Take advantage of the equivalent glob pattern, if one exists.
     * This is possible based only on the right mix of incoming flags (0)







|

|






|







439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
int
Tcl_RegExpExecObj(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting. */
    Tcl_RegExp re,		/* Compiled regular expression; must have been
				 * returned by previous call to
				 * Tcl_GetRegExpFromObj. */
    Tcl_Obj *textObj,		/* Text against which to match re. */
    Tcl_Size offset,		/* Character index that marks where matching
				 * should begin. */
    Tcl_Size nmatches,	/* How many subexpression matches (counting
				 * the whole match as subexpression 0) are of
				 * interest. -1 means all of them. */
    int flags)			/* Regular expression execution flags. */
{
    TclRegexp *regexpPtr = (TclRegexp *) re;
    Tcl_UniChar *udata;
    Tcl_Size length;
    int reflags = regexpPtr->flags;
#define TCL_REG_GLOBOK_FLAGS \
	(TCL_REG_ADVANCED | TCL_REG_NOSUB | TCL_REG_NOCASE)

    /*
     * Take advantage of the equivalent glob pattern, if one exists.
     * This is possible based only on the right mix of incoming flags (0)
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
				 * the interp regexp cache. */
    Tcl_Obj *objPtr,		/* Object whose string rep contains regular
				 * expression pattern. Internal rep will be
				 * changed to compiled form of this regular
				 * expression. */
    int flags)			/* Regular expression compilation flags. */
{
    size_t length;
    TclRegexp *regexpPtr;
    const char *pattern;

    RegexpGetInternalRep(objPtr, regexpPtr);

    if ((regexpPtr == NULL) || (regexpPtr->flags != flags)) {
	pattern = Tcl_GetStringFromObj(objPtr, &length);







|







591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
				 * the interp regexp cache. */
    Tcl_Obj *objPtr,		/* Object whose string rep contains regular
				 * expression pattern. Internal rep will be
				 * changed to compiled form of this regular
				 * expression. */
    int flags)			/* Regular expression compilation flags. */
{
    Tcl_Size length;
    TclRegexp *regexpPtr;
    const char *pattern;

    RegexpGetInternalRep(objPtr, regexpPtr);

    if ((regexpPtr == NULL) || (regexpPtr->flags != flags)) {
	pattern = Tcl_GetStringFromObj(objPtr, &length);
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
    const char *p;

    Tcl_ResetResult(interp);
    n = TclReError(status, buf, sizeof(buf));
    p = (n > sizeof(buf)) ? "..." : "";
    Tcl_SetObjResult(interp, Tcl_ObjPrintf("%s%s%s", msg, buf, p));

    sprintf(cbuf, "%d", status);
    (void) TclReError(REG_ITOA, cbuf, sizeof(cbuf));
    Tcl_SetErrorCode(interp, "REGEXP", cbuf, buf, NULL);
}

/*
 *----------------------------------------------------------------------
 *







|







726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
    const char *p;

    Tcl_ResetResult(interp);
    n = TclReError(status, buf, sizeof(buf));
    p = (n > sizeof(buf)) ? "..." : "";
    Tcl_SetObjResult(interp, Tcl_ObjPrintf("%s%s%s", msg, buf, p));

    snprintf(cbuf, sizeof(cbuf), "%d", status);
    (void) TclReError(REG_ITOA, cbuf, sizeof(cbuf));
    Tcl_SetErrorCode(interp, "REGEXP", cbuf, buf, NULL);
}

/*
 *----------------------------------------------------------------------
 *
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
     * Convert RE to a glob pattern equivalent, if any, and cache it.  If this
     * is not possible, then globObjPtr will be NULL.  This is used by
     * Tcl_RegExpExecObj to optionally do a fast match (avoids RE engine).
     */

    if (TclReToGlob(NULL, string, length, &stringBuf, &exact,
	    NULL) == TCL_OK) {
	regexpPtr->globObjPtr = TclDStringToObj(&stringBuf);
	Tcl_IncrRefCount(regexpPtr->globObjPtr);
    } else {
	regexpPtr->globObjPtr = NULL;
    }

    /*
     * Allocate enough space for all of the subexpressions, plus one extra for







|







956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
     * Convert RE to a glob pattern equivalent, if any, and cache it.  If this
     * is not possible, then globObjPtr will be NULL.  This is used by
     * Tcl_RegExpExecObj to optionally do a fast match (avoids RE engine).
     */

    if (TclReToGlob(NULL, string, length, &stringBuf, &exact,
	    NULL) == TCL_OK) {
	regexpPtr->globObjPtr = Tcl_DStringToObj(&stringBuf);
	Tcl_IncrRefCount(regexpPtr->globObjPtr);
    } else {
	regexpPtr->globObjPtr = NULL;
    }

    /*
     * Allocate enough space for all of the subexpressions, plus one extra for

Changes to generic/tclResult.c.

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

13
14
15
16
17
18
19
/*
 * tclResult.c --
 *
 *	This file contains code to manage the interpreter result.
 *
 * Copyright © 1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"


/*
 * Indices of the standard return options dictionary keys.
 */

enum returnKeys {
    KEY_CODE,	KEY_ERRORCODE,	KEY_ERRORINFO,	KEY_ERRORLINE,












>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/*
 * tclResult.c --
 *
 *	This file contains code to manage the interpreter result.
 *
 * Copyright © 1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include <assert.h>

/*
 * Indices of the standard return options dictionary keys.
 */

enum returnKeys {
    KEY_CODE,	KEY_ERRORCODE,	KEY_ERRORINFO,	KEY_ERRORLINE,
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
    Tcl_Free(statePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetObjResult --
 *
 *	Arrange for objPtr to be an interpreter's result value.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	interp->objResultPtr is left pointing to the object referenced by
 *	objPtr. The object's reference count is incremented since there is now
 *	a new reference to it. The reference count for any old objResultPtr

 *	value is decremented. Also, the string result is reset.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetObjResult(
    Tcl_Interp *interp,		/* Interpreter with which to associate the
				 * return object value. */
    Tcl_Obj *objPtr)	/* Tcl object to be returned. If NULL, the obj
				 * result is made an empty string object. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *oldObjResult = iPtr->objResultPtr;





    iPtr->objResultPtr = objPtr;
    Tcl_IncrRefCount(objPtr);	/* since interp result is a reference */

    /*
     * We wait until the end to release the old object result, in case we are
     * setting the result to itself.
     */

    TclDecrRefCount(oldObjResult);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetObjResult --
 *







<
|





|
<
|
>
|






|
<
|
<



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







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
    Tcl_Free(statePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetObjResult --

 *	Makes objPtr the interpreter's result value.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Stores objPtr interp->objResultPtr, increments its reference count, and

 *	decrements the reference count of any existing interp->objResultPtr.
 *
 *	The string result is reset.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetObjResult(
    Tcl_Interp *interp,		/* Interpreter to set the result for. */

    Tcl_Obj *objPtr)		/* The value to set as the result. */

{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *oldObjResult = iPtr->objResultPtr;
    if (objPtr == oldObjResult) {
	/* This should be impossible */
	assert(objPtr->refCount != 0);
	return;
    } else {
	iPtr->objResultPtr = objPtr;
	Tcl_IncrRefCount(objPtr);
	TclDecrRefCount(oldObjResult);




    }

}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetObjResult --
 *
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
    const char *element)	/* String to convert to list element and add
				 * to result. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *elementPtr = Tcl_NewStringObj(element, -1);
    Tcl_Obj *listPtr = Tcl_NewListObj(1, &elementPtr);
    const char *bytes;
    size_t length;

    if (Tcl_IsShared(iPtr->objResultPtr)) {
	Tcl_SetObjResult(interp, Tcl_DuplicateObj(iPtr->objResultPtr));
    }
    bytes = Tcl_GetStringFromObj(iPtr->objResultPtr, &length);
    if (TclNeedSpace(bytes, bytes + length)) {
	Tcl_AppendToObj(iPtr->objResultPtr, " ", 1);







|







350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
    const char *element)	/* String to convert to list element and add
				 * to result. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *elementPtr = Tcl_NewStringObj(element, -1);
    Tcl_Obj *listPtr = Tcl_NewListObj(1, &elementPtr);
    const char *bytes;
    Tcl_Size length;

    if (Tcl_IsShared(iPtr->objResultPtr)) {
	Tcl_SetObjResult(interp, Tcl_DuplicateObj(iPtr->objResultPtr));
    }
    bytes = Tcl_GetStringFromObj(iPtr->objResultPtr, &length);
    if (TclNeedSpace(bytes, bytes + length)) {
	Tcl_AppendToObj(iPtr->objResultPtr, " ", 1);
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508

    /*
     * Scan through the arguments one at a time, appending them to the
     * errorCode field as list elements.
     */

    va_start(argList, interp);
    errorObj = Tcl_NewObj();

    /*
     * Scan through the arguments one at a time, appending them to the
     * errorCode field as list elements.
     */

    while (1) {







|







491
492
493
494
495
496
497
498
499
500
501
502
503
504
505

    /*
     * Scan through the arguments one at a time, appending them to the
     * errorCode field as list elements.
     */

    va_start(argList, interp);
    TclNewObj(errorObj);

    /*
     * Scan through the arguments one at a time, appending them to the
     * errorCode field as list elements.
     */

    while (1) {
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
	if (iPtr->errorInfo) {
	    Tcl_DecrRefCount(iPtr->errorInfo);
	    iPtr->errorInfo = NULL;
	}
	Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORINFO],
                &valuePtr);
	if (valuePtr != NULL) {
	    size_t length;

	    (void) Tcl_GetStringFromObj(valuePtr, &length);
	    if (length) {
		iPtr->errorInfo = valuePtr;
		Tcl_IncrRefCount(iPtr->errorInfo);
		iPtr->flags |= ERR_ALREADY_LOGGED;
	    }
	}
	Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORSTACK],
                &valuePtr);
	if (valuePtr != NULL) {
            size_t len, valueObjc;
            Tcl_Obj **valueObjv;

            if (Tcl_IsShared(iPtr->errorStack)) {
                Tcl_Obj *newObj;

                newObj = Tcl_DuplicateObj(iPtr->errorStack);
                Tcl_DecrRefCount(iPtr->errorStack);







|











|







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
	if (iPtr->errorInfo) {
	    Tcl_DecrRefCount(iPtr->errorInfo);
	    iPtr->errorInfo = NULL;
	}
	Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORINFO],
                &valuePtr);
	if (valuePtr != NULL) {
	    Tcl_Size 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],
                &valuePtr);
	if (valuePtr != NULL) {
            Tcl_Size len, valueObjc;
            Tcl_Obj **valueObjv;

            if (Tcl_IsShared(iPtr->errorStack)) {
                Tcl_Obj *newObj;

                newObj = Tcl_DuplicateObj(iPtr->errorStack);
                Tcl_DecrRefCount(iPtr->errorStack);
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920

    /*
     * Check for bogus -errorcode value.
     */

    Tcl_DictObjGet(NULL, returnOpts, keys[KEY_ERRORCODE], &valuePtr);
    if (valuePtr != NULL) {
	size_t length;

	if (TCL_ERROR == TclListObjLengthM(NULL, valuePtr, &length )) {
	    /*
	     * Value is not a list, which is illegal for -errorcode.
	     */

	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(







|







903
904
905
906
907
908
909
910
911
912
913
914
915
916
917

    /*
     * Check for bogus -errorcode value.
     */

    Tcl_DictObjGet(NULL, returnOpts, keys[KEY_ERRORCODE], &valuePtr);
    if (valuePtr != NULL) {
	Tcl_Size length;

	if (TCL_ERROR == TclListObjLengthM(NULL, valuePtr, &length )) {
	    /*
	     * Value is not a list, which is illegal for -errorcode.
	     */

	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942

    /*
     * Check for bogus -errorstack value.
     */

    Tcl_DictObjGet(NULL, returnOpts, keys[KEY_ERRORSTACK], &valuePtr);
    if (valuePtr != NULL) {
	size_t length;

	if (TCL_ERROR == TclListObjLengthM(NULL, valuePtr, &length)) {
	    /*
	     * Value is not a list, which is illegal for -errorstack.
	     */

	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(







|







925
926
927
928
929
930
931
932
933
934
935
936
937
938
939

    /*
     * Check for bogus -errorstack value.
     */

    Tcl_DictObjGet(NULL, returnOpts, keys[KEY_ERRORSTACK], &valuePtr);
    if (valuePtr != NULL) {
	Tcl_Size length;

	if (TCL_ERROR == TclListObjLengthM(NULL, valuePtr, &length)) {
	    /*
	     * Value is not a list, which is illegal for -errorstack.
	     */

	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
 */

int
Tcl_SetReturnOptions(
    Tcl_Interp *interp,
    Tcl_Obj *options)
{
    size_t objc;
    int level, code;
    Tcl_Obj **objv, *mergedOpts;

    Tcl_IncrRefCount(options);
    if (TCL_ERROR == TclListObjGetElementsM(interp, options, &objc, &objv)
	    || (objc % 2)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(







|







1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
 */

int
Tcl_SetReturnOptions(
    Tcl_Interp *interp,
    Tcl_Obj *options)
{
    Tcl_Size objc;
    int level, code;
    Tcl_Obj **objv, *mergedOpts;

    Tcl_IncrRefCount(options);
    if (TCL_ERROR == TclListObjGetElementsM(interp, options, &objc, &objv)
	    || (objc % 2)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(

Changes to generic/tclScan.c.

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

14
15
16
17
18
19
20
/*
 * tclScan.c --
 *
 *	This file contains the implementation of the "scan" command.
 *
 * Copyright © 1998 Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

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


/*
 * Flag values used by Tcl_ScanObjCmd.
 */

#define SCAN_NOSKIP	0x1		/* Don't skip blanks. */
#define SCAN_SUPPRESS	0x2		/* Suppress assignment. */













>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/*
 * tclScan.c --
 *
 *	This file contains the implementation of the "scan" command.
 *
 * Copyright © 1998 Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclTomMath.h"
#include <assert.h>

/*
 * Flag values used by Tcl_ScanObjCmd.
 */

#define SCAN_NOSKIP	0x1		/* Don't skip blanks. */
#define SCAN_SUPPRESS	0x2		/* Suppress assignment. */
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
    Tcl_Interp *interp,		/* Current interpreter. */
    const char *format,		/* The format string. */
    int numVars,		/* The number of variables passed to the scan
				 * command. */
    int *totalSubs)		/* The number of variables that will be
				 * required. */
{
    int gotXpg, gotSequential, value, i, flags;
    char *end;
    Tcl_UniChar ch = 0;
    int objIndex, xpgSize, nspace = numVars;
    int *nassign = (int *)TclStackAlloc(interp, nspace * sizeof(int));
    Tcl_Obj *errorMsg;		/* Place to build an error messages. Note that
				 * these are messy operations because we do
				 * not want to use the formatting engine;







|







255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
    Tcl_Interp *interp,		/* Current interpreter. */
    const char *format,		/* The format string. */
    int numVars,		/* The number of variables passed to the scan
				 * command. */
    int *totalSubs)		/* The number of variables that will be
				 * required. */
{
    int gotXpg, gotSequential, i, flags;
    char *end;
    Tcl_UniChar ch = 0;
    int objIndex, xpgSize, nspace = numVars;
    int *nassign = (int *)TclStackAlloc(interp, nspace * sizeof(int));
    Tcl_Obj *errorMsg;		/* Place to build an error messages. Note that
				 * these are messy operations because we do
				 * not want to use the formatting engine;
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
	if ((ch < 0x80) && isdigit(UCHAR(ch))) {	/* INTL: "C" locale. */
	    /*
	     * Check for an XPG3-style %n$ specification. Note: there must
	     * not be a mixture of XPG3 specs and non-XPG3 specs in the same
	     * format string.
	     */


	    value = strtoul(format-1, &end, 10);	/* INTL: "C" locale. */
	    if (*end != '$') {
		goto notXpg;
	    }
	    format = end+1;
	    format += TclUtfToUniChar(format, &ch);
	    gotXpg = 1;
	    if (gotSequential) {
		goto mixedXPG;
	    }




	    objIndex = value - 1;
	    if ((objIndex < 0) || (numVars && (objIndex >= numVars))) {
		goto badIndex;

	    } else if (numVars == 0) {
		/*
		 * In the case where no vars are specified, the user can
		 * specify %9999$ legally, so we have to consider special
		 * rules for growing the assign array. 'value' is guaranteed
		 * to be > 0.
		 */
		xpgSize = (xpgSize > value) ? xpgSize : value;
	    }
	    goto xpgCheckDone;
	}

    notXpg:
	gotSequential = 1;
	if (gotXpg) {







>
|









>
>
>
>
|
|

>
|



|
|

|







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
	if ((ch < 0x80) && isdigit(UCHAR(ch))) {	/* INTL: "C" locale. */
	    /*
	     * Check for an XPG3-style %n$ specification. Note: there must
	     * not be a mixture of XPG3 specs and non-XPG3 specs in the same
	     * format string.
	     */

	    /* assert(value is >= 0) because of the isdigit() check above */
	    unsigned long long ull = strtoull(format-1, &end, 10);	/* INTL: "C" locale. */
	    if (*end != '$') {
		goto notXpg;
	    }
	    format = end+1;
	    format += TclUtfToUniChar(format, &ch);
	    gotXpg = 1;
	    if (gotSequential) {
		goto mixedXPG;
	    }
	    /* >=INT_MAX because 9.0 does not support more than INT_MAX-1 args */
	    if (ull == 0 || ull >= INT_MAX) {
		goto badIndex;
	    }
	    objIndex = (int) ull - 1;
	    if (numVars && (objIndex >= numVars)) {
		goto badIndex;
	    }
	    else if (numVars == 0) {
		/*
		 * In the case where no vars are specified, the user can
		 * specify %9999$ legally, so we have to consider special
		 * rules for growing the assign array. 'ull' is guaranteed
		 * to be > 0 and < INT_MAX as per checks above.
		 */
		xpgSize = (xpgSize > (int)ull) ? xpgSize : (int)ull;
	    }
	    goto xpgCheckDone;
	}

    notXpg:
	gotSequential = 1;
	if (gotXpg) {
344
345
346
347
348
349
350



351












352
353
354
355
356
357
358

    xpgCheckDone:
	/*
	 * Parse any width specifier.
	 */

	if ((ch < 0x80) && isdigit(UCHAR(ch))) {	/* INTL: "C" locale. */



	    value = strtoul(format-1, (char **) &format, 10);	/* INTL: "C" locale. */












	    flags |= SCAN_WIDTH;
	    format += TclUtfToUniChar(format, &ch);
	}

	/*
	 * Handle any size specifier.
	 */







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







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

    xpgCheckDone:
	/*
	 * Parse any width specifier.
	 */

	if ((ch < 0x80) && isdigit(UCHAR(ch))) {	/* INTL: "C" locale. */
	    /* Note ull >= 0 because of isdigit check above */
	    unsigned long long ull;
	    ull = strtoull(
		format - 1, (char **)&format, 10); /* INTL: "C" locale. */
	    /* Note >=, not >, to leave room for a nul */
	    if (ull >= TCL_SIZE_MAX) {
		Tcl_SetObjResult(
		    interp,
		    Tcl_ObjPrintf("specified field width %" TCL_LL_MODIFIER
				  "u exceeds limit %" TCL_SIZE_MODIFIER "d.",
				  ull,
				  (Tcl_Size)TCL_SIZE_MAX-1));
		Tcl_SetErrorCode(
		    interp, "TCL", "FORMAT", "WIDTHLIMIT", NULL);
		goto error;
	    }
	    flags |= SCAN_WIDTH;
	    format += TclUtfToUniChar(format, &ch);
	}

	/*
	 * Handle any size specifier.
	 */
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
	    if (objIndex >= nspace) {
		/*
		 * Expand the nassign buffer. If we are using XPG specifiers,
		 * make sure that we grow to a large enough size. xpgSize is
		 * guaranteed to be at least one larger than objIndex.
		 */

		value = nspace;
		if (xpgSize) {
		    nspace = xpgSize;
		} else {
		    nspace += 16;	/* formerly STATIC_LIST_SIZE */
		}
		nassign = (int *)TclStackRealloc(interp, nassign,
			nspace * sizeof(int));
		for (i = value; i < nspace; i++) {
		    nassign[i] = 0;
		}
	    }
	    nassign[objIndex]++;
	    objIndex++;
	}
    }







|







|







491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
	    if (objIndex >= nspace) {
		/*
		 * Expand the nassign buffer. If we are using XPG specifiers,
		 * make sure that we grow to a large enough size. xpgSize is
		 * guaranteed to be at least one larger than objIndex.
		 */

		int nspaceOrig = nspace;
		if (xpgSize) {
		    nspace = xpgSize;
		} else {
		    nspace += 16;	/* formerly STATIC_LIST_SIZE */
		}
		nassign = (int *)TclStackRealloc(interp, nassign,
			nspace * sizeof(int));
		for (i = nspaceOrig; i < nspace; i++) {
		    nassign[i] = 0;
		}
	    }
	    nassign[objIndex]++;
	    objIndex++;
	}
    }
571
572
573
574
575
576
577
578

579
580
581
582
583
584
585
{
    const char *format;
    int numVars, nconversions, totalVars = -1;
    int objIndex, offset, i, result, code;
    long value;
    const char *string, *end, *baseString;
    char op = 0;
    int width, underflow = 0;

    Tcl_WideInt wideValue;
    Tcl_UniChar ch = 0, sch = 0;
    Tcl_Obj **objs = NULL, *objPtr = NULL;
    int flags;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv,







|
>







593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
{
    const char *format;
    int numVars, nconversions, totalVars = -1;
    int objIndex, offset, i, result, code;
    long value;
    const char *string, *end, *baseString;
    char op = 0;
    int underflow = 0;
    Tcl_Size width;
    Tcl_WideInt wideValue;
    Tcl_UniChar ch = 0, sch = 0;
    Tcl_Obj **objs = NULL, *objPtr = NULL;
    int flags;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv,
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
	 */

	if (ch == '*') {
	    flags |= SCAN_SUPPRESS;
	    format += TclUtfToUniChar(format, &ch);
	} else if ((ch < 0x80) && isdigit(UCHAR(ch))) {	/* INTL: "C" locale. */
	    char *formatEnd;

	    value = strtoul(format-1, &formatEnd, 10);/* INTL: "C" locale. */
	    if (*formatEnd == '$') {
		format = formatEnd+1;
		format += TclUtfToUniChar(format, &ch);
		objIndex = (int) value - 1;
	    }
	}

	/*
	 * Parse any width specifier.
	 */

	if ((ch < 0x80) && isdigit(UCHAR(ch))) {	/* INTL: "C" locale. */

	    width = (int) strtoul(format-1, (char **) &format, 10);/* INTL: "C" locale. */


	    format += TclUtfToUniChar(format, &ch);
	} else {
	    width = 0;
	}

	/*
	 * Handle any size specifier.







>













>
|
>
>







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

	if (ch == '*') {
	    flags |= SCAN_SUPPRESS;
	    format += TclUtfToUniChar(format, &ch);
	} else if ((ch < 0x80) && isdigit(UCHAR(ch))) {	/* INTL: "C" locale. */
	    char *formatEnd;
	    /* Note currently XPG3 range limited to INT_MAX to match type of objc */
	    value = strtoul(format-1, &formatEnd, 10);/* INTL: "C" locale. */
	    if (*formatEnd == '$') {
		format = formatEnd+1;
		format += TclUtfToUniChar(format, &ch);
		objIndex = (int) value - 1;
	    }
	}

	/*
	 * Parse any width specifier.
	 */

	if ((ch < 0x80) && isdigit(UCHAR(ch))) {	/* INTL: "C" locale. */
	    unsigned long long ull;
	    ull  = strtoull(format-1, (char **) &format, 10); /* INTL: "C" locale. */
	    assert(ull <= TCL_SIZE_MAX); /* Else ValidateFormat should've error'ed */
	    width = (Tcl_Size)ull;
	    format += TclUtfToUniChar(format, &ch);
	} else {
	    width = 0;
	}

	/*
	 * Handle any size specifier.
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
	    break;

	case 'f':
	    /*
	     * Scan a floating point number
	     */

	    objPtr = Tcl_NewDoubleObj(0.0);
	    Tcl_IncrRefCount(objPtr);
	    if (width == 0) {
		width = ~0;
	    }
	    if (TCL_OK != TclParseNumber(NULL, objPtr, NULL, string, width,
		    &end, TCL_PARSE_DECIMAL_ONLY | TCL_PARSE_NO_WHITESPACE | TCL_PARSE_NO_UNDERSCORE)) {
		Tcl_DecrRefCount(objPtr);







|







1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
	    break;

	case 'f':
	    /*
	     * Scan a floating point number
	     */

	    TclNewDoubleObj(objPtr, 0.0);
	    Tcl_IncrRefCount(objPtr);
	    if (width == 0) {
		width = ~0;
	    }
	    if (TCL_OK != TclParseNumber(NULL, objPtr, NULL, string, width,
		    &end, TCL_PARSE_DECIMAL_ONLY | TCL_PARSE_NO_WHITESPACE | TCL_PARSE_NO_UNDERSCORE)) {
		Tcl_DecrRefCount(objPtr);
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
		code = TCL_ERROR;
	    }
	    Tcl_DecrRefCount(objs[i]);
	}
    } else {
	/*
	 * Here no vars were specified, we want a list returned (inline scan)


	 */



	TclNewObj(objPtr);
	for (i = 0; i < totalVars; i++) {
	    if (objs[i] != NULL) {
		Tcl_ListObjAppendElement(NULL, objPtr, objs[i]);
		Tcl_DecrRefCount(objs[i]);
	    } else {
		/*
		 * More %-specifiers than matching chars, so we just spit out
		 * empty strings for these.
		 */

		Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewObj());
	    }











	}
    }
    if (objs != NULL) {
	Tcl_Free(objs);
    }
    if (code == TCL_OK) {
	if (underflow && (nconversions == 0)) {
	    if (numVars) {
		TclNewIndexObj(objPtr, TCL_INDEX_NONE);
	    } else {
		if (objPtr) {
		    Tcl_SetListObj(objPtr, 0, NULL);
		} else {
		    TclNewObj(objPtr);
		}
	    }







>
>

|
>
>

|

|







|

>
>
>
>
>
>
>
>
>
>
>








|







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
		code = TCL_ERROR;
	    }
	    Tcl_DecrRefCount(objs[i]);
	}
    } else {
	/*
	 * Here no vars were specified, we want a list returned (inline scan)
	 * We create an empty Tcl_Obj to fill missing values rather than
	 * allocating a new Tcl_Obj every time. See test scan-bigdata-XX.
	 */
	Tcl_Obj *emptyObj;
	TclNewObj(emptyObj);
	Tcl_IncrRefCount(emptyObj);
	TclNewObj(objPtr);
	for (i = 0; code == TCL_OK && i < totalVars; i++) {
	    if (objs[i] != NULL) {
		code = Tcl_ListObjAppendElement(interp, objPtr, objs[i]);
		Tcl_DecrRefCount(objs[i]);
	    } else {
		/*
		 * More %-specifiers than matching chars, so we just spit out
		 * empty strings for these.
		 */

		code = Tcl_ListObjAppendElement(interp, objPtr, emptyObj);
	    }
	}
	Tcl_DecrRefCount(emptyObj);
	if (code != TCL_OK) {
	    /* If error'ed out, free up remaining. i contains last index freed */
	    while (++i < totalVars) {
		if (objs[i] != NULL) {
		    Tcl_DecrRefCount(objs[i]);
		}
	    }
	    Tcl_DecrRefCount(objPtr);
	    objPtr = NULL;
	}
    }
    if (objs != NULL) {
	Tcl_Free(objs);
    }
    if (code == TCL_OK) {
	if (underflow && (nconversions == 0)) {
	    if (numVars) {
		TclNewIntObj(objPtr, -1);
	    } else {
		if (objPtr) {
		    Tcl_SetListObj(objPtr, 0, NULL);
		} else {
		    TclNewObj(objPtr);
		}
	    }

Changes to generic/tclStrToD.c.

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
static const int log2pow5[27] = {
    01,  3,  5,  7, 10, 12, 14, 17, 19, 21,
    24, 26, 28, 31, 33, 35, 38, 40, 42, 45,
    47, 49, 52, 54, 56, 59, 61
};
#define N_LOG2POW5 27

static const Tcl_WideUInt wuipow5[27] = {
    (Tcl_WideUInt) 1,		/* 5**0 */
    (Tcl_WideUInt) 5,
    (Tcl_WideUInt) 25,
    (Tcl_WideUInt) 125,
    (Tcl_WideUInt) 625,
    (Tcl_WideUInt) 3125,	/* 5**5 */
    (Tcl_WideUInt) 3125*5,
    (Tcl_WideUInt) 3125*25,
    (Tcl_WideUInt) 3125*125,
    (Tcl_WideUInt) 3125*625,
    (Tcl_WideUInt) 3125*3125,	/* 5**10 */
    (Tcl_WideUInt) 3125*3125*5,
    (Tcl_WideUInt) 3125*3125*25,
    (Tcl_WideUInt) 3125*3125*125,
    (Tcl_WideUInt) 3125*3125*625,

    (Tcl_WideUInt) 3125*3125*3125, /* 5**15 */
    (Tcl_WideUInt) 3125*3125*3125*5,
    (Tcl_WideUInt) 3125*3125*3125*25,
    (Tcl_WideUInt) 3125*3125*3125*125,
    (Tcl_WideUInt) 3125*3125*3125*625,
    (Tcl_WideUInt) 3125*3125*3125*3125,	/* 5**20 */
    (Tcl_WideUInt) 3125*3125*3125*3125*5,
    (Tcl_WideUInt) 3125*3125*3125*3125*25,
    (Tcl_WideUInt) 3125*3125*3125*3125*125,
    (Tcl_WideUInt) 3125*3125*3125*3125*625,
    (Tcl_WideUInt) 3125*3125*3125*3125*3125,  /* 5**25 */
    (Tcl_WideUInt) 3125*3125*3125*3125*3125*5 /* 5**26 */
};

/*
 * Static functions defined in this file.
 */

static int		AccumulateDecimalDigit(unsigned, int,







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







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
static const int log2pow5[27] = {
    01,  3,  5,  7, 10, 12, 14, 17, 19, 21,
    24, 26, 28, 31, 33, 35, 38, 40, 42, 45,
    47, 49, 52, 54, 56, 59, 61
};
#define N_LOG2POW5 27

static const Tcl_WideUInt wuipow5[] = {
    (Tcl_WideUInt) 1U,		/* 5**0 */
    (Tcl_WideUInt) 5U,
    (Tcl_WideUInt) 25U,
    (Tcl_WideUInt) 125U,
    (Tcl_WideUInt) 625U,
    (Tcl_WideUInt) 3125U,	/* 5**5 */
    (Tcl_WideUInt) 3125U*5U,
    (Tcl_WideUInt) 3125U*25U,
    (Tcl_WideUInt) 3125U*125U,
    (Tcl_WideUInt) 3125U*625U,
    (Tcl_WideUInt) 3125U*3125U,	/* 5**10 */
    (Tcl_WideUInt) 3125U*3125U*5U,
    (Tcl_WideUInt) 3125U*3125U*25U,
    (Tcl_WideUInt) 3125U*3125U*125U,
    (Tcl_WideUInt) 3125U*3125U*625U,
    (Tcl_WideUInt) 3125U*3125U*3125U, /* 5**15 */
    (Tcl_WideUInt) 3125U*3125U*3125U*5U,
    (Tcl_WideUInt) 3125U*3125U*3125U*25U,
    (Tcl_WideUInt) 3125U*3125U*3125U*125U,
    (Tcl_WideUInt) 3125U*3125U*3125U*625U,
    (Tcl_WideUInt) 3125U*3125U*3125U*3125U,	/* 5**20 */
    (Tcl_WideUInt) 3125U*3125U*3125U*3125U*5U,
    (Tcl_WideUInt) 3125U*3125U*3125U*3125U*25U,
    (Tcl_WideUInt) 3125U*3125U*3125U*3125U*125U,
    (Tcl_WideUInt) 3125U*3125U*3125U*3125U*625U,
    (Tcl_WideUInt) 3125U*3125U*3125U*3125U*3125U,  /* 5**25 */
    (Tcl_WideUInt) 3125U*3125U*3125U*3125U*3125U*5U,
    (Tcl_WideUInt) 3125U*3125U*3125U*3125U*3125U*25U /* 5**27 */
};

/*
 * Static functions defined in this file.
 */

static int		AccumulateDecimalDigit(unsigned, int,
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
    Tcl_Interp *interp,		/* Used for error reporting. May be NULL. */
    Tcl_Obj *objPtr,		/* Object to receive the internal rep. */
    const char *expected,	/* Description of the type of number the
				 * caller expects to be able to parse
				 * ("integer", "boolean value", etc.). */
    const char *bytes,		/* Pointer to the start of the string to
				 * scan. */
    size_t numBytes,		/* Maximum number of bytes to scan, see
				 * above. */
    const char **endPtrPtr,	/* Place to store pointer to the character
				 * that terminated the scan. */
    int flags)			/* Flags governing the parse. */
{
    enum State {
	INITIAL, SIGNUM, ZERO, ZERO_X,







|







480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
    Tcl_Interp *interp,		/* Used for error reporting. May be NULL. */
    Tcl_Obj *objPtr,		/* Object to receive the internal rep. */
    const char *expected,	/* Description of the type of number the
				 * caller expects to be able to parse
				 * ("integer", "boolean value", etc.). */
    const char *bytes,		/* Pointer to the start of the string to
				 * scan. */
    Tcl_Size numBytes,		/* Maximum number of bytes to scan, see
				 * above. */
    const char **endPtrPtr,	/* Place to store pointer to the character
				 * that terminated the scan. */
    int flags)			/* Flags governing the parse. */
{
    enum State {
	INITIAL, SIGNUM, ZERO, ZERO_X,
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
				 * point in the parse. */
    int numDigitsAfterDp = 0;	/* Number of digits scanned after the decimal
				 * point. */
    int exponentSignum = 0;	/* Signum of the exponent of a floating point
				 * number. */
    long exponent = 0;		/* Exponent of a floating point number. */
    const char *p;		/* Pointer to next character to scan. */
    size_t len;			/* Number of characters remaining after p. */
    const char *acceptPoint;	/* Pointer to position after last character in
				 * an acceptable number. */
    size_t acceptLen;		/* Number of characters following that
				 * point. */
    int status = TCL_OK;	/* Status to return to caller. */
    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







|


|







525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
				 * point in the parse. */
    int numDigitsAfterDp = 0;	/* Number of digits scanned after the decimal
				 * point. */
    int exponentSignum = 0;	/* Signum of the exponent of a floating point
				 * number. */
    long exponent = 0;		/* Exponent of a floating point number. */
    const char *p;		/* Pointer to next character to scan. */
    Tcl_Size len;		/* Number of characters remaining after p. */
    const char *acceptPoint;	/* Pointer to position after last character in
				 * an acceptable number. */
    Tcl_Size acceptLen;		/* Number of characters following that
				 * point. */
    int status = TCL_OK;	/* Status to return to caller. */
    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
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
    if (bytes == NULL) {
	if (interp == NULL && endPtrPtr == NULL) {
	    if (TclHasInternalRep(objPtr, &tclDictType)) {
		/* A dict can never be a (single) number */
		return TCL_ERROR;
	    }
	    if (TclHasInternalRep(objPtr, &tclListType)) {
		size_t length;
		/* A list can only be a (single) number if its length == 1 */
		TclListObjLengthM(NULL, objPtr, &length);
		if (length != 1) {
		    return TCL_ERROR;
		}
	    }
	}







|







552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
    if (bytes == NULL) {
	if (interp == NULL && endPtrPtr == NULL) {
	    if (TclHasInternalRep(objPtr, &tclDictType)) {
		/* A dict can never be a (single) number */
		return TCL_ERROR;
	    }
	    if (TclHasInternalRep(objPtr, &tclListType)) {
		Tcl_Size length;
		/* A list can only be a (single) number if its length == 1 */
		TclListObjLengthM(NULL, objPtr, &length);
		if (length != 1) {
		    return TCL_ERROR;
		}
	    }
	}
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
			((Tcl_WideInt)significand / pow10vals[-exponent]);
		goto returnValue;
	    }
	}
    }

    /*
     * All the easy cases have failed. Promote ths significand to bignum and
     * call MakeHighPrecisionDouble to do it the hard way.
     */

    if (mp_init_u64(&significandBig, significand) != MP_OKAY) {
	return 0.0;
    }
    retval = MakeHighPrecisionDouble(0, &significandBig, numSigDigs,







|







1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
			((Tcl_WideInt)significand / pow10vals[-exponent]);
		goto returnValue;
	    }
	}
    }

    /*
     * All the easy cases have failed. Promote the significand to bignum and
     * call MakeHighPrecisionDouble to do it the hard way.
     */

    if (mp_init_u64(&significandBig, significand) != MP_OKAY) {
	return 0.0;
    }
    retval = MakeHighPrecisionDouble(0, &significandBig, numSigDigs,
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
	    return approxResult;
	}
    }

    /*
     * Compute twoMd as 2*M*d, where d is the exact value.
     * This is done by multiplying by 5**(M5+exponent) and then multiplying
     * by 2**(M5+exponent+1), which is, of couse, a left shift.
     */

    if (mp_init_copy(&twoMd, exactSignificand) != MP_OKAY) {
	mp_clear(&twoMv);
	return approxResult;
    }
    for (i = 0; (i <= 8); ++i) {







|







2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
	    return approxResult;
	}
    }

    /*
     * Compute twoMd as 2*M*d, where d is the exact value.
     * This is done by multiplying by 5**(M5+exponent) and then multiplying
     * by 2**(M5+exponent+1), which is, of course, a left shift.
     */

    if (mp_init_copy(&twoMd, exactSignificand) != MP_OKAY) {
	mp_clear(&twoMv);
	return approxResult;
    }
    for (i = 0; (i <= 8); ++i) {
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
}

/*
 *----------------------------------------------------------------------
 *
 * RequiredPrecision --
 *
 *	Determines the number of bits needed to hold an intger.
 *
 * Results:
 *	Returns the position of the most significant bit (0 - 63).  Returns 0
 *	if the number is zero.
 *
 *----------------------------------------------------------------------
 */







|







2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
}

/*
 *----------------------------------------------------------------------
 *
 * RequiredPrecision --
 *
 *	Determines the number of bits needed to hold an integer.
 *
 * Results:
 *	Returns the position of the most significant bit (0 - 63).  Returns 0
 *	if the number is zero.
 *
 *----------------------------------------------------------------------
 */
4480
4481
4482
4483
4484
4485
4486
4487
4488
4489
4490
4491
4492
4493
4494
	m2plus = m2minus;
	if (!denorm && bw == 1) {
	    ++b2;
	    ++s2;
	    ++m2plus;
	}

	if (s5+1 < N_LOG2POW5 && s2+1 + log2pow5[s5+1] <= 64) {
	    /*
	     * If 10*2**s2*5**s5 == 2**(s2+1)+5**(s5+1) fits in a 64-bit word,
	     * then all our intermediate calculations can be done using exact
	     * 64-bit arithmetic with no need for expensive multiprecision
	     * operations. (This will be true for all numbers in the range
	     * [1.0e-3 .. 1.0e+24]).
	     */







|







4481
4482
4483
4484
4485
4486
4487
4488
4489
4490
4491
4492
4493
4494
4495
	m2plus = m2minus;
	if (!denorm && bw == 1) {
	    ++b2;
	    ++s2;
	    ++m2plus;
	}

	if (s5+1 < N_LOG2POW5 && s2+1 + log2pow5[s5+1] < 64) {
	    /*
	     * If 10*2**s2*5**s5 == 2**(s2+1)+5**(s5+1) fits in a 64-bit word,
	     * then all our intermediate calculations can be done using exact
	     * 64-bit arithmetic with no need for expensive multiprecision
	     * operations. (This will be true for all numbers in the range
	     * [1.0e-3 .. 1.0e+24]).
	     */
4537
4538
4539
4540
4541
4542
4543
4544
4545
4546
4547
4548
4549
4550
4551

	if (b2 >= s2 && s2 > 0) {
	    b2 -= s2; s2 = 0;
	} else if (s2 >= b2 && b2 > 0) {
	    s2 -= b2; b2 = 0;
	}

	if (s5+1 < N_LOG2POW5 && s2+1 + log2pow5[s5+1] <= 64) {
	    /*
	     * If 10*2**s2*5**s5 == 2**(s2+1)+5**(s5+1) fits in a 64-bit word,
	     * then all our intermediate calculations can be done using exact
	     * 64-bit arithmetic with no need for expensive multiprecision
	     * operations.
	     */








|







4538
4539
4540
4541
4542
4543
4544
4545
4546
4547
4548
4549
4550
4551
4552

	if (b2 >= s2 && s2 > 0) {
	    b2 -= s2; s2 = 0;
	} else if (s2 >= b2 && b2 > 0) {
	    s2 -= b2; b2 = 0;
	}

	if (s5+1 < N_LOG2POW5 && s2+1 + log2pow5[s5+1] < 64) {
	    /*
	     * If 10*2**s2*5**s5 == 2**(s2+1)+5**(s5+1) fits in a 64-bit word,
	     * then all our intermediate calculations can be done using exact
	     * 64-bit arithmetic with no need for expensive multiprecision
	     * operations.
	     */

5268
5269
5270
5271
5272
5273
5274
5275
5276
5277
5278
5279
5280
5281
5282
	*buffer++ = '-';
    }
    *buffer++ = 'N';
    *buffer++ = 'a';
    *buffer++ = 'N';
    bitwhack.iv &= ((UINT64_C(1)) << 51) - 1;
    if (bitwhack.iv != 0) {
	sprintf(buffer, "(%" PRIx64 ")", bitwhack.iv);
    } else {
	*buffer = '\0';
    }
#endif /* IEEE_FLOATING_POINT */
}

/*







|







5269
5270
5271
5272
5273
5274
5275
5276
5277
5278
5279
5280
5281
5282
5283
	*buffer++ = '-';
    }
    *buffer++ = 'N';
    *buffer++ = 'a';
    *buffer++ = 'N';
    bitwhack.iv &= ((UINT64_C(1)) << 51) - 1;
    if (bitwhack.iv != 0) {
	snprintf(buffer, TCL_DOUBLE_SPACE, "(%" PRIx64 ")", bitwhack.iv);
    } else {
	*buffer = '\0';
    }
#endif /* IEEE_FLOATING_POINT */
}

/*

Changes to generic/tclStringObj.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
/*
 * tclStringObj.c --
 *
 *	This file contains functions that implement string operations on Tcl
 *	objects. Some string operations work with UTF strings and others
 *	require Unicode format. Functions that require knowledge of the width
 *	of each character, such as indexing, operate on Unicode data.
 *
 *	A Unicode string is an internationalized string. Conceptually, a
 *	Unicode string is an array of 16-bit quantities organized as a
 *	sequence of properly formed UTF-8 characters. There is a one-to-one
 *	map between Unicode and UTF characters. Because Unicode characters
 *	have a fixed width, operations such as indexing operate on Unicode

 *	data. The String object is optimized for the case where each UTF char
 *	in a string is only one byte. In this case, we store the value of
 *	numChars, but we don't store the Unicode data (unless Tcl_GetUnicode
 *	is explicitly called).
 *
 *	The String object type stores one or both formats. The default
 *	behavior is to store UTF. Once Unicode is calculated by a function, it
 *	is stored in the internal rep for future access (without an additional
 *	O(n) cost).
 *
 *	To allow many appends to be done to an object without constantly
 *	reallocating the space for the string or Unicode representation, we
 *	allocate double the space for the string or Unicode and use the
 *	internal representation to keep track of how much space is used vs.
 *	allocated.
 *
 * Copyright © 1995-1997 Sun Microsystems, Inc.
 * Copyright © 1999 Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

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

#include "assert.h"
/*
 * Prototypes for functions defined later in this file:
 */

static void		AppendPrintfToObjVA(Tcl_Obj *objPtr,
			    const char *format, va_list argList);
static void		AppendUnicodeToUnicodeRep(Tcl_Obj *objPtr,
			    const Tcl_UniChar *unicode, size_t appendNumChars);
static void		AppendUnicodeToUtfRep(Tcl_Obj *objPtr,
			    const Tcl_UniChar *unicode, size_t numChars);
static void		AppendUtfToUnicodeRep(Tcl_Obj *objPtr,
			    const char *bytes, size_t numBytes);
static void		AppendUtfToUtfRep(Tcl_Obj *objPtr,
			    const char *bytes, size_t numBytes);
static void		DupStringInternalRep(Tcl_Obj *objPtr,
			    Tcl_Obj *copyPtr);
static size_t		ExtendStringRepWithUnicode(Tcl_Obj *objPtr,
			    const Tcl_UniChar *unicode, size_t numChars);
static void		ExtendUnicodeRepWithString(Tcl_Obj *objPtr,
			    const char *bytes, size_t numBytes,
			    size_t numAppendChars);
static void		FillUnicodeRep(Tcl_Obj *objPtr);
static void		FreeStringInternalRep(Tcl_Obj *objPtr);
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);

#if TCL_UTF_MAX > 3
#define ISCONTINUATION(bytes) (\
	((bytes)[0] & 0xC0) == 0x80)
#else
#define ISCONTINUATION(bytes) (\



|
|
|
|

|
|
|
<
<
>
|

|
|

|
|
|
|


<
|













<








|

|

|

|


|
|

|
|


|
|


|
|







1
2
3
4
5
6
7
8
9
10
11


12
13
14
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
/*
 * tclStringObj.c --
 *
 *      This file contains functions that implement string operations on Tcl
 *      objects. Some string operations work with UTF-8 encoding forms.
 *      Functions that require knowledge of the width of each character,
 * 	such as indexing, operate on fixed width encoding forms such as UTF-32.
 *
 * 	Conceptually, a string is a sequence of Unicode code points. Internally
 * 	it may be stored in an encoding form such as a modified version of
 * 	UTF-8 or UTF-16 (when TCL_UTF_MAX=3) or UTF-32.


 *
 *	The String object is optimized for the case where each UTF char
 *	in a string is only one byte. In this case, we store the value of
 *	numChars, but we don't store the fixed form encoding (unless
 * 	Tcl_GetUnicode is explicitly called).
 *
 *      The String object type stores one or both formats. The default
 *      behavior is to store UTF-8. Once UTF-16/UTF32 is calculated, it is
 *      stored in the internal rep for future access (without an additional
 *      O(n) cost).
 *
 *	To allow many appends to be done to an object without constantly

 *	reallocating space, we allocate double the space and use the
 *	internal representation to keep track of how much space is used vs.
 *	allocated.
 *
 * 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"
#include "tclStringRep.h"

#include "assert.h"
/*
 * Prototypes for functions defined later in this file:
 */

static void		AppendPrintfToObjVA(Tcl_Obj *objPtr,
			    const char *format, va_list argList);
static void		AppendUnicodeToUnicodeRep(Tcl_Obj *objPtr,
			    const Tcl_UniChar *unicode, Tcl_Size appendNumChars);
static void		AppendUnicodeToUtfRep(Tcl_Obj *objPtr,
			    const Tcl_UniChar *unicode, Tcl_Size numChars);
static void		AppendUtfToUnicodeRep(Tcl_Obj *objPtr,
			    const char *bytes, Tcl_Size numBytes);
static void		AppendUtfToUtfRep(Tcl_Obj *objPtr,
			    const char *bytes, Tcl_Size numBytes);
static void		DupStringInternalRep(Tcl_Obj *objPtr,
			    Tcl_Obj *copyPtr);
static Tcl_Size		ExtendStringRepWithUnicode(Tcl_Obj *objPtr,
			    const Tcl_UniChar *unicode, Tcl_Size numChars);
static void		ExtendUnicodeRepWithString(Tcl_Obj *objPtr,
			    const char *bytes, Tcl_Size numBytes,
			    Tcl_Size numAppendChars);
static void		FillUnicodeRep(Tcl_Obj *objPtr);
static void		FreeStringInternalRep(Tcl_Obj *objPtr);
static void		GrowStringBuffer(Tcl_Obj *objPtr, Tcl_Size needed, int flag);
static void		GrowUnicodeBuffer(Tcl_Obj *objPtr, Tcl_Size needed);
static int		SetStringFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void		SetUnicodeObj(Tcl_Obj *objPtr,
			    const Tcl_UniChar *unicode, Tcl_Size numChars);
static Tcl_Size		UnicodeLength(const Tcl_UniChar *unicode);
static void		UpdateStringOfString(Tcl_Obj *objPtr);

#if TCL_UTF_MAX > 3
#define ISCONTINUATION(bytes) (\
	((bytes)[0] & 0xC0) == 0x80)
#else
#define ISCONTINUATION(bytes) (\
86
87
88
89
90
91
92
93

94
95
96
97
98
99
100
 */

const Tcl_ObjType tclStringType = {
    "string",			/* name */
    FreeStringInternalRep,	/* freeIntRepPro */
    DupStringInternalRep,	/* dupIntRepProc */
    UpdateStringOfString,	/* updateStringProc */
    SetStringFromAny		/* setFromAnyProc */

};

/*
 * TCL STRING GROWTH ALGORITHM
 *
 * When growing strings (during an append, for example), the following growth
 * algorithm is used:







|
>







83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
 */

const Tcl_ObjType tclStringType = {
    "string",			/* name */
    FreeStringInternalRep,	/* freeIntRepPro */
    DupStringInternalRep,	/* dupIntRepProc */
    UpdateStringOfString,	/* updateStringProc */
    SetStringFromAny,		/* setFromAnyProc */
    TCL_OBJTYPE_V0
};

/*
 * TCL STRING GROWTH ALGORITHM
 *
 * When growing strings (during an append, for example), the following growth
 * algorithm is used:
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
#ifndef TCL_MIN_UNICHAR_GROWTH
#define TCL_MIN_UNICHAR_GROWTH	TCL_MIN_GROWTH/sizeof(Tcl_UniChar)
#endif

static void
GrowStringBuffer(
    Tcl_Obj *objPtr,
    size_t needed,
    int flag)
{
    /*
     * Pre-conditions:
     *	objPtr->typePtr == &tclStringType
     *	needed > stringPtr->allocated
     *	flag || objPtr->bytes != NULL
     */

    String *stringPtr = GET_STRING(objPtr);
    char *ptr = NULL;

    size_t attempt;



    if (objPtr->bytes == &tclEmptyString) {
	objPtr->bytes = NULL;
    }
    if (flag == 0 || stringPtr->allocated > 0) {
	attempt = 2 * needed;
	ptr = (char *)Tcl_AttemptRealloc(objPtr->bytes, attempt + 1U);
	if (ptr == NULL) {
	    /*
	     * Take care computing the amount of modest growth to avoid
	     * overflow into invalid argument values for attempt.


	     */

	    size_t limit = INT_MAX - needed;
	    size_t extra = needed - objPtr->length + TCL_MIN_GROWTH;
	    size_t growth = (extra > limit) ? limit : extra;

	    attempt = needed + growth;

	    ptr = (char *)Tcl_AttemptRealloc(objPtr->bytes, attempt + 1U);
	}
    }
    if (ptr == NULL) {
	/*
	 * First allocation - just big enough; or last chance fallback.
	 */

	attempt = needed;
	ptr = (char *)Tcl_Realloc(objPtr->bytes, attempt + 1U);
    }
    objPtr->bytes = ptr;
    stringPtr->allocated = attempt;
}

static void
GrowUnicodeBuffer(
    Tcl_Obj *objPtr,
    size_t needed)
{
    /*
     * Pre-conditions:
     *	objPtr->typePtr == &tclStringType
     *	needed > stringPtr->maxChars
     */

    String *ptr = NULL, *stringPtr = GET_STRING(objPtr);

    size_t attempt;





    if (stringPtr->maxChars > 0) {
	/*
	 * Subsequent appends - apply the growth algorithm.
	 */

	attempt = 2 * needed;
	ptr = stringAttemptRealloc(stringPtr, attempt);
	if (ptr == NULL) {
	    /*
	     * Take care computing the amount of modest growth to avoid
	     * overflow into invalid argument values for attempt.
	     */

	    size_t extra = needed - stringPtr->numChars
		    + TCL_MIN_UNICHAR_GROWTH;

	    attempt = needed + extra;
	    ptr = stringAttemptRealloc(stringPtr, attempt);
	}
    }
    if (ptr == NULL) {

	/*
	 * First allocation - just big enough; or last chance fallback.

	 */

	attempt = needed;
	ptr = stringRealloc(stringPtr, attempt);
    }
    stringPtr = ptr;
    stringPtr->maxChars = attempt;
    SET_STRING(objPtr, stringPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_NewStringObj --







|
|


|






|
>
|
>
>




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

|





|


|




|
>
|
>
>
>
>
|

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

|
>

|
|
<

<
|







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
#ifndef TCL_MIN_UNICHAR_GROWTH
#define TCL_MIN_UNICHAR_GROWTH	TCL_MIN_GROWTH/sizeof(Tcl_UniChar)
#endif

static void
GrowStringBuffer(
    Tcl_Obj *objPtr,
    Tcl_Size needed, /* Not including terminating nul */
    int flag)      /* If 0, try to overallocate */
{
    /*
     * Preconditions:
     *	objPtr->typePtr == &tclStringType
     *	needed > stringPtr->allocated
     *	flag || objPtr->bytes != NULL
     */

    String *stringPtr = GET_STRING(objPtr);
    char *ptr;
    Tcl_Size capacity;

    assert(needed <= TCL_SIZE_MAX - 1);
    needed += 1; /* Include terminating nul */

    if (objPtr->bytes == &tclEmptyString) {
	objPtr->bytes = NULL;
    }




    /*


     * In code below, note 'capacity' and 'needed' include terminating nul,
     * while stringPtr->allocated does not.
     */
    if (flag == 0 || stringPtr->allocated > 0) {
	ptr = (char *)TclReallocEx(objPtr->bytes, needed, &capacity);


    } else {

	/* Allocate exact size */
	ptr = (char *)Tcl_Realloc(objPtr->bytes, needed);


	capacity = needed;



    }



    objPtr->bytes = ptr;
    stringPtr->allocated = capacity - 1; /* Does not include slot for end nul */
}

static void
GrowUnicodeBuffer(
    Tcl_Obj *objPtr,
    Tcl_Size needed)
{
    /*
     * Preconditions:
     *	objPtr->typePtr == &tclStringType
     *	needed > stringPtr->maxChars
     */

    String *stringPtr = GET_STRING(objPtr);
    Tcl_Size maxChars;

    /* Note STRING_MAXCHARS already takes into account space for nul */
    if (needed > STRING_MAXCHARS) {
	Tcl_Panic("max size for a Tcl unicode rep (%" TCL_Z_MODIFIER "d bytes) exceeded",
		  STRING_MAXCHARS);
    }
    if (stringPtr->maxChars > 0) {



	/* Expansion - try allocating extra space */

	stringPtr = (String *)TclReallocElemsEx(stringPtr,

						needed + 1, /* +1 for nul */
						sizeof(Tcl_UniChar),


						offsetof(String, unicode),
						&maxChars);

	maxChars -= 1; /* End nul not included */


    }


    else {
	/*
	 * First allocation - just big enough. Note needed does
	 * not include terminating nul but STRING_SIZE does
	 */
	stringPtr = (String *)Tcl_Realloc(stringPtr, STRING_SIZE(needed));
	maxChars = needed;

    }

    stringPtr->maxChars = maxChars;
    SET_STRING(objPtr, stringPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_NewStringObj --
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

#ifdef TCL_MEM_DEBUG
#undef Tcl_NewStringObj
Tcl_Obj *
Tcl_NewStringObj(
    const char *bytes,		/* Points to the first of the length bytes
				 * used to initialize the new object. */
    size_t length)			/* The number of bytes to copy from "bytes"
				 * when initializing the new object. If
				 * TCL_INDEX_NONE, use bytes up to the first NUL
				 * byte. */
{
    return Tcl_DbNewStringObj(bytes, length, "unknown", 0);
}
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
Tcl_NewStringObj(
    const char *bytes,		/* Points to the first of the length bytes
				 * used to initialize the new object. */
    size_t length)		/* The number of bytes to copy from "bytes"
				 * when initializing the new object. If -1,
				 * use bytes up to the first NUL byte. */
{
    Tcl_Obj *objPtr;

    if (length == TCL_INDEX_NONE) {
	length = (bytes? strlen(bytes) : 0);
    }
    TclNewStringObj(objPtr, bytes, length);
    return objPtr;
}
#endif /* TCL_MEM_DEBUG */








|











|





|







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

#ifdef TCL_MEM_DEBUG
#undef Tcl_NewStringObj
Tcl_Obj *
Tcl_NewStringObj(
    const char *bytes,		/* Points to the first of the length bytes
				 * used to initialize the new object. */
    Tcl_Size length)		/* The number of bytes to copy from "bytes"
				 * when initializing the new object. If
				 * TCL_INDEX_NONE, use bytes up to the first NUL
				 * byte. */
{
    return Tcl_DbNewStringObj(bytes, length, "unknown", 0);
}
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
Tcl_NewStringObj(
    const char *bytes,		/* Points to the first of the length bytes
				 * used to initialize the new object. */
    Tcl_Size length)		/* The number of bytes to copy from "bytes"
				 * when initializing the new object. If -1,
				 * use bytes up to the first NUL byte. */
{
    Tcl_Obj *objPtr;

    if (length < 0) {
	length = (bytes? strlen(bytes) : 0);
    }
    TclNewStringObj(objPtr, bytes, length);
    return objPtr;
}
#endif /* TCL_MEM_DEBUG */

313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
 */

#ifdef TCL_MEM_DEBUG
Tcl_Obj *
Tcl_DbNewStringObj(
    const char *bytes,		/* Points to the first of the length bytes
				 * used to initialize the new object. */
    size_t length,		/* The number of bytes to copy from "bytes"
				 * when initializing the new object. If -1,
				 * use bytes up to the first NUL byte. */
    const char *file,		/* The name of the source file calling this
				 * function; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{







|







294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
 */

#ifdef TCL_MEM_DEBUG
Tcl_Obj *
Tcl_DbNewStringObj(
    const char *bytes,		/* Points to the first of the length bytes
				 * used to initialize the new object. */
    Tcl_Size length,		/* The number of bytes to copy from "bytes"
				 * when initializing the new object. If -1,
				 * use bytes up to the first NUL byte. */
    const char *file,		/* The name of the source file calling this
				 * function; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
    return objPtr;
}
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
Tcl_DbNewStringObj(
    const char *bytes,		/* Points to the first of the length bytes
				 * used to initialize the new object. */
    size_t length,		/* The number of bytes to copy from "bytes"
				 * when initializing the new object. If -1,
				 * use bytes up to the first NUL byte. */
    TCL_UNUSED(const char *) /*file*/,
    TCL_UNUSED(int) /*line*/)
{
    return Tcl_NewStringObj(bytes, length);
}







|







316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
    return objPtr;
}
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
Tcl_DbNewStringObj(
    const char *bytes,		/* Points to the first of the length bytes
				 * used to initialize the new object. */
    Tcl_Size length,		/* The number of bytes to copy from "bytes"
				 * when initializing the new object. If -1,
				 * use bytes up to the first NUL byte. */
    TCL_UNUSED(const char *) /*file*/,
    TCL_UNUSED(int) /*line*/)
{
    return Tcl_NewStringObj(bytes, length);
}
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
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_NewUnicodeObj(
    const Tcl_UniChar *unicode,	/* The unicode string used to initialize the
				 * new object. */
    size_t numChars)		/* Number of characters in the unicode
				 * string. */
{
    Tcl_Obj *objPtr;

    TclNewObj(objPtr);
    SetUnicodeObj(objPtr, unicode, numChars);
    return objPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetCharLength --
 *
 *	Get the length of the Unicode string from the Tcl object.
 *
 * Results:
 *	Pointer to unicode string representing the unicode object.
 *
 * Side effects:
 *	Frees old internal rep. Allocates memory for new "String" internal
 *	rep.
 *
 *----------------------------------------------------------------------
 */

size_t
Tcl_GetCharLength(
    Tcl_Obj *objPtr)		/* The String object to get the num chars
				 * of. */
{
    String *stringPtr;
    size_t numChars = 0;

    /*
     * Quick, no-shimmer return for short string reps.
     */

    if ((objPtr->bytes) && (objPtr->length < 2)) {
	/* 0 bytes -> 0 chars; 1 byte -> 1 char */







|

















|








|





|







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

Tcl_Obj *
Tcl_NewUnicodeObj(
    const Tcl_UniChar *unicode,	/* The unicode string used to initialize the
				 * new object. */
    Tcl_Size numChars)		/* Number of characters in the unicode
				 * string. */
{
    Tcl_Obj *objPtr;

    TclNewObj(objPtr);
    SetUnicodeObj(objPtr, unicode, numChars);
    return objPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetCharLength --
 *
 *	Get the length of the Unicode string from the Tcl object.
 *
 * Results:
 *	Pointer to Unicode string representing the Unicode object.
 *
 * Side effects:
 *	Frees old internal rep. Allocates memory for new "String" internal
 *	rep.
 *
 *----------------------------------------------------------------------
 */

Tcl_Size
Tcl_GetCharLength(
    Tcl_Obj *objPtr)		/* The String object to get the num chars
				 * of. */
{
    String *stringPtr;
    Tcl_Size numChars = 0;

    /*
     * Quick, no-shimmer return for short string reps.
     */

    if ((objPtr->bytes) && (objPtr->length < 2)) {
	/* 0 bytes -> 0 chars; 1 byte -> 1 char */
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
    stringPtr = GET_STRING(objPtr);
    numChars = stringPtr->numChars;

    /*
     * If numChars is unknown, compute it.
     */

    if (numChars == TCL_INDEX_NONE) {
	TclNumUtfCharsM(numChars, objPtr->bytes, objPtr->length);
	stringPtr->numChars = numChars;
    }
    return numChars;
}

size_t
TclGetCharLength(
    Tcl_Obj *objPtr)		/* The String object to get the num chars
				 * of. */
{
    size_t numChars = 0;

    /*
     * Quick, no-shimmer return for short string reps.
     */

    if ((objPtr->bytes) && (objPtr->length < 2)) {
	/* 0 bytes -> 0 chars; 1 byte -> 1 char */







|






|




|







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
    stringPtr = GET_STRING(objPtr);
    numChars = stringPtr->numChars;

    /*
     * If numChars is unknown, compute it.
     */

    if (numChars < 0) {
	TclNumUtfCharsM(numChars, objPtr->bytes, objPtr->length);
	stringPtr->numChars = numChars;
    }
    return numChars;
}

Tcl_Size
TclGetCharLength(
    Tcl_Obj *objPtr)		/* The String object to get the num chars
				 * of. */
{
    Tcl_Size numChars = 0;

    /*
     * Quick, no-shimmer return for short string reps.
     */

    if ((objPtr->bytes) && (objPtr->length < 2)) {
	/* 0 bytes -> 0 chars; 1 byte -> 1 char */
505
506
507
508
509
510
511
512
513
514
515
516





517
518
519
520
521
522
523
 *
 *----------------------------------------------------------------------
 */
int
TclCheckEmptyString(
    Tcl_Obj *objPtr)
{
    size_t length = TCL_INDEX_NONE;

    if (objPtr->bytes == &tclEmptyString) {
	return TCL_EMPTYSTRING_YES;
    }






    if (TclListObjIsCanonical(objPtr)) {
	TclListObjLengthM(NULL, objPtr, &length);
	return length == 0;
    }

    if (TclIsPureDict(objPtr)) {







|




>
>
>
>
>







486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
 *
 *----------------------------------------------------------------------
 */
int
TclCheckEmptyString(
    Tcl_Obj *objPtr)
{
    Tcl_Size length = TCL_INDEX_NONE;

    if (objPtr->bytes == &tclEmptyString) {
	return TCL_EMPTYSTRING_YES;
    }

    if (TclIsPureByteArray(objPtr)
	&& Tcl_GetCharLength(objPtr) == 0) {
	return TCL_EMPTYSTRING_YES;
    }

    if (TclListObjIsCanonical(objPtr)) {
	TclListObjLengthM(NULL, objPtr, &length);
	return length == 0;
    }

    if (TclIsPureDict(objPtr)) {
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
 *----------------------------------------------------------------------
 */

int
Tcl_GetUniChar(
    Tcl_Obj *objPtr,		/* The object to get the Unicode charater
				 * from. */
    size_t index)		/* Get the index'th Unicode character. */
{
    String *stringPtr;
    int ch;





    /*
     * Optimize the case where we're really dealing with a bytearray object
     * we don't need to convert to a string to perform the indexing operation.
     */

    if (TclIsPureByteArray(objPtr)) {
	size_t length = 0;
	unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length);
	if (index >= length) {
		return -1;
	}

	return bytes[index];
    }







|




>
>
>
>

|




|







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

int
Tcl_GetUniChar(
    Tcl_Obj *objPtr,		/* The object to get the Unicode charater
				 * from. */
    Tcl_Size index)		/* Get the index'th Unicode character. */
{
    String *stringPtr;
    int ch;

    if (index < 0) {
	return -1;
    }

    /*
     * 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)) {
	Tcl_Size length = 0;
	unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length);
	if (index >= length) {
		return -1;
	}

	return bytes[index];
    }
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
    }
#endif
    return ch;
}

int
TclGetUniChar(
    Tcl_Obj *objPtr,		/* The object to get the Unicode charater
				 * from. */
    size_t index)		/* Get the index'th Unicode character. */
{
    int ch = 0;





    /*
     * Optimize the case where we're really dealing with a bytearray object
     * we don't need to convert to a string to perform the indexing operation.
     */

    if (TclIsPureByteArray(objPtr)) {
	size_t length = 0;
	unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length);
	if (index >= length) {
		return -1;
	}

	return bytes[index];
    }

    size_t numChars = TclNumUtfChars(objPtr->bytes, objPtr->length);

    if (index >= numChars) {
	return -1;
    }
    const char *begin = TclUtfAtIndex(objPtr->bytes, index);
#undef Tcl_UtfToUniChar
    Tcl_UtfToUniChar(begin, &ch);







|

|



>
>
>
>

|
|



|








|







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
    }
#endif
    return ch;
}

int
TclGetUniChar(
    Tcl_Obj *objPtr,		/* The object to get the Unicode character
				 * from. */
    Tcl_Size index)		/* Get the index'th Unicode character. */
{
    int ch = 0;

    if (index < 0) {
	return -1;
    }

    /*
	 * Optimize the ByteArray case:  N need need to convert to a string to
	 * perform the indexing operation.
     */

    if (TclIsPureByteArray(objPtr)) {
	Tcl_Size length = 0;
	unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length);
	if (index >= length) {
		return -1;
	}

	return bytes[index];
    }

    Tcl_Size numChars = TclNumUtfChars(objPtr->bytes, objPtr->length);

    if (index >= numChars) {
	return -1;
    }
    const char *begin = TclUtfAtIndex(objPtr->bytes, index);
#undef Tcl_UtfToUniChar
    Tcl_UtfToUniChar(begin, &ch);
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
 * 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) {
	if (stringPtr->numChars > INT_MAX) {
	    Tcl_Panic("Tcl_GetUnicodeFromObj with 'int' lengthPtr"
		    "cannot handle such long strings. Please use 'size_t'");
	}
	*lengthPtr = (int)stringPtr->numChars;
    }
    return stringPtr->unicode;
}


Tcl_UniChar *
Tcl_GetUnicodeFromObj(
    Tcl_Obj *objPtr,		/* The object to find the unicode string
				 * for. */
    size_t *lengthPtr)		/* If non-NULL, the location where the string
				 * rep's unichar length should be stored. If
				 * NULL, no length is stored. */
{
    String *stringPtr;

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);







>


|

|
|















|

|



>





|







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
 * Side effects:
 *	Converts the object to have the String internal rep.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_GetUnicodeFromObj
#if !defined(TCL_NO_DEPRECATED)
Tcl_UniChar *
TclGetUnicodeFromObj(
    Tcl_Obj *objPtr,		/* The object to find the Unicode string
				 * for. */
    void *lengthPtr)		/* If non-NULL, the location where the string
				 * rep's Tcl_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) {
	if (stringPtr->numChars > INT_MAX) {
	    Tcl_Panic("Tcl_GetUnicodeFromObj with 'int' lengthPtr"
		    " cannot handle such long strings. Please use 'Tcl_Size'");
	}
	*(int *)lengthPtr = (int)stringPtr->numChars;
    }
    return stringPtr->unicode;
}
#endif /* !defined(TCL_NO_DEPRECATED) */

Tcl_UniChar *
Tcl_GetUnicodeFromObj(
    Tcl_Obj *objPtr,		/* The object to find the unicode string
				 * for. */
    Tcl_Size *lengthPtr)	/* If non-NULL, the location where the string
				 * rep's unichar length should be stored. If
				 * NULL, no length is stored. */
{
    String *stringPtr;

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);
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
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_GetRange(
    Tcl_Obj *objPtr,		/* The Tcl object to find the range of. */
    size_t first,			/* First index of the range. */
    size_t last)			/* Last index of the range. */
{
    Tcl_Obj *newObjPtr;		/* The Tcl object to find the range of. */
    String *stringPtr;
    size_t length = 0;

    if (first == TCL_INDEX_NONE) {
	first = TCL_INDEX_START;
    }

    /*
     * Optimize the case where we're really dealing with a bytearray object
     * we don't need to convert to a string to perform the substring operation.
     */

    if (TclIsPureByteArray(objPtr)) {
	unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length);

	if (last >= length) {
	    last = length - 1;
	}
	if (last + 1 < first + 1) {
	    TclNewObj(newObjPtr);
	    return newObjPtr;
	}
	return Tcl_NewByteArrayObj(bytes + first, last - first + 1);
    }

    /*







|
|



|

|
|










|


|







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

Tcl_Obj *
Tcl_GetRange(
    Tcl_Obj *objPtr,		/* The Tcl object to find the range of. */
    Tcl_Size first,			/* First index of the range. */
    Tcl_Size last)			/* Last index of the range. */
{
    Tcl_Obj *newObjPtr;		/* The Tcl object to find the range of. */
    String *stringPtr;
    Tcl_Size length = 0;

    if (first < 0) {
	first = 0;
    }

    /*
     * Optimize the case where we're really dealing with a bytearray object
     * we don't need to convert to a string to perform the substring operation.
     */

    if (TclIsPureByteArray(objPtr)) {
	unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length);

	if (last < 0 || last >= length) {
	    last = length - 1;
	}
	if (last < first) {
	    TclNewObj(newObjPtr);
	    return newObjPtr;
	}
	return Tcl_NewByteArrayObj(bytes + first, last - first + 1);
    }

    /*
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
	 * If numChars is unknown, compute it.
	 */

	if (stringPtr->numChars == TCL_INDEX_NONE) {
	    TclNumUtfCharsM(stringPtr->numChars, objPtr->bytes, objPtr->length);
	}
	if (stringPtr->numChars == objPtr->length) {
	    if (last >= stringPtr->numChars) {
		last = stringPtr->numChars - 1;
	    }
	    if (last + 1 < first + 1) {
		TclNewObj(newObjPtr);
		return newObjPtr;
	    }
	    newObjPtr = Tcl_NewStringObj(objPtr->bytes + first, last - first + 1);

	    /*
	     * Since we know the char length of the result, store it.
	     */

	    SetStringFromAny(NULL, newObjPtr);
	    stringPtr = GET_STRING(newObjPtr);
	    stringPtr->numChars = newObjPtr->length;
	    return newObjPtr;
	}
	FillUnicodeRep(objPtr);
	stringPtr = GET_STRING(objPtr);
    }
    if (last >= stringPtr->numChars) {
	last = stringPtr->numChars - 1;
    }
    if (last + 1 < first + 1) {
	TclNewObj(newObjPtr);
	return newObjPtr;
    }
#if TCL_UTF_MAX < 4
    /* See: bug [11ae2be95dac9417] */
    if ((first + 1 > 1) && ((stringPtr->unicode[first] & 0xFC00) == 0xDC00)
	    && ((stringPtr->unicode[first-1] & 0xFC00) == 0xD800)) {
	++first;
    }
    if ((last + 2 < stringPtr->numChars + 1)
	    && ((stringPtr->unicode[last+1] & 0xFC00) == 0xDC00)
	    && ((stringPtr->unicode[last] & 0xFC00) == 0xD800)) {
	++last;
    }
#endif
    return Tcl_NewUnicodeObj(stringPtr->unicode + first, last - first + 1);
}

Tcl_Obj *
TclGetRange(
    Tcl_Obj *objPtr,		/* The Tcl object to find the range of. */
    size_t first,			/* First index of the range. */
    size_t last)			/* Last index of the range. */
{
    Tcl_Obj *newObjPtr;		/* The Tcl object to find the range of. */
    size_t length = 0;

    if (first == TCL_INDEX_NONE) {
	first = TCL_INDEX_START;
    }

    /*
     * Optimize the case where we're really dealing with a bytearray object
     * we don't need to convert to a string to perform the substring operation.
     */

    if (TclIsPureByteArray(objPtr)) {
	unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length);

	if (last >= length) {
	    last = length - 1;
	}
	if (last + 1 < first + 1) {
	    TclNewObj(newObjPtr);
	    return newObjPtr;
	}
	return Tcl_NewByteArrayObj(bytes + first, last - first + 1);
    }

    size_t numChars = TclNumUtfChars(objPtr->bytes, objPtr->length);

    if (last >= numChars) {
	last = numChars - 1;
    }
    if (last + 1 < first + 1) {
	TclNewObj(newObjPtr);
	return newObjPtr;
    }
    const char *begin = TclUtfAtIndex(objPtr->bytes, first);
    const char *end = TclUtfAtIndex(objPtr->bytes, last + 1);
    return Tcl_NewStringObj(begin, end - begin);
}







|


|

















|


|





|



|











|
|


|

|











|


|






|

|


|







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
	 * If numChars is unknown, compute it.
	 */

	if (stringPtr->numChars == TCL_INDEX_NONE) {
	    TclNumUtfCharsM(stringPtr->numChars, objPtr->bytes, objPtr->length);
	}
	if (stringPtr->numChars == objPtr->length) {
	    if (last < 0 || last >= stringPtr->numChars) {
		last = stringPtr->numChars - 1;
	    }
	    if (last < first) {
		TclNewObj(newObjPtr);
		return newObjPtr;
	    }
	    newObjPtr = Tcl_NewStringObj(objPtr->bytes + first, last - first + 1);

	    /*
	     * Since we know the char length of the result, store it.
	     */

	    SetStringFromAny(NULL, newObjPtr);
	    stringPtr = GET_STRING(newObjPtr);
	    stringPtr->numChars = newObjPtr->length;
	    return newObjPtr;
	}
	FillUnicodeRep(objPtr);
	stringPtr = GET_STRING(objPtr);
    }
    if (last < 0 || last >= stringPtr->numChars) {
	last = stringPtr->numChars - 1;
    }
    if (last < first) {
	TclNewObj(newObjPtr);
	return newObjPtr;
    }
#if TCL_UTF_MAX < 4
    /* See: bug [11ae2be95dac9417] */
    if ((first > 0) && ((stringPtr->unicode[first] & 0xFC00) == 0xDC00)
	    && ((stringPtr->unicode[first-1] & 0xFC00) == 0xD800)) {
	++first;
    }
    if ((last + 1 < stringPtr->numChars)
	    && ((stringPtr->unicode[last+1] & 0xFC00) == 0xDC00)
	    && ((stringPtr->unicode[last] & 0xFC00) == 0xD800)) {
	++last;
    }
#endif
    return Tcl_NewUnicodeObj(stringPtr->unicode + first, last - first + 1);
}

Tcl_Obj *
TclGetRange(
    Tcl_Obj *objPtr,		/* The Tcl object to find the range of. */
    Tcl_Size first,		/* First index of the range. */
    Tcl_Size last)		/* Last index of the range. */
{
    Tcl_Obj *newObjPtr;		/* The Tcl object to find the range of. */
    Tcl_Size length = 0;

    if (first < 0) {
	first = TCL_INDEX_START;
    }

    /*
     * Optimize the case where we're really dealing with a bytearray object
     * we don't need to convert to a string to perform the substring operation.
     */

    if (TclIsPureByteArray(objPtr)) {
	unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length);

	if (last < 0 || last >= length) {
	    last = length - 1;
	}
	if (last < first) {
	    TclNewObj(newObjPtr);
	    return newObjPtr;
	}
	return Tcl_NewByteArrayObj(bytes + first, last - first + 1);
    }

    Tcl_Size numChars = TclNumUtfChars(objPtr->bytes, objPtr->length);

    if (last < 0 || last >= numChars) {
	last = numChars - 1;
    }
    if (last < first) {
	TclNewObj(newObjPtr);
	return newObjPtr;
    }
    const char *begin = TclUtfAtIndex(objPtr->bytes, first);
    const char *end = TclUtfAtIndex(objPtr->bytes, last + 1);
    return Tcl_NewStringObj(begin, end - begin);
}
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
 */

void
Tcl_SetStringObj(
    Tcl_Obj *objPtr,		/* Object whose internal rep to init. */
    const char *bytes,		/* Points to the first of the length bytes
				 * used to initialize the object. */
    size_t length)		/* The number of bytes to copy from "bytes"
				 * when initializing the object. If -1,
				 * use bytes up to the first NUL byte.*/
{
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetStringObj");
    }








|







898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
 */

void
Tcl_SetStringObj(
    Tcl_Obj *objPtr,		/* Object whose internal rep to init. */
    const char *bytes,		/* Points to the first of the length bytes
				 * used to initialize the object. */
    Tcl_Size length)		/* The number of bytes to copy from "bytes"
				 * when initializing the object. If -1,
				 * use bytes up to the first NUL byte.*/
{
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetStringObj");
    }

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
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetObjLength --
 *
 *	This function changes the length of the string representation of an
 *	object.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	If the size of objPtr's string representation is greater than length,
 *	then it is reduced to length and a new terminating null byte is stored
 *	in the strength. If the length of the string representation is greater
 *	than length, the storage space is reallocated to the given length; a
 *	null byte is stored at the end, but other bytes past the end of the
 *	original string representation are undefined. The object's internal

 *	representation is changed to "expendable string".
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetObjLength(
    Tcl_Obj *objPtr,		/* Pointer to object. This object must not
				 * currently be shared. */
    size_t length)		/* Number of bytes desired for string
				 * representation of object, not including
				 * terminating null byte. */
{
    String *stringPtr;





    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetObjLength");
    }

    if (objPtr->bytes && objPtr->length == length) {
	return;
    }







|
<





|
|
|
|
|
<
>
|








|





>
>
>
>







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
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetObjLength --
 *
 *	Changes the length of the string representation of objPtr.

 *
 * Results:
 *	None.
 *
 * Side effects:
 *	If the size of objPtr's string representation is greater than length, a
 *	new terminating null byte is stored in objPtr->bytes at length, and
 *	bytes at positions past length have no meaning.  If the length of the
 *	string representation is greater than length, the storage space is
 *	reallocated to length+1.

 *
 *	The object's internal representation is changed to &tclStringType.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetObjLength(
    Tcl_Obj *objPtr,		/* Pointer to object. This object must not
				 * currently be shared. */
    Tcl_Size length)		/* Number of bytes desired for string
				 * representation of object, not including
				 * terminating null byte. */
{
    String *stringPtr;

    if (length < 0) {
	Tcl_Panic("Tcl_SetObjLength: length requested is negative: "
		"%" TCL_SIZE_MODIFIER "d (integer overflow?)", length);
    }
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetObjLength");
    }

    if (objPtr->bytes && objPtr->length == length) {
	return;
    }
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
	    stringPtr->allocated = length;
	}

	objPtr->length = length;
	objPtr->bytes[length] = 0;

	/*
	 * Invalidate the unicode data.
	 */

	stringPtr->numChars = TCL_INDEX_NONE;
	stringPtr->hasUnicode = 0;
    } else {
	if (length > stringPtr->maxChars) {
	    stringPtr = stringRealloc(stringPtr, length);
	    SET_STRING(objPtr, stringPtr);
	    stringPtr->maxChars = length;
	}

	/*
	 * Mark the new end of the unicode string
	 */

	stringPtr->numChars = length;
	stringPtr->unicode[length] = 0;
	stringPtr->hasUnicode = 1;

	/*







|












|







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
	    stringPtr->allocated = length;
	}

	objPtr->length = length;
	objPtr->bytes[length] = 0;

	/*
	 * Invalidate the Unicode data.
	 */

	stringPtr->numChars = TCL_INDEX_NONE;
	stringPtr->hasUnicode = 0;
    } else {
	if (length > stringPtr->maxChars) {
	    stringPtr = stringRealloc(stringPtr, length);
	    SET_STRING(objPtr, stringPtr);
	    stringPtr->maxChars = length;
	}

	/*
	 * Mark the new end of the Unicode string
	 */

	stringPtr->numChars = length;
	stringPtr->unicode[length] = 0;
	stringPtr->hasUnicode = 1;

	/*
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057





1058
1059
1060
1061
1062
1063
1064
 *----------------------------------------------------------------------
 */

int
Tcl_AttemptSetObjLength(
    Tcl_Obj *objPtr,		/* Pointer to object. This object must not
				 * currently be shared. */
    size_t length)		/* Number of bytes desired for string
				 * representation of object, not including
				 * terminating null byte. */
{
    String *stringPtr;






    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_AttemptSetObjLength");
    }
    if (objPtr->bytes && objPtr->length == length) {
	return 1;
    }







|




>
>
>
>
>







1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
 *----------------------------------------------------------------------
 */

int
Tcl_AttemptSetObjLength(
    Tcl_Obj *objPtr,		/* Pointer to object. This object must not
				 * currently be shared. */
    Tcl_Size length)		/* Number of bytes desired for string
				 * representation of object, not including
				 * terminating null byte. */
{
    String *stringPtr;

    if (length < 0) {
	/* Negative lengths => most likely integer overflow */
	return 0;
    }

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_AttemptSetObjLength");
    }
    if (objPtr->bytes && objPtr->length == length) {
	return 1;
    }
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
	    /*
	     * Need to enlarge the buffer.
	     */

	    char *newBytes;

	    if (objPtr->bytes == &tclEmptyString) {
		newBytes = (char *)Tcl_AttemptAlloc(length + 1);
	    } else {
		newBytes = (char *)Tcl_AttemptRealloc(objPtr->bytes, length + 1);
	    }
	    if (newBytes == NULL) {
		return 0;
	    }
	    objPtr->bytes = newBytes;
	    stringPtr->allocated = length;
	}

	objPtr->length = length;
	objPtr->bytes[length] = 0;

	/*
	 * Invalidate the unicode data.
	 */

	stringPtr->numChars = TCL_INDEX_NONE;
	stringPtr->hasUnicode = 0;
    } else {
	/*
	 * Changing length of pure unicode string.
	 */

	if (length > stringPtr->maxChars) {
	    stringPtr = stringAttemptRealloc(stringPtr, length);
	    if (stringPtr == NULL) {
		return 0;
	    }
	    SET_STRING(objPtr, stringPtr);
	    stringPtr->maxChars = length;
	}

	/*
	 * Mark the new end of the unicode string.
	 */

	stringPtr->unicode[length] = 0;
	stringPtr->numChars = length;
	stringPtr->hasUnicode = 1;

	/*







|

|












|






|












|







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
	    /*
	     * Need to enlarge the buffer.
	     */

	    char *newBytes;

	    if (objPtr->bytes == &tclEmptyString) {
		newBytes = (char *)Tcl_AttemptAlloc(length + 1U);
	    } else {
		newBytes = (char *)Tcl_AttemptRealloc(objPtr->bytes, length + 1U);
	    }
	    if (newBytes == NULL) {
		return 0;
	    }
	    objPtr->bytes = newBytes;
	    stringPtr->allocated = length;
	}

	objPtr->length = length;
	objPtr->bytes[length] = 0;

	/*
	 * Invalidate the Unicode data.
	 */

	stringPtr->numChars = TCL_INDEX_NONE;
	stringPtr->hasUnicode = 0;
    } else {
	/*
	 * Changing length of pure Unicode string.
	 */

	if (length > stringPtr->maxChars) {
	    stringPtr = stringAttemptRealloc(stringPtr, length);
	    if (stringPtr == NULL) {
		return 0;
	    }
	    SET_STRING(objPtr, stringPtr);
	    stringPtr->maxChars = length;
	}

	/*
	 * Mark the new end of the Unicode string.
	 */

	stringPtr->unicode[length] = 0;
	stringPtr->numChars = length;
	stringPtr->hasUnicode = 1;

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

void
Tcl_SetUnicodeObj(
    Tcl_Obj *objPtr,		/* The object to set the string of. */
    const Tcl_UniChar *unicode,	/* The unicode string used to initialize the
				 * object. */
    size_t numChars)		/* Number of characters in the unicode
				 * string. */
{
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetUnicodeObj");
    }
    TclFreeInternalRep(objPtr);
    SetUnicodeObj(objPtr, unicode, numChars);
}

static size_t
UnicodeLength(
    const Tcl_UniChar *unicode)
{
    size_t numChars = 0;

    if (unicode) {

	while ((numChars != TCL_INDEX_NONE) && (unicode[numChars] != 0)) {
	    numChars++;
	}
    }
    return numChars;
}

static void
SetUnicodeObj(
    Tcl_Obj *objPtr,		/* The object to set the string of. */
    const Tcl_UniChar *unicode,	/* The unicode string used to initialize the
				 * object. */
    size_t numChars)		/* Number of characters in the unicode
				 * string. */
{
    String *stringPtr;

    if (numChars == TCL_INDEX_NONE) {
	numChars = UnicodeLength(unicode);
    }

    /*
     * Allocate enough space for the String structure + Unicode string.
     */








|

|









|



|


>
|









|

|




|







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

void
Tcl_SetUnicodeObj(
    Tcl_Obj *objPtr,		/* The object to set the string of. */
    const Tcl_UniChar *unicode,	/* The Unicode string used to initialize the
				 * object. */
    Tcl_Size numChars)		/* Number of characters in the Unicode
				 * string. */
{
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetUnicodeObj");
    }
    TclFreeInternalRep(objPtr);
    SetUnicodeObj(objPtr, unicode, numChars);
}

static Tcl_Size
UnicodeLength(
    const Tcl_UniChar *unicode)
{
    Tcl_Size numChars = 0;

    if (unicode) {
	/* TODO - is this overflow check really necessary? */
	while ((numChars >= 0) && (unicode[numChars] != 0)) {
	    numChars++;
	}
    }
    return numChars;
}

static void
SetUnicodeObj(
    Tcl_Obj *objPtr,		/* The object to set the string of. */
    const Tcl_UniChar *unicode,	/* The Unicode string used to initialize the
				 * object. */
    Tcl_Size numChars)		/* Number of characters in the Unicode
				 * string. */
{
    String *stringPtr;

    if (numChars < 0) {
	numChars = UnicodeLength(unicode);
    }

    /*
     * Allocate enough space for the String structure + Unicode string.
     */

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

void
Tcl_AppendLimitedToObj(
    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 available to be
				 * appended from "bytes". If -1, then
				 * all bytes up to a NUL byte are available. */
    size_t limit,		/* The maximum number of bytes to append to
				 * the object. */
    const char *ellipsis)	/* Ellipsis marker string, appended to the
				 * object to indicate not all available bytes
				 * at "bytes" were appended. */
{
    String *stringPtr;
    size_t toCopy = 0;
    size_t eLen = 0;

    if (length == TCL_INDEX_NONE) {
	length = (bytes ? strlen(bytes) : 0);
    }
    if (length == 0) {
	return;
    }
    if (limit <= 0) {
	return;







|


|






|
|

|







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

void
Tcl_AppendLimitedToObj(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    const char *bytes,		/* Points to the bytes to append to the
				 * object. */
    Tcl_Size length,		/* The number of bytes available to be
				 * appended from "bytes". If -1, then
				 * all bytes up to a NUL byte are available. */
    Tcl_Size limit,		/* The maximum number of bytes to append to
				 * the object. */
    const char *ellipsis)	/* Ellipsis marker string, appended to the
				 * object to indicate not all available bytes
				 * at "bytes" were appended. */
{
    String *stringPtr;
    Tcl_Size toCopy = 0;
    Tcl_Size eLen = 0;

    if (length < 0) {
	length = (bytes ? strlen(bytes) : 0);
    }
    if (length == 0) {
	return;
    }
    if (limit <= 0) {
	return;
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

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

    stringPtr = GET_STRING(objPtr);
    if (stringPtr->hasUnicode && (stringPtr->numChars+1) > 1) {
	AppendUtfToUnicodeRep(objPtr, ellipsis, eLen);
    } else {
	AppendUtfToUtfRep(objPtr, ellipsis, eLen);
    }
}

/*







|










|







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

    /* If appended string starts with a continuation byte or a lower surrogate,
     * force objPtr to unicode representation. See [7f1162a867] */
    if (bytes && ISCONTINUATION(bytes)) {
	Tcl_GetUnicode(objPtr);
	stringPtr = GET_STRING(objPtr);
    }
    if (stringPtr->hasUnicode && (stringPtr->numChars) > 0) {
	AppendUtfToUnicodeRep(objPtr, bytes, toCopy);
    } else {
	AppendUtfToUtfRep(objPtr, bytes, toCopy);
    }

    if (length <= limit) {
	return;
    }

    stringPtr = GET_STRING(objPtr);
    if (stringPtr->hasUnicode && (stringPtr->numChars) > 0) {
	AppendUtfToUnicodeRep(objPtr, ellipsis, eLen);
    } else {
	AppendUtfToUtfRep(objPtr, ellipsis, eLen);
    }
}

/*
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
 */

void
Tcl_AppendToObj(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    const char *bytes,		/* Points to the bytes to append to the
				 * object. */
    size_t length)		/* The number of bytes to append from "bytes".
				 * If TCL_INDEX_NONE, then append all bytes up to NUL
				 * byte. */
{
    Tcl_AppendLimitedToObj(objPtr, bytes, length, TCL_INDEX_NONE, NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppendUnicodeToObj --
 *
 *	This function appends a Unicode string to an object in the most
 *	efficient manner possible. Length must be >= 0.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Invalidates the string rep and creates a new Unicode string.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_AppendUnicodeToObj(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    const Tcl_UniChar *unicode,	/* The unicode string to append to the
				 * object. */
    size_t length)		/* Number of chars in "unicode". */

{
    String *stringPtr;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_AppendUnicodeToObj");
    }








|



|








|













|

|
>







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

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. */
    Tcl_Size length)		/* The number of bytes to append from "bytes".
				 * If TCL_INDEX_NONE, then append all bytes up to NUL
				 * byte. */
{
    Tcl_AppendLimitedToObj(objPtr, bytes, length, TCL_SIZE_MAX, NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppendUnicodeToObj --
 *
 *	This function appends a Unicode string to an object in the most
 *	efficient manner possible.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Invalidates the string rep and creates a new Unicode string.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_AppendUnicodeToObj(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    const Tcl_UniChar *unicode,	/* The Unicode string to append to the
				 * object. */
    Tcl_Size length)		/* Number of chars in Unicode. Negative
    				 * lengths means nul terminated */
{
    String *stringPtr;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_AppendUnicodeToObj");
    }

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

void
Tcl_AppendObjToObj(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    Tcl_Obj *appendObjPtr)	/* Object to append. */
{
    String *stringPtr;
    size_t length = 0, numChars;
    size_t appendNumChars = TCL_INDEX_NONE;
    const char *bytes;

    /*

     * Special case: second object is standard-empty is fast case. We know
     * that appending nothing to anything leaves that starting anything...
     */

    if (appendObjPtr->bytes == &tclEmptyString) {


	return;
    }





    /*
     * Handle append of one bytearray object to another as a special case.
     * Note that we only do this when the objects are pure so that the
     * bytearray faithfully represent the true value; Otherwise appending the
     * byte arrays together could lose information;
     */

    if ((TclIsPureByteArray(objPtr) || objPtr->bytes == &tclEmptyString)
	    && TclIsPureByteArray(appendObjPtr)) {
	/*
	 * You might expect the code here to be
	 *
	 *  bytes = Tcl_GetByteArrayFromObj(appendObjPtr, &length);
	 *  TclAppendBytesToByteArray(objPtr, bytes, length);
	 *
	 * and essentially all of the time that would be fine. However, it
	 * would run into trouble in the case where objPtr and appendObjPtr
	 * point to the same thing. That may never be a good idea. It seems to
	 * violate Copy On Write, and we don't have any tests for the
	 * situation, since making any Tcl commands that call
	 * Tcl_AppendObjToObj() do that appears impossible (They honor Copy On
	 * Write!). For the sake of extensions that go off into that realm,
	 * though, here's a more complex approach that can handle all the
	 * cases.
	 *
	 * First, get the lengths.
	 */

	size_t lengthSrc = 0;

	(void) Tcl_GetByteArrayFromObj(objPtr, &length);
	(void) Tcl_GetByteArrayFromObj(appendObjPtr, &lengthSrc);

	/*
	 * Grow buffer enough for the append.
	 */







|
|


<
>
|
<
<
|
|
>
>



>
>
>
>
|
|
<
|
<
|

<
<

|

















|







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

void
Tcl_AppendObjToObj(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    Tcl_Obj *appendObjPtr)	/* Object to append. */
{
    String *stringPtr;
    Tcl_Size length = 0, numChars;
    Tcl_Size appendNumChars = TCL_INDEX_NONE;
    const char *bytes;


    if (TclCheckEmptyString(appendObjPtr) == TCL_EMPTYSTRING_YES) {
	return;


    }

    if (TclCheckEmptyString(objPtr) == TCL_EMPTYSTRING_YES) {
	TclSetDuplicateObj(objPtr, appendObjPtr);
	return;
    }

    if (
	TclIsPureByteArray(appendObjPtr)
	&& (TclIsPureByteArray(objPtr) || objPtr->bytes == &tclEmptyString)
    ) {
	/*
	 * Both bytearray objects are pure, so the second internal bytearray value

	 * can be appended to the first, with no need to modify the "bytes" field.

	 */



	/*
	 * One might expect the code here to be
	 *
	 *  bytes = Tcl_GetByteArrayFromObj(appendObjPtr, &length);
	 *  TclAppendBytesToByteArray(objPtr, bytes, length);
	 *
	 * and essentially all of the time that would be fine. However, it
	 * would run into trouble in the case where objPtr and appendObjPtr
	 * point to the same thing. That may never be a good idea. It seems to
	 * violate Copy On Write, and we don't have any tests for the
	 * situation, since making any Tcl commands that call
	 * Tcl_AppendObjToObj() do that appears impossible (They honor Copy On
	 * Write!). For the sake of extensions that go off into that realm,
	 * though, here's a more complex approach that can handle all the
	 * cases.
	 *
	 * First, get the lengths.
	 */

	Tcl_Size lengthSrc = 0;

	(void) Tcl_GetByteArrayFromObj(objPtr, &length);
	(void) Tcl_GetByteArrayFromObj(appendObjPtr, &lengthSrc);

	/*
	 * Grow buffer enough for the append.
	 */
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481

	/*
	 * Now do the append knowing that buffer growth cannot cause any
	 * trouble.
	 */

	TclAppendBytesToByteArray(objPtr,
		Tcl_GetBytesFromObj(NULL, appendObjPtr, (size_t *)NULL), lengthSrc);
	return;
    }

    /*
     * Must append as strings.
     */








|







1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487

	/*
	 * Now do the append knowing that buffer growth cannot cause any
	 * trouble.
	 */

	TclAppendBytesToByteArray(objPtr,
		Tcl_GetByteArrayFromObj(appendObjPtr, (Tcl_Size *) NULL), lengthSrc);
	return;
    }

    /*
     * Must append as strings.
     */

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
     * in both objects before appending, then set the combined number of
     * characters in the final (appended-to) object.
     */

    bytes = Tcl_GetStringFromObj(appendObjPtr, &length);

    numChars = stringPtr->numChars;
    if ((numChars != TCL_INDEX_NONE) && TclHasInternalRep(appendObjPtr, &tclStringType)) {
	String *appendStringPtr = GET_STRING(appendObjPtr);

	appendNumChars = appendStringPtr->numChars;
    }

    AppendUtfToUtfRep(objPtr, bytes, length);

    if ((numChars != TCL_INDEX_NONE) && (appendNumChars != TCL_INDEX_NONE)) {
	stringPtr->numChars = numChars + appendNumChars;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * AppendUnicodeToUnicodeRep --
 *
 *	This function appends the contents of "unicode" to the Unicode rep of
 *	"objPtr". objPtr must already have a valid Unicode rep.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	objPtr's internal rep is reallocated.
 *
 *----------------------------------------------------------------------
 */

static void
AppendUnicodeToUnicodeRep(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    const Tcl_UniChar *unicode,	/* String to append. */
    size_t appendNumChars)		/* Number of chars of "unicode" to append. */
{
    String *stringPtr;
    size_t numChars;

    if (appendNumChars == TCL_INDEX_NONE) {
	appendNumChars = UnicodeLength(unicode);
    }
    if (appendNumChars == 0) {
	return;
    }

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    /*
     * If not enough space has been allocated for the unicode rep, reallocate
     * the internal rep object with additional space. First try to double the
     * required allocation; if that fails, try a more modest increase. See the
     * "TCL STRING GROWTH ALGORITHM" comment at the top of this file for an
     * explanation of this growth algorithm.
     */

    numChars = stringPtr->numChars + appendNumChars;

    if (numChars > stringPtr->maxChars) {
	size_t index = TCL_INDEX_NONE;

	/*
	 * Protect against case where unicode points into the existing
	 * stringPtr->unicode array. Force it to follow any relocations due to
	 * the reallocs below.
	 */

	if (unicode && unicode >= stringPtr->unicode
		&& unicode <= stringPtr->unicode + stringPtr->maxChars) {
	    index = unicode - stringPtr->unicode;
	}

	GrowUnicodeBuffer(objPtr, numChars);
	stringPtr = GET_STRING(objPtr);

	/*
	 * Relocate unicode if needed; see above.
	 */

	if (index != TCL_INDEX_NONE) {
	    unicode = stringPtr->unicode + index;
	}
    }

    /*
     * Copy the new string onto the end of the old string, then add the
     * trailing null.
     */







|







|









|
|














|


|

|










|









|


|






|






|


|
|







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
     * in both objects before appending, then set the combined number of
     * characters in the final (appended-to) object.
     */

    bytes = Tcl_GetStringFromObj(appendObjPtr, &length);

    numChars = stringPtr->numChars;
    if ((numChars >= 0) && TclHasInternalRep(appendObjPtr, &tclStringType)) {
	String *appendStringPtr = GET_STRING(appendObjPtr);

	appendNumChars = appendStringPtr->numChars;
    }

    AppendUtfToUtfRep(objPtr, bytes, length);

    if ((numChars >= 0) && (appendNumChars >= 0)) {
	stringPtr->numChars = numChars + appendNumChars;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * AppendUnicodeToUnicodeRep --
 *
 *	Appends the contents of unicode to the Unicode rep of
 *	objPtr, which must already have a valid Unicode rep.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	objPtr's internal rep is reallocated.
 *
 *----------------------------------------------------------------------
 */

static void
AppendUnicodeToUnicodeRep(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    const Tcl_UniChar *unicode,	/* String to append. */
    Tcl_Size appendNumChars)	/* Number of chars of "unicode" to append. */
{
    String *stringPtr;
    Tcl_Size numChars;

    if (appendNumChars < 0) {
	appendNumChars = UnicodeLength(unicode);
    }
    if (appendNumChars == 0) {
	return;
    }

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    /*
     * If not enough space has been allocated for the Unicode rep, reallocate
     * the internal rep object with additional space. First try to double the
     * required allocation; if that fails, try a more modest increase. See the
     * "TCL STRING GROWTH ALGORITHM" comment at the top of this file for an
     * explanation of this growth algorithm.
     */

    numChars = stringPtr->numChars + appendNumChars;

    if (numChars > stringPtr->maxChars) {
	Tcl_Size offset = -1;

	/*
	 * Protect against case where Unicode points into the existing
	 * stringPtr->unicode array. Force it to follow any relocations due to
	 * the reallocs below.
	 */

	if (unicode && unicode >= stringPtr->unicode
		&& unicode <= stringPtr->unicode + stringPtr->maxChars) {
	    offset = unicode - stringPtr->unicode;
	}

	GrowUnicodeBuffer(objPtr, numChars);
	stringPtr = GET_STRING(objPtr);

	/*
	 * Relocate Unicode if needed; see above.
	 */

	if (offset >= 0) {
	    unicode = stringPtr->unicode + offset;
	}
    }

    /*
     * Copy the new string onto the end of the old string, then add the
     * trailing null.
     */
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
 *----------------------------------------------------------------------
 */

static void
AppendUnicodeToUtfRep(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    const Tcl_UniChar *unicode,	/* String to convert to UTF. */
    size_t numChars)		/* Number of chars of "unicode" to convert. */
{
    String *stringPtr = GET_STRING(objPtr);

    numChars = ExtendStringRepWithUnicode(objPtr, unicode, numChars);

    if (stringPtr->numChars != TCL_INDEX_NONE) {
	stringPtr->numChars += numChars;







|







1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
 *----------------------------------------------------------------------
 */

static void
AppendUnicodeToUtfRep(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    const Tcl_UniChar *unicode,	/* String to convert to UTF. */
    Tcl_Size numChars)		/* Number of chars of Unicode to convert. */
{
    String *stringPtr = GET_STRING(objPtr);

    numChars = ExtendStringRepWithUnicode(objPtr, unicode, numChars);

    if (stringPtr->numChars != TCL_INDEX_NONE) {
	stringPtr->numChars += numChars;
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
 *----------------------------------------------------------------------
 */

static void
AppendUtfToUnicodeRep(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    const char *bytes,		/* String to convert to Unicode. */
    size_t numBytes)		/* Number of bytes of "bytes" to convert. */
{
    String *stringPtr;

    if (numBytes == 0) {
	return;
    }








|







1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
 *----------------------------------------------------------------------
 */

static void
AppendUtfToUnicodeRep(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    const char *bytes,		/* String to convert to Unicode. */
    Tcl_Size numBytes)		/* Number of bytes of "bytes" to convert. */
{
    String *stringPtr;

    if (numBytes == 0) {
	return;
    }

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

static void
AppendUtfToUtfRep(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    const char *bytes,		/* String to append. */
    size_t numBytes)		/* Number of bytes of "bytes" to append. */
{
    String *stringPtr;
    size_t newLength, oldLength;

    if (numBytes == 0) {
	return;
    }

    /*
     * Copy the new string onto the end of the old string, then add the
     * trailing null.
     */

    if (objPtr->bytes == NULL) {
	objPtr->length = 0;
    }
    oldLength = objPtr->length;



    newLength = numBytes + oldLength;

    stringPtr = GET_STRING(objPtr);
    if (newLength > stringPtr->allocated) {
	size_t offset = TCL_INDEX_NONE;

	/*
	 * Protect against case where unicode points into the existing
	 * stringPtr->unicode array. Force it to follow any relocations due to
	 * the reallocs below.
	 */








|


|














>
>
>




|







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

static void
AppendUtfToUtfRep(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    const char *bytes,		/* String to append. */
    Tcl_Size numBytes)		/* Number of bytes of "bytes" to append. */
{
    String *stringPtr;
    Tcl_Size newLength, oldLength;

    if (numBytes == 0) {
	return;
    }

    /*
     * Copy the new string onto the end of the old string, then add the
     * trailing null.
     */

    if (objPtr->bytes == NULL) {
	objPtr->length = 0;
    }
    oldLength = objPtr->length;
    if (numBytes > TCL_SIZE_MAX - oldLength) {
	Tcl_Panic("max size for a Tcl value (%" TCL_SIZE_MODIFIER "d bytes) exceeded", TCL_SIZE_MAX);
    }
    newLength = numBytes + oldLength;

    stringPtr = GET_STRING(objPtr);
    if (newLength > stringPtr->allocated) {
	Tcl_Size offset = -1;

	/*
	 * Protect against case where unicode points into the existing
	 * stringPtr->unicode array. Force it to follow any relocations due to
	 * the reallocs below.
	 */

1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776

	GrowStringBuffer(objPtr, newLength, 0);

	/*
	 * Relocate bytes if needed; see above.
	 */

	if (offset != TCL_INDEX_NONE) {
	    bytes = objPtr->bytes + offset;
	}
    }

    /*
     * Invalidate the unicode data.
     */

    stringPtr->numChars = TCL_INDEX_NONE;
    stringPtr->hasUnicode = 0;

    if (bytes) {
	memmove(objPtr->bytes + oldLength, bytes, numBytes);
    }
    objPtr->bytes[newLength] = 0;
    objPtr->length = newLength;







|








|







1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785

	GrowStringBuffer(objPtr, newLength, 0);

	/*
	 * Relocate bytes if needed; see above.
	 */

	if (offset >= 0) {
	    bytes = objPtr->bytes + offset;
	}
    }

    /*
     * Invalidate the unicode data.
     */

    stringPtr->numChars = -1;
    stringPtr->hasUnicode = 0;

    if (bytes) {
	memmove(objPtr->bytes + oldLength, bytes, numBytes);
    }
    objPtr->bytes[newLength] = 0;
    objPtr->length = newLength;
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
 */

int
Tcl_AppendFormatToObj(
    Tcl_Interp *interp,
    Tcl_Obj *appendObj,
    const char *format,
    size_t objc,
    Tcl_Obj *const objv[])
{
    const char *span = format, *msg, *errCode;
    int gotXpg = 0, gotSequential = 0;
    size_t objIndex = 0, originalLength, limit, numBytes = 0;
    Tcl_UniChar ch = 0;
    static const char *mixedXPG =
	    "cannot mix \"%\" and \"%n$\" conversion specifiers";
    static const char *const badIndex[2] = {
	"not enough arguments for all format specifiers",
	"\"%n$\" argument index out of range"
    };
    static const char *overflow = "max size for a Tcl value exceeded";

    if (Tcl_IsShared(appendObj)) {
	Tcl_Panic("%s called with shared object", "Tcl_AppendFormatToObj");
    }
    (void)Tcl_GetStringFromObj(appendObj, &originalLength);
    limit = (size_t)INT_MAX - originalLength;

    /*
     * Format string is NUL-terminated.
     */

    while (*format != '\0') {
	char *end;
	int gotMinus = 0, gotHash = 0, gotZero = 0, gotSpace = 0, gotPlus = 0;
	int width, gotPrecision, precision, sawFlag, useShort = 0, useBig = 0;

#ifndef TCL_WIDE_INT_IS_LONG
	int useWide = 0;
#endif
	int newXpg, numChars, allocSegment = 0, segmentLimit;
	size_t segmentNumBytes;
	Tcl_Obj *segment;
	int step = TclUtfToUniChar(format, &ch);

	format += step;
	if (ch != '%') {
	    numBytes += step;
	    continue;







|




|













|








|
>



|
|







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

int
Tcl_AppendFormatToObj(
    Tcl_Interp *interp,
    Tcl_Obj *appendObj,
    const char *format,
    Tcl_Size objc,
    Tcl_Obj *const objv[])
{
    const char *span = format, *msg, *errCode;
    int gotXpg = 0, gotSequential = 0;
    Tcl_Size objIndex = 0, originalLength, limit, numBytes = 0;
    Tcl_UniChar ch = 0;
    static const char *mixedXPG =
	    "cannot mix \"%\" and \"%n$\" conversion specifiers";
    static const char *const badIndex[2] = {
	"not enough arguments for all format specifiers",
	"\"%n$\" argument index out of range"
    };
    static const char *overflow = "max size for a Tcl value exceeded";

    if (Tcl_IsShared(appendObj)) {
	Tcl_Panic("%s called with shared object", "Tcl_AppendFormatToObj");
    }
    (void)Tcl_GetStringFromObj(appendObj, &originalLength);
    limit = TCL_SIZE_MAX - originalLength;

    /*
     * Format string is NUL-terminated.
     */

    while (*format != '\0') {
	char *end;
	int gotMinus = 0, gotHash = 0, gotZero = 0, gotSpace = 0, gotPlus = 0;
	int gotPrecision, sawFlag, useShort = 0, useBig = 0;
	Tcl_Size width, precision;
#ifndef TCL_WIDE_INT_IS_LONG
	int useWide = 0;
#endif
	int newXpg, allocSegment = 0;
	Tcl_Size numChars, segmentLimit, segmentNumBytes;
	Tcl_Obj *segment;
	int step = TclUtfToUniChar(format, &ch);

	format += step;
	if (ch != '%') {
	    numBytes += step;
	    continue;
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
	    if (gotXpg) {
		msg = mixedXPG;
		errCode = "MIXEDSPECTYPES";
		goto errorMsg;
	    }
	    gotSequential = 1;
	}
	if (objIndex >= objc) {
	    msg = badIndex[gotXpg];
	    errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH";
	    goto errorMsg;
	}

	/*
	 * Step 2. Set of flags.







|







1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
	    if (gotXpg) {
		msg = mixedXPG;
		errCode = "MIXEDSPECTYPES";
		goto errorMsg;
	    }
	    gotSequential = 1;
	}
	if ((objIndex < 0) || (objIndex >= objc)) {
	    msg = badIndex[gotXpg];
	    errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH";
	    goto errorMsg;
	}

	/*
	 * Step 2. Set of flags.
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

	/*
	 * Step 3. Minimum field width.
	 */

	width = 0;
	if (isdigit(UCHAR(ch))) {


	    width = strtoul(format, &end, 10);

	    if (width < 0) {
		msg = overflow;
		errCode = "OVERFLOW";
		goto errorMsg;
	    }

	    format = end;
	    step = TclUtfToUniChar(format, &ch);
	} else if (ch == '*') {
	    if (objIndex >= objc - 1) {
		msg = badIndex[gotXpg];
		errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH";
		goto errorMsg;
	    }
	    if (TclGetIntFromObj(interp, objv[objIndex], &width) != TCL_OK) {
		goto error;
	    }
	    if (width < 0) {
		width = -width;
		gotMinus = 1;
	    }
	    objIndex++;
	    format += step;
	    step = TclUtfToUniChar(format, &ch);
	}
	if (width > (int) limit) {
	    msg = overflow;
	    errCode = "OVERFLOW";
	    goto errorMsg;
	}

	/*
	 * Step 4. Precision.
	 */

	gotPrecision = precision = 0;
	if (ch == '.') {
	    gotPrecision = 1;
	    format += step;
	    step = TclUtfToUniChar(format, &ch);
	}
	if (isdigit(UCHAR(ch))) {


	    precision = strtoul(format, &end, 10);







	    format = end;
	    step = TclUtfToUniChar(format, &ch);
	} else if (ch == '*') {
	    if (objIndex >= objc - 1) {
		msg = badIndex[gotXpg];
		errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH";
		goto errorMsg;
	    }
	    if (TclGetIntFromObj(interp, objv[objIndex], &precision)
		    != TCL_OK) {
		goto error;
	    }

	    /*
	     * TODO: Check this truncation logic.
	     */







>
>
|
>
|




>








|










|
















>
>
|
>
>
>
>
>
>
>








|







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

	/*
	 * Step 3. Minimum field width.
	 */

	width = 0;
	if (isdigit(UCHAR(ch))) {
	    /* Note ull will be >= 0 because of isdigit check above */
	    unsigned long long ull;
	    ull = strtoull(format, &end, 10);
	    /* Comparison is >=, not >, to leave room for nul */
	    if (ull >= TCL_SIZE_MAX) {
		msg = overflow;
		errCode = "OVERFLOW";
		goto errorMsg;
	    }
	    width = (Tcl_Size)ull;
	    format = end;
	    step = TclUtfToUniChar(format, &ch);
	} else if (ch == '*') {
	    if (objIndex >= objc - 1) {
		msg = badIndex[gotXpg];
		errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH";
		goto errorMsg;
	    }
	    if (TclGetSizeIntFromObj(interp, objv[objIndex], &width) != TCL_OK) {
		goto error;
	    }
	    if (width < 0) {
		width = -width;
		gotMinus = 1;
	    }
	    objIndex++;
	    format += step;
	    step = TclUtfToUniChar(format, &ch);
	}
	if (width > limit) {
	    msg = overflow;
	    errCode = "OVERFLOW";
	    goto errorMsg;
	}

	/*
	 * Step 4. Precision.
	 */

	gotPrecision = precision = 0;
	if (ch == '.') {
	    gotPrecision = 1;
	    format += step;
	    step = TclUtfToUniChar(format, &ch);
	}
	if (isdigit(UCHAR(ch))) {
	    /* Note ull will be >= 0 because of isdigit check above */
	    unsigned long long ull;
	    ull = strtoull(format, &end, 10);
	    /* Comparison is >=, not >, to leave room for nul */
	    if (ull >= TCL_SIZE_MAX) {
		msg = overflow;
		errCode = "OVERFLOW";
		goto errorMsg;
	    }
	    precision = (Tcl_Size)ull;
	    format = end;
	    step = TclUtfToUniChar(format, &ch);
	} else if (ch == '*') {
	    if (objIndex >= objc - 1) {
		msg = badIndex[gotXpg];
		errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH";
		goto errorMsg;
	    }
	    if (TclGetSizeIntFromObj(interp, objv[objIndex], &precision)
		    != TCL_OK) {
		goto error;
	    }

	    /*
	     * TODO: Check this truncation logic.
	     */
2125
2126
2127
2128
2129
2130
2131



2132
2133
2134
2135
2136
2137
2138
	    break;
	case 'c': {
	    char buf[4] = "";
	    int code, length;

	    if (TclGetIntFromObj(interp, segment, &code) != TCL_OK) {
		goto error;



	    }
	    length = Tcl_UniCharToUtf(code, buf);
#if TCL_UTF_MAX < 4
	    if ((code >= 0xD800) && (length < 3)) {
		/* Special case for handling high surrogates. */
		length += Tcl_UniCharToUtf(-1, buf + length);
	    }







>
>
>







2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
	    break;
	case 'c': {
	    char buf[4] = "";
	    int code, length;

	    if (TclGetIntFromObj(interp, segment, &code) != TCL_OK) {
		goto error;
	    }
	    if ((unsigned)code > 0x10FFFF) {
	    	code = 0xFFFD;
	    }
	    length = Tcl_UniCharToUtf(code, buf);
#if TCL_UTF_MAX < 4
	    if ((code >= 0xD800) && (length < 3)) {
		/* Special case for handling high surrogates. */
		length += Tcl_UniCharToUtf(-1, buf + length);
	    }
2152
2153
2154
2155
2156
2157
2158
2159

2160
2161
2162
2163
2164
2165
2166
	case 'X':
	case 'b': {
	    short s = 0;	/* Silence compiler warning; only defined and
				 * used when useShort is true. */
	    long l;
	    Tcl_WideInt w;
	    mp_int big;
	    int toAppend, isNegative = 0;


#ifndef TCL_WIDE_INT_IS_LONG
	    if (ch == 'p') {
		useWide = 1;
	    }
#endif
	    if (useBig) {







|
>







2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
	case 'X':
	case 'b': {
	    short s = 0;	/* Silence compiler warning; only defined and
				 * used when useShort is true. */
	    long l;
	    Tcl_WideInt w;
	    mp_int big;
	    int isNegative = 0;
	    Tcl_Size toAppend;

#ifndef TCL_WIDE_INT_IS_LONG
	    if (ch == 'p') {
		useWide = 1;
	    }
#endif
	    if (useBig) {
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
	    } else {
		isNegative = (l < (long) 0);
		if (l == (long) 0) gotHash = 0;
	    }

	    TclNewObj(segment);
	    allocSegment = 1;
	    segmentLimit = INT_MAX;
	    Tcl_IncrRefCount(segment);

	    if ((isNegative || gotPlus || gotSpace) && (useBig || ch=='d')) {
		Tcl_AppendToObj(segment,
			(isNegative ? "-" : gotPlus ? "+" : " "), 1);
		segmentLimit -= 1;
	    }







|







2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
	    } else {
		isNegative = (l < (long) 0);
		if (l == (long) 0) gotHash = 0;
	    }

	    TclNewObj(segment);
	    allocSegment = 1;
	    segmentLimit = TCL_SIZE_MAX;
	    Tcl_IncrRefCount(segment);

	    if ((isNegative || gotPlus || gotSpace) && (useBig || ch=='d')) {
		Tcl_AppendToObj(segment,
			(isNegative ? "-" : gotPlus ? "+" : " "), 1);
		segmentLimit -= 1;
	    }
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
		    segmentLimit -= 2;
		    break;
		}
	    }

	    switch (ch) {
	    case 'd': {
		size_t length;
		Tcl_Obj *pure;
		const char *bytes;

		if (useShort) {
		    TclNewIntObj(pure, s);
#ifndef TCL_WIDE_INT_IS_LONG
		} else if (useWide) {







|







2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
		    segmentLimit -= 2;
		    break;
		}
	    }

	    switch (ch) {
	    case 'd': {
		Tcl_Size length;
		Tcl_Obj *pure;
		const char *bytes;

		if (useShort) {
		    TclNewIntObj(pure, s);
#ifndef TCL_WIDE_INT_IS_LONG
		} else if (useWide) {
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
		/*
		 * Canonical decimal string reps for integers are composed
		 * entirely of one-byte encoded characters, so "length" is the
		 * number of chars.
		 */

		if (gotPrecision) {
		    if (length < (size_t)precision) {
			segmentLimit -= precision - length;
		    }
		    while (length < (size_t)precision) {
			Tcl_AppendToObj(segment, "0", 1);
			length++;
		    }
		    gotZero = 0;
		}
		if (gotZero) {
		    length += Tcl_GetCharLength(segment);
		    if (length < (size_t)width) {
			segmentLimit -= width - length;
		    }
		    while (length < (size_t)width) {
			Tcl_AppendToObj(segment, "0", 1);
			length++;
		    }
		}
		if (toAppend > segmentLimit) {
		    msg = overflow;
		    errCode = "OVERFLOW";







|


|







|


|







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
		/*
		 * Canonical decimal string reps for integers are composed
		 * entirely of one-byte encoded characters, so "length" is the
		 * number of chars.
		 */

		if (gotPrecision) {
		    if (length < precision) {
			segmentLimit -= precision - length;
		    }
		    while (length < precision) {
			Tcl_AppendToObj(segment, "0", 1);
			length++;
		    }
		    gotZero = 0;
		}
		if (gotZero) {
		    length += Tcl_GetCharLength(segment);
		    if (length < width) {
			segmentLimit -= width - length;
		    }
		    while (length < width) {
			Tcl_AppendToObj(segment, "0", 1);
			length++;
		    }
		}
		if (toAppend > segmentLimit) {
		    msg = overflow;
		    errCode = "OVERFLOW";
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
	    case 'p':
	    case 'x':
	    case 'X':
	    case 'b': {
		Tcl_WideUInt bits = 0;
		Tcl_WideInt numDigits = 0;
		int numBits = 4, base = 16, index = 0, shift = 0;
		size_t length;
		Tcl_Obj *pure;
		char *bytes;

		if (ch == 'u') {
		    base = 10;
		} else if (ch == 'o') {
		    base = 8;







|







2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
	    case 'p':
	    case 'x':
	    case 'X':
	    case 'b': {
		Tcl_WideUInt bits = 0;
		Tcl_WideInt numDigits = 0;
		int numBits = 4, base = 16, index = 0, shift = 0;
		Tcl_Size length;
		Tcl_Obj *pure;
		char *bytes;

		if (ch == 'u') {
		    base = 10;
		} else if (ch == 'o') {
		    base = 8;
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
		    }
		    bits /= base;
		}
		if (useBig) {
		    mp_clear(&big);
		}
		if (gotPrecision) {
		    if (length < (size_t)precision) {
			segmentLimit -= precision - length;
		    }
		    while (length < (size_t)precision) {
			Tcl_AppendToObj(segment, "0", 1);
			length++;
		    }
		    gotZero = 0;
		}
		if (gotZero) {
		    length += Tcl_GetCharLength(segment);
		    if (length < (size_t)width) {
			segmentLimit -= width - length;
		    }
		    while (length < (size_t)width) {
			Tcl_AppendToObj(segment, "0", 1);
			length++;
		    }
		}
		if (toAppend > segmentLimit) {
		    msg = overflow;
		    errCode = "OVERFLOW";







|


|







|


|







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
		    }
		    bits /= base;
		}
		if (useBig) {
		    mp_clear(&big);
		}
		if (gotPrecision) {
		    if (length < precision) {
			segmentLimit -= precision - length;
		    }
		    while (length < precision) {
			Tcl_AppendToObj(segment, "0", 1);
			length++;
		    }
		    gotZero = 0;
		}
		if (gotZero) {
		    length += Tcl_GetCharLength(segment);
		    if (length < width) {
			segmentLimit -= width - length;
		    }
		    while (length < width) {
			Tcl_AppendToObj(segment, "0", 1);
			length++;
		    }
		}
		if (toAppend > segmentLimit) {
		    msg = overflow;
		    errCode = "OVERFLOW";
2474
2475
2476
2477
2478
2479
2480
2481

2482
2483
2484
2485
2486
2487

2488
2489
2490
2491
2492
2493
2494
2495
2496
	    if (gotSpace) {
		*p++ = ' ';
	    }
	    if (gotPlus) {
		*p++ = '+';
	    }
	    if (width) {
		p += sprintf(p, "%d", width);

		if (width > length) {
		    length = width;
		}
	    }
	    if (gotPrecision) {
		*p++ = '.';

		p += sprintf(p, "%d", precision);
		if (precision > INT_MAX - length) {
		    msg = overflow;
		    errCode = "OVERFLOW";
		    goto errorMsg;
		}
		length += precision;
	    }








|
>






>
|
|







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
	    if (gotSpace) {
		*p++ = ' ';
	    }
	    if (gotPlus) {
		*p++ = '+';
	    }
	    if (width) {
		p += snprintf(
		    p, TCL_INTEGER_SPACE, "%" TCL_SIZE_MODIFIER "d", width);
		if (width > length) {
		    length = width;
		}
	    }
	    if (gotPrecision) {
		*p++ = '.';
		p += snprintf(
		    p, TCL_INTEGER_SPACE, "%" TCL_SIZE_MODIFIER "d", precision);
		if (precision > TCL_SIZE_MAX - length) {
		    msg = overflow;
		    errCode = "OVERFLOW";
		    goto errorMsg;
		}
		length += precision;
	    }

2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
	    allocSegment = 1;
	    if (!Tcl_AttemptSetObjLength(segment, length)) {
		msg = overflow;
		errCode = "OVERFLOW";
		goto errorMsg;
	    }
	    bytes = TclGetString(segment);
	    if (!Tcl_AttemptSetObjLength(segment, sprintf(bytes, spec, d))) {
		msg = overflow;
		errCode = "OVERFLOW";
		goto errorMsg;
	    }
	    if (ch == 'A') {
		char *q = TclGetString(segment) + 1;
		*q = 'x';







|







2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
	    allocSegment = 1;
	    if (!Tcl_AttemptSetObjLength(segment, length)) {
		msg = overflow;
		errCode = "OVERFLOW";
		goto errorMsg;
	    }
	    bytes = TclGetString(segment);
	    if (!Tcl_AttemptSetObjLength(segment, snprintf(bytes, segment->length, spec, d))) {
		msg = overflow;
		errCode = "OVERFLOW";
		goto errorMsg;
	    }
	    if (ch == 'A') {
		char *q = TclGetString(segment) + 1;
		*q = 'x';
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_Format(
    Tcl_Interp *interp,
    const char *format,
    size_t objc,
    Tcl_Obj *const objv[])
{
    int result;
    Tcl_Obj *objPtr;

    TclNewObj(objPtr);
    result = Tcl_AppendFormatToObj(interp, objPtr, format, objc, objv);







|







2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_Format(
    Tcl_Interp *interp,
    const char *format,
    Tcl_Size objc,
    Tcl_Obj *const objv[])
{
    int result;
    Tcl_Obj *objPtr;

    TclNewObj(objPtr);
    result = Tcl_AppendFormatToObj(interp, objPtr, format, objc, objv);
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
static void
AppendPrintfToObjVA(
    Tcl_Obj *objPtr,
    const char *format,
    va_list argList)
{
    int code;
    size_t objc;
    Tcl_Obj **objv, *list;
    const char *p;

    TclNewObj(list);
    p = format;
    Tcl_IncrRefCount(list);
    while (*p != '\0') {







|







2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
static void
AppendPrintfToObjVA(
    Tcl_Obj *objPtr,
    const char *format,
    va_list argList)
{
    int code;
    Tcl_Size objc;
    Tcl_Obj **objv, *list;
    const char *p;

    TclNewObj(list);
    p = format;
    Tcl_IncrRefCount(list);
    while (*p != '\0') {
2701
2702
2703
2704
2705
2706
2707





2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
		}

		Tcl_ListObjAppendElement(NULL, list,
			Tcl_NewStringObj(bytes , (end - bytes)));

		break;
	    }





	    case 'c':
	    case 'i':
	    case 'u':
	    case 'd':
	    case 'o':
	    case 'p':
	    case 'x':
	    case 'X':
		seekingConversion = 0;
		switch (size) {
		case -1:
		case 0:
		    Tcl_ListObjAppendElement(NULL, list, Tcl_NewWideIntObj(







>
>
>
>
>





<







2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746

2747
2748
2749
2750
2751
2752
2753
		}

		Tcl_ListObjAppendElement(NULL, list,
			Tcl_NewStringObj(bytes , (end - bytes)));

		break;
	    }
	    case 'p':
		if (sizeof(size_t) == sizeof(Tcl_WideInt)) {
		    size = 2;
		}
		/* FALLTHRU */
	    case 'c':
	    case 'i':
	    case 'u':
	    case 'd':
	    case 'o':

	    case 'x':
	    case 'X':
		seekingConversion = 0;
		switch (size) {
		case -1:
		case 0:
		    Tcl_ListObjAppendElement(NULL, list, Tcl_NewWideIntObj(
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
 *
 *---------------------------------------------------------------------------
 */

char *
TclGetStringStorage(
    Tcl_Obj *objPtr,
    size_t *sizePtr)
{
    String *stringPtr;

    if (!TclHasInternalRep(objPtr, &tclStringType) || objPtr->bytes == NULL) {
	return Tcl_GetStringFromObj(objPtr, sizePtr);
    }








|







2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
 *
 *---------------------------------------------------------------------------
 */

char *
TclGetStringStorage(
    Tcl_Obj *objPtr,
    Tcl_Size *sizePtr)
{
    String *stringPtr;

    if (!TclHasInternalRep(objPtr, &tclStringType) || objPtr->bytes == NULL) {
	return Tcl_GetStringFromObj(objPtr, sizePtr);
    }

2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933

2934

2935
2936
2937
2938
2939
2940
2941
2942
2943
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
TclStringRepeat(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,
    size_t count,
    int flags)
{
    Tcl_Obj *objResultPtr;
    int inPlace = flags & TCL_STRING_IN_PLACE;

    size_t length = 0, unichar = 0, done = 1;

    int binary = TclIsPureByteArray(objPtr);
    size_t maxCount;

    /* assert (count >= 2) */

    /*
     * Analyze to determine what representation result should be.
     * GOALS:	Avoid shimmering & string rep generation.
     * 		Produce pure bytearray when possible.







|




>
|
>

|







2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
TclStringRepeat(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,
    Tcl_Size count,
    int flags)
{
    Tcl_Obj *objResultPtr;
    int inPlace = flags & TCL_STRING_IN_PLACE;
    Tcl_Size length = 0;
    int unichar = 0;
    Tcl_Size done = 1;
    int binary = TclIsPureByteArray(objPtr);
    Tcl_Size maxCount;

    /* assert (count >= 2) */

    /*
     * Analyze to determine what representation result should be.
     * GOALS:	Avoid shimmering & string rep generation.
     * 		Produce pure bytearray when possible.
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
	    }
	}
    }

    if (binary) {
	/* Result will be pure byte array. Pre-size it */
	(void)Tcl_GetByteArrayFromObj(objPtr, &length);
	maxCount = TCL_SIZE_SMAX;
    }
    else if (unichar) {
	/* Result will be pure Tcl_UniChar array. Pre-size it. */
	(void)Tcl_GetUnicodeFromObj(objPtr, &length);
	maxCount = TCL_SIZE_SMAX/sizeof(Tcl_UniChar);
    }
    else {
	/* Result will be concat of string reps. Pre-size it. */
	(void)Tcl_GetStringFromObj(objPtr, &length);
	maxCount = TCL_SIZE_SMAX;
    }

    if (length == 0) {
	/* Any repeats of empty is empty. */
	return objPtr;
    }

    /* maxCount includes space for null */
    if (count > (maxCount-1)) {
	if (interp) {
	    Tcl_SetObjResult(
		interp,
		Tcl_ObjPrintf("max size for a Tcl value (%" TCL_Z_MODIFIER
			      "u bytes) exceeded",
			      TCL_SIZE_SMAX));
	    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	}
	return NULL;
    }

    if (binary) {
	/* Efficiently produce a pure byte array result */
	objResultPtr = (!inPlace || Tcl_IsShared(objPtr)) ?
		Tcl_DuplicateObj(objPtr) : objPtr;

	/* Allocate count*length space */
	Tcl_SetByteArrayLength(objResultPtr, count*length); /* PANIC? */
	Tcl_SetByteArrayLength(objResultPtr, length);
	while (count - done > done) {
	    Tcl_AppendObjToObj(objResultPtr, objResultPtr);
	    done *= 2;
	}
	TclAppendBytesToByteArray(objResultPtr,
		Tcl_GetBytesFromObj(NULL, objResultPtr, (size_t *)NULL),
		(count - done) * length);
    } else if (unichar) {
	/*
	 * Efficiently produce a pure Tcl_UniChar array result.
	 */

	if (!inPlace || Tcl_IsShared(objPtr)) {
	    objResultPtr = Tcl_NewUnicodeObj(Tcl_GetUnicode(objPtr), length);
	} else {
	    TclInvalidateStringRep(objPtr);
	    objResultPtr = objPtr;
	}


        if (0 == Tcl_AttemptSetObjLength(objResultPtr, count*length)) {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"string size overflow: unable to alloc %"
			TCL_Z_MODIFIER "u bytes",
			STRING_SIZE(count*length)));
		Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	    }
	    return NULL;
	}
	Tcl_SetObjLength(objResultPtr, length);
	while (count - done > done) {







|
<
|


|
<
|


|












|
|
|


















|













>




|







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

    if (binary) {
	/* Result will be pure byte array. Pre-size it */
	(void)Tcl_GetByteArrayFromObj(objPtr, &length);
	maxCount = TCL_SIZE_MAX;

    } else if (unichar) {
	/* Result will be pure Tcl_UniChar array. Pre-size it. */
	(void)Tcl_GetUnicodeFromObj(objPtr, &length);
	maxCount = TCL_SIZE_MAX/sizeof(Tcl_UniChar);

    } else {
	/* Result will be concat of string reps. Pre-size it. */
	(void)Tcl_GetStringFromObj(objPtr, &length);
	maxCount = TCL_SIZE_MAX;
    }

    if (length == 0) {
	/* Any repeats of empty is empty. */
	return objPtr;
    }

    /* maxCount includes space for null */
    if (count > (maxCount-1)) {
	if (interp) {
	    Tcl_SetObjResult(
		interp,
		Tcl_ObjPrintf("max size for a Tcl value (%" TCL_SIZE_MODIFIER
			      "d bytes) exceeded",
			      TCL_SIZE_MAX));
	    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	}
	return NULL;
    }

    if (binary) {
	/* Efficiently produce a pure byte array result */
	objResultPtr = (!inPlace || Tcl_IsShared(objPtr)) ?
		Tcl_DuplicateObj(objPtr) : objPtr;

	/* Allocate count*length space */
	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, (Tcl_Size *) NULL),
		(count - done) * length);
    } else if (unichar) {
	/*
	 * Efficiently produce a pure Tcl_UniChar array result.
	 */

	if (!inPlace || Tcl_IsShared(objPtr)) {
	    objResultPtr = Tcl_NewUnicodeObj(Tcl_GetUnicode(objPtr), length);
	} else {
	    TclInvalidateStringRep(objPtr);
	    objResultPtr = objPtr;
	}

        /* TODO - overflow check */
        if (0 == Tcl_AttemptSetObjLength(objResultPtr, count*length)) {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"string size overflow: unable to alloc %"
			TCL_SIZE_MODIFIER "d bytes",
			STRING_SIZE(count*length)));
		Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	    }
	    return NULL;
	}
	Tcl_SetObjLength(objResultPtr, length);
	while (count - done > done) {
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

	if (!inPlace || Tcl_IsShared(objPtr)) {
	    objResultPtr = Tcl_NewStringObj(TclGetString(objPtr), length);
	} else {
	    TclFreeInternalRep(objPtr);
	    objResultPtr = objPtr;
	}

        if (0 == Tcl_AttemptSetObjLength(objResultPtr, count*length)) {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"string size overflow: unable to alloc %" TCL_Z_MODIFIER "u bytes",
			count*length));
		Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	    }
	    return NULL;
	}
	Tcl_SetObjLength(objResultPtr, length);
	while (count - done > done) {
	    Tcl_AppendObjToObj(objResultPtr, objResultPtr);
	    done *= 2;
	}
	Tcl_AppendToObj(objResultPtr, TclGetString(objResultPtr),
		(count - done) * length);
    }
    return objResultPtr;

}

/*
 *---------------------------------------------------------------------------
 *
 * TclStringCat --
 *







>



|














<







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

	if (!inPlace || Tcl_IsShared(objPtr)) {
	    objResultPtr = Tcl_NewStringObj(TclGetString(objPtr), length);
	} else {
	    TclFreeInternalRep(objPtr);
	    objResultPtr = objPtr;
	}
        /* TODO - overflow check */
        if (0 == Tcl_AttemptSetObjLength(objResultPtr, count*length)) {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"string size overflow: unable to alloc %" TCL_SIZE_MODIFIER "d bytes",
			count*length));
		Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	    }
	    return NULL;
	}
	Tcl_SetObjLength(objResultPtr, length);
	while (count - done > done) {
	    Tcl_AppendObjToObj(objResultPtr, objResultPtr);
	    done *= 2;
	}
	Tcl_AppendToObj(objResultPtr, TclGetString(objResultPtr),
		(count - done) * length);
    }
    return objResultPtr;

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

Tcl_Obj *
TclStringCat(
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj * const objv[],
    int flags)
{
    Tcl_Obj *objResultPtr, * const *ov;
    int oc, binary = 1;
    size_t length = 0;
    int allowUniChar = 1, requestUniChar = 0, forceUniChar = 0;
    int first = objc - 1;	/* Index of first value possibly not empty */
    int last = 0;		/* Index of last value possibly not empty */
    int inPlace = flags & TCL_STRING_IN_PLACE;

    /* assert ( objc >= 0 ) */

    if (objc <= 1) {






	/* Only one or no objects; return first or empty */
	return objc ? objv[0] : Tcl_NewObj();
    }

    /* assert ( objc >= 2 ) */

    /*
     * Analyze to determine what representation result should be.
     * GOALS:	Avoid shimmering & string rep generation.







|




|
|

|
|
|




>
>
>
>
>
>
|
|







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

Tcl_Obj *
TclStringCat(
    Tcl_Interp *interp,
    Tcl_Size objc,
    Tcl_Obj * const objv[],
    int flags)
{
    Tcl_Obj *objResultPtr, * const *ov;
    int binary = 1;
    Tcl_Size oc, length = 0;
    int allowUniChar = 1, requestUniChar = 0, forceUniChar = 0;
    Tcl_Size first = objc - 1;	/* Index of first value possibly not empty */
    Tcl_Size last = 0;		/* Index of last value possibly not empty */
    int inPlace = (flags & TCL_STRING_IN_PLACE) && !Tcl_IsShared(*objv);

    /* assert ( objc >= 0 ) */

    if (objc <= 1) {
	if (objc != 1) {
	    /* Negative (shouldn't be) no objects; return empty */
	    Tcl_Obj *obj;
	    TclNewObj(obj);
	    return obj;
	}
	/* One object; return first */
	return objv[0];
    }

    /* assert ( objc >= 2 ) */

    /*
     * Analyze to determine what representation result should be.
     * GOALS:	Avoid shimmering & string rep generation.
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
    } while (--oc && (binary || allowUniChar));

    if (binary) {
	/*
	 * Result will be pure byte array. Pre-size it
	 */

	size_t numBytes = 0;
	ov = objv;
	oc = objc;
	do {
	    Tcl_Obj *objPtr = *ov++;

	    /*
	     * Every argument is either a bytearray with a ("pure")
	     * value we know we can safely use, or it is an empty string.
	     * We don't need to count bytes for the empty strings.
	     */

	    if (TclIsPureByteArray(objPtr)) {
		(void)Tcl_GetByteArrayFromObj(objPtr, &numBytes); /* PANIC? */

		if (numBytes) {
		    last = objc - oc;
		    if (length == 0) {
			first = last;
		    }
		    if (length > (TCL_SIZE_SMAX-numBytes)) {
			goto overflow;
		    }
		    length += numBytes;
		}
	    }
	} while (--oc);
    } else if ((allowUniChar && requestUniChar) || forceUniChar) {
	/*
	 * Result will be pure Tcl_UniChar array. Pre-size it.
	 */

	ov = objv;
	oc = objc;
	do {
	    Tcl_Obj *objPtr = *ov++;

	    if ((objPtr->bytes == NULL) || (objPtr->length)) {
		size_t numChars;

		(void)Tcl_GetUnicodeFromObj(objPtr, &numChars); /* PANIC? */
		if (numChars) {
		    last = objc - oc;
		    if (length == 0) {
			first = last;
		    }
		    if (length > ((TCL_SIZE_SMAX/sizeof(Tcl_UniChar))-numChars)) {
			goto overflow;
		    }
		    length += numChars;
		}
	    }
	} while (--oc);
    } else {







|



















|

















|







|







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
    } while (--oc && (binary || allowUniChar));

    if (binary) {
	/*
	 * Result will be pure byte array. Pre-size it
	 */

	Tcl_Size numBytes = 0;
	ov = objv;
	oc = objc;
	do {
	    Tcl_Obj *objPtr = *ov++;

	    /*
	     * Every argument is either a bytearray with a ("pure")
	     * value we know we can safely use, or it is an empty string.
	     * We don't need to count bytes for the empty strings.
	     */

	    if (TclIsPureByteArray(objPtr)) {
		(void)Tcl_GetByteArrayFromObj(objPtr, &numBytes); /* PANIC? */

		if (numBytes) {
		    last = objc - oc;
		    if (length == 0) {
			first = last;
		    }
		    if (length > (TCL_SIZE_MAX-numBytes)) {
			goto overflow;
		    }
		    length += numBytes;
		}
	    }
	} while (--oc);
    } else if ((allowUniChar && requestUniChar) || forceUniChar) {
	/*
	 * Result will be pure Tcl_UniChar array. Pre-size it.
	 */

	ov = objv;
	oc = objc;
	do {
	    Tcl_Obj *objPtr = *ov++;

	    if ((objPtr->bytes == NULL) || (objPtr->length)) {
		Tcl_Size numChars;

		(void)Tcl_GetUnicodeFromObj(objPtr, &numChars); /* PANIC? */
		if (numChars) {
		    last = objc - oc;
		    if (length == 0) {
			first = last;
		    }
		    if (length > (Tcl_Size) ((TCL_SIZE_MAX/sizeof(Tcl_UniChar))-numChars)) {
			goto overflow;
		    }
		    length += numChars;
		}
	    }
	} while (--oc);
    } else {
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

	    do {
		/* assert ( pendingPtr == NULL ) */
		/* assert ( length == 0 ) */

		Tcl_Obj *objPtr = *ov++;

		if (objPtr->bytes == NULL) {

		    /* No string rep; Take the chance we can avoid making it */
		    pendingPtr = objPtr;
		} else {
		    (void)Tcl_GetStringFromObj(objPtr, &length); /* PANIC? */
		}
	    } while (--oc && (length == 0) && (pendingPtr == NULL));

	    /*
 	     * Either we found a possibly non-empty value, and we remember
 	     * this index as the first and last such value so far seen,
	     * or (oc == 0) and all values are known empty,
 	     * so first = last = objc - 1 signals the right quick return.
 	     */

	    first = last = objc - oc - 1;

	    if (oc && (length == 0)) {
		size_t numBytes;

		/* assert ( pendingPtr != NULL ) */

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







|
>

















|







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

	    do {
		/* assert ( pendingPtr == NULL ) */
		/* assert ( length == 0 ) */

		Tcl_Obj *objPtr = *ov++;

		if (objPtr->bytes == NULL
		    && TclCheckEmptyString(objPtr) != TCL_EMPTYSTRING_YES) {
		    /* No string rep; Take the chance we can avoid making it */
		    pendingPtr = objPtr;
		} else {
		    (void)Tcl_GetStringFromObj(objPtr, &length); /* PANIC? */
		}
	    } while (--oc && (length == 0) && (pendingPtr == NULL));

	    /*
 	     * 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,
 	     * so first = last = objc - 1 signals the right quick return.
 	     */

	    first = last = objc - oc - 1;

	    if (oc && (length == 0)) {
		Tcl_Size numBytes;

		/* assert ( pendingPtr != NULL ) */

		/*
		 * 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.
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
		if (oc || numBytes) {
		    (void)Tcl_GetStringFromObj(pendingPtr, &length);
		}
		if (length == 0) {
		    if (numBytes) {
			first = last;
		    }
		} else if (numBytes > (TCL_SIZE_SMAX - length)) {
		    goto overflow;
		}
		length += numBytes;
	    }
	} while (oc && (length == 0));

	while (oc) {
	    size_t numBytes;
	    Tcl_Obj *objPtr = *ov++;

	    /* assert ( length > 0 && pendingPtr == NULL )  */

	    TclGetString(objPtr); /* PANIC? */
	    numBytes = objPtr->length;
	    if (numBytes) {
		last = objc - oc;
		if (numBytes > (TCL_SIZE_SMAX - length)) {
		    goto overflow;
		}
		length += numBytes;
	    }
	    --oc;
	}
    }

    if (last <= first /*|| length == 0 */) {
	/* Only one non-empty value or zero length; return first */
	/* NOTE: (length == 0) implies (last <= first) */
	return objv[first];
    }

    objv += first; objc = (last - first + 1);


    if (binary) {
	/* Efficiently produce a pure byte array result */
	unsigned char *dst;

	/*
	 * Broken interface! Byte array value routines offer no way to handle
	 * failure to allocate enough space. Following stanza may panic.
	 */

	if (inPlace && !Tcl_IsShared(*objv)) {
	    size_t start = 0;

	    objResultPtr = *objv++; objc--;
	    (void)Tcl_GetByteArrayFromObj(objResultPtr, &start);
	    dst = Tcl_SetByteArrayLength(objResultPtr, length) + start;
	} else {
	    objResultPtr = Tcl_NewByteArrayObj(NULL, length);
	    dst = Tcl_SetByteArrayLength(objResultPtr, length);
	}
	while (objc--) {
	    Tcl_Obj *objPtr = *objv++;

	    /*
	     * Every argument is either a bytearray with a ("pure")
	     * value we know we can safely use, or it is an empty string.
	     * We don't need to copy bytes from the empty strings.
	     */

	    if (TclIsPureByteArray(objPtr)) {
		size_t more = 0;
		unsigned char *src = Tcl_GetByteArrayFromObj(objPtr, &more);
		memcpy(dst, src, more);
		dst += more;
	    }
	}
    } else if ((allowUniChar && requestUniChar) || forceUniChar) {
	/* Efficiently produce a pure Tcl_UniChar array result */
	Tcl_UniChar *dst;

	if (inPlace && !Tcl_IsShared(*objv)) {
	    size_t start;

	    objResultPtr = *objv++; objc--;

	    /* Ugly interface! Force resize of the unicode array. */
	    (void)Tcl_GetUnicodeFromObj(objResultPtr, &start);
	    Tcl_InvalidateStringRep(objResultPtr);
	    if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {







|







|








|















>










|
|


















|









|
|







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
		if (oc || numBytes) {
		    (void)Tcl_GetStringFromObj(pendingPtr, &length);
		}
		if (length == 0) {
		    if (numBytes) {
			first = last;
		    }
		} else if (numBytes > (TCL_SIZE_MAX - length)) {
		    goto overflow;
		}
		length += numBytes;
	    }
	} while (oc && (length == 0));

	while (oc) {
	    Tcl_Size numBytes;
	    Tcl_Obj *objPtr = *ov++;

	    /* assert ( length > 0 && pendingPtr == NULL )  */

	    TclGetString(objPtr); /* PANIC? */
	    numBytes = objPtr->length;
	    if (numBytes) {
		last = objc - oc;
		if (numBytes > (TCL_SIZE_MAX - length)) {
		    goto overflow;
		}
		length += numBytes;
	    }
	    --oc;
	}
    }

    if (last <= first /*|| length == 0 */) {
	/* Only one non-empty value or zero length; return first */
	/* NOTE: (length == 0) implies (last <= first) */
	return objv[first];
    }

    objv += first; objc = (last - first + 1);
    inPlace = (flags & TCL_STRING_IN_PLACE) && !Tcl_IsShared(*objv);

    if (binary) {
	/* Efficiently produce a pure byte array result */
	unsigned char *dst;

	/*
	 * Broken interface! Byte array value routines offer no way to handle
	 * failure to allocate enough space. Following stanza may panic.
	 */

	if (inPlace) {
	    Tcl_Size start = 0;

	    objResultPtr = *objv++; objc--;
	    (void)Tcl_GetByteArrayFromObj(objResultPtr, &start);
	    dst = Tcl_SetByteArrayLength(objResultPtr, length) + start;
	} else {
	    objResultPtr = Tcl_NewByteArrayObj(NULL, length);
	    dst = Tcl_SetByteArrayLength(objResultPtr, length);
	}
	while (objc--) {
	    Tcl_Obj *objPtr = *objv++;

	    /*
	     * Every argument is either a bytearray with a ("pure")
	     * value we know we can safely use, or it is an empty string.
	     * We don't need to copy bytes from the empty strings.
	     */

	    if (TclIsPureByteArray(objPtr)) {
		Tcl_Size more = 0;
		unsigned char *src = Tcl_GetByteArrayFromObj(objPtr, &more);
		memcpy(dst, src, more);
		dst += more;
	    }
	}
    } else if ((allowUniChar && requestUniChar) || forceUniChar) {
	/* Efficiently produce a pure Tcl_UniChar array result */
	Tcl_UniChar *dst;

	if (inPlace) {
	    Tcl_Size start;

	    objResultPtr = *objv++; objc--;

	    /* Ugly interface! Force resize of the unicode array. */
	    (void)Tcl_GetUnicodeFromObj(objResultPtr, &start);
	    Tcl_InvalidateStringRep(objResultPtr);
	    if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
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
	    }
	    dst = Tcl_GetUnicode(objResultPtr);
	}
	while (objc--) {
	    Tcl_Obj *objPtr = *objv++;

	    if ((objPtr->bytes == NULL) || (objPtr->length)) {
		size_t more;
		Tcl_UniChar *src = Tcl_GetUnicodeFromObj(objPtr, &more);
		memcpy(dst, src, more * sizeof(Tcl_UniChar));
		dst += more;
	    }
	}
    } else {
	/* Efficiently concatenate string reps */
	char *dst;

	if (inPlace && !Tcl_IsShared(*objv)) {
	    size_t start;

	    objResultPtr = *objv++; objc--;

	    (void)Tcl_GetStringFromObj(objResultPtr, &start);
	    if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    	"concatenation failed: unable to alloc %" TCL_Z_MODIFIER "u bytes",
			length));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
		}
		return NULL;
	    }
	    dst = TclGetString(objResultPtr) + start;

	    /* assert ( length > start ) */
	    TclFreeInternalRep(objResultPtr);
	} else {
	    TclNewObj(objResultPtr);	/* PANIC? */
	    if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
		Tcl_DecrRefCount(objResultPtr);
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    	"concatenation failed: unable to alloc %" TCL_Z_MODIFIER "u bytes",
			length));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
		}
		return NULL;
	    }
	    dst = TclGetString(objResultPtr);
	}
	while (objc--) {
	    Tcl_Obj *objPtr = *objv++;

	    if ((objPtr->bytes == NULL) || (objPtr->length)) {
		size_t more;
		char *src = Tcl_GetStringFromObj(objPtr, &more);

		memcpy(dst, src, more);
		dst += more;
	    }
	}
	/* Must NUL-terminate! */
	*dst = '\0';
    }
    return objResultPtr;

  overflow:
    if (interp) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "max size for a Tcl value (%" TCL_Z_MODIFIER "u bytes) exceeded", TCL_SIZE_SMAX));
	Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
    }
    return NULL;
}

/*
 *---------------------------------------------------------------------------







|









|
|







|















|











|














|







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
	    }
	    dst = Tcl_GetUnicode(objResultPtr);
	}
	while (objc--) {
	    Tcl_Obj *objPtr = *objv++;

	    if ((objPtr->bytes == NULL) || (objPtr->length)) {
		Tcl_Size 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_Size start;

	    objResultPtr = *objv++; objc--;

	    (void)Tcl_GetStringFromObj(objResultPtr, &start);
	    if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    	"concatenation failed: unable to alloc %" TCL_SIZE_MODIFIER "d bytes",
			length));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
		}
		return NULL;
	    }
	    dst = TclGetString(objResultPtr) + start;

	    /* assert ( length > start ) */
	    TclFreeInternalRep(objResultPtr);
	} else {
	    TclNewObj(objResultPtr);	/* PANIC? */
	    if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
		Tcl_DecrRefCount(objResultPtr);
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    	"concatenation failed: unable to alloc %" TCL_SIZE_MODIFIER "d bytes",
			length));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
		}
		return NULL;
	    }
	    dst = TclGetString(objResultPtr);
	}
	while (objc--) {
	    Tcl_Obj *objPtr = *objv++;

	    if ((objPtr->bytes == NULL) || (objPtr->length)) {
		Tcl_Size more;
		char *src = Tcl_GetStringFromObj(objPtr, &more);

		memcpy(dst, src, more);
		dst += more;
	    }
	}
	/* Must NUL-terminate! */
	*dst = '\0';
    }
    return objResultPtr;

  overflow:
    if (interp) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "max size for a Tcl value (%" TCL_SIZE_MODIFIER "d bytes) exceeded", TCL_SIZE_MAX));
	Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
    }
    return NULL;
}

/*
 *---------------------------------------------------------------------------
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

int
TclStringCmp(
    Tcl_Obj *value1Ptr,
    Tcl_Obj *value2Ptr,
    int checkEq,		/* comparison is only for equality */
    int nocase,			/* comparison is not case sensitive */
    size_t reqlength)		/* requested length */

{
    char *s1, *s2;
    int empty, match;
    size_t length, s1len = 0, s2len = 0;
    memCmpFn_t memCmpFn;

    if ((reqlength == 0) || (value1Ptr == value2Ptr)) {
	/*
	 * Always match at 0 chars of if it is the same obj.

	 */
	match = 0;
    } else {
	if (!nocase && TclIsPureByteArray(value1Ptr)
		&& TclIsPureByteArray(value2Ptr)) {
	    /*
	     * Use binary versions of comparisons since that won't cause undue
	     * type conversions and it is much faster. Only do this if we're
	     * case-sensitive (which is all that really makes sense with byte
	     * arrays anyway, and we have no memcasecmp() for some reason... :^)
	     */

	    s1 = (char *) Tcl_GetByteArrayFromObj(value1Ptr, &s1len);
	    s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len);
	    memCmpFn = memcmp;
	} else if (TclHasInternalRep(value1Ptr, &tclStringType)
		&& TclHasInternalRep(value2Ptr, &tclStringType)) {
	    /*
	     * Do a unicode-specific comparison if both of the args are of
	     * String type. If the char length == byte length, we can do a
	     * memcmp. In benchmark testing this proved the most efficient
	     * check between the unicode and string comparison operations.
	     */

	    if (nocase) {
		s1 = (char *) Tcl_GetUnicodeFromObj(value1Ptr, &s1len);
		s2 = (char *) Tcl_GetUnicodeFromObj(value2Ptr, &s2len);
		memCmpFn = (memCmpFn_t)TclUniCharNcasecmp;
	    } else {
		s1len = Tcl_GetCharLength(value1Ptr);
		s2len = Tcl_GetCharLength(value2Ptr);
		if ((s1len == value1Ptr->length)
			&& (value1Ptr->bytes != NULL)
			&& (s2len == value2Ptr->length)
			&& (value2Ptr->bytes != NULL)) {



		    s1 = value1Ptr->bytes;
		    s2 = value2Ptr->bytes;
		    memCmpFn = memcmp;
		} else {
		    s1 = (char *) Tcl_GetUnicode(value1Ptr);
		    s2 = (char *) Tcl_GetUnicode(value2Ptr);
		    if (
#if defined(WORDS_BIGENDIAN) && (TCL_UTF_MAX > 3)
			    1
#else
			    checkEq
#endif
			    ) {
			memCmpFn = memcmp;
			s1len *= sizeof(Tcl_UniChar);
			s2len *= sizeof(Tcl_UniChar);



		    } else {
			memCmpFn = (memCmpFn_t) TclUniCharNcmp;
		    }
		}
	    }
	} else {
	    empty = TclCheckEmptyString(value1Ptr);
	    if (empty > 0) {
		switch (TclCheckEmptyString(value2Ptr)) {







|
>

|

|





>


















|
|
|
|













>
>
>
















>
>
>

|







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

int
TclStringCmp(
    Tcl_Obj *value1Ptr,
    Tcl_Obj *value2Ptr,
    int checkEq,		/* comparison is only for equality */
    int nocase,			/* comparison is not case sensitive */
    Tcl_Size reqlength)		/* requested length in characters;
						 * TCL_INDEX_NONE to compare whole strings */
{
    const char *s1, *s2;
    int empty, match;
    Tcl_Size length, s1len = 0, s2len = 0;
    memCmpFn_t memCmpFn;

    if ((reqlength == 0) || (value1Ptr == value2Ptr)) {
	/*
	 * Always match at 0 chars of if it is the same obj.
	 * Note: as documented reqlength negative means it is ignored
	 */
	match = 0;
    } else {
	if (!nocase && TclIsPureByteArray(value1Ptr)
		&& TclIsPureByteArray(value2Ptr)) {
	    /*
	     * Use binary versions of comparisons since that won't cause undue
	     * type conversions and it is much faster. Only do this if we're
	     * case-sensitive (which is all that really makes sense with byte
	     * arrays anyway, and we have no memcasecmp() for some reason... :^)
	     */

	    s1 = (char *) Tcl_GetByteArrayFromObj(value1Ptr, &s1len);
	    s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len);
	    memCmpFn = memcmp;
	} else if (TclHasInternalRep(value1Ptr, &tclStringType)
		&& TclHasInternalRep(value2Ptr, &tclStringType)) {
	    /*
	     * Do a Unicode-specific comparison if both of the args are of String
	     * type. If the char length == byte length, we can do a memcmp. In
	     * benchmark testing this proved the most efficient check between the
	     * Unicode and string comparison operations.
	     */

	    if (nocase) {
		s1 = (char *) Tcl_GetUnicodeFromObj(value1Ptr, &s1len);
		s2 = (char *) Tcl_GetUnicodeFromObj(value2Ptr, &s2len);
		memCmpFn = (memCmpFn_t)TclUniCharNcasecmp;
	    } else {
		s1len = Tcl_GetCharLength(value1Ptr);
		s2len = Tcl_GetCharLength(value2Ptr);
		if ((s1len == value1Ptr->length)
			&& (value1Ptr->bytes != NULL)
			&& (s2len == value2Ptr->length)
			&& (value2Ptr->bytes != NULL)) {
			/* each byte represents one character so s1l3n, s2l3n, and
			 * reqlength are in both bytes and characters
			 */
		    s1 = value1Ptr->bytes;
		    s2 = value2Ptr->bytes;
		    memCmpFn = memcmp;
		} else {
		    s1 = (char *) Tcl_GetUnicode(value1Ptr);
		    s2 = (char *) Tcl_GetUnicode(value2Ptr);
		    if (
#if defined(WORDS_BIGENDIAN) && (TCL_UTF_MAX > 3)
			    1
#else
			    checkEq
#endif
			    ) {
			memCmpFn = memcmp;
			s1len *= sizeof(Tcl_UniChar);
			s2len *= sizeof(Tcl_UniChar);
			if (reqlength > 0) {
			    reqlength *= sizeof(Tcl_UniChar);
			}
		    } else {
			memCmpFn = (memCmpFn_t)(void *)TclUniCharNcmp;
		    }
		}
	    }
	} else {
	    empty = TclCheckEmptyString(value1Ptr);
	    if (empty > 0) {
		switch (TclCheckEmptyString(value2Ptr)) {
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
		    match = 0;
		    goto matchdone;
		}
	    } else {
		s1 = Tcl_GetStringFromObj(value1Ptr, &s1len);
		s2 = Tcl_GetStringFromObj(value2Ptr, &s2len);
	    }
	    if (!nocase && checkEq) {
		/*
		 * When we have equal-length we can check only for
		 * (in)equality. We can use memcmp in all (n)eq cases because
		 * we don't need to worry about lexical LE/BE variance.
		 */

		memCmpFn = memcmp;
	    } else {
		/*
		 * As a catch-all we will work with UTF-8. We cannot use
		 * memcmp() as that is unsafe with any string containing NUL
		 * (\xC0\x80 in Tcl's utf rep). We can use the more efficient
		 * TclpUtfNcmp2 if we are case-sensitive and no specific
		 * length was requested.
		 */

		if ((reqlength == TCL_INDEX_NONE) && !nocase) {
		    memCmpFn = (memCmpFn_t) TclpUtfNcmp2;
		} else {
		    s1len = Tcl_NumUtfChars(s1, s1len);
		    s2len = Tcl_NumUtfChars(s2, s2len);
		    memCmpFn = (memCmpFn_t)
			    (nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp);
		}
	    }
	}





	length = (s1len < s2len) ? s1len : s2len;
	if (reqlength == TCL_INDEX_NONE) {
	    /*
	     * The requested length is negative, so we ignore it by setting it
	     * to length + 1 so we correct the match var.
	     */

	    reqlength = length + 1;
	} else if (reqlength > 0 && reqlength < length) {
	    length = reqlength;
	}

	if (checkEq && (s1len != s2len)) {
	    match = 1;		/* This will be reversed below. */
	} else {
	    /*
	     * The comparison function should compare up to the minimum byte
	     * length only.
	     */








|
















|
|



|





>
>
>
>

|

|
|







|







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
		    match = 0;
		    goto matchdone;
		}
	    } else {
		s1 = Tcl_GetStringFromObj(value1Ptr, &s1len);
		s2 = Tcl_GetStringFromObj(value2Ptr, &s2len);
	    }
	    if (!nocase && checkEq && reqlength < 0) {
		/*
		 * 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.
		 */

		memCmpFn = memcmp;
	    } else {
		/*
		 * As a catch-all we will work with UTF-8. We cannot use
		 * memcmp() as that is unsafe with any string containing NUL
		 * (\xC0\x80 in Tcl's utf rep). We can use the more efficient
		 * TclpUtfNcmp2 if we are case-sensitive and no specific
		 * length was requested.
		 */

		if ((reqlength < 0) && !nocase) {
		    memCmpFn = (memCmpFn_t)(void *)TclpUtfNcmp2;
		} else {
		    s1len = Tcl_NumUtfChars(s1, s1len);
		    s2len = Tcl_NumUtfChars(s2, s2len);
		    memCmpFn = (memCmpFn_t)(void *)
			    (nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp);
		}
	    }
	}

	/* At this point s1len, s2len, and reqlength should by now have been
	 * adjusted so that they are all in the units expected by the selected
	 * comparison function.
	 */
	length = (s1len < s2len) ? s1len : s2len;
	if (reqlength < 0) {
	    /*
	     * The requested length is negative, so ignore it by setting it
	     * to length + 1 to correct the match var.
	     */

	    reqlength = length + 1;
	} else if (reqlength > 0 && reqlength < length) {
	    length = reqlength;
	}

	if (checkEq && reqlength < 0 && (s1len != s2len)) {
	    match = 1;		/* This will be reversed below. */
	} else {
	    /*
	     * The comparison function should compare up to the minimum byte
	     * length only.
	     */

3647
3648
3649
3650
3651
3652
3653
3654
3655
3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
TclStringFirst(
    Tcl_Obj *needle,
    Tcl_Obj *haystack,
    size_t start)
{
    size_t lh = 0, ln = Tcl_GetCharLength(needle);
    size_t value = TCL_INDEX_NONE;
    Tcl_UniChar *checkStr, *endStr, *uh, *un;
    Tcl_Obj *obj;

    if (start == TCL_INDEX_NONE) {
	start = 0;
    }
    if (ln == 0) {
	/* We don't find empty substrings.  Bizarre!
	 * Whenever this routine is turned into a proper substring
	 * finder, change to `return start` after limits imposed. */
	goto firstEnd;







|

|
|



|







3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
TclStringFirst(
    Tcl_Obj *needle,
    Tcl_Obj *haystack,
    Tcl_Size start)
{
    Tcl_Size lh = 0, ln = Tcl_GetCharLength(needle);
    Tcl_Size value = -1;
    Tcl_UniChar *checkStr, *endStr, *uh, *un;
    Tcl_Obj *obj;

    if (start < 0) {
	start = 0;
    }
    if (ln == 0) {
	/* We don't find empty substrings.  Bizarre!
	 * Whenever this routine is turned into a proper substring
	 * finder, change to `return start` after limits imposed. */
	goto firstEnd;
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
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
TclStringLast(
    Tcl_Obj *needle,
    Tcl_Obj *haystack,
    size_t last)
{
    size_t lh = 0, ln = Tcl_GetCharLength(needle);
    size_t value = TCL_INDEX_NONE;
    Tcl_UniChar *checkStr, *uh, *un;
    Tcl_Obj *obj;

    if (ln == 0) {
	/*
	 * 	We don't find empty substrings.  Bizarre!
	 *
	 * 	TODO: When we one day make this a true substring
	 * 	finder, change this to "return last", after limitation.
	 */
	goto lastEnd;
    }

    if (TclIsPureByteArray(needle) && TclIsPureByteArray(haystack)) {
	unsigned char *check, *bh = Tcl_GetByteArrayFromObj(haystack, &lh);
	unsigned char *bn = Tcl_GetByteArrayFromObj(needle, &ln);

	if (last + 1 >= lh + 1) {
	    last = lh - 1;
	}
	if (last + 1 < ln) {
	    /* Don't start the loop if there cannot be a valid answer */
	    goto lastEnd;
	}
	check = bh + last + 1 - ln;







|

|
|

















|







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

Tcl_Obj *
TclStringLast(
    Tcl_Obj *needle,
    Tcl_Obj *haystack,
    Tcl_Size last)
{
    Tcl_Size lh = 0, ln = Tcl_GetCharLength(needle);
    Tcl_Size value = -1;
    Tcl_UniChar *checkStr, *uh, *un;
    Tcl_Obj *obj;

    if (ln == 0) {
	/*
	 * 	We don't find empty substrings.  Bizarre!
	 *
	 * 	TODO: When we one day make this a true substring
	 * 	finder, change this to "return last", after limitation.
	 */
	goto lastEnd;
    }

    if (TclIsPureByteArray(needle) && TclIsPureByteArray(haystack)) {
	unsigned char *check, *bh = Tcl_GetByteArrayFromObj(haystack, &lh);
	unsigned char *bn = Tcl_GetByteArrayFromObj(needle, &ln);

	if (last >= lh) {
	    last = lh - 1;
	}
	if (last + 1 < ln) {
	    /* Don't start the loop if there cannot be a valid answer */
	    goto lastEnd;
	}
	check = bh + last + 1 - ln;
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
	}
	goto lastEnd;
    }

    uh = Tcl_GetUnicodeFromObj(haystack, &lh);
    un = Tcl_GetUnicodeFromObj(needle, &ln);

    if (last + 1 >= lh + 1) {
	last = lh - 1;
    }
    if (last + 1 < ln) {
	/* Don't start the loop if there cannot be a valid answer */
	goto lastEnd;
    }
    checkStr = uh + last + 1 - ln;







|







3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
	}
	goto lastEnd;
    }

    uh = Tcl_GetUnicodeFromObj(haystack, &lh);
    un = Tcl_GetUnicodeFromObj(needle, &ln);

    if (last >= lh) {
	last = lh - 1;
    }
    if (last + 1 < ln) {
	/* Don't start the loop if there cannot be a valid answer */
	goto lastEnd;
    }
    checkStr = uh + last + 1 - ln;
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
 *---------------------------------------------------------------------------
 */

static void
ReverseBytes(
    unsigned char *to,		/* Copy bytes into here... */
    unsigned char *from,	/* ...from here... */
    size_t count)		/* Until this many are copied, */
				/* reversing as you go. */
{
    unsigned char *src = from + count;

    if (to == from) {
	/* Reversing in place */
	while (--src > to) {







|







3895
3896
3897
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
 *---------------------------------------------------------------------------
 */

static void
ReverseBytes(
    unsigned char *to,		/* Copy bytes into here... */
    unsigned char *from,	/* ...from here... */
    Tcl_Size count)		/* Until this many are copied, */
				/* reversing as you go. */
{
    unsigned char *src = from + count;

    if (to == from) {
	/* Reversing in place */
	while (--src > to) {
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
    Tcl_UniChar ch = 0;
    int inPlace = flags & TCL_STRING_IN_PLACE;
#if TCL_UTF_MAX < 4
    int needFlip = 0;
#endif

    if (TclIsPureByteArray(objPtr)) {
	size_t numBytes = 0;
	unsigned char *from = Tcl_GetByteArrayFromObj(objPtr, &numBytes);

	if (!inPlace || Tcl_IsShared(objPtr)) {
	    objPtr = Tcl_NewByteArrayObj(NULL, numBytes);
	}
	ReverseBytes(Tcl_GetBytesFromObj(NULL, objPtr, (size_t *)NULL), from, numBytes);
	return objPtr;
    }

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    if (stringPtr->hasUnicode) {
	Tcl_UniChar *from = Tcl_GetUnicode(objPtr);
	stringPtr = GET_STRING(objPtr);
	Tcl_UniChar *src = from + stringPtr->numChars;
	Tcl_UniChar *to;

	if (!inPlace || Tcl_IsShared(objPtr)) {
	    /*
	     * Create a non-empty, pure unicode value, so we can coax
	     * Tcl_SetObjLength into growing the unicode rep buffer.
	     */

	    objPtr = Tcl_NewUnicodeObj(&ch, 1);
	    Tcl_SetObjLength(objPtr, stringPtr->numChars);
	    to = Tcl_GetUnicode(objPtr);
	    stringPtr = GET_STRING(objPtr);
	    while (--src >= from) {







|





|














|
|







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
    Tcl_UniChar ch = 0;
    int inPlace = flags & TCL_STRING_IN_PLACE;
#if TCL_UTF_MAX < 4
    int needFlip = 0;
#endif

    if (TclIsPureByteArray(objPtr)) {
	Tcl_Size numBytes = 0;
	unsigned char *from = Tcl_GetByteArrayFromObj(objPtr, &numBytes);

	if (!inPlace || Tcl_IsShared(objPtr)) {
	    objPtr = Tcl_NewByteArrayObj(NULL, numBytes);
	}
	ReverseBytes(Tcl_GetByteArrayFromObj(objPtr, (Tcl_Size *)NULL), from, numBytes);
	return objPtr;
    }

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    if (stringPtr->hasUnicode) {
	Tcl_UniChar *from = Tcl_GetUnicode(objPtr);
	stringPtr = GET_STRING(objPtr);
	Tcl_UniChar *src = from + stringPtr->numChars;
	Tcl_UniChar *to;

	if (!inPlace || Tcl_IsShared(objPtr)) {
	    /*
	     * Create a non-empty, pure Unicode value, so we can coax
	     * Tcl_SetObjLength into growing the Unicode rep buffer.
	     */

	    objPtr = Tcl_NewUnicodeObj(&ch, 1);
	    Tcl_SetObjLength(objPtr, stringPtr->numChars);
	    to = Tcl_GetUnicode(objPtr);
	    stringPtr = GET_STRING(objPtr);
	    while (--src >= from) {
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
		}
	    }
	}
#endif
    }

    if (objPtr->bytes) {
	size_t numChars = stringPtr->numChars;
	size_t numBytes = objPtr->length;
	char *to, *from = objPtr->bytes;

	if (!inPlace || Tcl_IsShared(objPtr)) {
	    TclNewObj(objPtr);
	    Tcl_SetObjLength(objPtr, numBytes);
	}
	to = objPtr->bytes;

	if ((numChars == TCL_INDEX_NONE) || (numChars < numBytes)) {
	    /*
	     * Either numChars == -1 and we don't know how many chars are
	     * represented by objPtr->bytes and we need Pass 1 just in case,
	     * or numChars >= 0 and we know we have fewer chars than bytes, so
	     * we know there's a multibyte character needing Pass 1.
	     *
	     * Pass 1. Reverse the bytes of each multi-byte character.
	     */

	    size_t bytesLeft = numBytes;
	    int chw;

	    while (bytesLeft) {
		/*
		 * NOTE: We know that the from buffer is NUL-terminated. It's
		 * part of the contract for objPtr->bytes values. Thus, we can
		 * skip calling Tcl_UtfCharComplete() here.
		 */

		size_t bytesInChar = TclUtfToUCS4(from, &chw);

		ReverseBytes((unsigned char *)to, (unsigned char *)from,
			bytesInChar);
		to += bytesInChar;
		from += bytesInChar;
		bytesLeft -= bytesInChar;
	    }







|
|








|









|









|







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

    if (objPtr->bytes) {
	Tcl_Size numChars = stringPtr->numChars;
	Tcl_Size numBytes = objPtr->length;
	char *to, *from = objPtr->bytes;

	if (!inPlace || Tcl_IsShared(objPtr)) {
	    TclNewObj(objPtr);
	    Tcl_SetObjLength(objPtr, numBytes);
	}
	to = objPtr->bytes;

	if (numChars < numBytes) {
	    /*
	     * Either numChars == -1 and we don't know how many chars are
	     * 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.
	     */

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

		int bytesInChar = TclUtfToUCS4(from, &chw);

		ReverseBytes((unsigned char *)to, (unsigned char *)from,
			bytesInChar);
		to += bytesInChar;
		from += bytesInChar;
		bytesLeft -= bytesInChar;
	    }
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
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
TclStringReplace(
    Tcl_Interp *interp,		/* For error reporting, may be NULL */
    Tcl_Obj *objPtr,		/* String to act upon */
    size_t first,		/* First index to replace */
    size_t count,		/* How many chars to replace */
    Tcl_Obj *insertPtr,		/* Replacement string, may be NULL */
    int flags)			/* TCL_STRING_IN_PLACE => attempt in-place */
{
    int inPlace = flags & TCL_STRING_IN_PLACE;
    Tcl_Obj *result;

    /* Replace nothing with nothing */
    if ((insertPtr == NULL) && (count == 0)) {
	if (inPlace) {
	    return objPtr;
	} else {
	    return Tcl_DuplicateObj(objPtr);
	}



    }

    /*
     * The caller very likely had to call Tcl_GetCharLength() or similar
     * to be able to process index values.  This means it is likely that
     * objPtr is either a proper "bytearray" or a "string" or else it has
     * a known and short string rep.
     */

    if (TclIsPureByteArray(objPtr)) {
	size_t numBytes = 0;
	unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &numBytes);

	if (insertPtr == NULL) {
	    /* Replace something with nothing. */

	    assert ( first <= numBytes ) ;
	    assert ( count <= numBytes ) ;







|
|







|





>
>
>










|







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

Tcl_Obj *
TclStringReplace(
    Tcl_Interp *interp,		/* For error reporting, may be NULL */
    Tcl_Obj *objPtr,		/* String to act upon */
    Tcl_Size first,		/* First index to replace */
    Tcl_Size count,		/* How many chars to replace */
    Tcl_Obj *insertPtr,		/* Replacement string, may be NULL */
    int flags)			/* TCL_STRING_IN_PLACE => attempt in-place */
{
    int inPlace = flags & TCL_STRING_IN_PLACE;
    Tcl_Obj *result;

    /* Replace nothing with nothing */
    if ((insertPtr == NULL) && (count <= 0)) {
	if (inPlace) {
	    return objPtr;
	} else {
	    return Tcl_DuplicateObj(objPtr);
	}
    }
    if (first < 0) {
	first = 0;
    }

    /*
     * The caller very likely had to call Tcl_GetCharLength() or similar
     * 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)) {
	Tcl_Size numBytes = 0;
	unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &numBytes);

	if (insertPtr == NULL) {
	    /* Replace something with nothing. */

	    assert ( first <= numBytes ) ;
	    assert ( count <= numBytes ) ;
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

	/* Replace everything */
	if ((first == 0) && (count == numBytes)) {
	    return insertPtr;
	}

	if (TclIsPureByteArray(insertPtr)) {
	    size_t newBytes = 0;
	    unsigned char *iBytes
		    = Tcl_GetByteArrayFromObj(insertPtr, &newBytes);

	    if (count == newBytes && inPlace && !Tcl_IsShared(objPtr)) {
		/*
		 * Removal count and replacement count are equal.
		 * Other conditions permit. Do in-place splice.
		 */

		memcpy(bytes + first, iBytes, count);
		Tcl_InvalidateStringRep(objPtr);
		return objPtr;
	    }

	    if (newBytes > (TCL_SIZE_SMAX - (numBytes - count))) {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "max size for a Tcl value (%" TCL_Z_MODIFIER "u bytes) exceeded",
			    TCL_SIZE_SMAX));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
		}
		return NULL;
	    }
	    result = Tcl_NewByteArrayObj(NULL, numBytes - count + newBytes);
								/* PANIC? */
	    Tcl_SetByteArrayLength(result, 0);







|














|


|
|







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

	/* Replace everything */
	if ((first == 0) && (count == numBytes)) {
	    return insertPtr;
	}

	if (TclIsPureByteArray(insertPtr)) {
	    Tcl_Size newBytes = 0;
	    unsigned char *iBytes
		    = Tcl_GetByteArrayFromObj(insertPtr, &newBytes);

	    if (count == newBytes && inPlace && !Tcl_IsShared(objPtr)) {
		/*
		 * Removal count and replacement count are equal.
		 * Other conditions permit. Do in-place splice.
		 */

		memcpy(bytes + first, iBytes, count);
		Tcl_InvalidateStringRep(objPtr);
		return objPtr;
	    }

	    if (newBytes > (TCL_SIZE_MAX - (numBytes - count))) {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "max size for a Tcl value (%" TCL_SIZE_MODIFIER "d bytes) exceeded",
			    TCL_SIZE_MAX));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
		}
		return NULL;
	    }
	    result = Tcl_NewByteArrayObj(NULL, numBytes - count + newBytes);
								/* PANIC? */
	    Tcl_SetByteArrayLength(result, 0);
4126
4127
4128
4129
4130
4131
4132
4133
4134
4135
4136
4137
4138
4139
4140
     * TODO: Figure out how not to generate a Tcl_UniChar array rep
     * when it can be determined objPtr->bytes points to a string of
     * all single-byte characters so we can index it directly.
     */

    /* The traditional implementation... */
    {
	size_t numChars;
	Tcl_UniChar *ustring = Tcl_GetUnicodeFromObj(objPtr, &numChars);

	/* TODO: Is there an in-place option worth pursuing here? */

	result = Tcl_NewUnicodeObj(ustring, first);
	if (insertPtr) {
	    Tcl_AppendObjToObj(result, insertPtr);







|







4183
4184
4185
4186
4187
4188
4189
4190
4191
4192
4193
4194
4195
4196
4197
     * TODO: Figure out how not to generate a Tcl_UniChar array rep
     * 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... */
    {
	Tcl_Size 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);
4150
4151
4152
4153
4154
4155
4156
4157
4158
4159
4160
4161
4162
4163
4164

/*
 *---------------------------------------------------------------------------
 *
 * FillUnicodeRep --
 *
 *	Populate the Unicode internal rep with the Unicode form of its string
 *	rep. The object must alread have a "String" internal rep.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Reallocates the String internal rep.
 *







|







4207
4208
4209
4210
4211
4212
4213
4214
4215
4216
4217
4218
4219
4220
4221

/*
 *---------------------------------------------------------------------------
 *
 * FillUnicodeRep --
 *
 *	Populate the Unicode internal rep with the Unicode form of its string
 *	rep. The object must already have a "String" internal rep.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Reallocates the String internal rep.
 *
4176
4177
4178
4179
4180
4181
4182
4183
4184
4185
4186
4187
4188
4189
4190
4191
4192
4193
4194
	    stringPtr->numChars);
}

static void
ExtendUnicodeRepWithString(
    Tcl_Obj *objPtr,
    const char *bytes,
    size_t numBytes,
    size_t numAppendChars)
{
    String *stringPtr = GET_STRING(objPtr);
    size_t needed, numOrigChars = 0;
    Tcl_UniChar *dst, unichar = 0;

    if (stringPtr->hasUnicode) {
	numOrigChars = stringPtr->numChars;
    }
    if (numAppendChars == TCL_INDEX_NONE) {
	TclNumUtfCharsM(numAppendChars, bytes, numBytes);







|
|


|







4233
4234
4235
4236
4237
4238
4239
4240
4241
4242
4243
4244
4245
4246
4247
4248
4249
4250
4251
	    stringPtr->numChars);
}

static void
ExtendUnicodeRepWithString(
    Tcl_Obj *objPtr,
    const char *bytes,
    Tcl_Size numBytes,
    Tcl_Size numAppendChars)
{
    String *stringPtr = GET_STRING(objPtr);
    Tcl_Size needed, numOrigChars = 0;
    Tcl_UniChar *dst, unichar = 0;

    if (stringPtr->hasUnicode) {
	numOrigChars = stringPtr->numChars;
    }
    if (numAppendChars == TCL_INDEX_NONE) {
	TclNumUtfCharsM(numAppendChars, bytes, numBytes);
4248
4249
4250
4251
4252
4253
4254
4255
4256
4257
4258
4259
4260
4261
4262

    if (srcStringPtr->numChars == TCL_INDEX_NONE) {
	/*
	 * The String struct in the source value holds zero useful data. Don't
	 * bother copying it. Don't even bother allocating space in which to
	 * copy it. Just let the copy be untyped.
	 */

	return;
    }

    if (srcStringPtr->hasUnicode) {
	int copyMaxChars;

	if (srcStringPtr->maxChars / 2 >= srcStringPtr->numChars) {







<







4305
4306
4307
4308
4309
4310
4311

4312
4313
4314
4315
4316
4317
4318

    if (srcStringPtr->numChars == TCL_INDEX_NONE) {
	/*
	 * The String struct in the source value holds zero useful data. Don't
	 * bother copying it. Don't even bother allocating space in which to
	 * copy it. Just let the copy be untyped.
	 */

	return;
    }

    if (srcStringPtr->hasUnicode) {
	int copyMaxChars;

	if (srcStringPtr->maxChars / 2 >= srcStringPtr->numChars) {
4300
4301
4302
4303
4304
4305
4306
4307
4308
4309
4310
4311
4312
4313
4314
4315
 *
 *	Create an internal representation of type "String" for an object.
 *
 * Results:
 *	This operation always succeeds and returns TCL_OK.
 *
 * Side effects:
 *	Any old internal reputation for objPtr is freed and the internal
 *	representation is set to "String".
 *
 *----------------------------------------------------------------------
 */

static int
SetStringFromAny(
    TCL_UNUSED(Tcl_Interp *),







|
|







4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
 *
 *	Create an internal representation of type "String" for an object.
 *
 * Results:
 *	This operation always succeeds and returns TCL_OK.
 *
 * Side effects:
 *	Any old internal representation for objPtr is freed and the internal
 *	representation is set to &tclStringType.
 *
 *----------------------------------------------------------------------
 */

static int
SetStringFromAny(
    TCL_UNUSED(Tcl_Interp *),
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
 *	Update the string representation for an object whose internal
 *	representation is "String".
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The object's string may be set by converting its Unicode represention
 *	to UTF format.
 *
 *----------------------------------------------------------------------
 */

static void
UpdateStringOfString(







|







4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
 *	Update the string representation for an object whose internal
 *	representation is "String".
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The object's string may be set by converting its Unicode representation
 *	to UTF format.
 *
 *----------------------------------------------------------------------
 */

static void
UpdateStringOfString(
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
     * memory pointed to by that NULL pointer is clearly bogus, and
     * needs a reset.
     */

    stringPtr->allocated = 0;

    if (stringPtr->numChars == 0) {
	TclInitStringRep(objPtr, NULL, 0);
    } else {
	(void) ExtendStringRepWithUnicode(objPtr, stringPtr->unicode,
		stringPtr->numChars);
    }
}

static size_t
ExtendStringRepWithUnicode(
    Tcl_Obj *objPtr,
    const Tcl_UniChar *unicode,
    size_t numChars)
{
    /*
     * Pre-condition: this is the "string" Tcl_ObjType.
     */

    size_t i, origLength, size = 0;
    char *dst;
    String *stringPtr = GET_STRING(objPtr);

    if (numChars == TCL_INDEX_NONE) {
	numChars = UnicodeLength(unicode);
    }

    if (numChars == 0) {
	return 0;
    }

    if (objPtr->bytes == NULL) {
	objPtr->length = 0;
    }
    size = origLength = objPtr->length;

    /*
     * Quick cheap check in case we have more than enough room.
     */

    if (numChars <= (INT_MAX - size)/TCL_UTF_MAX
	    && stringPtr->allocated >= size + numChars * TCL_UTF_MAX) {
	goto copyBytes;
    }

    for (i = 0; i < numChars; i++) {

	size += TclUtfCount(unicode[i]);
    }




    /*
     * Grow space if needed.
     */

    if (size > stringPtr->allocated) {
	GrowStringBuffer(objPtr, size, 1);
    }

  copyBytes:
    dst = objPtr->bytes + origLength;








    for (i = 0; i < numChars; i++) {
	dst += Tcl_UniCharToUtf(unicode[i], dst);
    }
    *dst = '\0';
    objPtr->length = dst - objPtr->bytes;
    return numChars;
}







|






|



|


|


|



|
















|




|
>


>
>
>











>
>
>
>
>
>
>
>







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
     * memory pointed to by that NULL pointer is clearly bogus, and
     * needs a reset.
     */

    stringPtr->allocated = 0;

    if (stringPtr->numChars == 0) {
	TclInitEmptyStringRep(objPtr);
    } else {
	(void) ExtendStringRepWithUnicode(objPtr, stringPtr->unicode,
		stringPtr->numChars);
    }
}

static Tcl_Size
ExtendStringRepWithUnicode(
    Tcl_Obj *objPtr,
    const Tcl_UniChar *unicode,
    Tcl_Size numChars)
{
    /*
     * Precondition: this is the "string" Tcl_ObjType.
     */

    Tcl_Size i, origLength, size = 0;
    char *dst;
    String *stringPtr = GET_STRING(objPtr);

    if (numChars < 0) {
	numChars = UnicodeLength(unicode);
    }

    if (numChars == 0) {
	return 0;
    }

    if (objPtr->bytes == NULL) {
	objPtr->length = 0;
    }
    size = origLength = objPtr->length;

    /*
     * Quick cheap check in case we have more than enough room.
     */

    if (numChars <= (TCL_SIZE_MAX - size)/TCL_UTF_MAX
	    && stringPtr->allocated >= size + numChars * TCL_UTF_MAX) {
	goto copyBytes;
    }

    for (i = 0; i < numChars && size >= 0; i++) {
	/* TODO - overflow check! I don't think check below at end suffices */
	size += TclUtfCount(unicode[i]);
    }
    if (size < 0) {
	Tcl_Panic("max size for a Tcl value (%" TCL_SIZE_MODIFIER "d bytes) exceeded", TCL_SIZE_MAX);
    }

    /*
     * Grow space if needed.
     */

    if (size > stringPtr->allocated) {
	GrowStringBuffer(objPtr, size, 1);
    }

  copyBytes:
    dst = objPtr->bytes + origLength;
#if TCL_UTF_MAX < 4
    /* Initialize the buffer so that some random data doesn't trick
     * Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
     * Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
     * prior non-stateful nature, this call to memset can also be removed.
     */
    memset(dst, 0xff, stringPtr->allocated - origLength);
#endif
    for (i = 0; i < numChars; i++) {
	dst += Tcl_UniCharToUtf(unicode[i], dst);
    }
    *dst = '\0';
    objPtr->length = dst - objPtr->bytes;
    return numChars;
}

Changes to generic/tclStringRep.h.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26

27
28
29
30
31
32
33
34
35
36
37
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
/*
 * tclStringRep.h --
 *
 *	This file contains the definition of the Unicode string internal
 *	representation and macros to access it.
 *
 *	A Unicode string is an internationalized string. Conceptually, a
 *	Unicode string is an array of 16-bit quantities organized as a
 *	sequence of properly formed UTF-8 characters. There is a one-to-one
 *	map between Unicode and UTF characters. Because Unicode characters
 *	have a fixed width, operations such as indexing operate on Unicode
 *	data. The String object is optimized for the case where each UTF char
 *	in a string is only one byte. In this case, we store the value of
 *	numChars, but we don't store the Unicode data (unless Tcl_GetUnicode
 *	is explicitly called).
 *
 *	The String object type stores one or both formats. The default
 *	behavior is to store UTF. Once Unicode is calculated by a function, it
 *	is stored in the internal rep for future access (without an additional
 *	O(n) cost).
 *
 *	To allow many appends to be done to an object without constantly
 *	reallocating the space for the string or Unicode representation, we
 *	allocate double the space for the string or Unicode and use the
 *	internal representation to keep track of how much space is used vs.
 *	allocated.

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

#ifndef _TCLSTRINGREP
#define _TCLSTRINGREP


/*
 * The following structure is the internal rep for a String object. It keeps
 * track of how much memory has been used and how much has been allocated for
 * the Unicode and UTF string to enable growing and shrinking of the UTF and
 * Unicode reps of the String object with fewer mallocs. To optimize string
 * length and indexing operations, this structure also stores the number of
 * characters (same of UTF and Unicode!) once that value has been computed.
 *
 * Under normal configurations, what Tcl calls "Unicode" is actually UTF-16
 * restricted to the Basic Multilingual Plane (i.e. U+00000 to U+0FFFF). This
 * can be officially modified by altering the definition of Tcl_UniChar in
 * tcl.h, but do not do that unless you are sure what you're doing!
 */

typedef struct {
    Tcl_Size numChars;		/* The number of chars in the string.
				 * TCL_INDEX_NONE means this value has not been
				 * calculated. Any other means that there is a valid
				 * Unicode rep, or that the number of UTF bytes ==
				 * the number of chars. */
    Tcl_Size allocated;		/* The amount of space actually allocated for
				 * the UTF string (minus 1 byte for the
				 * termination char). */

    Tcl_Size maxChars;		/* Max number of chars that can fit in the
				 * space allocated for the unicode array. */
    int hasUnicode;		/* Boolean determining whether the string has
				 * a Unicode representation. */
    Tcl_UniChar unicode[TCLFLEXARRAY];	/* The array of Unicode chars. The actual size
				 * of this field depends on the 'maxChars'
				 * field above. */
} String;





#define STRING_SIZE(numChars) \
    (offsetof(String, unicode) + sizeof(Tcl_UniChar) + ((numChars) * sizeof(Tcl_UniChar)))
#define stringAttemptAlloc(numChars) \
    (String *) Tcl_AttemptAlloc(STRING_SIZE(numChars))
#define stringAlloc(numChars) \
    (String *) Tcl_Alloc(STRING_SIZE(numChars))
#define stringRealloc(ptr, numChars) \



|
|

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















|
|

|
<
<
<
<
<








|
|
|
>

|

|
|
|
|


>
>
>
>







1
2
3
4
5
6
7











8







9
10
11
12
13
14
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
/*
 * tclStringRep.h --
 *
 *  This file contains the definition of internal representations of a string
 *  and macros to access it.
 *
 *  Conceptually, a string is a sequence of Unicode code points. Internally











 *  it may be stored in an encoding form such as a modified version of UTF-8







 *  or UTF-16 (when TCL_UTF_MAX=3) or UTF-32.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifndef _TCLSTRINGREP
#define _TCLSTRINGREP


/*
 * The following structure is the internal rep for a String object. It keeps
 * track of how much memory has been used and how much has been allocated for
 * the various representations to enable growing and shrinking of
 * the String object with fewer mallocs. To optimize string
 * length and indexing operations, this structure also stores the number of
 * code points (independent of encoding form) once that value has been computed.





 */

typedef struct {
    Tcl_Size numChars;		/* The number of chars in the string.
				 * TCL_INDEX_NONE means this value has not been
				 * calculated. Any other means that there is a valid
				 * Unicode rep, or that the number of UTF bytes ==
				 * the number of chars. */
    Tcl_Size allocated;		/* The amount of space allocated for
				 * the UTF-8 string. Does not include nul
				 * terminator so actual allocation is
				 * (allocated+1). */
    Tcl_Size maxChars;		/* Max number of chars that can fit in the
				 * space allocated for the Unicode array. */
    int hasUnicode;		/* Boolean determining whether the string has
				 * a Tcl_UniChar representation. */
    Tcl_UniChar unicode[TCLFLEXARRAY];	/* The array of Tcl_UniChar units.
				 * The actual size of this field depends on
				 * the maxChars field above. */
} String;

/* Limit on string lengths. The -1 because limit does not include the nul */
#define STRING_MAXCHARS \
    ((Tcl_Size)((TCL_SIZE_MAX - offsetof(String, unicode))/sizeof(Tcl_UniChar) - 1))
/* Memory needed to hold a string of length numChars - including NUL */
#define STRING_SIZE(numChars) \
    (offsetof(String, unicode) + sizeof(Tcl_UniChar) + ((numChars) * sizeof(Tcl_UniChar)))
#define stringAttemptAlloc(numChars) \
    (String *) Tcl_AttemptAlloc(STRING_SIZE(numChars))
#define stringAlloc(numChars) \
    (String *) Tcl_Alloc(STRING_SIZE(numChars))
#define stringRealloc(ptr, numChars) \

Changes to generic/tclStubInit.c.

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
#define TclStaticLibrary Tcl_StaticLibrary
#undef Tcl_UniCharToUtfDString
#undef Tcl_UtfToUniCharDString
#undef Tcl_UtfToUniChar
#undef Tcl_UniCharLen
#undef TclObjInterpProc
#if !defined(_WIN32) && !defined(__CYGWIN__)
#undef Tcl_WinConvertError
#define Tcl_WinConvertError 0










#endif
#undef Tcl_Close
#define Tcl_Close 0
#undef TclGetByteArrayFromObj
#define TclGetByteArrayFromObj 0
#undef Tcl_GetByteArrayFromObj
#define Tcl_GetByteArrayFromObj 0



#if TCL_UTF_MAX < 4
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_GetUnicodeFromObj (Tcl_UniChar *(*)(Tcl_Obj *, size_t *))(void *)uniCodePanic
#   define TclGetUnicodeFromObj (Tcl_UniChar *(*)(Tcl_Obj *, int *))(void *)uniCodePanic
#   define Tcl_NewUnicodeObj (Tcl_Obj *(*)(const Tcl_UniChar *, size_t))(void *)uniCodePanic
#   define Tcl_SetUnicodeObj (void(*)(Tcl_Obj *, const Tcl_UniChar *, size_t))(void *)uniCodePanic
#   define Tcl_AppendUnicodeToObj (void(*)(Tcl_Obj *, const Tcl_UniChar *, size_t))(void *)uniCodePanic
#endif

#define TclUtfCharComplete Tcl_UtfCharComplete
#define TclUtfNext Tcl_UtfNext
#define TclUtfPrev Tcl_UtfPrev










int TclListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr,
    int *objcPtr, Tcl_Obj ***objvPtr) {
    size_t n = TCL_INDEX_NONE;
    int result = Tcl_ListObjGetElements(interp, listPtr, &n, objvPtr);
    if (objcPtr) {
	if ((sizeof(int) != sizeof(size_t)) && (result == TCL_OK) && (n > INT_MAX)) {
	    if (interp) {
		Tcl_AppendResult(interp, "List too large to be processed", NULL);
	    }
	    return TCL_ERROR;
	}
	*objcPtr = n;
    }
    return result;
}
int TclListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr,
    int *lengthPtr) {
    size_t n = TCL_INDEX_NONE;
    int result = Tcl_ListObjLength(interp, listPtr, &n);
    if (lengthPtr) {
	if ((sizeof(int) != sizeof(size_t)) && (result == TCL_OK) && (n > INT_MAX)) {
	    if (interp) {
		Tcl_AppendResult(interp, "List too large to be processed", NULL);
	    }
	    return TCL_ERROR;
	}
	*lengthPtr = n;
    }
    return result;
}
int TclDictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr,
    int *sizePtr) {
    size_t n = TCL_INDEX_NONE;
    int result = Tcl_DictObjSize(interp, dictPtr, &n);
    if (sizePtr) {
	if ((sizeof(int) != sizeof(size_t)) && (result == TCL_OK) && (n > INT_MAX)) {
	    if (interp) {
		Tcl_AppendResult(interp, "Dict too large to be processed", NULL);
	    }
	    return TCL_ERROR;
	}
	*sizePtr = n;
    }
    return result;
}
int TclSplitList(Tcl_Interp *interp, const char *listStr, int *argcPtr,
	const char ***argvPtr) {
    size_t n = TCL_INDEX_NONE;
    int result = Tcl_SplitList(interp, listStr, &n, argvPtr);
    if (argcPtr) {
	if ((sizeof(int) != sizeof(size_t)) && (result == TCL_OK) && (n > INT_MAX)) {
	    if (interp) {
		Tcl_AppendResult(interp, "List too large to be processed", NULL);
	    }
	    Tcl_Free((void *)*argvPtr);
	    return TCL_ERROR;
	}
	*argcPtr = n;
    }
    return result;
}
void TclSplitPath(const char *path, int *argcPtr, const char ***argvPtr) {
    size_t n = TCL_INDEX_NONE;
    Tcl_SplitPath(path, &n, argvPtr);
    if (argcPtr) {
	if ((sizeof(int) != sizeof(size_t)) && (n > INT_MAX)) {
	    n = TCL_INDEX_NONE; /* No other way to return an error-situation */
	    Tcl_Free((void *)*argvPtr);
	    *argvPtr = NULL;
	}
	*argcPtr = n;
    }
}
Tcl_Obj *TclFSSplitPath(Tcl_Obj *pathPtr, int *lenPtr) {
    size_t n = TCL_INDEX_NONE;
    Tcl_Obj *result = Tcl_FSSplitPath(pathPtr, &n);
    if (lenPtr) {
	if ((sizeof(int) != sizeof(size_t)) && result && (n > INT_MAX)) {
	    Tcl_DecrRefCount(result);
	    return NULL;
	}
	*lenPtr = n;
    }
    return result;
}
int TclParseArgsObjv(Tcl_Interp *interp,
	const Tcl_ArgvInfo *argTable, int *objcPtr, Tcl_Obj *const *objv,
	Tcl_Obj ***remObjv) {
    size_t n = (*objcPtr < 0) ? TCL_INDEX_NONE: (size_t)*objcPtr ;
    int result = Tcl_ParseArgsObjv(interp, argTable, &n, objv, remObjv);
    *objcPtr = (int)n;
    return result;
}


#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







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







>






>
|

|
|
|






>
>
>
>
>
>
>
>
>

|
|








|




|
|








|




|
|








|



|

|









|



|
|







|


|
|






|




|

|

|


>







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
#define TclStaticLibrary Tcl_StaticLibrary
#undef Tcl_UniCharToUtfDString
#undef Tcl_UtfToUniCharDString
#undef Tcl_UtfToUniChar
#undef Tcl_UniCharLen
#undef TclObjInterpProc
#if !defined(_WIN32) && !defined(__CYGWIN__)
# undef Tcl_WinConvertError
# define Tcl_WinConvertError 0
#endif
#if defined(TCL_NO_DEPRECATED)
# undef TclGetStringFromObj
# undef TclGetBytesFromObj
# undef TclGetUnicodeFromObj
# define TclGetStringFromObj 0
# define TclGetBytesFromObj 0
# if TCL_UTF_MAX > 3
#   define TclGetUnicodeFromObj 0
# endif
#endif
#undef Tcl_Close
#define Tcl_Close 0
#undef TclGetByteArrayFromObj
#define TclGetByteArrayFromObj 0
#undef Tcl_GetByteArrayFromObj
#define Tcl_GetByteArrayFromObj 0
#define TclUnusedStubEntry 0


#if TCL_UTF_MAX < 4
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_GetUnicodeFromObj (Tcl_UniChar *(*)(Tcl_Obj *, Tcl_Size *))(void *)uniCodePanic
#   define TclGetUnicodeFromObj (Tcl_UniChar *(*)(Tcl_Obj *, int *))(void *)uniCodePanic
#   define Tcl_NewUnicodeObj (Tcl_Obj *(*)(const Tcl_UniChar *, Tcl_Size))(void *)uniCodePanic
#   define Tcl_SetUnicodeObj (void(*)(Tcl_Obj *, const Tcl_UniChar *, Tcl_Size))(void *)uniCodePanic
#   define Tcl_AppendUnicodeToObj (void(*)(Tcl_Obj *, const Tcl_UniChar *, Tcl_Size))(void *)uniCodePanic
#endif

#define TclUtfCharComplete Tcl_UtfCharComplete
#define TclUtfNext Tcl_UtfNext
#define TclUtfPrev Tcl_UtfPrev

#if defined(TCL_NO_DEPRECATED)
# define TclListObjGetElements 0
# define TclListObjLength 0
# define TclDictObjSize 0
# define TclSplitList 0
# define TclSplitPath 0
# define TclFSSplitPath 0
# define TclParseArgsObjv 0
#else /* !defined(TCL_NO_DEPRECATED) */
int TclListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr,
    void *objcPtr, Tcl_Obj ***objvPtr) {
    Tcl_Size n = TCL_INDEX_NONE;
    int result = Tcl_ListObjGetElements(interp, listPtr, &n, objvPtr);
    if (objcPtr) {
	if ((sizeof(int) != sizeof(size_t)) && (result == TCL_OK) && (n > INT_MAX)) {
	    if (interp) {
		Tcl_AppendResult(interp, "List too large to be processed", NULL);
	    }
	    return TCL_ERROR;
	}
	*(int *)objcPtr = (int)n;
    }
    return result;
}
int TclListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr,
    void *lengthPtr) {
    Tcl_Size n = TCL_INDEX_NONE;
    int result = Tcl_ListObjLength(interp, listPtr, &n);
    if (lengthPtr) {
	if ((sizeof(int) != sizeof(size_t)) && (result == TCL_OK) && (n > INT_MAX)) {
	    if (interp) {
		Tcl_AppendResult(interp, "List too large to be processed", NULL);
	    }
	    return TCL_ERROR;
	}
	*(int *)lengthPtr = (int)n;
    }
    return result;
}
int TclDictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr,
    void *sizePtr) {
    Tcl_Size n = TCL_INDEX_NONE;
    int result = Tcl_DictObjSize(interp, dictPtr, &n);
    if (sizePtr) {
	if ((sizeof(int) != sizeof(size_t)) && (result == TCL_OK) && (n > INT_MAX)) {
	    if (interp) {
		Tcl_AppendResult(interp, "Dict too large to be processed", NULL);
	    }
	    return TCL_ERROR;
	}
	*(int *)sizePtr = (int)n;
    }
    return result;
}
int TclSplitList(Tcl_Interp *interp, const char *listStr, void *argcPtr,
	const char ***argvPtr) {
    Tcl_Size n = TCL_INDEX_NONE;
    int result = Tcl_SplitList(interp, listStr, &n, argvPtr);
    if (argcPtr) {
	if ((sizeof(int) != sizeof(size_t)) && (result == TCL_OK) && (n > INT_MAX)) {
	    if (interp) {
		Tcl_AppendResult(interp, "List too large to be processed", NULL);
	    }
	    Tcl_Free((void *)*argvPtr);
	    return TCL_ERROR;
	}
	*(int *)argcPtr = (int)n;
    }
    return result;
}
void TclSplitPath(const char *path, void *argcPtr, const char ***argvPtr) {
    Tcl_Size n = TCL_INDEX_NONE;
    Tcl_SplitPath(path, &n, argvPtr);
    if (argcPtr) {
	if ((sizeof(int) != sizeof(size_t)) && (n > INT_MAX)) {
	    n = TCL_INDEX_NONE; /* No other way to return an error-situation */
	    Tcl_Free((void *)*argvPtr);
	    *argvPtr = NULL;
	}
	*(int *)argcPtr = (int)n;
    }
}
Tcl_Obj *TclFSSplitPath(Tcl_Obj *pathPtr, void *lenPtr) {
    Tcl_Size n = TCL_INDEX_NONE;
    Tcl_Obj *result = Tcl_FSSplitPath(pathPtr, &n);
    if (lenPtr) {
	if ((sizeof(int) != sizeof(size_t)) && result && (n > INT_MAX)) {
	    Tcl_DecrRefCount(result);
	    return NULL;
	}
	*(int *)lenPtr = (int)n;
    }
    return result;
}
int TclParseArgsObjv(Tcl_Interp *interp,
	const Tcl_ArgvInfo *argTable, void *objcPtr, Tcl_Obj *const *objv,
	Tcl_Obj ***remObjv) {
    Tcl_Size n = (*(int *)objcPtr < 0) ? TCL_INDEX_NONE: (Tcl_Size)*(int *)objcPtr ;
    int result = Tcl_ParseArgsObjv(interp, argTable, &n, objv, remObjv);
    *(int *)objcPtr = (int)n;
    return result;
}
#endif /* !defined(TCL_NO_DEPRECATED) */

#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
228
229
230
231
232
233
234


235
236
237
238
239
240
241
#define TclBN_mp_mod_2d mp_mod_2d
#define TclBN_mp_mul mp_mul
#define TclBN_mp_mul_d mp_mul_d
#define TclBN_mp_mul_2 mp_mul_2
#define TclBN_mp_mul_2d mp_mul_2d
#define TclBN_mp_neg mp_neg
#define TclBN_mp_or mp_or


#define TclBN_mp_radix_size mp_radix_size
#define TclBN_mp_read_radix mp_read_radix
#define TclBN_mp_rshd mp_rshd
#define TclBN_mp_set_i64 mp_set_i64
#define TclBN_mp_set_u64 mp_set_u64
#define TclBN_mp_shrink mp_shrink
#define TclBN_mp_sqr mp_sqr







>
>







250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
#define TclBN_mp_mod_2d mp_mod_2d
#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_pack mp_pack
#define TclBN_mp_pack_count mp_pack_count
#define TclBN_mp_radix_size mp_radix_size
#define TclBN_mp_read_radix mp_read_radix
#define TclBN_mp_rshd mp_rshd
#define TclBN_mp_set_i64 mp_set_i64
#define TclBN_mp_set_u64 mp_set_u64
#define TclBN_mp_shrink mp_shrink
#define TclBN_mp_sqr mp_sqr
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
    0, /* 125 */
    Tcl_GetVariableFullName, /* 126 */
    0, /* 127 */
    Tcl_PopCallFrame, /* 128 */
    Tcl_PushCallFrame, /* 129 */
    Tcl_RemoveInterpResolvers, /* 130 */
    Tcl_SetNamespaceResolvers, /* 131 */
    TclpHasSockets, /* 132 */
    0, /* 133 */
    0, /* 134 */
    0, /* 135 */
    0, /* 136 */
    0, /* 137 */
    TclGetEnv, /* 138 */
    0, /* 139 */







|







551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
    0, /* 125 */
    Tcl_GetVariableFullName, /* 126 */
    0, /* 127 */
    Tcl_PopCallFrame, /* 128 */
    Tcl_PushCallFrame, /* 129 */
    Tcl_RemoveInterpResolvers, /* 130 */
    Tcl_SetNamespaceResolvers, /* 131 */
    0, /* 132 */
    0, /* 133 */
    0, /* 134 */
    0, /* 135 */
    0, /* 136 */
    0, /* 137 */
    TclGetEnv, /* 138 */
    0, /* 139 */
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
    TclBN_mp_init_i64, /* 65 */
    TclBN_mp_init_u64, /* 66 */
    0, /* 67 */
    TclBN_mp_set_u64, /* 68 */
    TclBN_mp_get_mag_u64, /* 69 */
    TclBN_mp_set_i64, /* 70 */
    TclBN_mp_unpack, /* 71 */
    0, /* 72 */
    0, /* 73 */
    0, /* 74 */
    0, /* 75 */
    TclBN_mp_signed_rsh, /* 76 */
    0, /* 77 */
    TclBN_mp_to_ubin, /* 78 */
    0, /* 79 */
    TclBN_mp_to_radix, /* 80 */
};

static const TclStubHooks tclStubHooks = {
    &tclPlatStubs,







|




|







803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
    TclBN_mp_init_i64, /* 65 */
    TclBN_mp_init_u64, /* 66 */
    0, /* 67 */
    TclBN_mp_set_u64, /* 68 */
    TclBN_mp_get_mag_u64, /* 69 */
    TclBN_mp_set_i64, /* 70 */
    TclBN_mp_unpack, /* 71 */
    TclBN_mp_pack, /* 72 */
    0, /* 73 */
    0, /* 74 */
    0, /* 75 */
    TclBN_mp_signed_rsh, /* 76 */
    TclBN_mp_pack_count, /* 77 */
    TclBN_mp_to_ubin, /* 78 */
    0, /* 79 */
    TclBN_mp_to_radix, /* 80 */
};

static const TclStubHooks tclStubHooks = {
    &tclPlatStubs,
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
    Tcl_CreateObjTrace2, /* 677 */
    Tcl_NRCreateCommand2, /* 678 */
    Tcl_NRCallObjProc2, /* 679 */
    Tcl_GetNumberFromObj, /* 680 */
    Tcl_GetNumber, /* 681 */
    Tcl_RemoveChannelMode, /* 682 */
    Tcl_GetEncodingNulLength, /* 683 */
    Tcl_AbstractListGetType, /* 684 */
    Tcl_AbstractListObjNew, /* 685 */
    Tcl_AbstractListObjLength, /* 686 */
    Tcl_AbstractListObjIndex, /* 687 */
    Tcl_AbstractListObjRange, /* 688 */
    Tcl_AbstractListObjReverse, /* 689 */
    Tcl_AbstractListObjGetElements, /* 690 */
    Tcl_AbstractListObjCopy, /* 691 */
    Tcl_AbstractListGetConcreteRep, /* 692 */
    Tcl_AbstractListSetElement, /* 693 */
};

/* !END!: Do not edit above this line. */







|
|
|
|
|
<
<
<
<
<



1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518





1519
1520
1521
    Tcl_CreateObjTrace2, /* 677 */
    Tcl_NRCreateCommand2, /* 678 */
    Tcl_NRCallObjProc2, /* 679 */
    Tcl_GetNumberFromObj, /* 680 */
    Tcl_GetNumber, /* 681 */
    Tcl_RemoveChannelMode, /* 682 */
    Tcl_GetEncodingNulLength, /* 683 */
    Tcl_GetWideUIntFromObj, /* 684 */
    Tcl_DStringToObj, /* 685 */
    Tcl_GetSizeIntFromObj, /* 686 */
    0, /* 687 */
    TclUnusedStubEntry, /* 688 */





};

/* !END!: Do not edit above this line. */

Changes to generic/tclTest.c.

58
59
60
61
62
63
64

65
66
67
68
69
70
71
 * One of the following structures exists for each command created by the
 * "testcmdtoken" command.
 */

typedef struct TestCommandTokenRef {
    int id;			/* Identifier for this reference. */
    Tcl_Command token;		/* Tcl's token for the command. */

    struct TestCommandTokenRef *nextPtr;
				/* Next in list of references. */
} TestCommandTokenRef;

static TestCommandTokenRef *firstCommandTokenRef = NULL;
static int nextCommandTokenRefId = 1;








>







58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
 * One of the following structures exists for each command created by the
 * "testcmdtoken" command.
 */

typedef struct TestCommandTokenRef {
    int id;			/* Identifier for this reference. */
    Tcl_Command token;		/* Tcl's token for the command. */
    const char *value;
    struct TestCommandTokenRef *nextPtr;
				/* Next in list of references. */
} TestCommandTokenRef;

static TestCommandTokenRef *firstCommandTokenRef = NULL;
static int nextCommandTokenRefId = 1;

219
220
221
222
223
224
225

226
227
228
229
230
231
232
233
static int		StaticInitProc(Tcl_Interp *interp);
static Tcl_CmdProc	TestasyncCmd;
static Tcl_ObjCmdProc	TestbumpinterpepochObjCmd;
static Tcl_ObjCmdProc	TestbytestringObjCmd;
static Tcl_ObjCmdProc	TestsetbytearraylengthObjCmd;
static Tcl_ObjCmdProc	TestpurebytesobjObjCmd;
static Tcl_ObjCmdProc	TeststringbytesObjCmd;

static Tcl_CmdProc	TestcmdinfoCmd;
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;







>
|







220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
static int		StaticInitProc(Tcl_Interp *interp);
static Tcl_CmdProc	TestasyncCmd;
static Tcl_ObjCmdProc	TestbumpinterpepochObjCmd;
static Tcl_ObjCmdProc	TestbytestringObjCmd;
static Tcl_ObjCmdProc	TestsetbytearraylengthObjCmd;
static Tcl_ObjCmdProc	TestpurebytesobjObjCmd;
static Tcl_ObjCmdProc	TeststringbytesObjCmd;
static Tcl_ObjCmdProc2	Testcmdobj2ObjCmd;
static Tcl_ObjCmdProc	TestcmdinfoObjCmd;
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;
329
330
331
332
333
334
335

336
337
338
339
340
341
342
static Tcl_ObjCmdProc	TestUtfNextCmd;
static Tcl_ObjCmdProc	TestUtfPrevCmd;
static Tcl_ObjCmdProc	TestNumUtfCharsCmd;
static Tcl_ObjCmdProc	TestFindFirstCmd;
static Tcl_ObjCmdProc	TestFindLastCmd;
static Tcl_ObjCmdProc	TestHashSystemHashCmd;
static Tcl_ObjCmdProc	TestGetIntForIndexCmd;


static Tcl_NRPostProc	NREUnwind_callback;
static Tcl_ObjCmdProc	TestNREUnwind;
static Tcl_ObjCmdProc	TestNRELevels;
static Tcl_ObjCmdProc	TestInterpResolverCmd;
#if defined(HAVE_CPUID) && !defined(MAC_OSX_TCL)
static Tcl_ObjCmdProc	TestcpuidCmd;







>







331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
static Tcl_ObjCmdProc	TestUtfNextCmd;
static Tcl_ObjCmdProc	TestUtfPrevCmd;
static Tcl_ObjCmdProc	TestNumUtfCharsCmd;
static Tcl_ObjCmdProc	TestFindFirstCmd;
static Tcl_ObjCmdProc	TestFindLastCmd;
static Tcl_ObjCmdProc	TestHashSystemHashCmd;
static Tcl_ObjCmdProc	TestGetIntForIndexCmd;
static Tcl_ObjCmdProc	TestLutilCmd;

static Tcl_NRPostProc	NREUnwind_callback;
static Tcl_ObjCmdProc	TestNREUnwind;
static Tcl_ObjCmdProc	TestNRELevels;
static Tcl_ObjCmdProc	TestInterpResolverCmd;
#if defined(HAVE_CPUID) && !defined(MAC_OSX_TCL)
static Tcl_ObjCmdProc	TestcpuidCmd;
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
#endif
#if defined(_MSC_VER)
	    ".msvc-" STRINGIFY(_MSC_VER)
#endif
#ifdef USE_NMAKE
	    ".nmake"
#endif
#ifdef TCL_NO_DEPRECATED
	    ".no-deprecate"
#endif
#if !TCL_THREADS
	    ".no-thread"
#endif
#ifndef TCL_CFG_OPTIMIZED
	    ".no-optimize"
#endif
#ifdef __OBJC__







<
<
<







490
491
492
493
494
495
496



497
498
499
500
501
502
503
#endif
#if defined(_MSC_VER)
	    ".msvc-" STRINGIFY(_MSC_VER)
#endif
#ifdef USE_NMAKE
	    ".nmake"
#endif



#if !TCL_THREADS
	    ".no-thread"
#endif
#ifndef TCL_CFG_OPTIMIZED
	    ".no-optimize"
#endif
#ifdef __OBJC__
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
int
Tcltest_Init(
    Tcl_Interp *interp)		/* Interpreter for application. */
{
    Tcl_CmdInfo info;
    Tcl_Obj **objv, *objPtr;
    Tcl_Size objc;
	int index;
    static const char *const specialOptions[] = {
	"-appinitprocerror", "-appinitprocdeleteinterp",
	"-appinitprocclosestderr", "-appinitprocsetrcfile", NULL
    };

    if (Tcl_InitStubs(interp, "8.7-", 0) == NULL) {
	return TCL_ERROR;







|







523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
int
Tcltest_Init(
    Tcl_Interp *interp)		/* Interpreter for application. */
{
    Tcl_CmdInfo info;
    Tcl_Obj **objv, *objPtr;
    Tcl_Size objc;
    int index;
    static const char *const specialOptions[] = {
	"-appinitprocerror", "-appinitprocdeleteinterp",
	"-appinitprocclosestderr", "-appinitprocsetrcfile", NULL
    };

    if (Tcl_InitStubs(interp, "8.7-", 0) == NULL) {
	return TCL_ERROR;
583
584
585
586
587
588
589


590
591
592
593
594
595
596
597
	    TestbumpinterpepochObjCmd, NULL, NULL);
    Tcl_CreateCommand(interp, "testchannel", TestChannelCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testchannelevent", TestChannelEventCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testcmdtoken", TestcmdtokenCmd, NULL,
	    NULL);


    Tcl_CreateCommand(interp, "testcmdinfo", TestcmdinfoCmd, NULL,
	    NULL);
    Tcl_CreateCommand(interp, "testcmdtrace", TestcmdtraceCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testconcatobj", TestconcatobjCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testcreatecommand", TestcreatecommandCmd,
	    NULL, NULL);







>
>
|







583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
	    TestbumpinterpepochObjCmd, NULL, NULL);
    Tcl_CreateCommand(interp, "testchannel", TestChannelCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testchannelevent", TestChannelEventCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testcmdtoken", TestcmdtokenCmd, NULL,
	    NULL);
    Tcl_CreateObjCommand2(interp, "testcmdobj2", Testcmdobj2ObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testcmdinfo", TestcmdinfoObjCmd, NULL,
	    NULL);
    Tcl_CreateCommand(interp, "testcmdtrace", TestcmdtraceCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testconcatobj", TestconcatobjCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testcreatecommand", TestcreatecommandCmd,
	    NULL, NULL);
719
720
721
722
723
724
725


726
727
728
729
730
731
732
    Tcl_CreateObjCommand(interp, "testinterpresolver", TestInterpResolverCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testgetencpath", TestgetencpathObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testsetencpath", TestsetencpathObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testapplylambda", TestApplyLambdaObjCmd,


	    NULL, NULL);

    if (TclObjTest_Init(interp) != TCL_OK) {
	return TCL_ERROR;
    }
    if (Procbodytest_Init(interp) != TCL_OK) {
	return TCL_ERROR;







>
>







721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
    Tcl_CreateObjCommand(interp, "testinterpresolver", TestInterpResolverCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testgetencpath", TestgetencpathObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testsetencpath", TestsetencpathObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testapplylambda", TestApplyLambdaObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testlutil", TestLutilCmd,
	    NULL, NULL);

    if (TclObjTest_Init(interp) != TCL_OK) {
	return TCL_ERROR;
    }
    if (Procbodytest_Init(interp) != TCL_OK) {
	return TCL_ERROR;
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
	for (asyncPtr = firstHandler; asyncPtr != NULL;
		asyncPtr = asyncPtr->nextPtr) {
	    if (asyncPtr->id == id) {
		Tcl_AsyncMark(asyncPtr->handler);
		break;
	    }
	}
	Tcl_SetObjResult(interp, Tcl_NewStringObj(argv[3], TCL_INDEX_NONE));
	Tcl_MutexUnlock(&asyncTestMutex);
	return code;
    } else if (strcmp(argv[1], "marklater") == 0) {
	if (argc != 3) {
	    goto wrongNumArgs;
	}
	if (Tcl_GetInt(interp, argv[2], &id) != TCL_OK) {







|







926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
	for (asyncPtr = firstHandler; asyncPtr != NULL;
		asyncPtr = asyncPtr->nextPtr) {
	    if (asyncPtr->id == id) {
		Tcl_AsyncMark(asyncPtr->handler);
		break;
	    }
	}
	Tcl_SetObjResult(interp, Tcl_NewStringObj(argv[3], -1));
	Tcl_MutexUnlock(&asyncTestMutex);
	return code;
    } else if (strcmp(argv[1], "marklater") == 0) {
	if (argc != 3) {
	    goto wrongNumArgs;
	}
	if (Tcl_GetInt(interp, argv[2], &id) != TCL_OK) {
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
    iPtr->compileEpoch++;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *


































 * TestcmdinfoCmd --
 *
 *	This procedure implements the "testcmdinfo" command.  It is used to
 *	test Tcl_GetCommandInfo, Tcl_SetCommandInfo, and command creation and
 *	deletion.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Creates and deletes various commands and modifies their data.
 *
 *----------------------------------------------------------------------
 */

static int
TestcmdinfoCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{







    Tcl_CmdInfo info;



    if (argc != 3) {














	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" option cmdName\"", NULL);
	return TCL_ERROR;
    }
    if (strcmp(argv[1], "create") == 0) {














	Tcl_CreateCommand(interp, argv[2], CmdProc1, (void *) "original",
		CmdDelProc1);
    } else if (strcmp(argv[1], "delete") == 0) {


	Tcl_DStringInit(&delString);
	Tcl_DeleteCommand(interp, argv[2]);
	Tcl_DStringResult(interp, &delString);

    } else if (strcmp(argv[1], "get") == 0) {
	if (Tcl_GetCommandInfo(interp, argv[2], &info) ==0) {
	    Tcl_AppendResult(interp, "??", NULL);
	    return TCL_OK;
	}
	if (info.proc == CmdProc1) {
	    Tcl_AppendResult(interp, "CmdProc1", " ",
		    (char *) info.clientData, NULL);
	} else if (info.proc == CmdProc2) {







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















|


|
|

>
>
>
>
>
>
>

>
>

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

|

>
|
|







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
    iPtr->compileEpoch++;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Testcmdobj2 --
 *
 *	Mock up to test the Tcl_CreateCommandObj2 functionality
 *
 * Results:
 *	Standard Tcl result.
 *
 * Side effects:
 *	Sets interpreter result to number of arguments, first arg, last arg.
 *
 *----------------------------------------------------------------------
 */

static int
Testcmdobj2ObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Size objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *resultObj;
    resultObj = Tcl_NewListObj(0, NULL);
    Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewWideIntObj(objc));
    if (objc > 1) {
	Tcl_ListObjAppendElement(interp, resultObj, objv[1]);
	Tcl_ListObjAppendElement(interp, resultObj, objv[objc-1]);
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestcmdinfoObjCmd --
 *
 *	This procedure implements the "testcmdinfo" command.  It is used to
 *	test Tcl_GetCommandInfo, Tcl_SetCommandInfo, and command creation and
 *	deletion.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Creates and deletes various commands and modifies their data.
 *
 *----------------------------------------------------------------------
 */

static int
TestcmdinfoObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])      /* Argument objects. */
{
    static const char *const subcmds[] = {
	   "call", "call2", "create", "delete", "get", "modify", NULL
    };
    enum options {
	CMDINFO_CALL, CMDINFO_CALL2, CMDINFO_CREATE,
	CMDINFO_DELETE, CMDINFO_GET, CMDINFO_MODIFY
    } idx;
    Tcl_CmdInfo info;
    Tcl_Obj **cmdObjv;
    Tcl_Size cmdObjc;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "command arg");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], subcmds, "option", 0,
	    &idx) != TCL_OK) {
	return TCL_ERROR;
    }
    switch (idx) {
    case CMDINFO_CALL:
    case CMDINFO_CALL2:
	if (Tcl_ListObjGetElements(interp, objv[2], &cmdObjc, &cmdObjv) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (cmdObjc == 0) {
	    Tcl_AppendResult(interp, "No command name given", NULL);

	    return TCL_ERROR;
	}
	if (Tcl_GetCommandInfo(interp, Tcl_GetString(cmdObjv[0]), &info) == 0) {
	    return TCL_ERROR;
	}
	if (idx == CMDINFO_CALL) {
	    /*
	     * Note when calling through the old 32-bit API, it is the caller's
	     * responsibility to check that number of arguments is <= INT_MAX.
	     * We do not do that here just so we can test what happens if the
	     * caller mistakenly passes more arguments.
	     */
	    return info.objProc(info.objClientData, interp, cmdObjc, cmdObjv);
	} else {
	    return info.objProc2(info.objClientData2, interp, cmdObjc, cmdObjv);
	}
    case CMDINFO_CREATE:
	Tcl_CreateCommand(interp, Tcl_GetString(objv[2]), CmdProc1,
		(void *)"original", CmdDelProc1);

	break;
    case CMDINFO_DELETE:
	Tcl_DStringInit(&delString);
	Tcl_DeleteCommand(interp, Tcl_GetString(objv[2]));
	Tcl_DStringResult(interp, &delString);
	break;
    case CMDINFO_GET:
	if (Tcl_GetCommandInfo(interp, Tcl_GetString(objv[2]), &info) ==0) {
	    Tcl_AppendResult(interp, "??", NULL);
	    return TCL_OK;
	}
	if (info.proc == CmdProc1) {
	    Tcl_AppendResult(interp, "CmdProc1", " ",
		    (char *) info.clientData, NULL);
	} else if (info.proc == CmdProc2) {
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
	} else if (info.deleteProc == CmdDelProc2) {
	    Tcl_AppendResult(interp, " CmdDelProc2", " ",
		    (char *) info.deleteData, NULL);
	} else {
	    Tcl_AppendResult(interp, " unknown", NULL);
	}
	Tcl_AppendResult(interp, " ", info.namespacePtr->fullName, NULL);
	if (info.isNativeObjectProc) {


	    Tcl_AppendResult(interp, " nativeObjectProc", NULL);


	} else {
	    Tcl_AppendResult(interp, " stringProc", NULL);


	}
    } else if (strcmp(argv[1], "modify") == 0) {


	info.proc = CmdProc2;
	info.clientData = (void *) "new_command_data";
	info.objProc = NULL;
	info.objClientData = NULL;
	info.deleteProc = CmdDelProc2;
	info.deleteData = (void *) "new_delete_data";
	if (Tcl_SetCommandInfo(interp, argv[2], &info) == 0) {
	    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0));
	} else {
	    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(1));
	}
    } else {

	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": must be create, delete, get, or modify", NULL);
	return TCL_ERROR;
    }










    return TCL_OK;
}

static int
CmdProc1(
    void *clientData,	/* String to return. */
    Tcl_Interp *interp,		/* Current interpreter. */







|
>
>

>
>

|
>
>

<
>
>






|




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







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
	} else if (info.deleteProc == CmdDelProc2) {
	    Tcl_AppendResult(interp, " CmdDelProc2", " ",
		    (char *) info.deleteData, NULL);
	} else {
	    Tcl_AppendResult(interp, " unknown", NULL);
	}
	Tcl_AppendResult(interp, " ", info.namespacePtr->fullName, NULL);
	if (info.isNativeObjectProc == 0) {
	    Tcl_AppendResult(interp, " stringProc", NULL);
	} else if (info.isNativeObjectProc == 1) {
	    Tcl_AppendResult(interp, " nativeObjectProc", NULL);
	} else if (info.isNativeObjectProc == 2) {
	    Tcl_AppendResult(interp, " nativeObjectProc2", NULL);
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf("Invalid isNativeObjectProc value %d",
		    info.isNativeObjectProc));
	    return TCL_ERROR;
	}

	break;
    case CMDINFO_MODIFY:
	info.proc = CmdProc2;
	info.clientData = (void *) "new_command_data";
	info.objProc = NULL;
	info.objClientData = NULL;
	info.deleteProc = CmdDelProc2;
	info.deleteData = (void *) "new_delete_data";
	if (Tcl_SetCommandInfo(interp, Tcl_GetString(objv[2]), &info) == 0) {
	    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0));
	} else {
	    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(1));
	}
	break;
    }


    return TCL_OK;
}

static int
CmdProc0(
    void *clientData,	/* String to return. */
    Tcl_Interp *interp,		/* Current interpreter. */
    TCL_UNUSED(int) /*argc*/,
    TCL_UNUSED(const char **) /*argv*/)
{
    TestCommandTokenRef *refPtr = (TestCommandTokenRef *) clientData;
    Tcl_AppendResult(interp, "CmdProc1 ", refPtr->value, NULL);
    return TCL_OK;
}

static int
CmdProc1(
    void *clientData,	/* String to return. */
    Tcl_Interp *interp,		/* Current interpreter. */
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
    Tcl_Interp *interp,		/* Current interpreter. */
    TCL_UNUSED(int) /*argc*/,
    TCL_UNUSED(const char **) /*argv*/)
{
    Tcl_AppendResult(interp, "CmdProc2 ", (char *) clientData, NULL);
    return TCL_OK;
}























static void
CmdDelProc1(
    void *clientData)	/* String to save. */
{
    Tcl_DStringInit(&delString);
    Tcl_DStringAppend(&delString, "CmdDelProc1 ", TCL_INDEX_NONE);
    Tcl_DStringAppend(&delString, (char *) clientData, TCL_INDEX_NONE);
}

static void
CmdDelProc2(
    void *clientData)	/* String to save. */
{
    Tcl_DStringInit(&delString);
    Tcl_DStringAppend(&delString, "CmdDelProc2 ", TCL_INDEX_NONE);
    Tcl_DStringAppend(&delString, (char *) clientData, TCL_INDEX_NONE);
}

/*
 *----------------------------------------------------------------------
 *
 * TestcmdtokenCmd --
 *







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






|
|







|
|







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
    Tcl_Interp *interp,		/* Current interpreter. */
    TCL_UNUSED(int) /*argc*/,
    TCL_UNUSED(const char **) /*argv*/)
{
    Tcl_AppendResult(interp, "CmdProc2 ", (char *) clientData, NULL);
    return TCL_OK;
}

static void
CmdDelProc0(
    void *clientData)	/* String to save. */
{
    TestCommandTokenRef *thisRefPtr, *prevRefPtr = NULL;
    TestCommandTokenRef *refPtr = (TestCommandTokenRef *) clientData;
    int id = refPtr->id;
    for (thisRefPtr = firstCommandTokenRef; refPtr != NULL;
	thisRefPtr = thisRefPtr->nextPtr) {
	if (thisRefPtr->id == id) {
	    if (prevRefPtr != NULL) {
		prevRefPtr->nextPtr = thisRefPtr->nextPtr;
	    } else {
		firstCommandTokenRef = thisRefPtr->nextPtr;
	    }
	    break;
	}
	prevRefPtr = thisRefPtr;
    }
    Tcl_Free(refPtr);
}

static void
CmdDelProc1(
    void *clientData)	/* String to save. */
{
    Tcl_DStringInit(&delString);
    Tcl_DStringAppend(&delString, "CmdDelProc1 ", -1);
    Tcl_DStringAppend(&delString, (char *) clientData, -1);
}

static void
CmdDelProc2(
    void *clientData)	/* String to save. */
{
    Tcl_DStringInit(&delString);
    Tcl_DStringAppend(&delString, "CmdDelProc2 ", -1);
    Tcl_DStringAppend(&delString, (char *) clientData, -1);
}

/*
 *----------------------------------------------------------------------
 *
 * TestcmdtokenCmd --
 *
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
TestcmdtokenCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    TestCommandTokenRef *refPtr;
    char buf[30];
    int id;


    if (argc != 3) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" option arg\"", NULL);
	return TCL_ERROR;
    }
    if (strcmp(argv[1], "create") == 0) {
	refPtr = (TestCommandTokenRef *)Tcl_Alloc(sizeof(TestCommandTokenRef));
	refPtr->token = Tcl_CreateCommand(interp, argv[2], CmdProc1,
		(void *) "original", NULL);
	refPtr->id = nextCommandTokenRefId;

	nextCommandTokenRefId++;
	refPtr->nextPtr = firstCommandTokenRef;
	firstCommandTokenRef = refPtr;
	sprintf(buf, "%d", refPtr->id);
	Tcl_AppendResult(interp, buf, NULL);
    } else if (strcmp(argv[1], "name") == 0) {
	Tcl_Obj *objPtr;

	if (sscanf(argv[2], "%d", &id) != 1) {
	    Tcl_AppendResult(interp, "bad command token \"", argv[2],
		    "\"", NULL);
	    return TCL_ERROR;
	}

	for (refPtr = firstCommandTokenRef; refPtr != NULL;
		refPtr = refPtr->nextPtr) {
	    if (refPtr->id == id) {
		break;
	    }
	}

	if (refPtr == NULL) {
	    Tcl_AppendResult(interp, "bad command token \"", argv[2],
		    "\"", NULL);
	    return TCL_ERROR;
	}




	objPtr = Tcl_NewObj();
	Tcl_GetCommandFullName(interp, refPtr->token, objPtr);

	Tcl_AppendElement(interp,
		Tcl_GetCommandName(interp, refPtr->token));
	Tcl_AppendElement(interp, Tcl_GetString(objPtr));
	Tcl_DecrRefCount(objPtr);
    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": must be create or name", NULL);
	return TCL_ERROR;
    }


    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestcmdtraceCmd --







<

>








|
|

>



|

|
<
<



















>
>
>
|
|

|
|
|
|
|
|
|
|
|
>
>







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
TestcmdtokenCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    TestCommandTokenRef *refPtr;

    int id;
    char buf[30];

    if (argc != 3) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" option arg\"", NULL);
	return TCL_ERROR;
    }
    if (strcmp(argv[1], "create") == 0) {
	refPtr = (TestCommandTokenRef *)Tcl_Alloc(sizeof(TestCommandTokenRef));
	refPtr->token = Tcl_CreateCommand(interp, argv[2], CmdProc0,
		refPtr, CmdDelProc0);
	refPtr->id = nextCommandTokenRefId;
	refPtr->value = "original";
	nextCommandTokenRefId++;
	refPtr->nextPtr = firstCommandTokenRef;
	firstCommandTokenRef = refPtr;
	snprintf(buf, sizeof(buf), "%d", refPtr->id);
	Tcl_AppendResult(interp, buf, NULL);
    } else {


	if (sscanf(argv[2], "%d", &id) != 1) {
	    Tcl_AppendResult(interp, "bad command token \"", argv[2],
		    "\"", NULL);
	    return TCL_ERROR;
	}

	for (refPtr = firstCommandTokenRef; refPtr != NULL;
		refPtr = refPtr->nextPtr) {
	    if (refPtr->id == id) {
		break;
	    }
	}

	if (refPtr == NULL) {
	    Tcl_AppendResult(interp, "bad command token \"", argv[2],
		    "\"", NULL);
	    return TCL_ERROR;
	}

	if (strcmp(argv[1], "name") == 0) {
	    Tcl_Obj *objPtr;

	    objPtr = Tcl_NewObj();
	    Tcl_GetCommandFullName(interp, refPtr->token, objPtr);

	    Tcl_AppendElement(interp,
		    Tcl_GetCommandName(interp, refPtr->token));
	    Tcl_AppendElement(interp, Tcl_GetString(objPtr));
	    Tcl_DecrRefCount(objPtr);
	} else {
	    Tcl_AppendResult(interp, "bad option \"", argv[1],
		    "\": must be create, name, or free", NULL);
	    return TCL_ERROR;
	}
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestcmdtraceCmd --
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
    TCL_UNUSED(Tcl_Command),
    TCL_UNUSED(int) /*objc*/,
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *word = Tcl_GetString(objv[0]);

    if (!strcmp(word, "Error")) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(command, TCL_INDEX_NONE));
	return TCL_ERROR;
    } else if (!strcmp(word, "Break")) {
	return TCL_BREAK;
    } else if (!strcmp(word, "Continue")) {
	return TCL_CONTINUE;
    } else if (!strcmp(word, "Return")) {
	return TCL_RETURN;







|







1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
    TCL_UNUSED(Tcl_Command),
    TCL_UNUSED(int) /*objc*/,
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *word = Tcl_GetString(objv[0]);

    if (!strcmp(word, "Error")) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(command, -1));
	return TCL_ERROR;
    } else if (!strcmp(word, "Break")) {
	return TCL_BREAK;
    } else if (!strcmp(word, "Continue")) {
	return TCL_CONTINUE;
    } else if (!strcmp(word, "Return")) {
	return TCL_RETURN;
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
			       TCL_EXACT, &type) != TCL_OK) {
	fprintf(stderr, "bad value? %g\n", d);
	return TCL_ERROR;
    }
    type = types[type];
    if (objc > 4) {
	if (strcmp(Tcl_GetString(objv[4]), "shorten")) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("bad flag", TCL_INDEX_NONE));
	    return TCL_ERROR;
	}
	type |= TCL_DD_SHORTEST;
    }
    str = TclDoubleDigits(d, ndigits, type, &decpt, &signum, &endPtr);
    strObj = Tcl_NewStringObj(str, endPtr-str);
    Tcl_Free(str);







|







1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
			       TCL_EXACT, &type) != TCL_OK) {
	fprintf(stderr, "bad value? %g\n", d);
	return TCL_ERROR;
    }
    type = types[type];
    if (objc > 4) {
	if (strcmp(Tcl_GetString(objv[4]), "shorten")) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("bad flag", -1));
	    return TCL_ERROR;
	}
	type |= TCL_DD_SHORTEST;
    }
    str = TclDoubleDigits(d, ndigits, type, &decpt, &signum, &endPtr);
    strObj = Tcl_NewStringObj(str, endPtr-str);
    Tcl_Free(str);
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
	}
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(Tcl_DStringLength(&dstring)));
    } else if (strcmp(argv[1], "result") == 0) {
	if (argc != 2) {
	    goto wrongNumArgs;
	}
	Tcl_DStringResult(interp, &dstring);





    } else if (strcmp(argv[1], "trunc") == 0) {
	if (argc != 3) {
	    goto wrongNumArgs;
	}
	if (Tcl_GetInt(interp, argv[2], &count) != TCL_OK) {
	    return TCL_ERROR;
	}
	Tcl_DStringSetLength(&dstring, count);
    } else if (strcmp(argv[1], "start") == 0) {
	if (argc != 2) {
	    goto wrongNumArgs;
	}
	Tcl_DStringStartSublist(&dstring);
    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": must be append, element, end, free, get, length, "
		"result, trunc, or start", NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 * The procedure below is used as a special freeProc to test how well
 * Tcl_DStringGetResult handles freeProc's other than free.
 */

static void SpecialFree(
    void *blockPtr			/* Block to free. */
) {
    Tcl_Free(((char *)blockPtr) - 16);
}








































































































































































































































/*
 *----------------------------------------------------------------------
 *
 * TestencodingCmd --
 *
 *	This procedure implements the "testencoding" command.  It is used







>
>
>
>
>















|
|















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







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
	}
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(Tcl_DStringLength(&dstring)));
    } else if (strcmp(argv[1], "result") == 0) {
	if (argc != 2) {
	    goto wrongNumArgs;
	}
	Tcl_DStringResult(interp, &dstring);
    } else if (strcmp(argv[1], "toobj") == 0) {
	if (argc != 2) {
	    goto wrongNumArgs;
	}
	Tcl_SetObjResult(interp, Tcl_DStringToObj(&dstring));
    } else if (strcmp(argv[1], "trunc") == 0) {
	if (argc != 3) {
	    goto wrongNumArgs;
	}
	if (Tcl_GetInt(interp, argv[2], &count) != TCL_OK) {
	    return TCL_ERROR;
	}
	Tcl_DStringSetLength(&dstring, count);
    } else if (strcmp(argv[1], "start") == 0) {
	if (argc != 2) {
	    goto wrongNumArgs;
	}
	Tcl_DStringStartSublist(&dstring);
    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": must be append, element, end, free, get, gresult, length, "
		"result, start, toobj, or trunc", NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 * The procedure below is used as a special freeProc to test how well
 * Tcl_DStringGetResult handles freeProc's other than free.
 */

static void SpecialFree(
    void *blockPtr			/* Block to free. */
) {
    Tcl_Free(((char *)blockPtr) - 16);
}

/*
 *------------------------------------------------------------------------
 *
 * UtfTransformFn --
 *
 *    Implements a direct call into Tcl_UtfToExternal and Tcl_ExternalToUtf
 *    as otherwise there is no script level command that directly exercises
 *    these functions (i/o command cannot test all combinations)
 *    The arguments at the script level are roughly those of the above
 *    functions:
 *        encodingname srcbytes flags state dstlen ?srcreadvar? ?dstwrotevar? ?dstcharsvar?
 *
 * Results:
 *    TCL_OK or TCL_ERROR. This any errors running the test, NOT the
 *    result of Tcl_UtfToExternal or Tcl_ExternalToUtf.
 *
 * Side effects:
 *
 *    The result in the interpreter is a list of the return code from the
 *    Tcl_UtfToExternal/Tcl_ExternalToUtf functions, the encoding state, and
 *    an encoded binary string of length dstLen. Note the string is the
 *    entire output buffer, not just the part containing the decoded
 *    portion. This allows for additional checks at test script level.
 *
 *    If any of the srcreadvar, dstwrotevar and
 *    dstcharsvar are specified and not empty, they are treated as names
 *    of variables where the *srcRead, *dstWrote and *dstChars output
 *    from the functions are stored.
 *
 *    The function also checks internally whether nuls are correctly
 *    appended as requested but the TCL_ENCODING_NO_TERMINATE flag
 *    and that no buffer overflows occur.
 *------------------------------------------------------------------------
 */
typedef int
UtfTransformFn(Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, Tcl_Size srcLen, int flags, Tcl_EncodingState *statePtr,
               char *dst, Tcl_Size dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr);
static int UtfExtWrapper(
    Tcl_Interp *interp, UtfTransformFn *transformer, int objc, Tcl_Obj *const objv[])
{
    Tcl_Encoding encoding;
    Tcl_EncodingState encState, *encStatePtr;
    Tcl_Size srcLen, bufLen;
    const unsigned char *bytes;
    unsigned char *bufPtr;
    int srcRead, dstLen, dstWrote, dstChars;
    Tcl_Obj *srcReadVar, *dstWroteVar, *dstCharsVar;
    int result;
    int flags;
    Tcl_Obj **flagObjs;
    Tcl_Size nflags;
    static const struct {
	const char *flagKey;
	int flag;
    } flagMap[] = {
	{"start", TCL_ENCODING_START},
	{"end", TCL_ENCODING_END},
	{"stoponerror", TCL_ENCODING_STOPONERROR},
	{"noterminate", TCL_ENCODING_NO_TERMINATE},
	{"charlimit", TCL_ENCODING_CHAR_LIMIT},
	{"profiletcl8", TCL_ENCODING_PROFILE_TCL8},
	{"profilestrict", TCL_ENCODING_PROFILE_STRICT},
	{"profilereplace", TCL_ENCODING_PROFILE_REPLACE},
	{NULL, 0}
    };
    Tcl_Size i;
    Tcl_WideInt wide;

    if (objc < 7 || objc > 10) {
        Tcl_WrongNumArgs(interp,
                         2,
                         objv,
                         "encoding srcbytes flags state dstlen ?srcreadvar? ?dstwrotevar? ?dstcharsvar?");
        return TCL_ERROR;
    }
    if (Tcl_GetEncodingFromObj(interp, objv[2], &encoding) != TCL_OK) {
        return TCL_ERROR;
    }

    /* Flags may be specified as list of integers and keywords */
    flags = 0;
    if (Tcl_ListObjGetElements(interp, objv[4], &nflags, &flagObjs) != TCL_OK) {
	return TCL_ERROR;
    }

    for (i = 0; i < nflags; ++i) {
	int flag;
	if (Tcl_GetIntFromObj(NULL, flagObjs[i], &flag) == TCL_OK) {
	    flags |= flag;
	} else {
	    int idx;
	    if (Tcl_GetIndexFromObjStruct(interp,
					  flagObjs[i],
					  flagMap,
					  sizeof(flagMap[0]),
					  "flag",
					  0,
					  &idx) != TCL_OK) {
		return TCL_ERROR;
	    }
	    flags |= flagMap[idx].flag;
	}
    }

    /* Assumes state is integer if not "" */
    if (Tcl_GetWideIntFromObj(interp, objv[5], &wide) == TCL_OK) {
        encState = (Tcl_EncodingState)(size_t)wide;
        encStatePtr = &encState;
    } else if (Tcl_GetCharLength(objv[5]) == 0) {
        encStatePtr = NULL;
    } else {
        return TCL_ERROR;
    }

    if (Tcl_GetIntFromObj(interp, objv[6], &dstLen) != TCL_OK) {
        return TCL_ERROR;
    }
    srcReadVar = NULL;
    dstWroteVar = NULL;
    dstCharsVar = NULL;
    if (objc > 7) {
	/* Has caller requested srcRead? */
	if (Tcl_GetCharLength(objv[7])) {
	    srcReadVar = objv[7];
	}
	if (objc > 8) {
	    /* Ditto for dstWrote */
            if (Tcl_GetCharLength(objv[8])) {
                dstWroteVar = objv[8];
            }
	    if (objc > 9) {
                if (Tcl_GetCharLength(objv[9])) {
                    dstCharsVar = objv[9];
		}
	    }
	}
    }
    if (flags & TCL_ENCODING_CHAR_LIMIT) {
	/* Caller should have specified the dest char limit */
	Tcl_Obj *valueObj;
	if (dstCharsVar == NULL ||
	    (valueObj = Tcl_ObjGetVar2(interp, dstCharsVar, NULL, 0)) == NULL
	) {
	    Tcl_SetResult(interp,
			 "dstCharsVar must be specified with integer value if "
			 "TCL_ENCODING_CHAR_LIMIT set in flags.", TCL_STATIC);
	    return TCL_ERROR;
	}
	if (Tcl_GetIntFromObj(interp, valueObj, &dstChars) != TCL_OK) {
	    return TCL_ERROR;
	}
    } else {
	dstChars = 0; /* Only used for output */
    }

    bufLen = dstLen + 4; /* 4 -> overflow detection */
    bufPtr = (unsigned char *) Tcl_Alloc(bufLen);
    memset(bufPtr, 0xFF, dstLen); /* Need to check nul terminator */
    memmove(bufPtr + dstLen, "\xAB\xCD\xEF\xAB", 4);   /* overflow detection */
    bytes = Tcl_GetByteArrayFromObj(objv[3], &srcLen); /* Last! to avoid shimmering */
    result = (*transformer)(interp, encoding, (const char *)bytes, srcLen, flags,
                            encStatePtr, (char *) bufPtr, dstLen,
                            srcReadVar ? &srcRead : NULL,
                            &dstWrote,
                            dstCharsVar ? &dstChars : NULL);
    if (memcmp(bufPtr + bufLen - 4, "\xAB\xCD\xEF\xAB", 4)) {
        Tcl_SetResult(interp,
                      "Tcl_ExternalToUtf wrote past output buffer",
                      TCL_STATIC);
        result = TCL_ERROR;
    } else if (result != TCL_ERROR) {
        Tcl_Obj *resultObjs[3];
        switch (result) {
        case TCL_OK:
            resultObjs[0] = Tcl_NewStringObj("ok", TCL_INDEX_NONE);
            break;
        case TCL_CONVERT_MULTIBYTE:
            resultObjs[0] = Tcl_NewStringObj("multibyte", TCL_INDEX_NONE);
            break;
        case TCL_CONVERT_SYNTAX:
            resultObjs[0] = Tcl_NewStringObj("syntax", TCL_INDEX_NONE);
            break;
        case TCL_CONVERT_UNKNOWN:
            resultObjs[0] = Tcl_NewStringObj("unknown", TCL_INDEX_NONE);
            break;
        case TCL_CONVERT_NOSPACE:
            resultObjs[0] = Tcl_NewStringObj("nospace", TCL_INDEX_NONE);
            break;
        default:
            resultObjs[0] = Tcl_NewIntObj(result);
            break;
        }
        result = TCL_OK;
        resultObjs[1] =
            encStatePtr ? Tcl_NewWideIntObj((Tcl_WideInt)(size_t)encState) : Tcl_NewObj();
        resultObjs[2] = Tcl_NewByteArrayObj(bufPtr, dstLen);
        if (srcReadVar) {
	    if (Tcl_ObjSetVar2(interp,
			       srcReadVar,
			       NULL,
			       Tcl_NewIntObj(srcRead),
			       TCL_LEAVE_ERR_MSG) == NULL) {
		result = TCL_ERROR;
	    }
	}
        if (dstWroteVar) {
	    if (Tcl_ObjSetVar2(interp,
			       dstWroteVar,
			       NULL,
			       Tcl_NewIntObj(dstWrote),
			       TCL_LEAVE_ERR_MSG) == NULL) {
		result = TCL_ERROR;
	    }
	}
        if (dstCharsVar) {
	    if (Tcl_ObjSetVar2(interp,
			       dstCharsVar,
			       NULL,
			       Tcl_NewIntObj(dstChars),
			       TCL_LEAVE_ERR_MSG) == NULL) {
		result = TCL_ERROR;
	    }
	}
        Tcl_SetObjResult(interp, Tcl_NewListObj(3, resultObjs));
    }

    Tcl_Free(bufPtr);
    Tcl_FreeEncoding(encoding); /* Free returned reference */
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TestencodingCmd --
 *
 *	This procedure implements the "testencoding" command.  It is used
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
TestencodingObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Encoding encoding;
    int length;
    const char *string;
    TclEncoding *encodingPtr;
    static const char *const optionStrings[] = {
	"create", "delete", "nullength", NULL
    };
    enum options {
	ENC_CREATE, ENC_DELETE, ENC_NULLENGTH
    } index;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "command ?args?");
	return TCL_ERROR;
    }

    if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
	    &index) != TCL_OK) {
	return TCL_ERROR;
    }

    switch (index) {
    case ENC_CREATE: {
	Tcl_EncodingType type;

	if (objc != 5) {
	    Tcl_WrongNumArgs(interp, 2, objv, "name toutfcmd fromutfcmd");
	    return TCL_ERROR;
	}
	encodingPtr = (TclEncoding*)Tcl_Alloc(sizeof(TclEncoding));
	encodingPtr->interp = interp;

	string = Tcl_GetStringFromObj(objv[3], &length);
	encodingPtr->toUtfCmd = (char *)Tcl_Alloc(length + 1);
	memcpy(encodingPtr->toUtfCmd, string, length + 1);

	string = Tcl_GetStringFromObj(objv[4], &length);







|



|


|




















|







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
TestencodingObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Encoding encoding;
    Tcl_Size length;
    const char *string;
    TclEncoding *encodingPtr;
    static const char *const optionStrings[] = {
	"create", "delete", "nullength", "Tcl_ExternalToUtf", "Tcl_UtfToExternal", NULL
    };
    enum options {
	ENC_CREATE, ENC_DELETE, ENC_NULLENGTH, ENC_EXTTOUTF, ENC_UTFTOEXT
    } index;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "command ?args?");
	return TCL_ERROR;
    }

    if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
	    &index) != TCL_OK) {
	return TCL_ERROR;
    }

    switch (index) {
    case ENC_CREATE: {
	Tcl_EncodingType type;

	if (objc != 5) {
	    Tcl_WrongNumArgs(interp, 2, objv, "name toutfcmd fromutfcmd");
	    return TCL_ERROR;
	}
	encodingPtr = (TclEncoding *)Tcl_Alloc(sizeof(TclEncoding));
	encodingPtr->interp = interp;

	string = Tcl_GetStringFromObj(objv[3], &length);
	encodingPtr->toUtfCmd = (char *)Tcl_Alloc(length + 1);
	memcpy(encodingPtr->toUtfCmd, string, length + 1);

	string = Tcl_GetStringFromObj(objv[4], &length);
2038
2039
2040
2041
2042
2043
2044





2045
2046
2047
2048
2049
2050
2051
	    Tcl_GetEncoding(interp, objc == 2 ? NULL : Tcl_GetString(objv[2]));
	if (encoding == NULL) {
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp,
			 Tcl_NewIntObj(Tcl_GetEncodingNulLength(encoding)));
	Tcl_FreeEncoding(encoding);





    }
    return TCL_OK;
}

static int
EncodingToUtfProc(
    void *clientData,	/* TclEncoding structure. */







>
>
>
>
>







2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
	    Tcl_GetEncoding(interp, objc == 2 ? NULL : Tcl_GetString(objv[2]));
	if (encoding == NULL) {
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp,
			 Tcl_NewIntObj(Tcl_GetEncodingNulLength(encoding)));
	Tcl_FreeEncoding(encoding);
        break;
    case ENC_EXTTOUTF:
        return UtfExtWrapper(interp,Tcl_ExternalToUtf,objc,objv);
    case ENC_UTFTOEXT:
        return UtfExtWrapper(interp,Tcl_UtfToExternal,objc,objv);
    }
    return TCL_OK;
}

static int
EncodingToUtfProc(
    void *clientData,	/* TclEncoding structure. */
2141
2142
2143
2144
2145
2146
2147
2148

2149
2150
2151
2152
2153
2154
2155
static int
TestevalexObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int length, flags;

    const char *script;

    flags = 0;
    if (objc == 3) {
	const char *global = Tcl_GetString(objv[2]);
	if (strcmp(global, "global") != 0) {
	    Tcl_AppendResult(interp, "bad value \"", global,







|
>







2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
static int
TestevalexObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int flags;
    Tcl_Size length;
    const char *script;

    flags = 0;
    if (objc == 3) {
	const char *global = Tcl_GetString(objv[2]);
	if (strcmp(global, "global") != 0) {
	    Tcl_AppendResult(interp, "bad value \"", global,
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
static void
ExitProcOdd(
    void *clientData)	/* Integer value to print. */
{
    char buf[16 + TCL_INTEGER_SPACE];
    int len;

    sprintf(buf, "odd %d\n", (int)PTR2INT(clientData));
    len = strlen(buf);
    if (len != (int) write(1, buf, len)) {
	Tcl_Panic("ExitProcOdd: unable to write to stdout");
    }
}

static void
ExitProcEven(
    void *clientData)	/* Integer value to print. */
{
    char buf[16 + TCL_INTEGER_SPACE];
    int len;

    sprintf(buf, "even %d\n", (int)PTR2INT(clientData));
    len = strlen(buf);
    if (len != (int) write(1, buf, len)) {
	Tcl_Panic("ExitProcEven: unable to write to stdout");
    }
}

/*







|













|







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
static void
ExitProcOdd(
    void *clientData)	/* Integer value to print. */
{
    char buf[16 + TCL_INTEGER_SPACE];
    int len;

    snprintf(buf, sizeof(buf), "odd %d\n", (int)PTR2INT(clientData));
    len = strlen(buf);
    if (len != (int) write(1, buf, len)) {
	Tcl_Panic("ExitProcOdd: unable to write to stdout");
    }
}

static void
ExitProcEven(
    void *clientData)	/* Integer value to print. */
{
    char buf[16 + TCL_INTEGER_SPACE];
    int len;

    snprintf(buf, sizeof(buf), "even %d\n", (int)PTR2INT(clientData));
    len = strlen(buf);
    if (len != (int) write(1, buf, len)) {
	Tcl_Panic("ExitProcEven: unable to write to stdout");
    }
}

/*
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
	return TCL_ERROR;
    }
    Tcl_AppendResult(interp, "This is a result", NULL);
    result = Tcl_ExprLong(interp, argv[1], &exprResult);
    if (result != TCL_OK) {
	return result;
    }
    sprintf(buf, ": %ld", exprResult);
    Tcl_AppendResult(interp, buf, NULL);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *







|







2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
	return TCL_ERROR;
    }
    Tcl_AppendResult(interp, "This is a result", NULL);
    result = Tcl_ExprLong(interp, argv[1], &exprResult);
    if (result != TCL_OK) {
	return result;
    }
    snprintf(buf, sizeof(buf), ": %ld", exprResult);
    Tcl_AppendResult(interp, buf, NULL);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
	return TCL_ERROR;
    }
    Tcl_AppendResult(interp, "This is a result", NULL);
    result = Tcl_ExprLongObj(interp, objv[1], &exprResult);
    if (result != TCL_OK) {
	return result;
    }
    sprintf(buf, ": %ld", exprResult);
    Tcl_AppendResult(interp, buf, NULL);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *







|







2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
	return TCL_ERROR;
    }
    Tcl_AppendResult(interp, "This is a result", NULL);
    result = Tcl_ExprLongObj(interp, objv[1], &exprResult);
    if (result != TCL_OK) {
	return result;
    }
    snprintf(buf, sizeof(buf), ": %ld", exprResult);
    Tcl_AppendResult(interp, buf, NULL);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794

/*
 *----------------------------------------------------------------------
 *
 * TestgetplatformCmd --
 *
 *	This procedure implements the "testgetplatform" command. It is
 *	used to retrievel the value of the tclPlatform global variable.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *







|







3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155

/*
 *----------------------------------------------------------------------
 *
 * TestgetplatformCmd --
 *
 *	This procedure implements the "testgetplatform" command. It is
 *	used to retrieve the value of the tclPlatform global variable.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
3084
3085
3086
3087
3088
3089
3090









3091
3092
3093
3094
3095







3096

3097
3098
3099
3100
3101
3102
3103
	TclFormatInt(buffer, (int) ushortVar);
	Tcl_AppendElement(interp, buffer);
	TclFormatInt(buffer, (int) uintVar);
	Tcl_AppendElement(interp, buffer);
	tmp = Tcl_NewWideIntObj(longVar);
	Tcl_AppendElement(interp, Tcl_GetString(tmp));
	Tcl_DecrRefCount(tmp);









	tmp = Tcl_NewWideIntObj((long)ulongVar);
	Tcl_AppendElement(interp, Tcl_GetString(tmp));
	Tcl_DecrRefCount(tmp);
	Tcl_PrintDouble(NULL, (double)floatVar, buffer);
	Tcl_AppendElement(interp, buffer);







	tmp = Tcl_NewWideIntObj((Tcl_WideInt)uwideVar);

	Tcl_AppendElement(interp, Tcl_GetString(tmp));
	Tcl_DecrRefCount(tmp);
    } else if (strcmp(argv[1], "set") == 0) {
	int v;

	if (argc != 16) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",







>
>
>
>
>
>
>
>
>
|




>
>
>
>
>
>
>
|
>







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
	TclFormatInt(buffer, (int) ushortVar);
	Tcl_AppendElement(interp, buffer);
	TclFormatInt(buffer, (int) uintVar);
	Tcl_AppendElement(interp, buffer);
	tmp = Tcl_NewWideIntObj(longVar);
	Tcl_AppendElement(interp, Tcl_GetString(tmp));
	Tcl_DecrRefCount(tmp);
#ifdef TCL_WIDE_INT_IS_LONG
	if (ulongVar > WIDE_MAX) {
		mp_int bignumValue;
		if (mp_init_u64(&bignumValue, ulongVar) != MP_OKAY) {
		    Tcl_Panic("%s: memory overflow", "Tcl_SetWideUIntObj");
		}
		tmp = Tcl_NewBignumObj(&bignumValue);
	} else
#endif /* TCL_WIDE_INT_IS_LONG */
	tmp = Tcl_NewWideIntObj((Tcl_WideInt)ulongVar);
	Tcl_AppendElement(interp, Tcl_GetString(tmp));
	Tcl_DecrRefCount(tmp);
	Tcl_PrintDouble(NULL, (double)floatVar, buffer);
	Tcl_AppendElement(interp, buffer);
	if (uwideVar > WIDE_MAX) {
		mp_int bignumValue;
		if (mp_init_u64(&bignumValue, uwideVar) != MP_OKAY) {
		    Tcl_Panic("%s: memory overflow", "Tcl_SetWideUIntObj");
		}
		tmp = Tcl_NewBignumObj(&bignumValue);
	} else {
	    tmp = Tcl_NewWideIntObj((Tcl_WideInt)uwideVar);
	}
	Tcl_AppendElement(interp, Tcl_GetString(tmp));
	Tcl_DecrRefCount(tmp);
    } else if (strcmp(argv[1], "set") == 0) {
	int v;

	if (argc != 16) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
		stringVar = NULL;
	    } else {
		stringVar = (char *)Tcl_Alloc(strlen(argv[5]) + 1);
		strcpy(stringVar, argv[5]);
	    }
	}
	if (argv[6][0] != 0) {
	    tmp = Tcl_NewStringObj(argv[6], TCL_INDEX_NONE);
	    if (Tcl_GetWideIntFromObj(interp, tmp, &wideVar) != TCL_OK) {
		Tcl_DecrRefCount(tmp);
		return TCL_ERROR;
	    }
	    Tcl_DecrRefCount(tmp);
	}
	if (argv[7][0]) {







|







3508
3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
		stringVar = NULL;
	    } else {
		stringVar = (char *)Tcl_Alloc(strlen(argv[5]) + 1);
		strcpy(stringVar, argv[5]);
	    }
	}
	if (argv[6][0] != 0) {
	    tmp = Tcl_NewStringObj(argv[6], -1);
	    if (Tcl_GetWideIntFromObj(interp, tmp, &wideVar) != TCL_OK) {
		Tcl_DecrRefCount(tmp);
		return TCL_ERROR;
	    }
	    Tcl_DecrRefCount(tmp);
	}
	if (argv[7][0]) {
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
	    if (Tcl_GetDouble(interp, argv[14], &d) != TCL_OK) {
		return TCL_ERROR;
	    }
	    floatVar = (float) d;
	}
	if (argv[15][0]) {
	    Tcl_WideInt w;
	    tmp = Tcl_NewStringObj(argv[15], TCL_INDEX_NONE);
	    if (Tcl_GetWideIntFromObj(interp, tmp, &w) != TCL_OK) {
		Tcl_DecrRefCount(tmp);
		return TCL_ERROR;
	    }
	    Tcl_DecrRefCount(tmp);
	    uwideVar = (Tcl_WideUInt) w;
	}







|







3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579
3580
	    if (Tcl_GetDouble(interp, argv[14], &d) != TCL_OK) {
		return TCL_ERROR;
	    }
	    floatVar = (float) d;
	}
	if (argv[15][0]) {
	    Tcl_WideInt w;
	    tmp = Tcl_NewStringObj(argv[15], -1);
	    if (Tcl_GetWideIntFromObj(interp, tmp, &w) != TCL_OK) {
		Tcl_DecrRefCount(tmp);
		return TCL_ERROR;
	    }
	    Tcl_DecrRefCount(tmp);
	    uwideVar = (Tcl_WideUInt) w;
	}
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
	    } else {
		stringVar = (char *)Tcl_Alloc(strlen(argv[5]) + 1);
		strcpy(stringVar, argv[5]);
	    }
	    Tcl_UpdateLinkedVar(interp, "string");
	}
	if (argv[6][0] != 0) {
	    tmp = Tcl_NewStringObj(argv[6], TCL_INDEX_NONE);
	    if (Tcl_GetWideIntFromObj(interp, tmp, &wideVar) != TCL_OK) {
		Tcl_DecrRefCount(tmp);
		return TCL_ERROR;
	    }
	    Tcl_DecrRefCount(tmp);
	    Tcl_UpdateLinkedVar(interp, "wide");
	}







|







3616
3617
3618
3619
3620
3621
3622
3623
3624
3625
3626
3627
3628
3629
3630
	    } else {
		stringVar = (char *)Tcl_Alloc(strlen(argv[5]) + 1);
		strcpy(stringVar, argv[5]);
	    }
	    Tcl_UpdateLinkedVar(interp, "string");
	}
	if (argv[6][0] != 0) {
	    tmp = Tcl_NewStringObj(argv[6], -1);
	    if (Tcl_GetWideIntFromObj(interp, tmp, &wideVar) != TCL_OK) {
		Tcl_DecrRefCount(tmp);
		return TCL_ERROR;
	    }
	    Tcl_DecrRefCount(tmp);
	    Tcl_UpdateLinkedVar(interp, "wide");
	}
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
		return TCL_ERROR;
	    }
	    floatVar = (float) d;
	    Tcl_UpdateLinkedVar(interp, "float");
	}
	if (argv[15][0]) {
	    Tcl_WideInt w;
	    tmp = Tcl_NewStringObj(argv[15], TCL_INDEX_NONE);
	    if (Tcl_GetWideIntFromObj(interp, tmp, &w) != TCL_OK) {
		Tcl_DecrRefCount(tmp);
		return TCL_ERROR;
	    }
	    Tcl_DecrRefCount(tmp);
	    uwideVar = (Tcl_WideUInt) w;
	    Tcl_UpdateLinkedVar(interp, "uwide");







|







3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693
3694
3695
3696
3697
		return TCL_ERROR;
	    }
	    floatVar = (float) d;
	    Tcl_UpdateLinkedVar(interp, "float");
	}
	if (argv[15][0]) {
	    Tcl_WideInt w;
	    tmp = Tcl_NewStringObj(argv[15], -1);
	    if (Tcl_GetWideIntFromObj(interp, tmp, &w) != TCL_OK) {
		Tcl_DecrRefCount(tmp);
		return TCL_ERROR;
	    }
	    Tcl_DecrRefCount(tmp);
	    uwideVar = (Tcl_WideUInt) w;
	    Tcl_UpdateLinkedVar(interp, "uwide");
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
    Tcl_Interp *interp,         /* Current interpreter. */
    int objc,                   /* Number of arguments. */
    Tcl_Obj *const objv[])      /* Argument objects. */
{
    static const char *LinkOption[] = {
        "update", "remove", "create", NULL
    };
    enum LinkOptionEnum {LINK_UPDATE, LINK_REMOVE, LINK_CREATE} optionIndex;
    static const char *LinkType[] = {
	"char", "uchar", "short", "ushort", "int", "uint", "long", "ulong",
	"wide", "uwide", "float", "double", "string", "char*", "binary", NULL
    };
    /* all values after TCL_LINK_CHARS_ARRAY are used as arrays (see below) */
    static int LinkTypes[] = {
	TCL_LINK_CHAR, TCL_LINK_UCHAR,
	TCL_LINK_SHORT, TCL_LINK_USHORT, TCL_LINK_INT, TCL_LINK_UINT,
	TCL_LINK_LONG, TCL_LINK_ULONG, TCL_LINK_WIDE_INT, TCL_LINK_WIDE_UINT,
	TCL_LINK_FLOAT, TCL_LINK_DOUBLE, TCL_LINK_STRING, TCL_LINK_CHARS,
	TCL_LINK_BINARY
    };
    int typeIndex, readonly, i, size, length;

    char *name, *arg;
    Tcl_WideInt addr;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option args");
	return TCL_ERROR;
    }







|












|
>







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
    Tcl_Interp *interp,         /* Current interpreter. */
    int objc,                   /* Number of arguments. */
    Tcl_Obj *const objv[])      /* Argument objects. */
{
    static const char *LinkOption[] = {
        "update", "remove", "create", NULL
    };
    enum LinkOptionEnum { LINK_UPDATE, LINK_REMOVE, LINK_CREATE } optionIndex;
    static const char *LinkType[] = {
	"char", "uchar", "short", "ushort", "int", "uint", "long", "ulong",
	"wide", "uwide", "float", "double", "string", "char*", "binary", NULL
    };
    /* all values after TCL_LINK_CHARS_ARRAY are used as arrays (see below) */
    static int LinkTypes[] = {
	TCL_LINK_CHAR, TCL_LINK_UCHAR,
	TCL_LINK_SHORT, TCL_LINK_USHORT, TCL_LINK_INT, TCL_LINK_UINT,
	TCL_LINK_LONG, TCL_LINK_ULONG, TCL_LINK_WIDE_INT, TCL_LINK_WIDE_UINT,
	TCL_LINK_FLOAT, TCL_LINK_DOUBLE, TCL_LINK_STRING, TCL_LINK_CHARS,
	TCL_LINK_BINARY
    };
    int typeIndex, readonly, i, size;
    Tcl_Size length;
    char *name, *arg;
    Tcl_WideInt addr;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option args");
	return TCL_ERROR;
    }
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
	    i++;
	}
	if (Tcl_GetIndexFromObj(interp, objv[i++], LinkType, "type", 0,
 		&typeIndex) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (Tcl_GetIntFromObj(interp, objv[i++], &size) == TCL_ERROR) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong size value", TCL_INDEX_NONE));
	    return TCL_ERROR;
	}
	name = Tcl_GetString(objv[i++]);

	/*
	 * If no address is given request one in the underlying function
	 */

	if (i < objc) {
	    if (Tcl_GetWideIntFromObj(interp, objv[i], &addr) == TCL_ERROR) {
 		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"wrong address value", TCL_INDEX_NONE));
		return TCL_ERROR;
	    }
	} else {
	    addr = 0;
	}
	return Tcl_LinkArray(interp, name, INT2PTR(addr),
		LinkTypes[typeIndex] | readonly, size);







|











|







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
	    i++;
	}
	if (Tcl_GetIndexFromObj(interp, objv[i++], LinkType, "type", 0,
 		&typeIndex) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (Tcl_GetIntFromObj(interp, objv[i++], &size) == TCL_ERROR) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong size value", -1));
	    return TCL_ERROR;
	}
	name = Tcl_GetString(objv[i++]);

	/*
	 * If no address is given request one in the underlying function
	 */

	if (i < objc) {
	    if (Tcl_GetWideIntFromObj(interp, objv[i], &addr) == TCL_ERROR) {
 		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"wrong address value", -1));
		return TCL_ERROR;
	    }
	} else {
	    addr = 0;
	}
	return Tcl_LinkArray(interp, name, INT2PTR(addr),
		LinkTypes[typeIndex] | readonly, size);
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
    }
    switch (cmdIndex) {
    case LISTREP_NEW:
	if (objc < 3 || objc > 5) {
	    Tcl_WrongNumArgs(interp, 2, objv, "length ?leadSpace endSpace?");
	    return TCL_ERROR;
	} else {
	    int length;
	    int leadSpace = 0;
	    int endSpace = 0;
	    if (Tcl_GetIntFromObj(interp, objv[2], &length) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (objc > 3) {
		if (Tcl_GetIntFromObj(interp, objv[3], &leadSpace) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (objc > 4) {
		    if (Tcl_GetIntFromObj(interp, objv[4], &endSpace)
			!= TCL_OK) {
			return TCL_ERROR;
		    }
		}
	    }
	    resultObj = TclListTestObj(length, leadSpace, endSpace);




	}
	break;

    case LISTREP_DESCRIBE:
#define APPEND_FIELD(targetObj_, structPtr_, fld_)                        \
    do {                                                                  \
	Tcl_ListObjAppendElement(                                         \
	    interp, (targetObj_), Tcl_NewStringObj(#fld_, TCL_INDEX_NONE));           \
	Tcl_ListObjAppendElement(                                         \
	    interp, (targetObj_), Tcl_NewWideIntObj((structPtr_)->fld_)); \
    } while (0)
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "object");
	    return TCL_ERROR;
	} else {
	    Tcl_Obj **objs;
	    Tcl_Size nobjs;
	    ListRep listRep;
	    Tcl_Obj *listRepObjs[4];

	    /* Force list representation */
	    if (Tcl_ListObjGetElements(interp, objv[2], &nobjs, &objs) != TCL_OK) {
		return TCL_ERROR;
	    }
	    ListObjGetRep(objv[2], &listRep);
	    listRepObjs[0] = Tcl_NewStringObj("store", TCL_INDEX_NONE);
	    listRepObjs[1] = Tcl_NewListObj(12, NULL);
	    Tcl_ListObjAppendElement(
		interp, listRepObjs[1], Tcl_NewStringObj("memoryAddress", TCL_INDEX_NONE));
	    Tcl_ListObjAppendElement(
		interp, listRepObjs[1], Tcl_ObjPrintf("%p", listRep.storePtr));
	    APPEND_FIELD(listRepObjs[1], listRep.storePtr, firstUsed);
	    APPEND_FIELD(listRepObjs[1], listRep.storePtr, numUsed);
	    APPEND_FIELD(listRepObjs[1], listRep.storePtr, numAllocated);
	    APPEND_FIELD(listRepObjs[1], listRep.storePtr, refCount);
	    APPEND_FIELD(listRepObjs[1], listRep.storePtr, flags);
	    if (listRep.spanPtr) {
		listRepObjs[2] = Tcl_NewStringObj("span", TCL_INDEX_NONE);
		listRepObjs[3] = Tcl_NewListObj(8, NULL);
		Tcl_ListObjAppendElement(interp,
					 listRepObjs[3],
					 Tcl_NewStringObj("memoryAddress", TCL_INDEX_NONE));
		Tcl_ListObjAppendElement(
		    interp, listRepObjs[3], Tcl_ObjPrintf("%p", listRep.spanPtr));
		APPEND_FIELD(listRepObjs[3], listRep.spanPtr, spanStart);
		APPEND_FIELD(
		    listRepObjs[3], listRep.spanPtr, spanLength);
		APPEND_FIELD(listRepObjs[3], listRep.spanPtr, refCount);
	    }
	    resultObj = Tcl_NewListObj(listRep.spanPtr ? 4 : 2, listRepObjs);
	}
#undef APPEND_FIELD
	break;

    case LISTREP_CONFIG:
	if (objc != 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, "object");
	    return TCL_ERROR;
	}
	resultObj = Tcl_NewListObj(2, NULL);
	Tcl_ListObjAppendElement(
	    NULL, resultObj, Tcl_NewStringObj("LIST_SPAN_THRESHOLD", TCL_INDEX_NONE));
	Tcl_ListObjAppendElement(
	    NULL, resultObj, Tcl_NewWideIntObj(LIST_SPAN_THRESHOLD));
	break;

    case LISTREP_VALIDATE:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "object");







|
|
|
|



|



|






>
>
>
>







|

















|


|








|



|



















|







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
    }
    switch (cmdIndex) {
    case LISTREP_NEW:
	if (objc < 3 || objc > 5) {
	    Tcl_WrongNumArgs(interp, 2, objv, "length ?leadSpace endSpace?");
	    return TCL_ERROR;
	} else {
	    Tcl_WideUInt length;
	    Tcl_WideUInt leadSpace = 0;
	    Tcl_WideUInt endSpace = 0;
	    if (Tcl_GetWideUIntFromObj(interp, objv[2], &length) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (objc > 3) {
		if (Tcl_GetWideUIntFromObj(interp, objv[3], &leadSpace) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (objc > 4) {
		    if (Tcl_GetWideUIntFromObj(interp, objv[4], &endSpace)
			!= TCL_OK) {
			return TCL_ERROR;
		    }
		}
	    }
	    resultObj = TclListTestObj(length, leadSpace, endSpace);
	    if (resultObj == NULL) {
		Tcl_AppendResult(interp, "List capacity exceeded", NULL);
		return TCL_ERROR;
	    }
	}
	break;

    case LISTREP_DESCRIBE:
#define APPEND_FIELD(targetObj_, structPtr_, fld_)                        \
    do {                                                                  \
	Tcl_ListObjAppendElement(                                         \
	    interp, (targetObj_), Tcl_NewStringObj(#fld_, -1));           \
	Tcl_ListObjAppendElement(                                         \
	    interp, (targetObj_), Tcl_NewWideIntObj((structPtr_)->fld_)); \
    } while (0)
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "object");
	    return TCL_ERROR;
	} else {
	    Tcl_Obj **objs;
	    Tcl_Size nobjs;
	    ListRep listRep;
	    Tcl_Obj *listRepObjs[4];

	    /* Force list representation */
	    if (Tcl_ListObjGetElements(interp, objv[2], &nobjs, &objs) != TCL_OK) {
		return TCL_ERROR;
	    }
	    ListObjGetRep(objv[2], &listRep);
	    listRepObjs[0] = Tcl_NewStringObj("store", -1);
	    listRepObjs[1] = Tcl_NewListObj(12, NULL);
	    Tcl_ListObjAppendElement(
		interp, listRepObjs[1], Tcl_NewStringObj("memoryAddress", -1));
	    Tcl_ListObjAppendElement(
		interp, listRepObjs[1], Tcl_ObjPrintf("%p", listRep.storePtr));
	    APPEND_FIELD(listRepObjs[1], listRep.storePtr, firstUsed);
	    APPEND_FIELD(listRepObjs[1], listRep.storePtr, numUsed);
	    APPEND_FIELD(listRepObjs[1], listRep.storePtr, numAllocated);
	    APPEND_FIELD(listRepObjs[1], listRep.storePtr, refCount);
	    APPEND_FIELD(listRepObjs[1], listRep.storePtr, flags);
	    if (listRep.spanPtr) {
		listRepObjs[2] = Tcl_NewStringObj("span", -1);
		listRepObjs[3] = Tcl_NewListObj(8, NULL);
		Tcl_ListObjAppendElement(interp,
					 listRepObjs[3],
					 Tcl_NewStringObj("memoryAddress", -1));
		Tcl_ListObjAppendElement(
		    interp, listRepObjs[3], Tcl_ObjPrintf("%p", listRep.spanPtr));
		APPEND_FIELD(listRepObjs[3], listRep.spanPtr, spanStart);
		APPEND_FIELD(
		    listRepObjs[3], listRep.spanPtr, spanLength);
		APPEND_FIELD(listRepObjs[3], listRep.spanPtr, refCount);
	    }
	    resultObj = Tcl_NewListObj(listRep.spanPtr ? 4 : 2, listRepObjs);
	}
#undef APPEND_FIELD
	break;

    case LISTREP_CONFIG:
	if (objc != 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, "object");
	    return TCL_ERROR;
	}
	resultObj = Tcl_NewListObj(2, NULL);
	Tcl_ListObjAppendElement(
	    NULL, resultObj, Tcl_NewStringObj("LIST_SPAN_THRESHOLD", -1));
	Tcl_ListObjAppendElement(
	    NULL, resultObj, Tcl_NewWideIntObj(LIST_SPAN_THRESHOLD));
	break;

    case LISTREP_VALIDATE:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "object");
3648
3649
3650
3651
3652
3653
3654
3655
3656
3657
3658
3659
3660
3661
3662
    if (objc == 3) {
	locale = Tcl_GetString(objv[2]);
    } else {
	locale = NULL;
    }
    locale = setlocale(lcTypes[index], locale);
    if (locale) {
	Tcl_SetStringObj(Tcl_GetObjResult(interp), locale, TCL_INDEX_NONE);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *







|







4031
4032
4033
4034
4035
4036
4037
4038
4039
4040
4041
4042
4043
4044
4045
    if (objc == 3) {
	locale = Tcl_GetString(objv[2]);
    } else {
	locale = NULL;
    }
    locale = setlocale(lcTypes[index], locale);
    if (locale) {
	Tcl_SetStringObj(Tcl_GetObjResult(interp), locale, -1);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
3703
3704
3705
3706
3707
3708
3709

3710
3711
3712
3713
3714
3715
3716
3717
TestparserObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    const char *script;

    int length, dummy;
    Tcl_Parse parse;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "script length");
	return TCL_ERROR;
    }
    script = Tcl_GetStringFromObj(objv[1], &dummy);







>
|







4086
4087
4088
4089
4090
4091
4092
4093
4094
4095
4096
4097
4098
4099
4100
4101
TestparserObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    const char *script;
    Tcl_Size dummy;
    int length;
    Tcl_Parse parse;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "script length");
	return TCL_ERROR;
    }
    script = Tcl_GetStringFromObj(objv[1], &dummy);
3759
3760
3761
3762
3763
3764
3765

3766
3767
3768
3769
3770
3771
3772
3773
TestexprparserObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    const char *script;

    int length, dummy;
    Tcl_Parse parse;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "expr length");
	return TCL_ERROR;
    }
    script = Tcl_GetStringFromObj(objv[1], &dummy);







>
|







4143
4144
4145
4146
4147
4148
4149
4150
4151
4152
4153
4154
4155
4156
4157
4158
TestexprparserObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    const char *script;
    Tcl_Size dummy;
    int length;
    Tcl_Parse parse;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "expr length");
	return TCL_ERROR;
    }
    script = Tcl_GetStringFromObj(objv[1], &dummy);
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
    Tcl_Interp *interp,		/* Interpreter whose result is to be set to
				 * the contents of a parse structure. */
    Tcl_Parse *parsePtr)	/* Parse structure to print out. */
{
    Tcl_Obj *objPtr;
    const char *typeString;
    Tcl_Token *tokenPtr;
    size_t i;

    objPtr = Tcl_GetObjResult(interp);
    if (parsePtr->commentSize + 1 > 1) {
	Tcl_ListObjAppendElement(NULL, objPtr,
		Tcl_NewStringObj(parsePtr->commentStart,
			parsePtr->commentSize));
    } else {
	Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewStringObj("-", 1));
    }
    Tcl_ListObjAppendElement(NULL, objPtr,
	    Tcl_NewStringObj(parsePtr->commandStart, parsePtr->commandSize));
    Tcl_ListObjAppendElement(NULL, objPtr,
	    Tcl_NewWideIntObj(parsePtr->numWords));
    for (i = 0; i < (size_t)parsePtr->numTokens; i++) {
	tokenPtr = &parsePtr->tokenPtr[i];
	switch (tokenPtr->type) {
	case TCL_TOKEN_EXPAND_WORD:
	    typeString = "expand";
	    break;
	case TCL_TOKEN_WORD:
	    typeString = "word";







|


|










|







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
    Tcl_Interp *interp,		/* Interpreter whose result is to be set to
				 * the contents of a parse structure. */
    Tcl_Parse *parsePtr)	/* Parse structure to print out. */
{
    Tcl_Obj *objPtr;
    const char *typeString;
    Tcl_Token *tokenPtr;
    Tcl_Size i;

    objPtr = Tcl_GetObjResult(interp);
    if (parsePtr->commentSize > 0) {
	Tcl_ListObjAppendElement(NULL, objPtr,
		Tcl_NewStringObj(parsePtr->commentStart,
			parsePtr->commentSize));
    } else {
	Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewStringObj("-", 1));
    }
    Tcl_ListObjAppendElement(NULL, objPtr,
	    Tcl_NewStringObj(parsePtr->commandStart, parsePtr->commandSize));
    Tcl_ListObjAppendElement(NULL, objPtr,
	    Tcl_NewWideIntObj(parsePtr->numWords));
    for (i = 0; i < parsePtr->numTokens; i++) {
	tokenPtr = &parsePtr->tokenPtr[i];
	switch (tokenPtr->type) {
	case TCL_TOKEN_EXPAND_WORD:
	    typeString = "expand";
	    break;
	case TCL_TOKEN_WORD:
	    typeString = "word";
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
	    typeString = "operator";
	    break;
	default:
	    typeString = "??";
	    break;
	}
	Tcl_ListObjAppendElement(NULL, objPtr,
		Tcl_NewStringObj(typeString, TCL_INDEX_NONE));
	Tcl_ListObjAppendElement(NULL, objPtr,
		Tcl_NewStringObj(tokenPtr->start, tokenPtr->size));
	Tcl_ListObjAppendElement(NULL, objPtr,
		Tcl_NewWideIntObj(tokenPtr->numComponents));
    }
    Tcl_ListObjAppendElement(NULL, objPtr,
	    parsePtr->commandStart ?







|







4255
4256
4257
4258
4259
4260
4261
4262
4263
4264
4265
4266
4267
4268
4269
	    typeString = "operator";
	    break;
	default:
	    typeString = "??";
	    break;
	}
	Tcl_ListObjAppendElement(NULL, objPtr,
		Tcl_NewStringObj(typeString, -1));
	Tcl_ListObjAppendElement(NULL, objPtr,
		Tcl_NewStringObj(tokenPtr->start, tokenPtr->size));
	Tcl_ListObjAppendElement(NULL, objPtr,
		Tcl_NewWideIntObj(tokenPtr->numComponents));
    }
    Tcl_ListObjAppendElement(NULL, objPtr,
	    parsePtr->commandStart ?
3948
3949
3950
3951
3952
3953
3954
3955

3956
3957
3958
3959
3960
3961
3962
TestparsevarnameObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    const char *script;
    int append, length, dummy;

    Tcl_Parse parse;

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "script length append");
	return TCL_ERROR;
    }
    script = Tcl_GetStringFromObj(objv[1], &dummy);







|
>







4333
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
TestparsevarnameObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    const char *script;
    int length, append;
    Tcl_Size dummy;
    Tcl_Parse parse;

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "script length append");
	return TCL_ERROR;
    }
    script = Tcl_GetStringFromObj(objv[1], &dummy);
4081
4082
4083
4084
4085
4086
4087
4088
4089
4090
4091
4092
4093
4094
4095
4096
static int
TestregexpObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int i, indices, stringLength, match, about;
    size_t ii;
    int hasxflags, cflags, eflags;
    Tcl_RegExp regExpr;
    const char *string;
    Tcl_Obj *objPtr;
    Tcl_RegExpInfo info;
    static const char *const options[] = {
	"-indices",	"-nocase",	"-about",	"-expanded",







|
|







4467
4468
4469
4470
4471
4472
4473
4474
4475
4476
4477
4478
4479
4480
4481
4482
static int
TestregexpObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int i, indices, match, about;
    Tcl_Size stringLength, ii;
    int hasxflags, cflags, eflags;
    Tcl_RegExp regExpr;
    const char *string;
    Tcl_Obj *objPtr;
    Tcl_RegExpInfo info;
    static const char *const options[] = {
	"-indices",	"-nocase",	"-about",	"-expanded",
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
	 * value 0.
	 */

	Tcl_SetWideIntObj(Tcl_GetObjResult(interp), 0);
	if (objc > 2 && (cflags&REG_EXPECT) && indices) {
	    const char *varName;
	    const char *value;
	    size_t start, end;
	    char resinfo[TCL_INTEGER_SPACE * 2];

	    varName = Tcl_GetString(objv[2]);
	    TclRegExpRangeUniChar(regExpr, TCL_INDEX_NONE, &start, &end);
	    sprintf(resinfo, "%" TCL_Z_MODIFIER "d %" TCL_Z_MODIFIER "d", start, (end-1));
	    value = Tcl_SetVar2(interp, varName, NULL, resinfo, 0);
	    if (value == NULL) {
		Tcl_AppendResult(interp, "couldn't set variable \"",
			varName, "\"", NULL);
		return TCL_ERROR;
	    }
	} else if (cflags & TCL_REG_CANMATCH) {
	    const char *varName;
	    const char *value;
	    char resinfo[TCL_INTEGER_SPACE * 2];

	    Tcl_RegExpGetInfo(regExpr, &info);
	    varName = Tcl_GetString(objv[2]);
	    sprintf(resinfo, "%" TCL_Z_MODIFIER "d", info.extendStart);
	    value = Tcl_SetVar2(interp, varName, NULL, resinfo, 0);
	    if (value == NULL) {
		Tcl_AppendResult(interp, "couldn't set variable \"",
			varName, "\"", NULL);
		return TCL_ERROR;
	    }
	}
	return TCL_OK;
    }

    /*
     * If additional variable names have been specified, return
     * index information in those variables.
     */

    objc -= 2;
    objv += 2;

    Tcl_RegExpGetInfo(regExpr, &info);
    for (i = 0; i < objc; i++) {
	size_t start, end;
	Tcl_Obj *newPtr, *varPtr, *valuePtr;

	varPtr = objv[i];
	ii = ((cflags&REG_EXPECT) && i == objc-1) ? TCL_INDEX_NONE : (size_t)i;
	if (indices) {
	    Tcl_Obj *objs[2];

	    if (ii == TCL_INDEX_NONE) {
		TclRegExpRangeUniChar(regExpr, ii, &start, &end);
	    } else if (ii > info.nsubs) {
		start = TCL_INDEX_NONE;







|




|













|




















|



|







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

	Tcl_SetWideIntObj(Tcl_GetObjResult(interp), 0);
	if (objc > 2 && (cflags&REG_EXPECT) && indices) {
	    const char *varName;
	    const char *value;
	    Tcl_Size start, end;
	    char resinfo[TCL_INTEGER_SPACE * 2];

	    varName = Tcl_GetString(objv[2]);
	    TclRegExpRangeUniChar(regExpr, TCL_INDEX_NONE, &start, &end);
	    snprintf(resinfo, sizeof(resinfo), "%" TCL_Z_MODIFIER "d %" TCL_Z_MODIFIER "d", start, end-1);
	    value = Tcl_SetVar2(interp, varName, NULL, resinfo, 0);
	    if (value == NULL) {
		Tcl_AppendResult(interp, "couldn't set variable \"",
			varName, "\"", NULL);
		return TCL_ERROR;
	    }
	} else if (cflags & TCL_REG_CANMATCH) {
	    const char *varName;
	    const char *value;
	    char resinfo[TCL_INTEGER_SPACE * 2];

	    Tcl_RegExpGetInfo(regExpr, &info);
	    varName = Tcl_GetString(objv[2]);
	    snprintf(resinfo, sizeof(resinfo), "%" TCL_Z_MODIFIER "d", info.extendStart);
	    value = Tcl_SetVar2(interp, varName, NULL, resinfo, 0);
	    if (value == NULL) {
		Tcl_AppendResult(interp, "couldn't set variable \"",
			varName, "\"", NULL);
		return TCL_ERROR;
	    }
	}
	return TCL_OK;
    }

    /*
     * If additional variable names have been specified, return
     * index information in those variables.
     */

    objc -= 2;
    objv += 2;

    Tcl_RegExpGetInfo(regExpr, &info);
    for (i = 0; i < objc; i++) {
	Tcl_Size start, end;
	Tcl_Obj *newPtr, *varPtr, *valuePtr;

	varPtr = objv[i];
	ii = ((cflags&REG_EXPECT) && i == objc-1) ? TCL_INDEX_NONE : (Tcl_Size)i;
	if (indices) {
	    Tcl_Obj *objs[2];

	    if (ii == TCL_INDEX_NONE) {
		TclRegExpRangeUniChar(regExpr, ii, &start, &end);
	    } else if (ii > info.nsubs) {
		start = TCL_INDEX_NONE;
4261
4262
4263
4264
4265
4266
4267
4268
4269
4270
4271
4272
4273
4274
4275
4276
4277
4278
4279
4280
4281
4282
4283
	     * instead of the first character after the match.
	     */

	    if (end != TCL_INDEX_NONE) {
		end--;
	    }

	    objs[0] = Tcl_NewWideIntObj((Tcl_WideInt)((Tcl_WideUInt)(start + 1U)) - 1);
	    objs[1] = Tcl_NewWideIntObj((Tcl_WideInt)((Tcl_WideUInt)(end + 1U)) - 1);

	    newPtr = Tcl_NewListObj(2, objs);
	} else {
	    if (ii == TCL_INDEX_NONE) {
		TclRegExpRangeUniChar(regExpr, ii, &start, &end);
		newPtr = Tcl_GetRange(objPtr, start, end);
	    } else if (ii > info.nsubs || info.matches[ii].end + 1 <= 1) {
		newPtr = Tcl_NewObj();
	    } else {
		newPtr = Tcl_GetRange(objPtr, info.matches[ii].start,
			info.matches[ii].end - 1);
	    }
	}
	valuePtr = Tcl_ObjSetVar2(interp, varPtr, NULL, newPtr, TCL_LEAVE_ERR_MSG);







|
|






|







4647
4648
4649
4650
4651
4652
4653
4654
4655
4656
4657
4658
4659
4660
4661
4662
4663
4664
4665
4666
4667
4668
4669
	     * instead of the first character after the match.
	     */

	    if (end != TCL_INDEX_NONE) {
		end--;
	    }

	    objs[0] = Tcl_NewWideIntObj(start);
	    objs[1] = Tcl_NewWideIntObj(end);

	    newPtr = Tcl_NewListObj(2, objs);
	} else {
	    if (ii == TCL_INDEX_NONE) {
		TclRegExpRangeUniChar(regExpr, ii, &start, &end);
		newPtr = Tcl_GetRange(objPtr, start, end);
	    } else if (ii > info.nsubs || info.matches[ii].end <= 0) {
		newPtr = Tcl_NewObj();
	    } else {
		newPtr = Tcl_GetRange(objPtr, info.matches[ii].start,
			info.matches[ii].end - 1);
	    }
	}
	valuePtr = Tcl_ObjSetVar2(interp, varPtr, NULL, newPtr, TCL_LEAVE_ERR_MSG);
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534
 *	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 interpreter,
 *	variable "x" in that interpreter is set to "loaded".
 *
 *----------------------------------------------------------------------
 */

static int
TeststaticlibraryCmd(







|







4906
4907
4908
4909
4910
4911
4912
4913
4914
4915
4916
4917
4918
4919
4920
 *	This procedure implements the "teststaticlibrary" command.
 *	It is used to test the procedure Tcl_StaticLibrary.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	When the package given by argv[1] is loaded into an interpreter,
 *	variable "x" in that interpreter is set to "loaded".
 *
 *----------------------------------------------------------------------
 */

static int
TeststaticlibraryCmd(
4986
4987
4988
4989
4990
4991
4992
4993
4994
4995
4996
4997
4998
4999
5000
/*
 *----------------------------------------------------------------------
 *
 * GetTimesObjCmd --
 *
 *	This procedure implements the "gettimes" command.  It is used for
 *	computing the time needed for various basic operations such as reading
 *	variables, allocating memory, sprintf, converting variables, etc.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Allocates and frees memory, sets a variable "a" in the interpreter.
 *







|







5372
5373
5374
5375
5376
5377
5378
5379
5380
5381
5382
5383
5384
5385
5386
/*
 *----------------------------------------------------------------------
 *
 * GetTimesObjCmd --
 *
 *	This procedure implements the "gettimes" command.  It is used for
 *	computing the time needed for various basic operations such as reading
 *	variables, allocating memory, snprintf, converting variables, etc.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Allocates and frees memory, sets a variable "a" in the interpreter.
 *
5068
5069
5070
5071
5072
5073
5074
5075
5076
5077
5078
5079
5080
5081
5082
    Tcl_GetTime(&stop);
    timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
    fprintf(stderr, "   %.3f usec per Tcl_DecrRefCount\n", timePer/5000);
    Tcl_Free(objv);

    /* TclGetString 100000 times */
    fprintf(stderr, "Tcl_GetStringFromObj of \"12345\" 100000 times\n");
    objPtr = Tcl_NewStringObj("12345", TCL_INDEX_NONE);
    Tcl_GetTime(&start);
    for (i = 0;  i < 100000;  i++) {
	(void) TclGetString(objPtr);
    }
    Tcl_GetTime(&stop);
    timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
    fprintf(stderr, "   %.3f usec per Tcl_GetStringFromObj of \"12345\"\n",







|







5454
5455
5456
5457
5458
5459
5460
5461
5462
5463
5464
5465
5466
5467
5468
    Tcl_GetTime(&stop);
    timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
    fprintf(stderr, "   %.3f usec per Tcl_DecrRefCount\n", timePer/5000);
    Tcl_Free(objv);

    /* TclGetString 100000 times */
    fprintf(stderr, "Tcl_GetStringFromObj of \"12345\" 100000 times\n");
    objPtr = Tcl_NewStringObj("12345", -1);
    Tcl_GetTime(&start);
    for (i = 0;  i < 100000;  i++) {
	(void) TclGetString(objPtr);
    }
    Tcl_GetTime(&stop);
    timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
    fprintf(stderr, "   %.3f usec per Tcl_GetStringFromObj of \"12345\"\n",
5105
5106
5107
5108
5109
5110
5111
5112
5113
5114
5115
5116
5117
5118
5119
5120
5121
5122
5123
5124
5125
5126
5127
	}
    }
    Tcl_GetTime(&stop);
    timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
    fprintf(stderr, "   %.3f usec per Tcl_GetInt of \"12345\"\n",
	    timePer/100000);

    /* sprintf 100000 times */
    fprintf(stderr, "sprintf of 12345 100000 times\n");
    Tcl_GetTime(&start);
    for (i = 0;  i < 100000;  i++) {
	sprintf(newString, "%d", 12345);
    }
    Tcl_GetTime(&stop);
    timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
    fprintf(stderr, "   %.3f usec per sprintf of 12345\n",
	    timePer/100000);

    /* hashtable lookup 100000 times */
    fprintf(stderr, "hashtable lookup of \"gettimes\" 100000 times\n");
    Tcl_GetTime(&start);
    for (i = 0;  i < 100000;  i++) {
	(void) Tcl_FindHashEntry(&iPtr->globalNsPtr->cmdTable, "gettimes");







|
|


|



|







5491
5492
5493
5494
5495
5496
5497
5498
5499
5500
5501
5502
5503
5504
5505
5506
5507
5508
5509
5510
5511
5512
5513
	}
    }
    Tcl_GetTime(&stop);
    timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
    fprintf(stderr, "   %.3f usec per Tcl_GetInt of \"12345\"\n",
	    timePer/100000);

    /* snprintf 100000 times */
    fprintf(stderr, "snprintf of 12345 100000 times\n");
    Tcl_GetTime(&start);
    for (i = 0;  i < 100000;  i++) {
	snprintf(newString, sizeof(newString), "%d", 12345);
    }
    Tcl_GetTime(&stop);
    timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
    fprintf(stderr, "   %.3f usec per snprintf of 12345\n",
	    timePer/100000);

    /* hashtable lookup 100000 times */
    fprintf(stderr, "hashtable lookup of \"gettimes\" 100000 times\n");
    Tcl_GetTime(&start);
    for (i = 0;  i < 100000;  i++) {
	(void) Tcl_FindHashEntry(&iPtr->globalNsPtr->cmdTable, "gettimes");
5235
5236
5237
5238
5239
5240
5241
5242
5243
5244
5245
5246
5247
5248
5249
static int
TeststringbytesObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    int n;
    const unsigned char *p;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "value");
	return TCL_ERROR;
    }
    p = (const unsigned char *)Tcl_GetStringFromObj(objv[1], &n);







|







5621
5622
5623
5624
5625
5626
5627
5628
5629
5630
5631
5632
5633
5634
5635
static int
TeststringbytesObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    Tcl_Size n;
    const unsigned char *p;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "value");
	return TCL_ERROR;
    }
    p = (const unsigned char *)Tcl_GetStringFromObj(objv[1], &n);
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
static int
TestbytestringObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{










    size_t n = 0;



    const char *p;

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

    p = (const char *)Tcl_GetBytesFromObj(interp, objv[1], &n);
    if (p == NULL) {
	return TCL_ERROR;
    }








    Tcl_SetObjResult(interp, Tcl_NewStringObj(p, n));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestsetCmd --







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







|



>
>
>
>
>
>
>
>
|







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
static int
TestbytestringObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    struct {
#if !defined(TCL_NO_DEPRECATED)
#   if defined(_MSC_VER) && !defined(NDEBUG)
#	pragma warning(disable:4133)
#   elif defined(__clang__)
#	pragma clang diagnostic push
#	pragma clang diagnostic ignored "-Wincompatible-pointer-types"
#   endif
	int n; /* On purpose, not Tcl_Size, in order to demonstrate what happens */
#else
	Tcl_Size n;
#endif
	int m; /* This variable should not be overwritten */
    } x = {0, 1};
    const char *p;

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

    p = (const char *)Tcl_GetBytesFromObj(interp, objv[1], &x.n);
    if (p == NULL) {
	return TCL_ERROR;
    }
#if !defined(TCL_NO_DEPRECATED) && defined(__clang__)
#   pragma clang diagnostic pop
#endif

    if (x.m != 1) {
	Tcl_AppendResult(interp, "Tcl_GetBytesFromObj() overwrites variable", NULL);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewStringObj(p, x.n));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestsetCmd --
5620
5621
5622
5623
5624
5625
5626
5627
5628
5629
5630
5631
5632
5633
5634
    Tcl_HashSearch hSearch;	/* Search variable. */
    Tcl_HashEntry *hPtr;	/* Search variable. */
    Channel *chanPtr;		/* The actual channel. */
    ChannelState *statePtr;	/* state info for channel */
    Tcl_Channel chan;		/* The opaque type. */
    size_t len;			/* Length of subcommand string. */
    int IOQueued;		/* How much IO is queued inside channel? */
    char buf[TCL_INTEGER_SPACE];/* For sprintf. */
    int mode;			/* rw mode of the channel */

    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" subcommand ?additional args..?\"", NULL);
	return TCL_ERROR;
    }







|







6027
6028
6029
6030
6031
6032
6033
6034
6035
6036
6037
6038
6039
6040
6041
    Tcl_HashSearch hSearch;	/* Search variable. */
    Tcl_HashEntry *hPtr;	/* Search variable. */
    Channel *chanPtr;		/* The actual channel. */
    ChannelState *statePtr;	/* state info for channel */
    Tcl_Channel chan;		/* The opaque type. */
    size_t len;			/* Length of subcommand string. */
    int IOQueued;		/* How much IO is queued inside channel? */
    char buf[TCL_INTEGER_SPACE];/* For snprintf. */
    int mode;			/* rw mode of the channel */

    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" subcommand ?additional args..?\"", NULL);
	return TCL_ERROR;
    }
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
    } else {
	statePtr	= NULL;
	chan		= NULL;
    }

    if ((cmdName[0] == 's') && (strncmp(cmdName, "setchannelerror", len) == 0)) {

	Tcl_Obj *msg = Tcl_NewStringObj(argv[3], TCL_INDEX_NONE);

	Tcl_IncrRefCount(msg);
	Tcl_SetChannelError(chan, msg);
	Tcl_DecrRefCount(msg);

	Tcl_GetChannelError(chan, &msg);
	Tcl_SetObjResult(interp, msg);
	Tcl_DecrRefCount(msg);
	return TCL_OK;
    }
    if ((cmdName[0] == 's') && (strncmp(cmdName, "setchannelerrorinterp", len) == 0)) {

	Tcl_Obj *msg = Tcl_NewStringObj(argv[3], TCL_INDEX_NONE);

	Tcl_IncrRefCount(msg);
	Tcl_SetChannelErrorInterp(interp, msg);
	Tcl_DecrRefCount(msg);

	Tcl_GetChannelErrorInterp(interp, &msg);
	Tcl_SetObjResult(interp, msg);







|












|







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
    } else {
	statePtr	= NULL;
	chan		= NULL;
    }

    if ((cmdName[0] == 's') && (strncmp(cmdName, "setchannelerror", len) == 0)) {

	Tcl_Obj *msg = Tcl_NewStringObj(argv[3], -1);

	Tcl_IncrRefCount(msg);
	Tcl_SetChannelError(chan, msg);
	Tcl_DecrRefCount(msg);

	Tcl_GetChannelError(chan, &msg);
	Tcl_SetObjResult(interp, msg);
	Tcl_DecrRefCount(msg);
	return TCL_OK;
    }
    if ((cmdName[0] == 's') && (strncmp(cmdName, "setchannelerrorinterp", len) == 0)) {

	Tcl_Obj *msg = Tcl_NewStringObj(argv[3], -1);

	Tcl_IncrRefCount(msg);
	Tcl_SetChannelErrorInterp(interp, msg);
	Tcl_DecrRefCount(msg);

	Tcl_GetChannelErrorInterp(interp, &msg);
	Tcl_SetObjResult(interp, msg);
6071
6072
6073
6074
6075
6076
6077
6078
6079
6080
6081
6082
6083
6084
6085
	if (strcmp(argv[3], "-command") != 0) {
	    Tcl_AppendResult(interp, "bad argument \"", argv[3],
		    "\": should be \"-command\"", NULL);
	    return TCL_ERROR;
	}

	return TclChannelTransform(interp, chan,
		Tcl_NewStringObj(argv[4], TCL_INDEX_NONE));
    }

    if ((cmdName[0] == 'u') && (strncmp(cmdName, "unstack", len) == 0)) {
	/*
	 * Syntax: unstack channel
	 */








|







6478
6479
6480
6481
6482
6483
6484
6485
6486
6487
6488
6489
6490
6491
6492
	if (strcmp(argv[3], "-command") != 0) {
	    Tcl_AppendResult(interp, "bad argument \"", argv[3],
		    "\": should be \"-command\"", NULL);
	    return TCL_ERROR;
	}

	return TclChannelTransform(interp, chan,
		Tcl_NewStringObj(argv[4], -1));
    }

    if ((cmdName[0] == 'u') && (strncmp(cmdName, "unstack", len) == 0)) {
	/*
	 * Syntax: unstack channel
	 */

6162
6163
6164
6165
6166
6167
6168
6169
6170
6171
6172
6173
6174
6175
6176
	esPtr = (EventScriptRecord *)Tcl_Alloc(sizeof(EventScriptRecord));
	esPtr->nextPtr = statePtr->scriptRecordPtr;
	statePtr->scriptRecordPtr = esPtr;

	esPtr->chanPtr = chanPtr;
	esPtr->interp = interp;
	esPtr->mask = mask;
	esPtr->scriptPtr = Tcl_NewStringObj(argv[4], TCL_INDEX_NONE);
	Tcl_IncrRefCount(esPtr->scriptPtr);

	Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
		TclChannelEventScriptInvoker, esPtr);

	return TCL_OK;
    }







|







6569
6570
6571
6572
6573
6574
6575
6576
6577
6578
6579
6580
6581
6582
6583
	esPtr = (EventScriptRecord *)Tcl_Alloc(sizeof(EventScriptRecord));
	esPtr->nextPtr = statePtr->scriptRecordPtr;
	statePtr->scriptRecordPtr = esPtr;

	esPtr->chanPtr = chanPtr;
	esPtr->interp = interp;
	esPtr->mask = mask;
	esPtr->scriptPtr = Tcl_NewStringObj(argv[4], -1);
	Tcl_IncrRefCount(esPtr->scriptPtr);

	Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
		TclChannelEventScriptInvoker, esPtr);

	return TCL_OK;
    }
6229
6230
6231
6232
6233
6234
6235
6236
6237
6238
6239
6240
6241
6242
6243
6244
6245
6246
	}
	resultListPtr = Tcl_GetObjResult(interp);
	for (esPtr = statePtr->scriptRecordPtr;
	     esPtr != NULL;
	     esPtr = esPtr->nextPtr) {
	    if (esPtr->mask) {
		Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj(
		    (esPtr->mask == TCL_READABLE) ? "readable" : "writable", TCL_INDEX_NONE));
	    } else {
		Tcl_ListObjAppendElement(interp, resultListPtr,
			Tcl_NewStringObj("none", TCL_INDEX_NONE));
	    }
	    Tcl_ListObjAppendElement(interp, resultListPtr, esPtr->scriptPtr);
	}
	Tcl_SetObjResult(interp, resultListPtr);
	return TCL_OK;
    }








|


|







6636
6637
6638
6639
6640
6641
6642
6643
6644
6645
6646
6647
6648
6649
6650
6651
6652
6653
	}
	resultListPtr = Tcl_GetObjResult(interp);
	for (esPtr = statePtr->scriptRecordPtr;
	     esPtr != NULL;
	     esPtr = esPtr->nextPtr) {
	    if (esPtr->mask) {
		Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj(
		    (esPtr->mask == TCL_READABLE) ? "readable" : "writable", -1));
	    } else {
		Tcl_ListObjAppendElement(interp, resultListPtr,
			Tcl_NewStringObj("none", -1));
	    }
	    Tcl_ListObjAppendElement(interp, resultListPtr, esPtr->scriptPtr);
	}
	Tcl_SetObjResult(interp, resultListPtr);
	return TCL_OK;
    }

6453
6454
6455
6456
6457
6458
6459
6460
6461
6462
6463
6464
6465
6466
6467
6468
6469
6470
6471
6472
6473
 *----------------------------------------------------------------------
 */

static int
TestWrongNumArgsObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    size_t objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    size_t i, length;
    const char *msg;

    if (objc + 1 < 4) {
	goto insufArgs;
    }

    if (Tcl_GetIntForIndex(interp, objv[1], TCL_INDEX_NONE, &i) != TCL_OK) {
	return TCL_ERROR;
    }








|


|


|







6860
6861
6862
6863
6864
6865
6866
6867
6868
6869
6870
6871
6872
6873
6874
6875
6876
6877
6878
6879
6880
 *----------------------------------------------------------------------
 */

static int
TestWrongNumArgsObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Size objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Size i, length;
    const char *msg;

    if (objc < 3) {
	goto insufArgs;
    }

    if (Tcl_GetIntForIndex(interp, objv[1], TCL_INDEX_NONE, &i) != TCL_OK) {
	return TCL_ERROR;
    }

6534
6535
6536
6537
6538
6539
6540
6541
6542
6543
6544
6545
6546
6547
6548
6549
6550
6551
	return TCL_ERROR;
    }
    if (idx[0] != 85 || idx[2] != 85) {
	Tcl_AppendResult(interp, "Tcl_GetIndexFromObjStruct overwrites bytes near index variable", NULL);
	return TCL_ERROR;
    } else if (idx[1] != target) {
	char buffer[64];
	sprintf(buffer, "%d", idx[1]);
	Tcl_AppendResult(interp, "index value comparison failed: got ",
		buffer, NULL);
	sprintf(buffer, "%d", target);
	Tcl_AppendResult(interp, " when ", buffer, " expected", NULL);
	return TCL_ERROR;
    }
    Tcl_WrongNumArgs(interp, objc, objv, NULL);
    return TCL_OK;
}








|


|







6941
6942
6943
6944
6945
6946
6947
6948
6949
6950
6951
6952
6953
6954
6955
6956
6957
6958
	return TCL_ERROR;
    }
    if (idx[0] != 85 || idx[2] != 85) {
	Tcl_AppendResult(interp, "Tcl_GetIndexFromObjStruct overwrites bytes near index variable", NULL);
	return TCL_ERROR;
    } else if (idx[1] != target) {
	char buffer[64];
	snprintf(buffer, sizeof(buffer), "%d", idx[1]);
	Tcl_AppendResult(interp, "index value comparison failed: got ",
		buffer, NULL);
	snprintf(buffer, sizeof(buffer), "%d", target);
	Tcl_AppendResult(interp, " when ", buffer, " expected", NULL);
	return TCL_ERROR;
    }
    Tcl_WrongNumArgs(interp, objc, objv, NULL);
    return TCL_OK;
}

6587
6588
6589
6590
6591
6592
6593
6594
6595
6596
6597
6598
6599
6600
6601
    if (boolVal) {
	res = Tcl_FSRegister(interp, &testReportingFilesystem);
	msg = (res == TCL_OK) ? "registered" : "failed";
    } else {
	res = Tcl_FSUnregister(&testReportingFilesystem);
	msg = (res == TCL_OK) ? "unregistered" : "failed";
    }
    Tcl_SetObjResult(interp, Tcl_NewStringObj(msg , TCL_INDEX_NONE));
    return res;
}

static int
TestReportInFilesystem(
    Tcl_Obj *pathPtr,
    void **clientDataPtr)







|







6994
6995
6996
6997
6998
6999
7000
7001
7002
7003
7004
7005
7006
7007
7008
    if (boolVal) {
	res = Tcl_FSRegister(interp, &testReportingFilesystem);
	msg = (res == TCL_OK) ? "registered" : "failed";
    } else {
	res = Tcl_FSUnregister(&testReportingFilesystem);
	msg = (res == TCL_OK) ? "unregistered" : "failed";
    }
    Tcl_SetObjResult(interp, Tcl_NewStringObj(msg , -1));
    return res;
}

static int
TestReportInFilesystem(
    Tcl_Obj *pathPtr,
    void **clientDataPtr)
6669
6670
6671
6672
6673
6674
6675
6676
6677
6678
6679
6680
6681
6682
6683
    if (interp == NULL) {
	/* This is bad, but not much we can do about it */
    } else {
	Tcl_Obj *savedResult;
	Tcl_DString ds;

	Tcl_DStringInit(&ds);
	Tcl_DStringAppend(&ds, "lappend filesystemReport ", TCL_INDEX_NONE);
	Tcl_DStringStartSublist(&ds);
	Tcl_DStringAppendElement(&ds, cmd);
	if (path != NULL) {
	    Tcl_DStringAppendElement(&ds, Tcl_GetString(path));
	}
	if (arg2 != NULL) {
	    Tcl_DStringAppendElement(&ds, Tcl_GetString(arg2));







|







7076
7077
7078
7079
7080
7081
7082
7083
7084
7085
7086
7087
7088
7089
7090
    if (interp == NULL) {
	/* This is bad, but not much we can do about it */
    } else {
	Tcl_Obj *savedResult;
	Tcl_DString ds;

	Tcl_DStringInit(&ds);
	Tcl_DStringAppend(&ds, "lappend filesystemReport ", -1);
	Tcl_DStringStartSublist(&ds);
	Tcl_DStringAppendElement(&ds, cmd);
	if (path != NULL) {
	    Tcl_DStringAppendElement(&ds, Tcl_GetString(path));
	}
	if (arg2 != NULL) {
	    Tcl_DStringAppendElement(&ds, Tcl_GetString(arg2));
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
    if (boolVal) {
	res = Tcl_FSRegister(interp, &simpleFilesystem);
	msg = (res == TCL_OK) ? "registered" : "failed";
    } else {
	res = Tcl_FSUnregister(&simpleFilesystem);
	msg = (res == TCL_OK) ? "unregistered" : "failed";
    }
    Tcl_SetObjResult(interp, Tcl_NewStringObj(msg , TCL_INDEX_NONE));
    return res;
}

/*
 * Treats a file name 'simplefs:/foo' by using the file 'foo' in the current
 * (native) directory.
 */

static Tcl_Obj *
SimpleRedirect(
    Tcl_Obj *pathPtr)		/* Name of file to copy. */
{
    int len;
    const char *str;
    Tcl_Obj *origPtr;

    /*
     * We assume the same name in the current directory is ok.
     */

    str = Tcl_GetStringFromObj(pathPtr, &len);
    if (len < 10 || strncmp(str, "simplefs:/", 10)) {
	/* Probably shouldn't ever reach here */
	Tcl_IncrRefCount(pathPtr);
	return pathPtr;
    }
    origPtr = Tcl_NewStringObj(str+10, TCL_INDEX_NONE);
    Tcl_IncrRefCount(origPtr);
    return origPtr;
}

static int
SimpleMatchInDirectory(
    Tcl_Interp *interp,		/* Interpreter for error







|












|













|







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
    if (boolVal) {
	res = Tcl_FSRegister(interp, &simpleFilesystem);
	msg = (res == TCL_OK) ? "registered" : "failed";
    } else {
	res = Tcl_FSUnregister(&simpleFilesystem);
	msg = (res == TCL_OK) ? "unregistered" : "failed";
    }
    Tcl_SetObjResult(interp, Tcl_NewStringObj(msg , -1));
    return res;
}

/*
 * Treats a file name 'simplefs:/foo' by using the file 'foo' in the current
 * (native) directory.
 */

static Tcl_Obj *
SimpleRedirect(
    Tcl_Obj *pathPtr)		/* Name of file to copy. */
{
    Tcl_Size len;
    const char *str;
    Tcl_Obj *origPtr;

    /*
     * We assume the same name in the current directory is ok.
     */

    str = Tcl_GetStringFromObj(pathPtr, &len);
    if (len < 10 || strncmp(str, "simplefs:/", 10)) {
	/* Probably shouldn't ever reach here */
	Tcl_IncrRefCount(pathPtr);
	return pathPtr;
    }
    origPtr = Tcl_NewStringObj(str+10, -1);
    Tcl_IncrRefCount(origPtr);
    return origPtr;
}

static int
SimpleMatchInDirectory(
    Tcl_Interp *interp,		/* Interpreter for error
7017
7018
7019
7020
7021
7022
7023
7024
7025
7026
7027
7028
7029
7030
7031
     * We assume the same name in the current directory is ok.
     */
    resPtr = Tcl_NewObj();
    Tcl_IncrRefCount(resPtr);
    origPtr = SimpleRedirect(dirPtr);
    res = Tcl_FSMatchInDirectory(interp, resPtr, origPtr, pattern, types);
    if (res == TCL_OK) {
	int gLength, j;
	Tcl_ListObjLength(NULL, resPtr, &gLength);
	for (j = 0; j < gLength; j++) {
	    Tcl_Obj *gElt, *nElt;
	    Tcl_ListObjIndex(NULL, resPtr, j, &gElt);
	    nElt = Tcl_NewStringObj("simplefs:/",10);
	    Tcl_AppendObjToObj(nElt, gElt);
	    Tcl_ListObjAppendElement(NULL, resultPtr, nElt);







|







7424
7425
7426
7427
7428
7429
7430
7431
7432
7433
7434
7435
7436
7437
7438
     * We assume the same name in the current directory is ok.
     */
    resPtr = Tcl_NewObj();
    Tcl_IncrRefCount(resPtr);
    origPtr = SimpleRedirect(dirPtr);
    res = Tcl_FSMatchInDirectory(interp, resPtr, origPtr, pattern, types);
    if (res == TCL_OK) {
	Tcl_Size gLength, j;
	Tcl_ListObjLength(NULL, resPtr, &gLength);
	for (j = 0; j < gLength; j++) {
	    Tcl_Obj *gElt, *nElt;
	    Tcl_ListObjIndex(NULL, resPtr, j, &gElt);
	    nElt = Tcl_NewStringObj("simplefs:/",10);
	    Tcl_AppendObjToObj(nElt, gElt);
	    Tcl_ListObjAppendElement(NULL, resultPtr, nElt);
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

static Tcl_Obj *
SimpleListVolumes(void)
{
    /* Add one new volume */
    Tcl_Obj *retVal;

    retVal = Tcl_NewStringObj("simplefs:/", TCL_INDEX_NONE);
    Tcl_IncrRefCount(retVal);
    return retVal;
}

/*
 * Used to check operations of Tcl_UtfNext.
 *
 * Usage: testutfnext -bytestring $bytes
 */

static int
TestUtfNextCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    size_t numBytes;
    char *bytes;
    const char *result, *first;
    char buffer[32];
    static const char tobetested[] = "A\xA0\xC0\xC1\xC2\xD0\xE0\xE8\xF2\xF7\xF8\xFE\xFF";
    const char *p = tobetested;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-bytestring? bytes");
	return TCL_ERROR;
    }
	bytes = Tcl_GetStringFromObj(objv[1], &numBytes);

    if (numBytes + 4U > sizeof(buffer)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"\"testutfnext\" can only handle %" TCL_Z_MODIFIER "u bytes",
		sizeof(buffer) - 4));
	return TCL_ERROR;
    }

    memcpy(buffer + 1, bytes, numBytes);







|

















|












|







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

static Tcl_Obj *
SimpleListVolumes(void)
{
    /* Add one new volume */
    Tcl_Obj *retVal;

    retVal = Tcl_NewStringObj("simplefs:/", -1);
    Tcl_IncrRefCount(retVal);
    return retVal;
}

/*
 * Used to check operations of Tcl_UtfNext.
 *
 * Usage: testutfnext -bytestring $bytes
 */

static int
TestUtfNextCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Size numBytes;
    char *bytes;
    const char *result, *first;
    char buffer[32];
    static const char tobetested[] = "A\xA0\xC0\xC1\xC2\xD0\xE0\xE8\xF2\xF7\xF8\xFE\xFF";
    const char *p = tobetested;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-bytestring? bytes");
	return TCL_ERROR;
    }
	bytes = Tcl_GetStringFromObj(objv[1], &numBytes);

    if ((size_t)numBytes > sizeof(buffer) - 4) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"\"testutfnext\" can only handle %" TCL_Z_MODIFIER "u bytes",
		sizeof(buffer) - 4));
	return TCL_ERROR;
    }

    memcpy(buffer + 1, bytes, numBytes);
7164
7165
7166
7167
7168
7169
7170
7171
7172
7173
7174
7175
7176
7177
7178
static int
TestUtfPrevCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    size_t numBytes, offset;
    char *bytes;
    const char *result;

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "bytes ?offset?");
	return TCL_ERROR;
    }







|







7571
7572
7573
7574
7575
7576
7577
7578
7579
7580
7581
7582
7583
7584
7585
static int
TestUtfPrevCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Size numBytes, offset;
    char *bytes;
    const char *result;

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "bytes ?offset?");
	return TCL_ERROR;
    }
7205
7206
7207
7208
7209
7210
7211
7212
7213
7214
7215
7216
7217
7218
7219
TestNumUtfCharsCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    if (objc > 1) {
	size_t numBytes, len, limit = TCL_INDEX_NONE;
	const char *bytes = Tcl_GetStringFromObj(objv[1], &numBytes);

	if (objc > 2) {
	    if (Tcl_GetIntForIndex(interp, objv[2], numBytes, &limit) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (limit > numBytes + 1) {







|







7612
7613
7614
7615
7616
7617
7618
7619
7620
7621
7622
7623
7624
7625
7626
TestNumUtfCharsCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    if (objc > 1) {
	Tcl_Size numBytes, len, limit = TCL_INDEX_NONE;
	const char *bytes = Tcl_GetStringFromObj(objv[1], &numBytes);

	if (objc > 2) {
	    if (Tcl_GetIntForIndex(interp, objv[2], numBytes, &limit) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (limit > numBytes + 1) {
7239
7240
7241
7242
7243
7244
7245
7246
7247
7248
7249
7250
7251
7252
7253
{
    if (objc > 1) {
	int len = -1;

	if (objc > 2) {
	    (void) Tcl_GetIntFromObj(interp, objv[2], &len);
	}
	Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_UtfFindFirst(Tcl_GetString(objv[1]), len), TCL_INDEX_NONE));
    }
    return TCL_OK;
}

/*
 * Used to check correct operation of Tcl_UtfFindLast
 */







|







7646
7647
7648
7649
7650
7651
7652
7653
7654
7655
7656
7657
7658
7659
7660
{
    if (objc > 1) {
	int len = -1;

	if (objc > 2) {
	    (void) Tcl_GetIntFromObj(interp, objv[2], &len);
	}
	Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_UtfFindFirst(Tcl_GetString(objv[1]), len), -1));
    }
    return TCL_OK;
}

/*
 * Used to check correct operation of Tcl_UtfFindLast
 */
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
{
    if (objc > 1) {
	int len = -1;

	if (objc > 2) {
	    (void) Tcl_GetIntFromObj(interp, objv[2], &len);
	}
	Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_UtfFindLast(Tcl_GetString(objv[1]), len), TCL_INDEX_NONE));
    }
    return TCL_OK;
}

static int
TestGetIntForIndexCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    size_t result;
    Tcl_WideInt endvalue;

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

    if (Tcl_GetWideIntFromObj(interp, objv[2], &endvalue) != TCL_OK) {
	return TCL_ERROR;
    }
    if (Tcl_GetIntForIndex(interp, objv[1], endvalue, &result) != TCL_OK) {
	return TCL_ERROR;
    }
    /* Make sure that (size_t)-2 is output as "-2" and (size_t)-3 as "-3", even for 32-bit */
    Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)((Tcl_WideUInt)(result + 3U)) - 3));
    return TCL_OK;
}



#if defined(HAVE_CPUID) && !defined(MAC_OSX_TCL)
/*







|











|













<
|







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
{
    if (objc > 1) {
	int len = -1;

	if (objc > 2) {
	    (void) Tcl_GetIntFromObj(interp, objv[2], &len);
	}
	Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_UtfFindLast(Tcl_GetString(objv[1]), len), -1));
    }
    return TCL_OK;
}

static int
TestGetIntForIndexCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Size result;
    Tcl_WideInt endvalue;

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

    if (Tcl_GetWideIntFromObj(interp, objv[2], &endvalue) != TCL_OK) {
	return TCL_ERROR;
    }
    if (Tcl_GetIntForIndex(interp, objv[1], endvalue, &result) != TCL_OK) {
	return TCL_ERROR;
    }

    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(result));
    return TCL_OK;
}



#if defined(HAVE_CPUID) && !defined(MAC_OSX_TCL)
/*
7339
7340
7341
7342
7343
7344
7345
7346
7347
7348
7349
7350
7351
7352
7353
    }
    if (Tcl_GetIntFromObj(interp, objv[1], &index) != TCL_OK) {
	return TCL_ERROR;
    }
    status = TclWinCPUID(index, regs);
    if (status != TCL_OK) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("operation not available", TCL_INDEX_NONE));
	return status;
    }
    for (i=0 ; i<4 ; ++i) {
	regsObjs[i] = Tcl_NewWideIntObj(regs[i]);
    }
    Tcl_SetObjResult(interp, Tcl_NewListObj(4, regsObjs));
    return TCL_OK;







|







7745
7746
7747
7748
7749
7750
7751
7752
7753
7754
7755
7756
7757
7758
7759
    }
    if (Tcl_GetIntFromObj(interp, objv[1], &index) != TCL_OK) {
	return TCL_ERROR;
    }
    status = TclWinCPUID(index, regs);
    if (status != TCL_OK) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("operation not available", -1));
	return status;
    }
    for (i=0 ; i<4 ; ++i) {
	regsObjs[i] = Tcl_NewWideIntObj(regs[i]);
    }
    Tcl_SetObjResult(interp, Tcl_NewListObj(4, regsObjs));
    return TCL_OK;
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
	return TCL_ERROR;
    }

    for (i=0 ; i<limit ; i++) {
	hPtr = Tcl_CreateHashEntry(&hash, INT2PTR(i), &isNew);
	if (!isNew) {
	    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(i));
	    Tcl_AppendToObj(Tcl_GetObjResult(interp)," creation problem", TCL_INDEX_NONE);
	    Tcl_DeleteHashTable(&hash);
	    return TCL_ERROR;
	}
	Tcl_SetHashValue(hPtr, INT2PTR(i+42));
    }

    if (hash.numEntries != (size_t)limit) {
	Tcl_AppendResult(interp, "unexpected maximal size", NULL);
	Tcl_DeleteHashTable(&hash);
	return TCL_ERROR;
    }

    for (i=0 ; i<limit ; i++) {
	hPtr = Tcl_FindHashEntry(&hash, (char *) INT2PTR(i));
	if (hPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(i));
	    Tcl_AppendToObj(Tcl_GetObjResult(interp)," lookup problem", TCL_INDEX_NONE);
	    Tcl_DeleteHashTable(&hash);
	    return TCL_ERROR;
	}
	if (PTR2INT(Tcl_GetHashValue(hPtr)) != i+42) {
	    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(i));
	    Tcl_AppendToObj(Tcl_GetObjResult(interp)," value problem", TCL_INDEX_NONE);
	    Tcl_DeleteHashTable(&hash);
	    return TCL_ERROR;
	}
	Tcl_DeleteHashEntry(hPtr);
    }

    if (hash.numEntries != 0) {







|






|









|





|







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

    for (i=0 ; i<limit ; i++) {
	hPtr = Tcl_CreateHashEntry(&hash, INT2PTR(i), &isNew);
	if (!isNew) {
	    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(i));
	    Tcl_AppendToObj(Tcl_GetObjResult(interp)," creation problem", -1);
	    Tcl_DeleteHashTable(&hash);
	    return TCL_ERROR;
	}
	Tcl_SetHashValue(hPtr, INT2PTR(i+42));
    }

    if (hash.numEntries != (Tcl_Size)limit) {
	Tcl_AppendResult(interp, "unexpected maximal size", NULL);
	Tcl_DeleteHashTable(&hash);
	return TCL_ERROR;
    }

    for (i=0 ; i<limit ; i++) {
	hPtr = Tcl_FindHashEntry(&hash, (char *) INT2PTR(i));
	if (hPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(i));
	    Tcl_AppendToObj(Tcl_GetObjResult(interp)," lookup problem", -1);
	    Tcl_DeleteHashTable(&hash);
	    return TCL_ERROR;
	}
	if (PTR2INT(Tcl_GetHashValue(hPtr)) != i+42) {
	    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(i));
	    Tcl_AppendToObj(Tcl_GetObjResult(interp)," value problem", -1);
	    Tcl_DeleteHashTable(&hash);
	    return TCL_ERROR;
	}
	Tcl_DeleteHashEntry(hPtr);
    }

    if (hash.numEntries != 0) {
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
    TCL_UNUSED(int) /*objc*/,
    TCL_UNUSED(Tcl_Obj *const *) /*objv*/)
{
    Interp *iPtr = (Interp *) interp;
    static ptrdiff_t *refDepth = NULL;
    ptrdiff_t depth;
    Tcl_Obj *levels[6];
    size_t i = 0;
    NRE_callback *cbPtr = iPtr->execEnvPtr->callbackPtr;

    if (refDepth == NULL) {
	refDepth = &depth;
    }

    depth = (refDepth - &depth);

    levels[0] = Tcl_NewWideIntObj(depth);
    levels[1] = Tcl_NewWideIntObj((Tcl_WideInt)((Tcl_WideUInt)(iPtr->numLevels + 1U)) - 1);
    levels[2] = Tcl_NewWideIntObj((Tcl_WideInt)((Tcl_WideUInt)(iPtr->cmdFramePtr->level + 1U)) - 1);
    levels[3] = Tcl_NewWideIntObj((Tcl_WideInt)((Tcl_WideUInt)(iPtr->varFramePtr->level + 1U)) - 1);
    levels[4] = Tcl_NewWideIntObj(iPtr->execEnvPtr->execStackPtr->tosPtr
	    - iPtr->execEnvPtr->execStackPtr->stackWords);

    while (cbPtr) {
	i++;
	cbPtr = cbPtr->nextPtr;
    }
    levels[5] = Tcl_NewWideIntObj(i);

    Tcl_SetObjResult(interp, Tcl_NewListObj(6, levels));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestconcatobjCmd --
 *
 *	This procedure implements the "testconcatobj" command. It is used
 *	to test that Tcl_ConcatObj does indeed return a fresh Tcl_Obj in all
 *	cases and thet it never corrupts its arguments. In other words, that
 *	[Bug 1447328] was fixed properly.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestconcatobjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    TCL_UNUSED(int) /*argc*/,
    TCL_UNUSED(const char **) /*argv*/)
{
    Tcl_Obj *list1Ptr, *list2Ptr, *emptyPtr, *concatPtr, *tmpPtr;
    int result = TCL_OK, len;

    Tcl_Obj *objv[3];

    /*
     * Set the start of the error message as obj result; it will be cleared at
     * the end if no errors were found.
     */

    Tcl_SetObjResult(interp,
	    Tcl_NewStringObj("Tcl_ConcatObj is unsafe:", TCL_INDEX_NONE));

    emptyPtr = Tcl_NewObj();

    list1Ptr = Tcl_NewStringObj("foo bar sum", TCL_INDEX_NONE);
    Tcl_ListObjLength(NULL, list1Ptr, &len);
    Tcl_InvalidateStringRep(list1Ptr);

    list2Ptr = Tcl_NewStringObj("eeny meeny", TCL_INDEX_NONE);
    Tcl_ListObjLength(NULL, list2Ptr, &len);
    Tcl_InvalidateStringRep(list2Ptr);

    /*
     * Verify that concat'ing a list obj with one or more empty strings does
     * return a fresh Tcl_Obj (see also [Bug 2055782]).
     */







|









|
|
|




















|



















|
>








|



|



|







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
    TCL_UNUSED(int) /*objc*/,
    TCL_UNUSED(Tcl_Obj *const *) /*objv*/)
{
    Interp *iPtr = (Interp *) interp;
    static ptrdiff_t *refDepth = NULL;
    ptrdiff_t depth;
    Tcl_Obj *levels[6];
    Tcl_Size i = 0;
    NRE_callback *cbPtr = iPtr->execEnvPtr->callbackPtr;

    if (refDepth == NULL) {
	refDepth = &depth;
    }

    depth = (refDepth - &depth);

    levels[0] = Tcl_NewWideIntObj(depth);
    levels[1] = Tcl_NewWideIntObj(iPtr->numLevels);
    levels[2] = Tcl_NewWideIntObj(iPtr->cmdFramePtr->level);
    levels[3] = Tcl_NewWideIntObj(iPtr->varFramePtr->level);
    levels[4] = Tcl_NewWideIntObj(iPtr->execEnvPtr->execStackPtr->tosPtr
	    - iPtr->execEnvPtr->execStackPtr->stackWords);

    while (cbPtr) {
	i++;
	cbPtr = cbPtr->nextPtr;
    }
    levels[5] = Tcl_NewWideIntObj(i);

    Tcl_SetObjResult(interp, Tcl_NewListObj(6, levels));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestconcatobjCmd --
 *
 *	This procedure implements the "testconcatobj" command. It is used
 *	to test that Tcl_ConcatObj does indeed return a fresh Tcl_Obj in all
 *	cases and that it never corrupts its arguments. In other words, that
 *	[Bug 1447328] was fixed properly.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestconcatobjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    TCL_UNUSED(int) /*argc*/,
    TCL_UNUSED(const char **) /*argv*/)
{
    Tcl_Obj *list1Ptr, *list2Ptr, *emptyPtr, *concatPtr, *tmpPtr;
    int result = TCL_OK;
    Tcl_Size len;
    Tcl_Obj *objv[3];

    /*
     * Set the start of the error message as obj result; it will be cleared at
     * the end if no errors were found.
     */

    Tcl_SetObjResult(interp,
	    Tcl_NewStringObj("Tcl_ConcatObj is unsafe:", -1));

    emptyPtr = Tcl_NewObj();

    list1Ptr = Tcl_NewStringObj("foo bar sum", -1);
    Tcl_ListObjLength(NULL, list1Ptr, &len);
    Tcl_InvalidateStringRep(list1Ptr);

    list2Ptr = Tcl_NewStringObj("eeny meeny", -1);
    Tcl_ListObjLength(NULL, list2Ptr, &len);
    Tcl_InvalidateStringRep(list2Ptr);

    /*
     * Verify that concat'ing a list obj with one or more empty strings does
     * return a fresh Tcl_Obj (see also [Bug 2055782]).
     */
7938
7939
7940
7941
7942
7943
7944
7945
7946
7947
7948
7949
7950
7951
7952
TestparseargsCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Arguments. */
{
    static int foo = 0;
    int count = objc;
    Tcl_Obj **remObjv, *result[3];
    Tcl_ArgvInfo argTable[] = {
        {TCL_ARGV_CONSTANT, "-bool", INT2PTR(1), &foo, "booltest", NULL},
        TCL_ARGV_AUTO_REST, TCL_ARGV_AUTO_HELP, TCL_ARGV_TABLE_END
    };

    foo = 0;







|







8345
8346
8347
8348
8349
8350
8351
8352
8353
8354
8355
8356
8357
8358
8359
TestparseargsCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Arguments. */
{
    static int foo = 0;
    Tcl_Size count = objc;
    Tcl_Obj **remObjv, *result[3];
    Tcl_ArgvInfo argTable[] = {
        {TCL_ARGV_CONSTANT, "-bool", INT2PTR(1), &foo, "booltest", NULL},
        TCL_ARGV_AUTO_REST, TCL_ARGV_AUTO_HELP, TCL_ARGV_TABLE_END
    };

    foo = 0;
7966
7967
7968
7969
7970
7971
7972
7973
7974
7975
7976
7977
7978
7979
7980
 */

static int
InterpCmdResolver(
    Tcl_Interp *interp,
    const char *name,
    TCL_UNUSED(Tcl_Namespace *),
    TCL_UNUSED(int) /*flags*/,
    Tcl_Command *rPtr)
{
    Interp *iPtr = (Interp *) interp;
    CallFrame *varFramePtr = iPtr->varFramePtr;
    Proc *procPtr = (varFramePtr->isProcCallFrame & FRAME_IS_PROC) ?
            varFramePtr->procPtr : NULL;
    Namespace *callerNsPtr = varFramePtr->nsPtr;







|







8373
8374
8375
8376
8377
8378
8379
8380
8381
8382
8383
8384
8385
8386
8387
 */

static int
InterpCmdResolver(
    Tcl_Interp *interp,
    const char *name,
    TCL_UNUSED(Tcl_Namespace *),
    TCL_UNUSED(int) /* flags */,
    Tcl_Command *rPtr)
{
    Interp *iPtr = (Interp *) interp;
    CallFrame *varFramePtr = iPtr->varFramePtr;
    Proc *procPtr = (varFramePtr->isProcCallFrame & FRAME_IS_PROC) ?
            varFramePtr->procPtr : NULL;
    Namespace *callerNsPtr = varFramePtr->nsPtr;
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
    return var;
}

static int
InterpCompiledVarResolver(
    TCL_UNUSED(Tcl_Interp *),
    const char *name,
    TCL_UNUSED(size_t) /*length*/,
    TCL_UNUSED(Tcl_Namespace *),
    Tcl_ResolvedVarInfo **rPtr)
{
    if (*name == 'T') {
 	MyResolvedVarInfo *resVarInfo = (MyResolvedVarInfo *)Tcl_Alloc(sizeof(MyResolvedVarInfo));

 	resVarInfo->vInfo.fetchProc = MyCompiledVarFetch;
 	resVarInfo->vInfo.deleteProc = MyCompiledVarFree;
 	resVarInfo->var = NULL;
 	resVarInfo->nameObj = Tcl_NewStringObj(name, TCL_INDEX_NONE);
 	Tcl_IncrRefCount(resVarInfo->nameObj);
 	*rPtr = &resVarInfo->vInfo;
 	return TCL_OK;
    }
    return TCL_CONTINUE;
}








|









|







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

static int
InterpCompiledVarResolver(
    TCL_UNUSED(Tcl_Interp *),
    const char *name,
    TCL_UNUSED(Tcl_Size) /* length */,
    TCL_UNUSED(Tcl_Namespace *),
    Tcl_ResolvedVarInfo **rPtr)
{
    if (*name == 'T') {
 	MyResolvedVarInfo *resVarInfo = (MyResolvedVarInfo *)Tcl_Alloc(sizeof(MyResolvedVarInfo));

 	resVarInfo->vInfo.fetchProc = MyCompiledVarFetch;
 	resVarInfo->vInfo.deleteProc = MyCompiledVarFree;
 	resVarInfo->var = NULL;
 	resVarInfo->nameObj = Tcl_NewStringObj(name, -1);
 	Tcl_IncrRefCount(resVarInfo->nameObj);
 	*rPtr = &resVarInfo->vInfo;
 	return TCL_OK;
    }
    return TCL_CONTINUE;
}

8245
8246
8247
8248
8249
8250
8251
8252
8253
8254
8255
8256
8257
8258
8259
8260
8261
8262
8263
8264
    Tcl_Obj *lambdaObjs[2];
    Tcl_Obj *evalObjs[2];
    Tcl_Obj *lambdaObj;
    int result;

    /* Create a lambda {{} {set a 42}} */
    lambdaObjs[0] = Tcl_NewObj(); /* No parameters */
    lambdaObjs[1] = Tcl_NewStringObj("set a 42", TCL_INDEX_NONE); /* Body */
    lambdaObj = Tcl_NewListObj(2, lambdaObjs);
    Tcl_IncrRefCount(lambdaObj);

    /* Create the command "apply {{} {set a 42}" */
    evalObjs[0] = Tcl_NewStringObj("apply", TCL_INDEX_NONE);
    Tcl_IncrRefCount(evalObjs[0]);
    /*
     * NOTE: IMPORTANT TO EXHIBIT THE BUG. We duplicate the lambda because
     * it will get shimmered to a Lambda internal representation but we
     * want to hold on to our list representation.
     */
    evalObjs[1] = Tcl_DuplicateObj(lambdaObj);







|




|







8652
8653
8654
8655
8656
8657
8658
8659
8660
8661
8662
8663
8664
8665
8666
8667
8668
8669
8670
8671
    Tcl_Obj *lambdaObjs[2];
    Tcl_Obj *evalObjs[2];
    Tcl_Obj *lambdaObj;
    int result;

    /* Create a lambda {{} {set a 42}} */
    lambdaObjs[0] = Tcl_NewObj(); /* No parameters */
    lambdaObjs[1] = Tcl_NewStringObj("set a 42", -1); /* Body */
    lambdaObj = Tcl_NewListObj(2, lambdaObjs);
    Tcl_IncrRefCount(lambdaObj);

    /* Create the command "apply {{} {set a 42}" */
    evalObjs[0] = Tcl_NewStringObj("apply", -1);
    Tcl_IncrRefCount(evalObjs[0]);
    /*
     * NOTE: IMPORTANT TO EXHIBIT THE BUG. We duplicate the lambda because
     * it will get shimmered to a Lambda internal representation but we
     * want to hold on to our list representation.
     */
    evalObjs[1] = Tcl_DuplicateObj(lambdaObj);
8289
8290
8291
8292
8293
8294
8295
8296
8297
































































































8298
8299
8300
8301
8302
8303
8304
8305
     				no need for IncrRef */
    result = Tcl_EvalObjv(interp, 2, evalObjs, TCL_EVAL_GLOBAL);
    Tcl_DecrRefCount(evalObjs[0]);
    Tcl_DecrRefCount(lambdaObj);

    return result;
}

/*
































































































 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * indent-tabs-mode: nil
 * End:
 */









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








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
     				no need for IncrRef */
    result = Tcl_EvalObjv(interp, 2, evalObjs, TCL_EVAL_GLOBAL);
    Tcl_DecrRefCount(evalObjs[0]);
    Tcl_DecrRefCount(lambdaObj);

    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TestLutilCmd --
 *
 *	This procedure implements the "testlequal" command. It is used to
 *	test compare two lists for equality using the string representation
 *      of each element. Implemented in C because script level loops are
 *	too slow for comparing large (GB count) lists.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestLutilCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Arguments. */
{
    Tcl_Size nL1, nL2;
    Tcl_Obj *l1Obj = NULL;
    Tcl_Obj *l2Obj = NULL;
    Tcl_Obj **l1Elems;
    Tcl_Obj **l2Elems;
    static const char *const subcmds[] = {
	   "equal", "diffindex", NULL
    };
    enum options {
	   LUTIL_EQUAL, LUTIL_DIFFINDEX
    } idx;

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "list1 list2");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], subcmds, "option", 0,
	    &idx) != TCL_OK) {
	return TCL_ERROR;
    }

    /* Protect against shimmering, just to be safe */
    l1Obj = Tcl_DuplicateObj(objv[2]);
    l2Obj = Tcl_DuplicateObj(objv[3]);

    int ret = TCL_ERROR;
    if (Tcl_ListObjGetElements(interp, l1Obj, &nL1, &l1Elems) != TCL_OK) {
	goto vamoose;
    }
    if (Tcl_ListObjGetElements(interp, l2Obj, &nL2, &l2Elems) != TCL_OK) {
	goto vamoose;
    }

    Tcl_Size i, nCmp;

    ret = TCL_OK;
    switch (idx) {
    case LUTIL_EQUAL:
	/* Avoid the loop below if lengths differ */
	if (nL1 != nL2) {
	    Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
	    break;
	}
	/* FALLTHRU */
    case LUTIL_DIFFINDEX:
	nCmp = nL1 <= nL2 ? nL1 : nL2;
	for (i = 0; i < nCmp; ++i) {
	    if (strcmp(Tcl_GetString(l1Elems[i]), Tcl_GetString(l2Elems[i]))) {
		break;
	    }
	}
	if (i == nCmp && nCmp == nL1 && nCmp == nL2) {
	    nCmp = idx == LUTIL_EQUAL ? 1 : -1;
	} else {
	    nCmp = idx == LUTIL_EQUAL ? 0 : i;
	}
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(nCmp));
	break;
    }

vamoose:
    if (l1Obj) {
	Tcl_DecrRefCount(l1Obj);
    }
    if (l2Obj) {
	Tcl_DecrRefCount(l2Obj);
    }
    return ret;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * indent-tabs-mode: nil
 * End:
 */

Changes to generic/tclTestABSList.c.

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
static void freeRep(Tcl_Obj* alObj);
static Tcl_Obj* my_LStringObjSetElem(Tcl_Interp *interp,
				     Tcl_Obj *listPtr,
				     Tcl_Size numIndcies,
				     Tcl_Obj *const indicies[],
				     Tcl_Obj *valueObj);
static void DupLStringRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
static Tcl_WideInt my_LStringObjLength(Tcl_Obj *lstringObjPtr);
static int my_LStringObjIndex(Tcl_Interp *interp,
			      Tcl_Obj *lstringObj,
			      Tcl_Size index,
			      Tcl_Obj **charObjPtr);
static int my_LStringObjRange(Tcl_Interp *interp, Tcl_Obj *lstringObj,
			      Tcl_Size fromIdx, Tcl_Size toIdx,
			      Tcl_Obj **newObjPtr);
static int my_LStringObjReverse(Tcl_Interp *interp, Tcl_Obj *srcObj,
			  Tcl_Obj **newObjPtr);
static int my_LStringReplace(Tcl_Interp *interp,
		      Tcl_Obj *listObj,
		      Tcl_Size first,
		      Tcl_Size numToDelete,
		      Tcl_Size numToInsert,
		      Tcl_Obj *const insertObjs[]);
static int my_LStringGetElements(Tcl_Interp *interp,
				 Tcl_Obj *listPtr,
				 Tcl_Size *objcptr,
				 Tcl_Obj ***objvptr);



/*
 * Internal Representation of an lstring type value
 */

typedef struct LString {
    char *string;	// NULL terminated utf-8 string
    Tcl_Size strlen;	// num bytes in string
    Tcl_Size allocated; // num bytes allocated
    Tcl_Obj**elements;	// elements array, allocated when GetElements is
			// called
} LString;

/*
 * AbstractList definition of an lstring type
 */
static Tcl_AbstractListType lstringTypes[12] = {
    {
	TCL_ABSTRACTLIST_VERSION_1,
	"lstring",
/**/	NULL, /*default NULL,*/
	DupLStringRep,
	my_LStringObjLength,
	my_LStringObjIndex,
	my_LStringObjRange,/*ObjRange*/
	my_LStringObjReverse,
        my_LStringGetElements,
        freeRep,
	NULL /*toString*/,
	my_LStringObjSetElem, /* use default update string */
	my_LStringReplace
    },
    {
	TCL_ABSTRACTLIST_VERSION_1,
	"lstring",
	NULL,
/**/	NULL, /*default DupLStringRep,*/

	my_LStringObjLength,
	my_LStringObjIndex,
	my_LStringObjRange,/*ObjRange*/
	my_LStringObjReverse,
        my_LStringGetElements,
        freeRep,
	NULL /*toString*/,
	my_LStringObjSetElem, /* use default update string */
	my_LStringReplace
    },
    {
	TCL_ABSTRACTLIST_VERSION_1,
	"lstring",



	NULL,
	DupLStringRep,
/**/	NULL, /*default my_LStringObjLength,*/
	my_LStringObjIndex,
	my_LStringObjRange,/*ObjRange*/
	my_LStringObjReverse,
        my_LStringGetElements,
        freeRep,
	NULL /*toString*/,
	my_LStringObjSetElem, /* use default update string */
	my_LStringReplace
    },
    {
	TCL_ABSTRACTLIST_VERSION_1,
	"lstring",
	NULL,

	DupLStringRep,



	my_LStringObjLength,
/**/	NULL, /*default my_LStringObjIndex,*/
	my_LStringObjRange,/*ObjRange*/
	my_LStringObjReverse,
        my_LStringGetElements,
        freeRep,
	NULL /*toString*/,
	my_LStringObjSetElem, /* use default update string */
	my_LStringReplace
    },
    {





	TCL_ABSTRACTLIST_VERSION_1,
	"lstring",
	NULL,
	DupLStringRep,
	my_LStringObjLength,
	my_LStringObjIndex,
/**/	NULL, /*default my_LStringObjRange,*/
	my_LStringObjReverse,
        my_LStringGetElements,
        freeRep,
	NULL /*toString*/,
	my_LStringObjSetElem, /* use default update string */
	my_LStringReplace
    },
    {
	TCL_ABSTRACTLIST_VERSION_1,
	"lstring",
	NULL,

	DupLStringRep,



	my_LStringObjLength,
	my_LStringObjIndex,
	my_LStringObjRange,/*ObjRange*/
/**/	NULL, /*defaults my_LStringObjReverse,*/
        my_LStringGetElements,
        freeRep,
	NULL /*toString*/,
	my_LStringObjSetElem, /* use default update string */
	my_LStringReplace
    },
    {
	TCL_ABSTRACTLIST_VERSION_1,
	"lstring",
	NULL,

	DupLStringRep,



	my_LStringObjLength,
	my_LStringObjIndex,
	my_LStringObjRange,/*ObjRange*/
	my_LStringObjReverse,
/**/	NULL, /*default NULL / *my_LStringGetElements,*/
        freeRep,
	NULL /*toString*/,
	my_LStringObjSetElem, /* use default update string */
	my_LStringReplace
    },
    {





	TCL_ABSTRACTLIST_VERSION_1,
	"lstring",
	NULL,
	DupLStringRep,
	my_LStringObjLength,
	my_LStringObjIndex,
	my_LStringObjRange,/*ObjRange*/
	my_LStringObjReverse,
        my_LStringGetElements,
/**/	NULL, /*default freeRep,*/
	NULL /*toString*/,
	my_LStringObjSetElem, /* use default update string */
	my_LStringReplace
    },
    {
	TCL_ABSTRACTLIST_VERSION_1,
	"lstring",
	NULL,

	DupLStringRep,



	my_LStringObjLength,
	my_LStringObjIndex,
	my_LStringObjRange,/*ObjRange*/
	my_LStringObjReverse,
        my_LStringGetElements,
        freeRep,
/**/	NULL, /*toString*/
	my_LStringObjSetElem, /* use default update string */
	my_LStringReplace
    },
    {
	TCL_ABSTRACTLIST_VERSION_1,
	"lstring",
	NULL,

	DupLStringRep,



	my_LStringObjLength,
	my_LStringObjIndex,
	my_LStringObjRange,/*ObjRange*/
	my_LStringObjReverse,
        my_LStringGetElements,
        freeRep,
	NULL /*toString*/,
/**/	NULL, /*default my_LStringObjSetElem, / * use default update string */
	NULL, /*default my_LStringReplace*/
    },
    {





	TCL_ABSTRACTLIST_VERSION_1,
	"lstring",
	NULL,
	DupLStringRep,
	my_LStringObjLength,
	my_LStringObjIndex,
	my_LStringObjRange,/*ObjRange*/
	my_LStringObjReverse,
        my_LStringGetElements,
        freeRep,
	NULL /*toString*/,
	my_LStringObjSetElem, /* use default update string */
/**/	NULL, /*default my_LStringReplace*/
    },
    {
	TCL_ABSTRACTLIST_VERSION_1,
	"lstring",
	NULL,

	DupLStringRep,



	my_LStringObjLength,
	my_LStringObjIndex,
	my_LStringObjRange,/*ObjRange*/
	my_LStringObjReverse,
        my_LStringGetElements,
        freeRep,
	NULL /*toString*/,
	my_LStringObjSetElem, /* use default update string */
	my_LStringReplace
    }
};

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







|



















>
>
















|
|
<

<
<
<
<
<
<
<
|
<
<
|
<
<
<
|

<
>
|
|
|
|
|
<
<
|
|

|
<

>
>
>

|
|
|
|
|
|
<
<
|
|

|
<

<
>

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

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

|
<

<
>

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

|
<

<
>

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

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

|
<

<
>

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

|
<

<
>

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

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

|
<

<
>

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







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
static void freeRep(Tcl_Obj* alObj);
static Tcl_Obj* my_LStringObjSetElem(Tcl_Interp *interp,
				     Tcl_Obj *listPtr,
				     Tcl_Size numIndcies,
				     Tcl_Obj *const indicies[],
				     Tcl_Obj *valueObj);
static void DupLStringRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
static Tcl_Size my_LStringObjLength(Tcl_Obj *lstringObjPtr);
static int my_LStringObjIndex(Tcl_Interp *interp,
			      Tcl_Obj *lstringObj,
			      Tcl_Size index,
			      Tcl_Obj **charObjPtr);
static int my_LStringObjRange(Tcl_Interp *interp, Tcl_Obj *lstringObj,
			      Tcl_Size fromIdx, Tcl_Size toIdx,
			      Tcl_Obj **newObjPtr);
static int my_LStringObjReverse(Tcl_Interp *interp, Tcl_Obj *srcObj,
			  Tcl_Obj **newObjPtr);
static int my_LStringReplace(Tcl_Interp *interp,
		      Tcl_Obj *listObj,
		      Tcl_Size first,
		      Tcl_Size numToDelete,
		      Tcl_Size numToInsert,
		      Tcl_Obj *const insertObjs[]);
static int my_LStringGetElements(Tcl_Interp *interp,
				 Tcl_Obj *listPtr,
				 Tcl_Size *objcptr,
				 Tcl_Obj ***objvptr);
static void lstringFreeElements(Tcl_Obj* lstringObj);
static void UpdateStringOfLString(Tcl_Obj *objPtr);

/*
 * Internal Representation of an lstring type value
 */

typedef struct LString {
    char *string;	// NULL terminated utf-8 string
    Tcl_Size strlen;	// num bytes in string
    Tcl_Size allocated; // num bytes allocated
    Tcl_Obj**elements;	// elements array, allocated when GetElements is
			// called
} LString;

/*
 * AbstractList definition of an lstring type
 */
static const Tcl_ObjType lstringTypes[11] = {
    {/*0*/

	"lstring",







	freeRep,


	DupLStringRep,



	UpdateStringOfLString,
	NULL,

	TCL_OBJTYPE_V2(
	    my_LStringObjLength,   /* Length */
	    my_LStringObjIndex,    /* Index */
	    my_LStringObjRange,    /* Slice */
	    my_LStringObjReverse,  /* Reverse */
	    my_LStringGetElements, /* GetElements */


	    my_LStringObjSetElem,  /* SetElement */
	    my_LStringReplace)     /* Replace */
    },
    {/*1*/

	"lstring",
	freeRep,
	DupLStringRep,
	UpdateStringOfLString,
	NULL,
	TCL_OBJTYPE_V2(
	    NULL,   /* Length */
	    my_LStringObjIndex,    /* Index */
	    my_LStringObjRange,    /* Slice */
	    my_LStringObjReverse,  /* Reverse */
	    my_LStringGetElements, /* GetElements */


	    my_LStringObjSetElem,  /* SetElement */
	    my_LStringReplace)     /* Replace */
    },
    {/*2*/

	"lstring",

	freeRep,
	DupLStringRep,
	UpdateStringOfLString,
	NULL,
	TCL_OBJTYPE_V2(
	    my_LStringObjLength,   /* Length */
	    NULL,                  /* Index */
	    my_LStringObjRange,    /* Slice */
	    my_LStringObjReverse,  /* Reverse */
	    my_LStringGetElements, /* GetElements */


	    my_LStringObjSetElem,  /* SetElement */
	    my_LStringReplace)     /* Replace */
    },
    {/*3*/
	"lstring",
	freeRep,
	DupLStringRep,
	UpdateStringOfLString,
	NULL,
	TCL_OBJTYPE_V2(



	    my_LStringObjLength,   /* Length */
	    my_LStringObjIndex,    /* Index */
	    NULL,                  /* Slice */
	    my_LStringObjReverse,  /* Reverse */
	    my_LStringGetElements, /* GetElements */


	    my_LStringObjSetElem,  /* SetElement */
	    my_LStringReplace)     /* Replace */
    },
    {/*4*/

	"lstring",

	freeRep,
	DupLStringRep,
	UpdateStringOfLString,
	NULL,
	TCL_OBJTYPE_V2(
	    my_LStringObjLength,   /* Length */
	    my_LStringObjIndex,    /* Index */
	    my_LStringObjRange,    /* Slice */
	    NULL,                  /* Reverse */
	    my_LStringGetElements, /* GetElements */


	    my_LStringObjSetElem,  /* SetElement */
	    my_LStringReplace)     /* Replace */
    },
    {/*5*/

	"lstring",

	freeRep,
	DupLStringRep,
	UpdateStringOfLString,
	NULL,
	TCL_OBJTYPE_V2(
	    my_LStringObjLength,   /* Length */
	    my_LStringObjIndex,    /* Index */
	    my_LStringObjRange,    /* Slice */
	    my_LStringObjReverse,  /* Reverse */
	    NULL,                  /* GetElements */


	    my_LStringObjSetElem,  /* SetElement */
	    my_LStringReplace)     /* Replace */
    },
    {/*6*/
	"lstring",
	freeRep,
	DupLStringRep,
	UpdateStringOfLString,
	NULL,
	TCL_OBJTYPE_V2(



	    my_LStringObjLength,   /* Length */
	    my_LStringObjIndex,    /* Index */
	    my_LStringObjRange,    /* Slice */
	    my_LStringObjReverse,  /* Reverse */
	    my_LStringGetElements, /* GetElements */
	    NULL,                  /* SetElement */


	    my_LStringReplace)     /* Replace */
    },
    {/*7*/

	"lstring",

	freeRep,
	DupLStringRep,
	UpdateStringOfLString,
	NULL,
	TCL_OBJTYPE_V2(
	    my_LStringObjLength,   /* Length */
	    my_LStringObjIndex,    /* Index */
	    my_LStringObjRange,    /* Slice */
	    my_LStringObjReverse,  /* Reverse */
	    my_LStringGetElements, /* GetElements */


	    my_LStringObjSetElem,  /* SetElement */
	    NULL)                  /* Replace */
    },
    {/*8*/

	"lstring",

	freeRep,
	DupLStringRep,
	UpdateStringOfLString,
	NULL,
	TCL_OBJTYPE_V2(
	    my_LStringObjLength,   /* Length */
	    my_LStringObjIndex,    /* Index */
	    my_LStringObjRange,    /* Slice */
	    my_LStringObjReverse,  /* Reverse */
	    my_LStringGetElements, /* GetElements */


	    my_LStringObjSetElem,  /* SetElement */
	    my_LStringReplace)     /* Replace */
    },
    {/*9*/
	"lstring",
	freeRep,
	DupLStringRep,
	UpdateStringOfLString,
	NULL,
	TCL_OBJTYPE_V2(



	    my_LStringObjLength,   /* Length */
	    my_LStringObjIndex,    /* Index */
	    my_LStringObjRange,    /* Slice */
	    my_LStringObjReverse,  /* Reverse */
	    my_LStringGetElements, /* GetElements */


	    my_LStringObjSetElem,  /* SetElement */
	    my_LStringReplace)     /* Replace */
    },
    {/*10*/

	"lstring",

	freeRep,
	DupLStringRep,
	UpdateStringOfLString,
	NULL,
	TCL_OBJTYPE_V2(
	    my_LStringObjLength,   /* Length */
	    my_LStringObjIndex,    /* Index */
	    my_LStringObjRange,    /* Slice */
	    my_LStringObjReverse,  /* Reverse */
	    my_LStringGetElements, /* GetElements */


	    my_LStringObjSetElem,  /* SetElement */
	    my_LStringReplace)     /* Replace */
    }
};


/*
 *----------------------------------------------------------------------
 *
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
static int
my_LStringObjIndex(
    Tcl_Interp *interp,
    Tcl_Obj *lstringObj,
    Tcl_Size index,
    Tcl_Obj **charObjPtr)
{
  LString *lstringRepPtr = (LString*)Tcl_AbstractListGetConcreteRep(lstringObj);

  (void)interp;

  if (index < lstringRepPtr->strlen) {
      char cchar[2];
      cchar[0] = lstringRepPtr->string[index];
      cchar[1] = 0;







|







249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
static int
my_LStringObjIndex(
    Tcl_Interp *interp,
    Tcl_Obj *lstringObj,
    Tcl_Size index,
    Tcl_Obj **charObjPtr)
{
    LString *lstringRepPtr = (LString*)lstringObj->internalRep.twoPtrValue.ptr1;

  (void)interp;

  if (index < lstringRepPtr->strlen) {
      char cchar[2];
      cchar[0] = lstringRepPtr->string[index];
      cchar[1] = 0;
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static Tcl_WideInt
my_LStringObjLength(Tcl_Obj *lstringObjPtr)
{
    LString *lstringRepPtr = (LString *)Tcl_AbstractListGetConcreteRep(lstringObjPtr);
    return lstringRepPtr->strlen;
}

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







|


|







283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Size
my_LStringObjLength(Tcl_Obj *lstringObjPtr)
{
    LString *lstringRepPtr = (LString *)lstringObjPtr->internalRep.twoPtrValue.ptr1;
    return lstringRepPtr->strlen;
}


/*
 *----------------------------------------------------------------------
 *
324
325
326
327
328
329
330
331
332
333
334
335
336

337

338


339
340
341
342
343
344
345
 *
 *----------------------------------------------------------------------
 */

static void
DupLStringRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr)
{
  LString *srcLString = (LString*)Tcl_AbstractListGetConcreteRep(srcPtr);
  LString *copyLString = (LString*)Tcl_Alloc(sizeof(LString));

  memcpy(copyLString, srcLString, sizeof(LString));
  copyLString->string = (char*)Tcl_Alloc(srcLString->allocated);
  strcpy(copyLString->string, srcLString->string);

  copyLString->elements = NULL;

  Tcl_AbstractListSetConcreteRep(copyPtr,copyLString);



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







|




|
>

>
|
>
>







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

static void
DupLStringRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr)
{
  LString *srcLString = (LString*)srcPtr->internalRep.twoPtrValue.ptr1;
  LString *copyLString = (LString*)Tcl_Alloc(sizeof(LString));

  memcpy(copyLString, srcLString, sizeof(LString));
  copyLString->string = (char*)Tcl_Alloc(srcLString->allocated);
  strncpy(copyLString->string, srcLString->string, srcLString->strlen);
  copyLString->string[srcLString->strlen] = '\0';
  copyLString->elements = NULL;
  Tcl_ObjInternalRep itr;
  itr.twoPtrValue.ptr1 = copyLString;
  itr.twoPtrValue.ptr2 = NULL;
  Tcl_StoreInternalRep(copyPtr, srcPtr->typePtr, &itr);

  return;
}

/*
 *----------------------------------------------------------------------
 *
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
my_LStringObjSetElem(
    Tcl_Interp *interp,
    Tcl_Obj *lstringObj,
    Tcl_Size numIndicies,
    Tcl_Obj *const indicies[],
    Tcl_Obj *valueObj)
{
    LString *lstringRepPtr = (LString*)Tcl_AbstractListGetConcreteRep(lstringObj);
    Tcl_Size index;
    const char *newvalue;
    int status;
    Tcl_Obj *returnObj;

    if (numIndicies > 1) {
	Tcl_SetObjResult(interp,
	    Tcl_ObjPrintf("Multiple indicies not supported by lstring."));
	return NULL;
    }

    status = Tcl_GetIntForIndex(interp, indicies[0], lstringRepPtr->strlen, &index);
    if (status != TCL_OK) {
	return NULL;
    }

    returnObj = Tcl_IsShared(lstringObj) ? Tcl_DuplicateObj(lstringObj) : lstringObj;
    lstringRepPtr = (LString*)Tcl_AbstractListGetConcreteRep(returnObj);

    if (index >= lstringRepPtr->strlen) {
	index = lstringRepPtr->strlen;
	lstringRepPtr->strlen++;
	lstringRepPtr->string = (char*)Tcl_Realloc(lstringRepPtr->string, lstringRepPtr->strlen+1);
    }








|

















|







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
my_LStringObjSetElem(
    Tcl_Interp *interp,
    Tcl_Obj *lstringObj,
    Tcl_Size numIndicies,
    Tcl_Obj *const indicies[],
    Tcl_Obj *valueObj)
{
    LString *lstringRepPtr = (LString*)lstringObj->internalRep.twoPtrValue.ptr1;
    Tcl_Size index;
    const char *newvalue;
    int status;
    Tcl_Obj *returnObj;

    if (numIndicies > 1) {
	Tcl_SetObjResult(interp,
	    Tcl_ObjPrintf("Multiple indicies not supported by lstring."));
	return NULL;
    }

    status = Tcl_GetIntForIndex(interp, indicies[0], lstringRepPtr->strlen, &index);
    if (status != TCL_OK) {
	return NULL;
    }

    returnObj = Tcl_IsShared(lstringObj) ? Tcl_DuplicateObj(lstringObj) : lstringObj;
    lstringRepPtr = (LString*)returnObj->internalRep.twoPtrValue.ptr1;

    if (index >= lstringRepPtr->strlen) {
	index = lstringRepPtr->strlen;
	lstringRepPtr->strlen++;
	lstringRepPtr->string = (char*)Tcl_Realloc(lstringRepPtr->string, lstringRepPtr->strlen+1);
    }

422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
    Tcl_Interp *interp,
    Tcl_Obj *lstringObj,
    Tcl_Size fromIdx,
    Tcl_Size toIdx,
    Tcl_Obj **newObjPtr)
{
    Tcl_Obj *rangeObj;
    LString *lstringRepPtr = (LString*)Tcl_AbstractListGetConcreteRep(lstringObj);
    LString *rangeRep;
    Tcl_WideInt len = toIdx - fromIdx + 1;

    if (lstringRepPtr->strlen < fromIdx ||
	lstringRepPtr->strlen < toIdx) {
	Tcl_SetObjResult(interp,
	    Tcl_ObjPrintf("Range out of bounds "));







|







413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
    Tcl_Interp *interp,
    Tcl_Obj *lstringObj,
    Tcl_Size fromIdx,
    Tcl_Size toIdx,
    Tcl_Obj **newObjPtr)
{
    Tcl_Obj *rangeObj;
    LString *lstringRepPtr = (LString*)lstringObj->internalRep.twoPtrValue.ptr1;
    LString *rangeRep;
    Tcl_WideInt len = toIdx - fromIdx + 1;

    if (lstringRepPtr->strlen < fromIdx ||
	lstringRepPtr->strlen < toIdx) {
	Tcl_SetObjResult(interp,
	    Tcl_ObjPrintf("Range out of bounds "));
444
445
446
447
448
449
450
451







452

453
454
455
456
457
458
459
	rangeRep = (LString*)Tcl_Alloc(sizeof(LString));
	rangeRep->allocated = len+1;
	rangeRep->strlen = len;
	rangeRep->string = (char*)Tcl_Alloc(rangeRep->allocated);
	strncpy(rangeRep->string,&lstringRepPtr->string[fromIdx],len);
	rangeRep->string[len] = 0;
	rangeRep->elements = NULL;
	rangeObj = Tcl_AbstractListObjNew(interp, Tcl_AbstractListGetType(lstringObj));







	Tcl_AbstractListSetConcreteRep(rangeObj, rangeRep);

	*newObjPtr = rangeObj;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------







|
>
>
>
>
>
>
>
|
>







435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
	rangeRep = (LString*)Tcl_Alloc(sizeof(LString));
	rangeRep->allocated = len+1;
	rangeRep->strlen = len;
	rangeRep->string = (char*)Tcl_Alloc(rangeRep->allocated);
	strncpy(rangeRep->string,&lstringRepPtr->string[fromIdx],len);
	rangeRep->string[len] = 0;
	rangeRep->elements = NULL;
	rangeObj = Tcl_NewObj();
	Tcl_ObjInternalRep itr;
	itr.twoPtrValue.ptr1 = rangeRep;
	itr.twoPtrValue.ptr2 = NULL;
	Tcl_StoreInternalRep(rangeObj, lstringObj->typePtr, &itr);
	if (rangeRep->strlen > 0) {
	    Tcl_InvalidateStringRep(rangeObj);
	} else {
	    Tcl_InitStringRep(rangeObj, NULL, 0);
	}
	*newObjPtr = rangeObj;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
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
 *
 *----------------------------------------------------------------------
 */

static int
my_LStringObjReverse(Tcl_Interp *interp, Tcl_Obj *srcObj, Tcl_Obj **newObjPtr)
{
    LString *srcRep = (LString*)Tcl_AbstractListGetConcreteRep(srcObj);
    Tcl_Obj *revObj;
    LString *revRep = (LString*)Tcl_Alloc(sizeof(LString));

    Tcl_WideInt len;
    char *srcp, *dstp, *endp;

    len = srcRep->strlen;
    revRep->strlen = len;
    revRep->allocated = len+1;
    revRep->string = (char*)Tcl_Alloc(revRep->allocated);
    revRep->elements = NULL;
    srcp = srcRep->string;
    endp = &srcRep->string[len];
    dstp = &revRep->string[len];
    *dstp-- = 0;
    while (srcp < endp) {
	*dstp-- = *srcp++;
    }
    revObj = Tcl_AbstractListObjNew(interp, Tcl_AbstractListGetType(srcObj));






    Tcl_AbstractListSetConcreteRep(revObj, revRep);

    *newObjPtr = revObj;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *







|


>
|

>












|
>
>
>
>
>
>
|
>







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

static int
my_LStringObjReverse(Tcl_Interp *interp, Tcl_Obj *srcObj, Tcl_Obj **newObjPtr)
{
    LString *srcRep = (LString*)srcObj->internalRep.twoPtrValue.ptr1;
    Tcl_Obj *revObj;
    LString *revRep = (LString*)Tcl_Alloc(sizeof(LString));
    Tcl_ObjInternalRep itr;
    Tcl_Size len;
    char *srcp, *dstp, *endp;
    (void)interp;
    len = srcRep->strlen;
    revRep->strlen = len;
    revRep->allocated = len+1;
    revRep->string = (char*)Tcl_Alloc(revRep->allocated);
    revRep->elements = NULL;
    srcp = srcRep->string;
    endp = &srcRep->string[len];
    dstp = &revRep->string[len];
    *dstp-- = 0;
    while (srcp < endp) {
	*dstp-- = *srcp++;
    }
    revObj = Tcl_NewObj();
    itr.twoPtrValue.ptr1 = revRep;
    itr.twoPtrValue.ptr2 = NULL;
    Tcl_StoreInternalRep(revObj, srcObj->typePtr, &itr);
    if (revRep->strlen > 0) {
	Tcl_InvalidateStringRep(revObj);
    } else {
	Tcl_InitStringRep(revObj, NULL, 0);
    }
    *newObjPtr = revObj;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
    Tcl_Interp *interp,
    Tcl_Obj *listObj,
    Tcl_Size first,
    Tcl_Size numToDelete,
    Tcl_Size numToInsert,
    Tcl_Obj *const insertObjs[])
{
    LString *lstringRep = (LString*)Tcl_AbstractListGetConcreteRep(listObj);
    Tcl_Size newLen;
    Tcl_Size x, ix, kx;
    char *newStr;
    char *oldStr = lstringRep->string;
    (void)interp;

    newLen = lstringRep->strlen - numToDelete + numToInsert;







|







529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
    Tcl_Interp *interp,
    Tcl_Obj *listObj,
    Tcl_Size first,
    Tcl_Size numToDelete,
    Tcl_Size numToInsert,
    Tcl_Obj *const insertObjs[])
{
    LString *lstringRep = (LString*)listObj->internalRep.twoPtrValue.ptr1;
    Tcl_Size newLen;
    Tcl_Size x, ix, kx;
    char *newStr;
    char *oldStr = lstringRep->string;
    (void)interp;

    newLen = lstringRep->strlen - numToDelete + numToInsert;
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

    if (oldStr != newStr) {
	Tcl_Free(oldStr);
    }
    lstringRep->string = newStr;
    lstringRep->strlen = newLen;

    /* Changes made to value, string rep no longer valid */
    Tcl_InvalidateStringRep(listObj);


    return TCL_OK;
}

static Tcl_AbstractListType *
my_SetAbstractProc(Tcl_AbstractListProcType ptype)
{
    Tcl_AbstractListType *typePtr = &lstringTypes[11];
    if (TCL_ABSL_NEW <= ptype && ptype <= TCL_ABSL_REPLACE) {

	typePtr = &lstringTypes[ptype];
    }
    return typePtr;
}

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







|

>




|
|

|
|
>
|







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

    if (oldStr != newStr) {
	Tcl_Free(oldStr);
    }
    lstringRep->string = newStr;
    lstringRep->strlen = newLen;

    /* Changes made to value, string rep and elements array no longer valid */
    Tcl_InvalidateStringRep(listObj);
    lstringFreeElements(listObj);

    return TCL_OK;
}

static const Tcl_ObjType *
my_SetAbstractProc(int ptype)
{
    const Tcl_ObjType *typePtr = &lstringTypes[0]; /* default value */
    if (4 <= ptype && ptype <= 11) {
	/* Table has no entries for the slots upto setfromany */
	typePtr = &lstringTypes[(ptype-3)];
    }
    return typePtr;
}


/*
 *----------------------------------------------------------------------
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
static Tcl_Obj *
my_NewLStringObj(
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj * const objv[])
{
    LString *lstringRepPtr;

    size_t repSize;
    Tcl_Obj *lstringPtr;
    const char *string;
    static const char* procTypeNames[] = {
	"NEW", "DUPREP", "LENGTH", "INDEX",
	"SLICE", "REVERSE", "GETELEMENTS", "FREEREP",
	"TOSTRING", "SETELEMENT", "REPLACE", NULL
    };
    int i = 0;
    Tcl_AbstractListProcType ptype;
    Tcl_AbstractListType *lstringTypePtr = &lstringTypes[11];

    repSize = sizeof(LString);
    lstringRepPtr = (LString*)Tcl_Alloc(repSize);

    while (i<objc) {
	const char *s = Tcl_GetString(objv[i]);
	if (strcmp(s, "-not")==0) {







>




|
|
|


|
|







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
static Tcl_Obj *
my_NewLStringObj(
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj * const objv[])
{
    LString *lstringRepPtr;
    Tcl_ObjInternalRep itr;
    size_t repSize;
    Tcl_Obj *lstringPtr;
    const char *string;
    static const char* procTypeNames[] = {
	"FREEREP", "DUPREP", "UPDATESTRING", "SETFROMANY",
	"LENGTH", "INDEX", "SLICE", "REVERSE", "GETELEMENTS",
	"SETELEMENT", "REPLACE", NULL
    };
    int i = 0;
    int ptype;
    const Tcl_ObjType *lstringTypePtr = &lstringTypes[10];

    repSize = sizeof(LString);
    lstringRepPtr = (LString*)Tcl_Alloc(repSize);

    while (i<objc) {
	const char *s = Tcl_GetString(objv[i]);
	if (strcmp(s, "-not")==0) {
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
    }
    if (i != objc-1) {
	Tcl_WrongNumArgs(interp, 0, objv, "lstring string");
	return NULL;
    }
    string = Tcl_GetString(objv[i]);

    lstringPtr = Tcl_AbstractListObjNew(interp, lstringTypePtr);
    lstringRepPtr->strlen = strlen(string);
    lstringRepPtr->allocated = lstringRepPtr->strlen + 1;
    lstringRepPtr->string = (char*)Tcl_Alloc(lstringRepPtr->allocated);
    strcpy(lstringRepPtr->string, string);
    lstringRepPtr->elements = NULL;



    Tcl_AbstractListSetConcreteRep(lstringPtr, lstringRepPtr);
    if (lstringRepPtr->strlen > 0) {
	Tcl_InvalidateStringRep(lstringPtr);
    } else {
	Tcl_InitStringRep(lstringPtr, NULL, 0);
    }


    return lstringPtr;








}














/*
 *----------------------------------------------------------------------
 *
 * freeRep --
 *
 *	Free the value storage of the lstring Obj.
 *
 * Results:
 *	void
 *
 * Side effects:
 *	Memory free'd.
 *
 *----------------------------------------------------------------------
 */

static void
freeRep(Tcl_Obj* lstringObj)
{
    LString *lstringRepPtr = (LString*)Tcl_AbstractListGetConcreteRep(lstringObj);
    if (lstringRepPtr->string) {
	Tcl_Free(lstringRepPtr->string);
    }
    if (lstringRepPtr->elements) {
	Tcl_Obj **objptr = lstringRepPtr->elements;
	while (objptr < &lstringRepPtr->elements[lstringRepPtr->strlen]) {
	    Tcl_DecrRefCount(*objptr++);
	}
	Tcl_Free((char*)lstringRepPtr->elements);
	lstringRepPtr->elements = NULL;
    }
    Tcl_Free((char*)lstringRepPtr);
    Tcl_AbstractListSetConcreteRep(lstringObj, NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * my_LStringGetElements --
 *







<





>
>
>
|





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




















|



|
<
<
<
<
<
<
<

|







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
    }
    if (i != objc-1) {
	Tcl_WrongNumArgs(interp, 0, objv, "lstring string");
	return NULL;
    }
    string = Tcl_GetString(objv[i]);


    lstringRepPtr->strlen = strlen(string);
    lstringRepPtr->allocated = lstringRepPtr->strlen + 1;
    lstringRepPtr->string = (char*)Tcl_Alloc(lstringRepPtr->allocated);
    strcpy(lstringRepPtr->string, string);
    lstringRepPtr->elements = NULL;
    lstringPtr = Tcl_NewObj();
    itr.twoPtrValue.ptr1 = lstringRepPtr;
    itr.twoPtrValue.ptr2 = NULL;
    Tcl_StoreInternalRep(lstringPtr, lstringTypePtr, &itr);
    if (lstringRepPtr->strlen > 0) {
	Tcl_InvalidateStringRep(lstringPtr);
    } else {
	Tcl_InitStringRep(lstringPtr, NULL, 0);
    }
    return lstringPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * freeElements --
 *
 *      Free the element array
 *
 */

static void
lstringFreeElements(Tcl_Obj* lstringObj)
{
    LString *lstringRepPtr = (LString*)lstringObj->internalRep.twoPtrValue.ptr1;
    if (lstringRepPtr->elements) {
	Tcl_Obj **objptr = lstringRepPtr->elements;
	while (objptr < &lstringRepPtr->elements[lstringRepPtr->strlen]) {
	    Tcl_DecrRefCount(*objptr++);
	}
	Tcl_Free((char*)lstringRepPtr->elements);
	lstringRepPtr->elements = NULL;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * freeRep --
 *
 *	Free the value storage of the lstring Obj.
 *
 * Results:
 *	void
 *
 * Side effects:
 *	Memory free'd.
 *
 *----------------------------------------------------------------------
 */

static void
freeRep(Tcl_Obj* lstringObj)
{
    LString *lstringRepPtr = (LString*)lstringObj->internalRep.twoPtrValue.ptr1;
    if (lstringRepPtr->string) {
	Tcl_Free(lstringRepPtr->string);
    }
    lstringFreeElements(lstringObj);







    Tcl_Free((char*)lstringRepPtr);
    lstringObj->internalRep.twoPtrValue.ptr1 = NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * my_LStringGetElements --
 *
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
 */

static int my_LStringGetElements(Tcl_Interp *interp,
				 Tcl_Obj *lstringObj,
				 Tcl_Size *objcptr,
				 Tcl_Obj ***objvptr)
{
    LString *lstringRepPtr = (LString*)Tcl_AbstractListGetConcreteRep(lstringObj);
    Tcl_Obj **objPtr;
    char *cptr = lstringRepPtr->string;
    (void)interp;
    if (lstringRepPtr->strlen == 0) {
	*objcptr = 0;
	*objvptr = NULL;
	return TCL_OK;
    }
    if (lstringRepPtr->elements == NULL) {
	lstringRepPtr->elements = (Tcl_Obj**)Tcl_Alloc(sizeof(Tcl_Obj*) * lstringRepPtr->strlen);
	objPtr=lstringRepPtr->elements;
	while (objPtr<&lstringRepPtr->elements[lstringRepPtr->strlen]) {
	    *objPtr = Tcl_NewStringObj(cptr++,1);
	    Tcl_IncrRefCount(*objPtr++);
	}
    }
    *objvptr = lstringRepPtr->elements;
    *objcptr = lstringRepPtr->strlen;
    return TCL_OK;
}

















































































/*
 *----------------------------------------------------------------------
 *
 * lLStringObjCmd --
 *
 *	Script level command that creats an lstring Obj value.







|











|








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







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

static int my_LStringGetElements(Tcl_Interp *interp,
				 Tcl_Obj *lstringObj,
				 Tcl_Size *objcptr,
				 Tcl_Obj ***objvptr)
{
    LString *lstringRepPtr = (LString*)lstringObj->internalRep.twoPtrValue.ptr1;
    Tcl_Obj **objPtr;
    char *cptr = lstringRepPtr->string;
    (void)interp;
    if (lstringRepPtr->strlen == 0) {
	*objcptr = 0;
	*objvptr = NULL;
	return TCL_OK;
    }
    if (lstringRepPtr->elements == NULL) {
	lstringRepPtr->elements = (Tcl_Obj**)Tcl_Alloc(sizeof(Tcl_Obj*) * lstringRepPtr->strlen);
	objPtr=lstringRepPtr->elements;
	while (objPtr < &lstringRepPtr->elements[lstringRepPtr->strlen]) {
	    *objPtr = Tcl_NewStringObj(cptr++,1);
	    Tcl_IncrRefCount(*objPtr++);
	}
    }
    *objvptr = lstringRepPtr->elements;
    *objcptr = lstringRepPtr->strlen;
    return TCL_OK;
}

/*
** UpdateStringRep
*/

static void
UpdateStringOfLString(Tcl_Obj *objPtr)
{
#   define LOCAL_SIZE 64
    int localFlags[LOCAL_SIZE], *flagPtr = NULL;
    Tcl_ObjType const *typePtr = objPtr->typePtr;
    char *p;
    int bytesNeeded = 0;
    int llen, i;


    /*
     * Handle empty list case first, so rest of the routine is simpler.
     */
    llen = typePtr->lengthProc(objPtr);
    if (llen <= 0) {
	Tcl_InitStringRep(objPtr, NULL, 0);
	return;
    }

    /*
     * Pass 1: estimate space.
     */
    if (llen <= LOCAL_SIZE) {
	flagPtr = localFlags;
    } else {
	/* We know numElems <= LIST_MAX, so this is safe. */
	flagPtr = (int *) Tcl_Alloc(llen*sizeof(int));
    }
    for (bytesNeeded = 0, i = 0; i < llen; i++) {
        Tcl_Obj *elemObj;
        const char *elemStr;
        Tcl_Size elemLen;
	flagPtr[i] = (i ? TCL_DONT_QUOTE_HASH : 0);
	typePtr->indexProc(NULL, objPtr, i, &elemObj);
	Tcl_IncrRefCount(elemObj);
        elemStr = Tcl_GetStringFromObj(elemObj, &elemLen);
        /* Note TclScanElement updates flagPtr[i] */
	bytesNeeded += Tcl_ScanCountedElement(elemStr, elemLen, &flagPtr[i]);
	if (bytesNeeded < 0) {
	    Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
	}
	Tcl_DecrRefCount(elemObj);
    }
    if (bytesNeeded > INT_MAX - llen + 1) {
	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
    }
    bytesNeeded += llen; /* Separating spaces and terminating nul */

    /*
     * Pass 2: generate the string repr.
     */
    objPtr->bytes = (char *) Tcl_Alloc(bytesNeeded);
    p = objPtr->bytes;
    for (i = 0; i < llen; i++) {
        Tcl_Obj *elemObj;
        const char *elemStr;
        Tcl_Size elemLen;
	flagPtr[i] |= (i ? TCL_DONT_QUOTE_HASH : 0);
	typePtr->indexProc(NULL, objPtr, i, &elemObj);
	Tcl_IncrRefCount(elemObj);
	elemStr = Tcl_GetStringFromObj(elemObj, &elemLen);
	p += Tcl_ConvertCountedElement(elemStr, elemLen, p, flagPtr[i]);
	*p++ = ' ';
	Tcl_DecrRefCount(elemObj);
    }
    p[-1] = '\0'; /* Overwrite last space added */

    /* Length of generated string */
    objPtr->length = p - 1 - objPtr->bytes;

    if (flagPtr != localFlags) {
	Tcl_Free(flagPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * lLStringObjCmd --
 *
 *	Script level command that creats an lstring Obj value.
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

  if (lstringObj) {
      Tcl_SetObjResult(interp, lstringObj);
      return TCL_OK;
  }
  return TCL_ERROR;
}














































































































































































































































































/*
 *----------------------------------------------------------------------
 *
 * Lstring_Init --
 *











 *	DL load init function. Defines the "lstring" command.


 *



 * Results:
 *	"lstring" command added to the interp.
 *
 * Side effects:
 *	A new command is defined.
 *
 *----------------------------------------------------------------------
 */

int Tcl_ABSListTest_Init(Tcl_Interp *interp) {
    if (Tcl_InitStubs(interp, "8.7", 0) == NULL) {
	return TCL_ERROR;
    }
    Tcl_CreateObjCommand(interp, "lstring", lLStringObjCmd, NULL, NULL);

    Tcl_PkgProvide(interp, "abstractlisttest", "1.0.0");
    return TCL_OK;
}







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




|

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

>
>
>

|


|





|



>



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

  if (lstringObj) {
      Tcl_SetObjResult(interp, lstringObj);
      return TCL_OK;
  }
  return TCL_ERROR;
}

/*
** lgen - Derived from TIP 192 - Lazy Lists
** Generate a list using a command provided as argument(s).
** The command computes the value for a given index.
*/

/*
 * Internal rep for the Generate Series
 */
typedef struct LgenSeries {
    Tcl_Interp *interp; // used to evaluate gen script
    Tcl_Size len;       // list length
    Tcl_Size nargs;     // Number of arguments in genFn including "index"
    Tcl_Obj *genFnObj;  // The preformed command as a list. Index is set in
			// the last element (last argument)
} LgenSeries;

/*
 * Evaluate the generation function.
 * The provided funtion computes the value for a give index
 */
static Tcl_Obj*
lgen(
    Tcl_Obj* objPtr,
    Tcl_Size index)
{
    LgenSeries *lgenSeriesPtr = (LgenSeries*)objPtr->internalRep.twoPtrValue.ptr1;
    Tcl_Obj *elemObj = NULL;
    Tcl_Interp *intrp = lgenSeriesPtr->interp;
    Tcl_Obj *genCmd = lgenSeriesPtr->genFnObj;
    Tcl_Size endidx = lgenSeriesPtr->nargs-1;

    if (0 <= index && index < lgenSeriesPtr->len) {
	Tcl_Obj *indexObj = Tcl_NewWideIntObj(index);
	Tcl_ListObjReplace(intrp, genCmd, endidx, 1, 1, &indexObj);
	// EVAL DIRECT to avoid interfering with bytecode compile which may be
	// active on the stack
	int flags = TCL_EVAL_GLOBAL|TCL_EVAL_DIRECT;
	int status = Tcl_EvalObjEx(intrp, genCmd, flags);
	elemObj = Tcl_GetObjResult(intrp);
	if (status != TCL_OK) {
	    Tcl_SetObjResult(intrp, Tcl_ObjPrintf(
	        "Error: %s\nwhile executing %s\n",
		elemObj ? Tcl_GetString(elemObj) : "NULL", Tcl_GetString(genCmd)));
	    return NULL;
	}
    }
    return elemObj;
}

/*
 *  Abstract List Length function
 */
static Tcl_Size
lgenSeriesObjLength(Tcl_Obj *objPtr)
{
    LgenSeries *lgenSeriesRepPtr = (LgenSeries *)objPtr->internalRep.twoPtrValue.ptr1;
    return lgenSeriesRepPtr->len;
}

/*
 *  Abstract List Index function
 */
static int
lgenSeriesObjIndex(
    Tcl_Interp *interp,
    Tcl_Obj *lgenSeriesObjPtr,
    Tcl_Size index,
    Tcl_Obj **elemPtr)
{
    LgenSeries *lgenSeriesRepPtr;
    Tcl_Obj *element;

    lgenSeriesRepPtr = (LgenSeries*)lgenSeriesObjPtr->internalRep.twoPtrValue.ptr1;

    if (index < 0 || index >= lgenSeriesRepPtr->len)
	return TCL_ERROR;

    if (lgenSeriesRepPtr->interp == NULL && interp == NULL) {
	return TCL_ERROR;
    }

    lgenSeriesRepPtr->interp = interp;

    element = lgen(lgenSeriesObjPtr, index);
    if (element) {
	*elemPtr = element;
    } else {
	return TCL_ERROR;
    }

    return TCL_OK;
}

/*
** UpdateStringRep
*/

static void
UpdateStringOfLgen(Tcl_Obj *objPtr)
{
    LgenSeries *lgenSeriesRepPtr;
    Tcl_Obj *element;
    Tcl_Size i;
    size_t bytlen;
    Tcl_Obj *tmpstr = Tcl_NewObj();

    lgenSeriesRepPtr = (LgenSeries*)objPtr->internalRep.twoPtrValue.ptr1;

    for (i=0, bytlen=0; i<lgenSeriesRepPtr->len; i++) {
	element = lgen(objPtr, i);
	if (element) {
	    if (i) {
		Tcl_AppendToObj(tmpstr," ",1);
	    }
	    Tcl_AppendObjToObj(tmpstr,element);
	}
    }

    bytlen = Tcl_GetCharLength(tmpstr);
    Tcl_InitStringRep(objPtr, Tcl_GetString(tmpstr), bytlen);
    Tcl_DecrRefCount(tmpstr);

    return;
}

/*
 *  ObjType Free Internal Rep function
 */
static void
FreeLgenInternalRep(Tcl_Obj *objPtr)
{
    LgenSeries *lgenSeries = (LgenSeries*)objPtr->internalRep.twoPtrValue.ptr1;
    if (lgenSeries->genFnObj) {
	Tcl_DecrRefCount(lgenSeries->genFnObj);
    }
    lgenSeries->interp = NULL;
    Tcl_Free(lgenSeries);
    objPtr->internalRep.twoPtrValue.ptr1 = 0;
}

static void DupLgenSeriesRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);

/*
 *  Abstract List ObjType definition
 */

static Tcl_ObjType lgenType = {
    "lgenseries",
    FreeLgenInternalRep,
    DupLgenSeriesRep,
    UpdateStringOfLgen,
    NULL, /* SetFromAnyProc */
    TCL_OBJTYPE_V2(
	lgenSeriesObjLength,
	lgenSeriesObjIndex,
	NULL, /* slice */
	NULL, /* reverse */
	NULL, /* get elements */
        NULL, /* set element */
        NULL) /* replace */
};

/*
 *  ObjType Duplicate Internal Rep Function
 */
static void
DupLgenSeriesRep(
    Tcl_Obj *srcPtr,
    Tcl_Obj *copyPtr)
{
    LgenSeries *srcLgenSeries = (LgenSeries*)srcPtr->internalRep.twoPtrValue.ptr1;
    Tcl_Size repSize = sizeof(LgenSeries);
    LgenSeries *copyLgenSeries = (LgenSeries*)Tcl_Alloc(repSize);

    copyLgenSeries->interp = srcLgenSeries->interp;
    copyLgenSeries->nargs = srcLgenSeries->nargs;
    copyLgenSeries->len = srcLgenSeries->len;
    copyLgenSeries->genFnObj = Tcl_DuplicateObj(srcLgenSeries->genFnObj);
    Tcl_IncrRefCount(copyLgenSeries->genFnObj);
    copyPtr->typePtr = &lgenType;
    copyPtr->internalRep.twoPtrValue.ptr1 = copyLgenSeries;
    copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
    return;
}

/*
 *  Create a new lgen Tcl_Obj
 */
Tcl_Obj *
newLgenObj(
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj * const objv[])
{
    Tcl_WideInt length;
    LgenSeries *lGenSeriesRepPtr;
    Tcl_Size repSize;
    Tcl_Obj *lGenSeriesObj;

    if (objc < 2) {
	return NULL;
    }

    if (Tcl_GetWideIntFromObj(NULL, objv[0], &length) != TCL_OK
	|| length < 0) {
	return NULL;
    }

    lGenSeriesObj = Tcl_NewObj();
    repSize = sizeof(LgenSeries);
    lGenSeriesRepPtr = (LgenSeries*)Tcl_Alloc(repSize);
    lGenSeriesRepPtr->interp = interp; //Tcl_CreateInterp();
    lGenSeriesRepPtr->len = length;

    // Allocate array of *obj for cmd + index + args
    // objv  length cmd arg1 arg2 arg3 ...
    // argsv         0   1    2    3   ... index

    lGenSeriesRepPtr->nargs = objc;
    lGenSeriesRepPtr->genFnObj = Tcl_NewListObj(objc-1, objv+1);
    // Addd 0 placeholder for index
    Tcl_ListObjAppendElement(interp, lGenSeriesRepPtr->genFnObj, Tcl_NewIntObj(0));
    Tcl_IncrRefCount(lGenSeriesRepPtr->genFnObj);
    lGenSeriesObj->internalRep.twoPtrValue.ptr1 = lGenSeriesRepPtr;
    lGenSeriesObj->internalRep.twoPtrValue.ptr2 = NULL;
    lGenSeriesObj->typePtr = &lgenType;

    if (length > 0) {
	Tcl_InvalidateStringRep(lGenSeriesObj);
    } else {
	Tcl_InitStringRep(lGenSeriesObj, NULL, 0);
    }
    return lGenSeriesObj;
}

/*
 *  The [lgen] command
 */
static int
lGenObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj * const objv[])
{
    Tcl_Obj *genObj = newLgenObj(interp, objc-1, &objv[1]);
    if (genObj) {
	Tcl_SetObjResult(interp, genObj);
	return TCL_OK;
    }
    Tcl_WrongNumArgs(interp, 1, objv, "length cmd ?args?");
    return TCL_ERROR;
}

/*
 *  lgen package init
 */
int Lgen_Init(Tcl_Interp *interp) {
    if (Tcl_InitStubs(interp, "8.7", 0) == NULL) {
	return TCL_ERROR;
    }
    Tcl_CreateObjCommand(interp, "lgen", lGenObjCmd, NULL, NULL);
    Tcl_PkgProvide(interp, "lgen", "1.0");
    return TCL_OK;
}



/*
 *----------------------------------------------------------------------
 *
 * ABSListTest_Init --
 *
 *	Provides Abstract List implemenations via new commands
 *
 * lstring command
 * Usage:
 *      lstring /string/
 *
 * Description:
 *      Creates a list where each character in the string is treated as an
 *      element. The string is kept as a string, not an actual list. Indexing
 *      is done by char.
 *
 * lgen command
 * Usage:
 *      lgen /length/ /cmd/ ?args...?
 *
 *      The /cmd/ should take the last argument as the index value, and return
 *      a value for that element.
 *
 * Results:
 *	The commands listed above are added to the interp.
 *
 * Side effects:
 *	New commands defined.
 *
 *----------------------------------------------------------------------
 */

int Tcl_ABSListTest_Init(Tcl_Interp *interp) {
    if (Tcl_InitStubs(interp, "8.7-", 0) == NULL) {
	return TCL_ERROR;
    }
    Tcl_CreateObjCommand(interp, "lstring", lLStringObjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "lgen", lGenObjCmd, NULL, NULL);
    Tcl_PkgProvide(interp, "abstractlisttest", "1.0.0");
    return TCL_OK;
}

Changes to generic/tclTestObj.c.

21
22
23
24
25
26
27

28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44

45
46
47
48
49
50
51
#ifdef TCL_WITH_EXTERNAL_TOMMATH
#   include "tommath.h"
#else
#   include "tclTomMath.h"
#endif
#include "tclStringRep.h"



/*
 * Forward declarations for functions defined later in this file:
 */

static int		CheckIfVarUnset(Tcl_Interp *interp, Tcl_Obj **varPtr, size_t varIndex);
static int		GetVariableIndex(Tcl_Interp *interp,
			    Tcl_Obj *obj, size_t *indexPtr);
static void		SetVarToObj(Tcl_Obj **varPtr, size_t varIndex, Tcl_Obj *objPtr);
static Tcl_ObjCmdProc	TestbignumobjCmd;
static Tcl_ObjCmdProc	TestbooleanobjCmd;
static Tcl_ObjCmdProc	TestdoubleobjCmd;
static Tcl_ObjCmdProc	TestindexobjCmd;
static Tcl_ObjCmdProc	TestintobjCmd;
static Tcl_ObjCmdProc	TestlistobjCmd;
static Tcl_ObjCmdProc	TestobjCmd;
static Tcl_ObjCmdProc	TeststringobjCmd;


#define VARPTR_KEY "TCLOBJTEST_VARPTR"
#define NUMBER_OF_OBJECT_VARS 20

static void VarPtrDeleteProc(void *clientData, TCL_UNUSED(Tcl_Interp *))
{
    int i;







>





|

|
|








>







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
#ifdef TCL_WITH_EXTERNAL_TOMMATH
#   include "tommath.h"
#else
#   include "tclTomMath.h"
#endif
#include "tclStringRep.h"

#include <assert.h>

/*
 * Forward declarations for functions defined later in this file:
 */

static int		CheckIfVarUnset(Tcl_Interp *interp, Tcl_Obj **varPtr, Tcl_Size varIndex);
static int		GetVariableIndex(Tcl_Interp *interp,
			    Tcl_Obj *obj, Tcl_Size *indexPtr);
static void		SetVarToObj(Tcl_Obj **varPtr, Tcl_Size varIndex, Tcl_Obj *objPtr);
static Tcl_ObjCmdProc	TestbignumobjCmd;
static Tcl_ObjCmdProc	TestbooleanobjCmd;
static Tcl_ObjCmdProc	TestdoubleobjCmd;
static Tcl_ObjCmdProc	TestindexobjCmd;
static Tcl_ObjCmdProc	TestintobjCmd;
static Tcl_ObjCmdProc	TestlistobjCmd;
static Tcl_ObjCmdProc	TestobjCmd;
static Tcl_ObjCmdProc	TeststringobjCmd;
static Tcl_ObjCmdProc	TestbigdataCmd;

#define VARPTR_KEY "TCLOBJTEST_VARPTR"
#define NUMBER_OF_OBJECT_VARS 20

static void VarPtrDeleteProc(void *clientData, TCL_UNUSED(Tcl_Interp *))
{
    int i;
113
114
115
116
117
118
119




120
121
122
123
124
125
126
    Tcl_CreateObjCommand(interp, "testindexobj", TestindexobjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testlistobj", TestlistobjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testobj", TestobjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "teststringobj", TeststringobjCmd,
	    NULL, NULL);




    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestbignumobjCmd --







>
>
>
>







115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
    Tcl_CreateObjCommand(interp, "testindexobj", TestindexobjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testlistobj", TestlistobjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testobj", TestobjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "teststringobj", TeststringobjCmd,
	    NULL, NULL);
    if (sizeof(Tcl_Size) == sizeof(Tcl_WideInt)) {
	Tcl_CreateObjCommand(interp, "testbigdata", TestbigdataCmd,
		NULL, NULL);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestbignumobjCmd --
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
	"set", "get", "mult10", "div10", "iseven", "radixsize", NULL
    };
    enum options {
	BIGNUM_SET, BIGNUM_GET, BIGNUM_MULT10, BIGNUM_DIV10, BIGNUM_ISEVEN,
	BIGNUM_RADIXSIZE
    } idx;
    int index;
    size_t varIndex;
    const char *string;
    mp_int bignumValue;
    Tcl_Obj **varPtr;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
	return TCL_ERROR;







|







155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
	"set", "get", "mult10", "div10", "iseven", "radixsize", NULL
    };
    enum options {
	BIGNUM_SET, BIGNUM_GET, BIGNUM_MULT10, BIGNUM_DIV10, BIGNUM_ISEVEN,
	BIGNUM_RADIXSIZE
    } idx;
    int index;
    Tcl_Size varIndex;
    const char *string;
    mp_int bignumValue;
    Tcl_Obj **varPtr;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
	return TCL_ERROR;
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
static int
TestbooleanobjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    size_t varIndex;
    int boolValue;
    const char *subCmd;
    Tcl_Obj **varPtr;

    if (objc < 3) {
	wrongNumArgs:
	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");







|







346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
static int
TestbooleanobjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Size varIndex;
    int boolValue;
    const char *subCmd;
    Tcl_Obj **varPtr;

    if (objc < 3) {
	wrongNumArgs:
	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
static int
TestdoubleobjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    size_t varIndex;
    double doubleValue;
    const char *subCmd;
    Tcl_Obj **varPtr;

    if (objc < 3) {
	wrongNumArgs:
	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");







|







446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
static int
TestdoubleobjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Size varIndex;
    double doubleValue;
    const char *subCmd;
    Tcl_Obj **varPtr;

    if (objc < 3) {
	wrongNumArgs:
	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
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
TestindexobjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int allowAbbrev, index, setError, i, result;
    Tcl_WideInt index2;
    const char **argv;
    static const char *const tablePtr[] = {"a", "b", "check", NULL};

    /*
     * Keep this structure declaration in sync with tclIndexObj.c
     */
    struct IndexRep {
	void *tablePtr;		/* Pointer to the table of strings. */
	TCL_HASH_TYPE offset;		/* Offset between table entries. */
	TCL_HASH_TYPE index;		/* Selected index into table. */
    } *indexRep;

    if ((objc == 3) && (strcmp(Tcl_GetString(objv[1]),
	    "check") == 0)) {
	/*
	 * This code checks to be sure that the results of Tcl_GetIndexFromObj
	 * are properly cached in the object and returned on subsequent
	 * lookups.
	 */

	if (Tcl_GetWideIntFromObj(interp, objv[2], &index2) != TCL_OK) {
	    return TCL_ERROR;
	}

	Tcl_GetIndexFromObj(NULL, objv[1], tablePtr, "token", 0, &index);
	indexRep = (struct IndexRep *)objv[1]->internalRep.twoPtrValue.ptr1;
	indexRep->index = index2;
	result = Tcl_GetIndexFromObj(NULL, objv[1],







|








|
|










|







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
TestindexobjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int allowAbbrev, index, setError, i, result;
    Tcl_Size index2;
    const char **argv;
    static const char *const tablePtr[] = {"a", "b", "check", NULL};

    /*
     * Keep this structure declaration in sync with tclIndexObj.c
     */
    struct IndexRep {
	void *tablePtr;		/* Pointer to the table of strings. */
	Tcl_Size offset;		/* Offset between table entries. */
	Tcl_Size index;		/* Selected index into table. */
    } *indexRep;

    if ((objc == 3) && (strcmp(Tcl_GetString(objv[1]),
	    "check") == 0)) {
	/*
	 * This code checks to be sure that the results of Tcl_GetIndexFromObj
	 * are properly cached in the object and returned on subsequent
	 * lookups.
	 */

	if (Tcl_GetIntForIndex(interp, objv[2], TCL_INDEX_NONE, &index2) != TCL_OK) {
	    return TCL_ERROR;
	}

	Tcl_GetIndexFromObj(NULL, objv[1], tablePtr, "token", 0, &index);
	indexRep = (struct IndexRep *)objv[1]->internalRep.twoPtrValue.ptr1;
	indexRep->index = index2;
	result = Tcl_GetIndexFromObj(NULL, objv[1],
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
static int
TestintobjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    size_t varIndex;
#if (INT_MAX != LONG_MAX)   /* int is not the same size as long */
    int i;
#endif
    Tcl_WideInt wideValue;
    const char *subCmd;
    Tcl_Obj **varPtr;








|







652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
static int
TestintobjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Size varIndex;
#if (INT_MAX != LONG_MAX)   /* int is not the same size as long */
    int i;
#endif
    Tcl_WideInt wideValue;
    const char *subCmd;
    Tcl_Obj **varPtr;

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
	LISTOBJ_SET,
	LISTOBJ_GET,
	LISTOBJ_REPLACE,
	LISTOBJ_INDEXMEMCHECK,
	LISTOBJ_GETELEMENTSMEMCHECK,
    } cmdIndex;

    size_t varIndex;		/* Variable number converted to binary */
    Tcl_WideInt first;			/* First index in the list */
    Tcl_WideInt count;			/* Count of elements in a list */
    Tcl_Obj **varPtr;
    int i, len;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg...?");
	return TCL_ERROR;
    }
    varPtr = GetVarPtr(interp);
    if (GetVariableIndex(interp, objv[2], &varIndex) != TCL_OK) {
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "command",
			    0, &cmdIndex) != TCL_OK) {
	return TCL_ERROR;
    }
    switch (cmdIndex) {
    case LISTOBJ_SET:
	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetListObj(varPtr[varIndex], objc-3, objv+3);
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewListObj(objc-3, objv+3));
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);







|
|
|

|













|







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
	LISTOBJ_SET,
	LISTOBJ_GET,
	LISTOBJ_REPLACE,
	LISTOBJ_INDEXMEMCHECK,
	LISTOBJ_GETELEMENTSMEMCHECK,
    } cmdIndex;

    Tcl_Size varIndex;		/* Variable number converted to binary */
    Tcl_Size first;			/* First index in the list */
    Tcl_Size count;			/* Count of elements in a list */
    Tcl_Obj **varPtr;
    Tcl_Size i, len;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg...?");
	return TCL_ERROR;
    }
    varPtr = GetVarPtr(interp);
    if (GetVariableIndex(interp, objv[2], &varIndex) != TCL_OK) {
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "command",
			    0, &cmdIndex) != TCL_OK) {
	return TCL_ERROR;
    }
    switch(cmdIndex) {
    case LISTOBJ_SET:
	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetListObj(varPtr[varIndex], objc-3, objv+3);
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewListObj(objc-3, objv+3));
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951

    case LISTOBJ_REPLACE:
	if (objc < 5) {
	    Tcl_WrongNumArgs(interp, 2, objv,
			     "varIndex start count ?element...?");
	    return TCL_ERROR;
	}
	if (Tcl_GetWideIntFromObj(interp, objv[3], &first) != TCL_OK
	    || Tcl_GetWideIntFromObj(interp, objv[4], &count) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (Tcl_IsShared(varPtr[varIndex])) {
	    SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
	}
	Tcl_ResetResult(interp);
	return Tcl_ListObjReplace(interp, varPtr[varIndex], first, count,







|
|







942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957

    case LISTOBJ_REPLACE:
	if (objc < 5) {
	    Tcl_WrongNumArgs(interp, 2, objv,
			     "varIndex start count ?element...?");
	    return TCL_ERROR;
	}
	if (Tcl_GetIntForIndex(interp, objv[3], TCL_INDEX_NONE, &first) != TCL_OK
	    || Tcl_GetIntForIndex(interp, objv[4], TCL_INDEX_NONE, &count) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (Tcl_IsShared(varPtr[varIndex])) {
	    SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
	}
	Tcl_ResetResult(interp);
	return Tcl_ListObjReplace(interp, varPtr[varIndex], first, count,
964
965
966
967
968
969
970
971
972
973
974
975
976

977
978
979
980
981
982
983
	}
	for (i = 0; i < len; ++i) {
	    Tcl_Obj *objP;
	    if (Tcl_ListObjIndex(interp, varPtr[varIndex], i, &objP)
		!= TCL_OK) {
		return TCL_ERROR;
	    }
	    if (objP->refCount <= 0) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"Tcl_ListObjIndex returned object with ref count <= 0",
			TCL_INDEX_NONE));
		/* Keep looping since we are also looping for leaks */
	    }

	}
	break;

    case LISTOBJ_GETELEMENTSMEMCHECK:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
	    return TCL_ERROR;







|

|



>







970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
	}
	for (i = 0; i < len; ++i) {
	    Tcl_Obj *objP;
	    if (Tcl_ListObjIndex(interp, varPtr[varIndex], i, &objP)
		!= TCL_OK) {
		return TCL_ERROR;
	    }
	    if (objP->refCount < 0) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"Tcl_ListObjIndex returned object with ref count < 0",
			TCL_INDEX_NONE));
		/* Keep looping since we are also looping for leaks */
	    }
	    Tcl_BumpObj(objP);
	}
	break;

    case LISTOBJ_GETELEMENTSMEMCHECK:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
	    return TCL_ERROR;
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
static int
TestobjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    size_t varIndex, destIndex;
    int i;
    const Tcl_ObjType *targetType;
    Tcl_Obj **varPtr;
    const char *subcommands[] = {
	"freeallvars", "bug3598580", "types",
	"objtype", "newobj", "set",
	"assign", "convert", "duplicate",







|







1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
static int
TestobjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Size varIndex, destIndex;
    int i;
    const Tcl_ObjType *targetType;
    Tcl_Obj **varPtr;
    const char *subcommands[] = {
	"freeallvars", "bug3598580", "types",
	"objtype", "newobj", "set",
	"assign", "convert", "duplicate",
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
	if (objc != 3) {
	    goto wrongNumArgs;
	} else {
	    const char *typeName;

	    if (objv[2]->typePtr == NULL) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj("none", -1));
	    }
	    else {
		typeName = objv[2]->typePtr->name;
		if (!strcmp(typeName, "utf32string"))
		    typeName = "string";
#ifndef TCL_WIDE_INT_IS_LONG
	    else if (!strcmp(typeName, "wideInt")) typeName = "int";
#endif
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(typeName, -1));







<
|







1108
1109
1110
1111
1112
1113
1114

1115
1116
1117
1118
1119
1120
1121
1122
	if (objc != 3) {
	    goto wrongNumArgs;
	} else {
	    const char *typeName;

	    if (objv[2]->typePtr == NULL) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj("none", -1));

	    } else {
		typeName = objv[2]->typePtr->name;
		if (!strcmp(typeName, "utf32string"))
		    typeName = "string";
#ifndef TCL_WIDE_INT_IS_LONG
	    else if (!strcmp(typeName, "wideInt")) typeName = "int";
#endif
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(typeName, -1));
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
TeststringobjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_UniChar *unicode;
    size_t size, varIndex;
    int option, i;
    Tcl_WideInt length;
#define MAX_STRINGS 11
    const char *string, *strings[MAX_STRINGS+1];
    String *strPtr;
    Tcl_Obj **varPtr;
    static const char *const options[] = {
	"append", "appendstrings", "get", "get2", "length", "length2",
	"set", "set2", "setlength", "maxchars", "range", "appendself",
	"appendself2", NULL
    };

    if (objc < 3) {
	wrongNumArgs:
	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
	return TCL_ERROR;
    }







|

|







|







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
TeststringobjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_UniChar *unicode;
    Tcl_Size size, varIndex;
    int option, i;
    Tcl_Size length;
#define MAX_STRINGS 11
    const char *string, *strings[MAX_STRINGS+1];
    String *strPtr;
    Tcl_Obj **varPtr;
    static const char *const options[] = {
	"append", "appendstrings", "get", "get2", "length", "length2",
	"set", "set2", "setlength", "maxchars", "range", "appendself",
	"appendself2", "newunicode", NULL
    };

    if (objc < 3) {
	wrongNumArgs:
	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
	return TCL_ERROR;
    }
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
	return TCL_ERROR;
    }
    switch (option) {
	case 0:				/* append */
	    if (objc != 5) {
		goto wrongNumArgs;
	    }
	    if (Tcl_GetWideIntFromObj(interp, objv[4], &length) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (varPtr[varIndex] == NULL) {
		SetVarToObj(varPtr, varIndex, Tcl_NewObj());
	    }

	    /*







|







1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
	return TCL_ERROR;
    }
    switch (option) {
	case 0:				/* append */
	    if (objc != 5) {
		goto wrongNumArgs;
	    }
	    if (Tcl_GetIntForIndex(interp, objv[4], TCL_INDEX_NONE, &length) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (varPtr[varIndex] == NULL) {
		SetVarToObj(varPtr, varIndex, Tcl_NewObj());
	    }

	    /*
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
	    }
	    if (varPtr[varIndex] != NULL) {
		Tcl_ConvertToType(NULL, varPtr[varIndex],
			Tcl_GetObjType("string"));
		strPtr = (String *)varPtr[varIndex]->internalRep.twoPtrValue.ptr1;
		length = strPtr->allocated;
	    } else {
		length = -1;
	    }
	    Tcl_SetWideIntObj(Tcl_GetObjResult(interp), length);
	    break;
	case 6:				/* set */
	    if (objc != 4) {
		goto wrongNumArgs;
	    }

	    /*







|

|







1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
	    }
	    if (varPtr[varIndex] != NULL) {
		Tcl_ConvertToType(NULL, varPtr[varIndex],
			Tcl_GetObjType("string"));
		strPtr = (String *)varPtr[varIndex]->internalRep.twoPtrValue.ptr1;
		length = strPtr->allocated;
	    } else {
		length = TCL_INDEX_NONE;
	    }
	    Tcl_SetWideIntObj(Tcl_GetObjResult(interp), (Tcl_WideInt)((Tcl_WideUInt)(length + 1U)) - 1);
	    break;
	case 6:				/* set */
	    if (objc != 4) {
		goto wrongNumArgs;
	    }

	    /*
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
	    }
	    SetVarToObj(varPtr, varIndex, objv[3]);
	    break;
	case 8:				/* setlength */
	    if (objc != 4) {
		goto wrongNumArgs;
	    }
	    if (Tcl_GetWideIntFromObj(interp, objv[3], &length) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (varPtr[varIndex] != NULL) {
		Tcl_SetObjLength(varPtr[varIndex], length);
	    }
	    break;
	case 9:				/* maxchars */
	    if (objc != 3) {
		goto wrongNumArgs;
	    }
	    if (varPtr[varIndex] != NULL) {
		Tcl_ConvertToType(NULL, varPtr[varIndex],
			Tcl_GetObjType("string"));
		strPtr = (String *)varPtr[varIndex]->internalRep.twoPtrValue.ptr1;
		length = strPtr->maxChars;
	    } else {
		length = -1;
	    }
	    Tcl_SetWideIntObj(Tcl_GetObjResult(interp), length);
	    break;
	case 10: {				/* range */
	    Tcl_WideInt first, last;
	    if (objc != 5) {
		goto wrongNumArgs;
	    }
	    if ((Tcl_GetWideIntFromObj(interp, objv[3], &first) != TCL_OK)
		    || (Tcl_GetWideIntFromObj(interp, objv[4], &last) != TCL_OK)) {
		return TCL_ERROR;
	    }
	    Tcl_SetObjResult(interp, Tcl_GetRange(varPtr[varIndex], first, last));
	    break;
	}
	case 11:			/* appendself */
	    if (objc != 4) {







|
















|




|



|
|







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
	    }
	    SetVarToObj(varPtr, varIndex, objv[3]);
	    break;
	case 8:				/* setlength */
	    if (objc != 4) {
		goto wrongNumArgs;
	    }
	    if (Tcl_GetIntForIndex(interp, objv[3], TCL_INDEX_NONE, &length) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (varPtr[varIndex] != NULL) {
		Tcl_SetObjLength(varPtr[varIndex], length);
	    }
	    break;
	case 9:				/* maxchars */
	    if (objc != 3) {
		goto wrongNumArgs;
	    }
	    if (varPtr[varIndex] != NULL) {
		Tcl_ConvertToType(NULL, varPtr[varIndex],
			Tcl_GetObjType("string"));
		strPtr = (String *)varPtr[varIndex]->internalRep.twoPtrValue.ptr1;
		length = strPtr->maxChars;
	    } else {
		length = TCL_INDEX_NONE;
	    }
	    Tcl_SetWideIntObj(Tcl_GetObjResult(interp), length);
	    break;
	case 10: {				/* range */
	    Tcl_Size first, last;
	    if (objc != 5) {
		goto wrongNumArgs;
	    }
	    if ((Tcl_GetIntForIndex(interp, objv[3], TCL_INDEX_NONE, &first) != TCL_OK)
		    || (Tcl_GetIntForIndex(interp, objv[4], TCL_INDEX_NONE, &last) != TCL_OK)) {
		return TCL_ERROR;
	    }
	    Tcl_SetObjResult(interp, Tcl_GetRange(varPtr[varIndex], first, last));
	    break;
	}
	case 11:			/* appendself */
	    if (objc != 4) {
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467

	    if (Tcl_IsShared(varPtr[varIndex])) {
		SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
	    }

	    string = Tcl_GetStringFromObj(varPtr[varIndex], &size);

	    if (Tcl_GetWideIntFromObj(interp, objv[3], &length) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if ((length < 0) || ((Tcl_WideUInt)length > (Tcl_WideUInt)size)) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"index value out of range", -1));
		return TCL_ERROR;
	    }

	    Tcl_AppendToObj(varPtr[varIndex], string + length, size - length);
	    Tcl_SetObjResult(interp, varPtr[varIndex]);







|


|







1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473

	    if (Tcl_IsShared(varPtr[varIndex])) {
		SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
	    }

	    string = Tcl_GetStringFromObj(varPtr[varIndex], &size);

	    if (Tcl_GetIntForIndex(interp, objv[3], size-1, &length) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (length == TCL_INDEX_NONE) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"index value out of range", -1));
		return TCL_ERROR;
	    }

	    Tcl_AppendToObj(varPtr[varIndex], string + length, size - length);
	    Tcl_SetObjResult(interp, varPtr[varIndex]);
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

	    if (Tcl_IsShared(varPtr[varIndex])) {
		SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
	    }

	    unicode = Tcl_GetUnicodeFromObj(varPtr[varIndex], &size);

	    if (Tcl_GetWideIntFromObj(interp, objv[3], &length) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if ((length < 0) || ((Tcl_WideUInt)length > (Tcl_WideUInt)size)) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"index value out of range", -1));
		return TCL_ERROR;
	    }

	    Tcl_AppendUnicodeToObj(varPtr[varIndex], unicode + length, size - length);
	    Tcl_SetObjResult(interp, varPtr[varIndex]);
	    break;






    }












    return TCL_OK;
}











































































































































/*
 *----------------------------------------------------------------------
 *
 * SetVarToObj --
 *
 *	Utility routine to assign a Tcl_Obj* to a test variable. The
 *	Tcl_Obj* can be NULL.







|


|








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



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







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

	    if (Tcl_IsShared(varPtr[varIndex])) {
		SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
	    }

	    unicode = Tcl_GetUnicodeFromObj(varPtr[varIndex], &size);

	    if (Tcl_GetIntForIndex(interp, objv[3], size-1, &length) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (length == TCL_INDEX_NONE) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"index value out of range", -1));
		return TCL_ERROR;
	    }

	    Tcl_AppendUnicodeToObj(varPtr[varIndex], unicode + length, size - length);
	    Tcl_SetObjResult(interp, varPtr[varIndex]);
	    break;
	case 13: /* newunicode*/
	    unicode = (Tcl_UniChar *)Tcl_Alloc((objc - 3) * sizeof(Tcl_UniChar));
	    for (i = 0; i < (objc - 3); ++i) {
		int val;
		if (Tcl_GetIntFromObj(interp, objv[i + 3], &val) != TCL_OK) {
		    break;
		}
		unicode[i] = (Tcl_UniChar)val;
	    }
	    if (i < (objc-3)) {
		Tcl_Free(unicode);
		return TCL_ERROR;
	    }
	    SetVarToObj(varPtr, varIndex, Tcl_NewUnicodeObj(unicode, objc - 3));
	    Tcl_SetObjResult(interp, varPtr[varIndex]);
	    Tcl_Free(unicode);
	    break;
    }

    return TCL_OK;
}

/*
 *------------------------------------------------------------------------
 *
 * TestbigdataCmd --
 *
 *    Implements the Tcl command testbigdata
 *	testbigdata string ?LEN? ?SPLIT? - returns 01234567890123...
 *      testbigdata bytearray ?LEN? ?SPLIT? - returns {0 1 2 3 4 5 6 7 8 9 0 1 ...}
 *      testbigdata dict ?SIZE? - returns dict mapping integers to themselves
 *    If no arguments given, returns the pattern used to generate strings.
 *    If SPLIT is specified, the character at that position is set to "X".
 *
 * Results:
 *    TCL_OK    - Success.
 *    TCL_ERROR - Error.
 *
 * Side effects:
 *    Interpreter result holds result or error message.
 *
 *------------------------------------------------------------------------
 */
static int
TestbigdataCmd (
    TCL_UNUSED(void *),
    Tcl_Interp *interp,    /* Current interpreter. */
    int objc,              /* Number of arguments. */
    Tcl_Obj *const objv[]) /* Argument objects. */
{
    static const char *const subcmds[] = {
	   "string", "bytearray", "list", "dict", NULL
    };
    enum options {
	   BIGDATA_STRING, BIGDATA_BYTEARRAY, BIGDATA_LIST, BIGDATA_DICT
    } idx;
    char *s;
    unsigned char *p;
    Tcl_WideInt i, len, split;
    Tcl_DString ds;
    Tcl_Obj *objPtr;
#define PATTERN_LEN 10
    Tcl_Obj *patternObjs[PATTERN_LEN];

    if (objc < 2 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "command ?len? ?split?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], subcmds, "option", 0,
	    &idx) != TCL_OK) {
	return TCL_ERROR;
    }
    split = -1;
    if (objc == 2) {
	len = PATTERN_LEN;
    } else {
	if (Tcl_GetWideIntFromObj(interp, objv[2], &len) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (objc == 4) {
	    if (Tcl_GetWideIntFromObj(interp, objv[3], &split) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (split >= len) {
		split = len - 1; /* Last position */
	    }
	}
    }
    /* Need one byte for nul terminator */
    Tcl_WideInt limit =
	sizeof(Tcl_Size) == sizeof(Tcl_WideInt) ? WIDE_MAX-1 : INT_MAX-1;
    if (len < 0 || len > limit) {
	Tcl_SetObjResult(
	    interp,
	    Tcl_ObjPrintf(
		"%s is greater than max permitted length %" TCL_LL_MODIFIER "d",
		Tcl_GetString(objv[2]),
		limit));
	return TCL_ERROR;
    }

    switch (idx) {
    case BIGDATA_STRING:
	Tcl_DStringInit(&ds);
	Tcl_DStringSetLength(&ds, len);/* Also stores \0 at index len+1 */
	s = Tcl_DStringValue(&ds);
	for (i = 0; i < len; ++i) {
	    s[i] = '0' + (i % PATTERN_LEN);
	}
	if (split >= 0) {
	    assert(split < len);
	    s[split] = 'X';
	}
	Tcl_DStringResult(interp, &ds);
	break;
    case BIGDATA_BYTEARRAY:
	objPtr = Tcl_NewByteArrayObj(NULL, len);
	p = Tcl_GetByteArrayFromObj(objPtr, &len);
	for (i = 0; i < len; ++i) {
	    p[i] = '0' + (i % PATTERN_LEN);
	}
	if (split >= 0) {
	    assert(split < len);
	    p[split] = 'X';
	}
	Tcl_SetObjResult(interp, objPtr);
	break;
    case BIGDATA_LIST:
	for (i = 0; i < PATTERN_LEN; ++i) {
	    patternObjs[i] = Tcl_NewIntObj(i);
	    Tcl_IncrRefCount(patternObjs[i]);
	}
	objPtr = Tcl_NewListObj(len, NULL);
	for (i = 0; i < len; ++i) {
	    Tcl_ListObjAppendElement(
		interp, objPtr, patternObjs[i % PATTERN_LEN]);
	}
	if (split >= 0) {
	    assert(split < len);
	    Tcl_Obj *splitMarker = Tcl_NewStringObj("X", 1);
	    Tcl_ListObjReplace(interp, objPtr, split, 1, 1, &splitMarker);
	}
	for (i = 0; i < PATTERN_LEN; ++i) {
	    patternObjs[i] = Tcl_NewIntObj(i);
	    Tcl_DecrRefCount(patternObjs[i]);
	}
	Tcl_SetObjResult(interp, objPtr);
	break;
    case BIGDATA_DICT:
	objPtr = Tcl_NewDictObj();
	for (i = 0; i < len; ++i) {
	    Tcl_Obj *objPtr2 = Tcl_NewWideIntObj(i);
	    Tcl_DictObjPut(interp, objPtr, objPtr2, objPtr2);
	}
	Tcl_SetObjResult(interp, objPtr);
	break;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * SetVarToObj --
 *
 *	Utility routine to assign a Tcl_Obj* to a test variable. The
 *	Tcl_Obj* can be NULL.
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
 *
 *----------------------------------------------------------------------
 */

static void
SetVarToObj(
    Tcl_Obj **varPtr,
    size_t varIndex,		/* Designates the assignment variable. */
    Tcl_Obj *objPtr)		/* Points to object to assign to var. */
{
    if (varPtr[varIndex] != NULL) {
	Tcl_DecrRefCount(varPtr[varIndex]);
    }
    varPtr[varIndex] = objPtr;
    if (objPtr != NULL) {







|







1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
 *
 *----------------------------------------------------------------------
 */

static void
SetVarToObj(
    Tcl_Obj **varPtr,
    Tcl_Size varIndex,		/* Designates the assignment variable. */
    Tcl_Obj *objPtr)		/* Points to object to assign to var. */
{
    if (varPtr[varIndex] != NULL) {
	Tcl_DecrRefCount(varPtr[varIndex]);
    }
    varPtr[varIndex] = objPtr;
    if (objPtr != NULL) {
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575

static int
GetVariableIndex(
    Tcl_Interp *interp,		/* Interpreter for error reporting. */
    Tcl_Obj *obj,		/* The variable index
				 * specified as a nonnegative number less than
				 * NUMBER_OF_OBJECT_VARS. */
    size_t *indexPtr)		/* Place to store converted result. */
{
    Tcl_WideInt index;

    if (Tcl_GetWideIntFromObj(interp, obj, &index) != TCL_OK) {
	return TCL_ERROR;
    }
    if (index < 0 || index >= NUMBER_OF_OBJECT_VARS) {
	Tcl_ResetResult(interp);
	Tcl_AppendToObj(Tcl_GetObjResult(interp), "bad variable index", -1);
	return TCL_ERROR;
    }

    *indexPtr = index;
    return TCL_OK;







|

|

|


|







1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736

static int
GetVariableIndex(
    Tcl_Interp *interp,		/* Interpreter for error reporting. */
    Tcl_Obj *obj,		/* The variable index
				 * specified as a nonnegative number less than
				 * NUMBER_OF_OBJECT_VARS. */
    Tcl_Size *indexPtr)		/* Place to store converted result. */
{
    Tcl_Size index;

    if (Tcl_GetIntForIndex(interp, obj, NUMBER_OF_OBJECT_VARS - 1, &index) != TCL_OK) {
	return TCL_ERROR;
    }
    if (index == TCL_INDEX_NONE) {
	Tcl_ResetResult(interp);
	Tcl_AppendToObj(Tcl_GetObjResult(interp), "bad variable index", -1);
	return TCL_ERROR;
    }

    *indexPtr = index;
    return TCL_OK;
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
 *----------------------------------------------------------------------
 */

static int
CheckIfVarUnset(
    Tcl_Interp *interp,		/* Interpreter for error reporting. */
    Tcl_Obj ** varPtr,
    size_t varIndex)		/* Index of the test variable to check. */
{
    if (varPtr[varIndex] == NULL) {
	char buf[32 + TCL_INTEGER_SPACE];

	sprintf(buf, "variable %" TCL_Z_MODIFIER "u is unset (NULL)", varIndex);
	Tcl_ResetResult(interp);
	Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
	return 1;
    }
    return 0;
}








|

|


|







1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
 *----------------------------------------------------------------------
 */

static int
CheckIfVarUnset(
    Tcl_Interp *interp,		/* Interpreter for error reporting. */
    Tcl_Obj ** varPtr,
    Tcl_Size varIndex)		/* Index of the test variable to check. */
{
    if (varIndex < 0 || varPtr[varIndex] == NULL) {
	char buf[32 + TCL_INTEGER_SPACE];

	snprintf(buf, sizeof(buf), "variable %" TCL_SIZE_MODIFIER "d is unset (NULL)", varIndex);
	Tcl_ResetResult(interp);
	Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
	return 1;
    }
    return 0;
}


Changes to generic/tclTestProcBodyObj.c.

140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
    const char *namesp,		/* the namespace in which the command is
				 * registered */
    const CmdTable *cmdTablePtr)/* the command to register */
{
    char buf[128];

    if (cmdTablePtr->exportIt) {
	sprintf(buf, "namespace eval %s { namespace export %s }",
		namesp, cmdTablePtr->cmdName);
	if (Tcl_EvalEx(interp, buf, -1, 0) != TCL_OK) {
	    return TCL_ERROR;
	}
    }

    sprintf(buf, "%s::%s", namesp, cmdTablePtr->cmdName);
    Tcl_CreateObjCommand(interp, buf, cmdTablePtr->proc, 0, 0);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *







|

|




|







140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
    const char *namesp,		/* the namespace in which the command is
				 * registered */
    const CmdTable *cmdTablePtr)/* the command to register */
{
    char buf[128];

    if (cmdTablePtr->exportIt) {
	snprintf(buf, sizeof(buf), "namespace eval %s { namespace export %s }",
		namesp, cmdTablePtr->cmdName);
	if (Tcl_EvalEx(interp, buf, TCL_INDEX_NONE, 0) != TCL_OK) {
	    return TCL_ERROR;
	}
    }

    snprintf(buf, sizeof(buf), "%s::%s", namesp, cmdTablePtr->cmdName);
    Tcl_CreateObjCommand(interp, buf, cmdTablePtr->proc, 0, 0);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

Changes to generic/tclThread.c.

57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
 *
 *----------------------------------------------------------------------
 */

void *
Tcl_GetThreadData(
    Tcl_ThreadDataKey *keyPtr,	/* Identifier for the data chunk */
    size_t size)		/* Size of storage block */
{
    void *result;
#if TCL_THREADS
    /*
     * Initialize the key for this thread.
     */








|







57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
 *
 *----------------------------------------------------------------------
 */

void *
Tcl_GetThreadData(
    Tcl_ThreadDataKey *keyPtr,	/* Identifier for the data chunk */
    Tcl_Size size)		/* Size of storage block */
{
    void *result;
#if TCL_THREADS
    /*
     * Initialize the key for this thread.
     */

Changes to generic/tclThreadAlloc.c.

636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
    Tcl_MutexLock(listLockPtr);
    cachePtr = firstCachePtr;
    while (cachePtr != NULL) {
	Tcl_DStringStartSublist(dsPtr);
	if (cachePtr == sharedPtr) {
	    Tcl_DStringAppendElement(dsPtr, "shared");
	} else {
	    sprintf(buf, "thread%p", cachePtr->owner);
	    Tcl_DStringAppendElement(dsPtr, buf);
	}
	for (n = 0; n < NBUCKETS; ++n) {
	    sprintf(buf, "%" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %"
		    TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u",
		    bucketInfo[n].blockSize,
		    cachePtr->buckets[n].numFree,
		    cachePtr->buckets[n].numRemoves,
		    cachePtr->buckets[n].numInserts,
		    cachePtr->buckets[n].totalAssigned,
		    cachePtr->buckets[n].numLocks);







|



|







636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
    Tcl_MutexLock(listLockPtr);
    cachePtr = firstCachePtr;
    while (cachePtr != NULL) {
	Tcl_DStringStartSublist(dsPtr);
	if (cachePtr == sharedPtr) {
	    Tcl_DStringAppendElement(dsPtr, "shared");
	} else {
	    snprintf(buf, sizeof(buf), "thread%p", cachePtr->owner);
	    Tcl_DStringAppendElement(dsPtr, buf);
	}
	for (n = 0; n < NBUCKETS; ++n) {
	    snprintf(buf, sizeof(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);
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
    Cache *cachePtr,
    int bucket)
{
    Block *blockPtr;
    size_t n;

    /*
     * First, atttempt to move blocks from the shared cache. Note the
     * potentially dirty read of numFree before acquiring the lock which is a
     * slight performance enhancement. The value is verified after the lock is
     * actually acquired.
     */

    if (cachePtr != sharedPtr && sharedPtr->buckets[bucket].numFree > 0) {
	LockBucket(cachePtr, bucket);







|







933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
    Cache *cachePtr,
    int bucket)
{
    Block *blockPtr;
    size_t n;

    /*
     * First, attempt to move blocks from the shared cache. Note the
     * potentially dirty read of numFree before acquiring the lock which is a
     * slight performance enhancement. The value is verified after the lock is
     * actually acquired.
     */

    if (cachePtr != sharedPtr && sharedPtr->buckets[bucket].numFree > 0) {
	LockBucket(cachePtr, bucket);

Changes to generic/tclThreadJoin.c.

207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
}

/*
 *----------------------------------------------------------------------
 *
 * TclRememberJoinableThread --
 *
 *	This procedure remebers a thread as joinable. Only a call to
 *	TclJoinThread will remove the structre created (and initialized) here.
 *	IOW, not waiting upon a joinable thread will cause memory leaks.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Allocates memory, adds it to the global list of all joinable threads.







|
|







207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
}

/*
 *----------------------------------------------------------------------
 *
 * TclRememberJoinableThread --
 *
 *	This procedure remembers a thread as joinable. Only a call to
 *	TclJoinThread will remove the structure created (and initialized) here.
 *	IOW, not waiting upon a joinable thread will cause memory leaks.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Allocates memory, adds it to the global list of all joinable threads.

Changes to generic/tclThreadTest.c.

268
269
270
271
272
273
274
275

276
277
278
279
280
281
282
	} else {
	    result = NULL;
	}
	return ThreadCancel(interp, (Tcl_ThreadId) INT2PTR(id), result, flags);
    }
    case THREAD_CREATE: {
	const char *script;
	int joinable, len;


	if (objc == 2) {
	    /*
	     * Neither joinable nor special script
	     */

	    joinable = 0;







|
>







268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
	} else {
	    result = NULL;
	}
	return ThreadCancel(interp, (Tcl_ThreadId) INT2PTR(id), result, flags);
    }
    case THREAD_CREATE: {
	const char *script;
	int joinable;
	Tcl_Size len;

	if (objc == 2) {
	    /*
	     * Neither joinable nor special script
	     */

	    joinable = 0;
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377

	result = Tcl_JoinThread((Tcl_ThreadId)INT2PTR(id), &status);
	if (result == TCL_OK) {
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), status);
	} else {
	    char buf[TCL_INTEGER_SPACE];

	    sprintf(buf, "%" TCL_LL_MODIFIER "d", (long long)id);
	    Tcl_AppendResult(interp, "cannot join thread ", buf, NULL);
	}
	return result;
    }
    case THREAD_NAMES:
	if (objc > 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, NULL);







|







364
365
366
367
368
369
370
371
372
373
374
375
376
377
378

	result = Tcl_JoinThread((Tcl_ThreadId)INT2PTR(id), &status);
	if (result == TCL_OK) {
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), status);
	} else {
	    char buf[TCL_INTEGER_SPACE];

	    snprintf(buf, sizeof(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);
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
    Tcl_MutexUnlock(&threadMutex);

    /*
     * Run the script.
     */

    Tcl_Preserve(tsdPtr->interp);
    result = Tcl_EvalEx(tsdPtr->interp, threadEvalScript, -1, 0);
    if (result != TCL_OK) {
	ThreadErrorProc(tsdPtr->interp);
    }

    /*
     * Clean up.
     */







|







604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
    Tcl_MutexUnlock(&threadMutex);

    /*
     * Run the script.
     */

    Tcl_Preserve(tsdPtr->interp);
    result = Tcl_EvalEx(tsdPtr->interp, threadEvalScript, TCL_INDEX_NONE, 0);
    if (result != TCL_OK) {
	ThreadErrorProc(tsdPtr->interp);
    }

    /*
     * Clean up.
     */
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
    Tcl_Interp *interp)		/* Interp that failed */
{
    Tcl_Channel errChannel;
    const char *errorInfo, *argv[3];
    char *script;
    char buf[TCL_DOUBLE_SPACE+1];

    sprintf(buf, "%p", Tcl_GetCurrentThread());

    errorInfo = Tcl_GetVar2(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY);
    if (errorProcString == NULL) {
	errChannel = Tcl_GetStdChannel(TCL_STDERR);
	Tcl_WriteChars(errChannel, "Error from thread ", -1);
	Tcl_WriteChars(errChannel, buf, -1);
	Tcl_WriteChars(errChannel, "\n", 1);







|







646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
    Tcl_Interp *interp)		/* Interp that failed */
{
    Tcl_Channel errChannel;
    const char *errorInfo, *argv[3];
    char *script;
    char buf[TCL_DOUBLE_SPACE+1];

    snprintf(buf, sizeof(buf), "%p", Tcl_GetCurrentThread());

    errorInfo = Tcl_GetVar2(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY);
    if (errorProcString == NULL) {
	errChannel = Tcl_GetStdChannel(TCL_STDERR);
	Tcl_WriteChars(errChannel, "Error from thread ", -1);
	Tcl_WriteChars(errChannel, buf, -1);
	Tcl_WriteChars(errChannel, "\n", 1);
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
    if (!found) {
	Tcl_MutexUnlock(&threadMutex);
	Tcl_AppendResult(interp, "invalid thread id", NULL);
	return TCL_ERROR;
    }

    /*
     * Short circut sends to ourself. Ought to do something with -async, like
     * run in an idle handler.
     */

    if (threadId == Tcl_GetCurrentThread()) {
	Tcl_MutexUnlock(&threadMutex);
	return Tcl_EvalEx(interp, script,-1,TCL_EVAL_GLOBAL);
    }







|







819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
    if (!found) {
	Tcl_MutexUnlock(&threadMutex);
	Tcl_AppendResult(interp, "invalid thread id", NULL);
	return TCL_ERROR;
    }

    /*
     * Short circuit sends to ourself. Ought to do something with -async, like
     * run in an idle handler.
     */

    if (threadId == Tcl_GetCurrentThread()) {
	Tcl_MutexUnlock(&threadMutex);
	return Tcl_EvalEx(interp, script,-1,TCL_EVAL_GLOBAL);
    }

Changes to generic/tclTimer.c.

17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
 * type. The normal handlers (created by Tcl_CreateTimerHandler) are chained
 * together in a list sorted by time (earliest event first).
 */

typedef struct TimerHandler {
    Tcl_Time time;		/* When timer is to fire. */
    Tcl_TimerProc *proc;	/* Function to call. */
    ClientData clientData;	/* Argument to pass to proc. */
    Tcl_TimerToken token;	/* Identifies handler so it can be deleted. */
    struct TimerHandler *nextPtr;
				/* Next event in queue, or NULL for end of
				 * queue. */
} TimerHandler;

/*







|







17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
 * type. The normal handlers (created by Tcl_CreateTimerHandler) are chained
 * together in a list sorted by time (earliest event first).
 */

typedef struct TimerHandler {
    Tcl_Time time;		/* When timer is to fire. */
    Tcl_TimerProc *proc;	/* Function to call. */
    void *clientData;	/* Argument to pass to proc. */
    Tcl_TimerToken token;	/* Identifies handler so it can be deleted. */
    struct TimerHandler *nextPtr;
				/* Next event in queue, or NULL for end of
				 * queue. */
} TimerHandler;

/*
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
 * There is one of the following structures for each of the handlers declared
 * in a call to Tcl_DoWhenIdle. All of the currently-active handlers are
 * linked together into a list.
 */

typedef struct IdleHandler {
    Tcl_IdleProc *proc;		/* Function to call. */
    ClientData clientData;	/* Value to pass to proc. */
    int generation;		/* Used to distinguish older handlers from
				 * recently-created ones. */
    struct IdleHandler *nextPtr;/* Next in list of active handlers. */
} IdleHandler;

/*
 * The timer and idle queues are per-thread because they are associated with







|







69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
 * There is one of the following structures for each of the handlers declared
 * in a call to Tcl_DoWhenIdle. All of the currently-active handlers are
 * linked together into a list.
 */

typedef struct IdleHandler {
    Tcl_IdleProc *proc;		/* Function to call. */
    void *clientData;	/* Value to pass to proc. */
    int generation;		/* Used to distinguish older handlers from
				 * recently-created ones. */
    struct IdleHandler *nextPtr;/* Next in list of active handlers. */
} IdleHandler;

/*
 * The timer and idle queues are per-thread because they are associated with
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

#define TCL_TIME_MAXIMUM_SLICE 500

/*
 * Prototypes for functions referenced only in this file:
 */

static void		AfterCleanupProc(ClientData clientData,
			    Tcl_Interp *interp);
static int		AfterDelay(Tcl_Interp *interp, Tcl_WideInt ms);
static void		AfterProc(ClientData clientData);
static void		FreeAfterPtr(AfterInfo *afterPtr);
static AfterInfo *	GetAfterEvent(AfterAssocData *assocPtr,
			    Tcl_Obj *commandPtr);
static ThreadSpecificData *InitTimer(void);
static void		TimerExitProc(ClientData clientData);
static int		TimerHandlerEventProc(Tcl_Event *evPtr, int flags);
static void		TimerCheckProc(ClientData clientData, int flags);
static void		TimerSetupProc(ClientData clientData, int flags);

/*
 *----------------------------------------------------------------------
 *
 * InitTimer --
 *
 *	This function initializes the timer module.







|


|




|

|
|







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

#define TCL_TIME_MAXIMUM_SLICE 500

/*
 * Prototypes for functions referenced only in this file:
 */

static void		AfterCleanupProc(void *clientData,
			    Tcl_Interp *interp);
static int		AfterDelay(Tcl_Interp *interp, Tcl_WideInt ms);
static void		AfterProc(void *clientData);
static void		FreeAfterPtr(AfterInfo *afterPtr);
static AfterInfo *	GetAfterEvent(AfterAssocData *assocPtr,
			    Tcl_Obj *commandPtr);
static ThreadSpecificData *InitTimer(void);
static void		TimerExitProc(void *clientData);
static int		TimerHandlerEventProc(Tcl_Event *evPtr, int flags);
static void		TimerCheckProc(void *clientData, int flags);
static void		TimerSetupProc(void *clientData, int flags);

/*
 *----------------------------------------------------------------------
 *
 * InitTimer --
 *
 *	This function initializes the timer module.
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
 */

Tcl_TimerToken
Tcl_CreateTimerHandler(
    int milliseconds,		/* How many milliseconds to wait before
				 * invoking proc. */
    Tcl_TimerProc *proc,	/* Function to invoke. */
    ClientData clientData)	/* Arbitrary data to pass to proc. */
{
    Tcl_Time time;

    /*
     * Compute when the event should fire.
     */








|







247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
 */

Tcl_TimerToken
Tcl_CreateTimerHandler(
    int milliseconds,		/* How many milliseconds to wait before
				 * invoking proc. */
    Tcl_TimerProc *proc,	/* Function to invoke. */
    void *clientData)	/* Arbitrary data to pass to proc. */
{
    Tcl_Time time;

    /*
     * Compute when the event should fire.
     */

288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
 *--------------------------------------------------------------
 */

Tcl_TimerToken
TclCreateAbsoluteTimerHandler(
    Tcl_Time *timePtr,
    Tcl_TimerProc *proc,
    ClientData clientData)
{
    TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr;
    ThreadSpecificData *tsdPtr = InitTimer();

    timerHandlerPtr = (TimerHandler *)Tcl_Alloc(sizeof(TimerHandler));

    /*







|







288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
 *--------------------------------------------------------------
 */

Tcl_TimerToken
TclCreateAbsoluteTimerHandler(
    Tcl_Time *timePtr,
    Tcl_TimerProc *proc,
    void *clientData)
{
    TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr;
    ThreadSpecificData *tsdPtr = InitTimer();

    timerHandlerPtr = (TimerHandler *)Tcl_Alloc(sizeof(TimerHandler));

    /*
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
 *
 *--------------------------------------------------------------
 */

void
Tcl_DoWhenIdle(
    Tcl_IdleProc *proc,		/* Function to invoke. */
    ClientData clientData)	/* Arbitrary value to pass to proc. */
{
    IdleHandler *idlePtr;
    Tcl_Time blockTime;
    ThreadSpecificData *tsdPtr = InitTimer();

    idlePtr = (IdleHandler *)Tcl_Alloc(sizeof(IdleHandler));
    idlePtr->proc = proc;







|







615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
 *
 *--------------------------------------------------------------
 */

void
Tcl_DoWhenIdle(
    Tcl_IdleProc *proc,		/* Function to invoke. */
    void *clientData)	/* Arbitrary value to pass to proc. */
{
    IdleHandler *idlePtr;
    Tcl_Time blockTime;
    ThreadSpecificData *tsdPtr = InitTimer();

    idlePtr = (IdleHandler *)Tcl_Alloc(sizeof(IdleHandler));
    idlePtr->proc = proc;
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
 *
 *----------------------------------------------------------------------
 */

void
Tcl_CancelIdleCall(
    Tcl_IdleProc *proc,		/* Function that was previously registered. */
    ClientData clientData)	/* Arbitrary value to pass to proc. */
{
    IdleHandler *idlePtr, *prevPtr;
    IdleHandler *nextPtr;
    ThreadSpecificData *tsdPtr = InitTimer();

    for (prevPtr = NULL, idlePtr = tsdPtr->idleList; idlePtr != NULL;
	    prevPtr = idlePtr, idlePtr = idlePtr->nextPtr) {







|







659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
 *
 *----------------------------------------------------------------------
 */

void
Tcl_CancelIdleCall(
    Tcl_IdleProc *proc,		/* Function that was previously registered. */
    void *clientData)	/* Arbitrary value to pass to proc. */
{
    IdleHandler *idlePtr, *prevPtr;
    IdleHandler *nextPtr;
    ThreadSpecificData *tsdPtr = InitTimer();

    for (prevPtr = NULL, idlePtr = tsdPtr->idleList; idlePtr != NULL;
	    prevPtr = idlePtr, idlePtr = idlePtr->nextPtr) {
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_WideInt ms = 0;		/* Number of milliseconds to wait */
    Tcl_Time wakeup;
    AfterInfo *afterPtr;
    AfterAssocData *assocPtr;
    size_t length;
    int index = -1;
    static const char *const afterSubCmds[] = {
	"cancel", "idle", "info", NULL
    };
    enum afterSubCmdsEnum {AFTER_CANCEL, AFTER_IDLE, AFTER_INFO};
    ThreadSpecificData *tsdPtr = InitTimer();








|







783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_WideInt ms = 0;		/* Number of milliseconds to wait */
    Tcl_Time wakeup;
    AfterInfo *afterPtr;
    AfterAssocData *assocPtr;
    Tcl_Size length;
    int index = -1;
    static const char *const afterSubCmds[] = {
	"cancel", "idle", "info", NULL
    };
    enum afterSubCmdsEnum {AFTER_CANCEL, AFTER_IDLE, AFTER_INFO};
    ThreadSpecificData *tsdPtr = InitTimer();

878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
	assocPtr->firstAfterPtr = afterPtr;
	Tcl_SetObjResult(interp, Tcl_ObjPrintf("after#%d", afterPtr->id));
	return TCL_OK;
    }
    case AFTER_CANCEL: {
	Tcl_Obj *commandPtr;
	const char *command, *tempCommand;
	size_t tempLength;

	if (objc < 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "id|command");
	    return TCL_ERROR;
	}
	if (objc == 3) {
	    commandPtr = objv[2];







|







878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
	assocPtr->firstAfterPtr = afterPtr;
	Tcl_SetObjResult(interp, Tcl_ObjPrintf("after#%d", afterPtr->id));
	return TCL_OK;
    }
    case AFTER_CANCEL: {
	Tcl_Obj *commandPtr;
	const char *command, *tempCommand;
	Tcl_Size tempLength;

	if (objc < 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "id|command");
	    return TCL_ERROR;
	}
	if (objc == 3) {
	    commandPtr = objv[2];
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
 *	bgerror fails then information about the error is output on stderr.
 *
 *----------------------------------------------------------------------
 */

static void
AfterProc(
    ClientData clientData)	/* Describes command to execute. */
{
    AfterInfo *afterPtr = (AfterInfo *)clientData;
    AfterAssocData *assocPtr = afterPtr->assocPtr;
    AfterInfo *prevPtr;
    int result;
    Tcl_Interp *interp;








|







1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
 *	bgerror fails then information about the error is output on stderr.
 *
 *----------------------------------------------------------------------
 */

static void
AfterProc(
    void *clientData)	/* Describes command to execute. */
{
    AfterInfo *afterPtr = (AfterInfo *)clientData;
    AfterAssocData *assocPtr = afterPtr->assocPtr;
    AfterInfo *prevPtr;
    int result;
    Tcl_Interp *interp;

1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
 *	After commands are removed.
 *
 *----------------------------------------------------------------------
 */

static void
AfterCleanupProc(
    ClientData clientData,	/* Points to AfterAssocData for the
				 * interpreter. */
    TCL_UNUSED(Tcl_Interp *))
{
    AfterAssocData *assocPtr = (AfterAssocData *)clientData;
    AfterInfo *afterPtr;

    while (assocPtr->firstAfterPtr != NULL) {







|







1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
 *	After commands are removed.
 *
 *----------------------------------------------------------------------
 */

static void
AfterCleanupProc(
    void *clientData,	/* Points to AfterAssocData for the
				 * interpreter. */
    TCL_UNUSED(Tcl_Interp *))
{
    AfterAssocData *assocPtr = (AfterAssocData *)clientData;
    AfterInfo *afterPtr;

    while (assocPtr->firstAfterPtr != NULL) {

Changes to generic/tclTomMath.decls.

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
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()
#declare 74 {
#    int TclBN_mp_tc_or(const mp_int *a, const mp_int *b, mp_int *c)
#}
# No longer in use: replaced by mp_xor()
#declare 75 {
#    int TclBN_mp_tc_xor(const mp_int *a, const mp_int *b, mp_int *c)
#}
declare 76 {
    mp_err MP_WUR TclBN_mp_signed_rsh(const mp_int *a, int b, mp_int *c)
}




# Added in libtommath 1.2.0
declare 78 {
    int MP_WUR TclBN_mp_to_ubin(const mp_int *a, unsigned char *buf, size_t maxlen, size_t *written)
}
# Removed in 9.0
#declare 79 {







>
>
>
>

















>
>
>







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
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)
}
declare 72 {
    mp_err MP_WUR TclBN_mp_pack(void *rop, size_t maxcount, size_t *written, mp_order order,
	    size_t size, mp_endian endian, size_t nails, const mp_int *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()
#declare 74 {
#    int TclBN_mp_tc_or(const mp_int *a, const mp_int *b, mp_int *c)
#}
# No longer in use: replaced by mp_xor()
#declare 75 {
#    int TclBN_mp_tc_xor(const mp_int *a, const mp_int *b, mp_int *c)
#}
declare 76 {
    mp_err MP_WUR TclBN_mp_signed_rsh(const mp_int *a, int b, mp_int *c)
}
declare 77 {
    size_t MP_WUR TclBN_mp_pack_count(const mp_int *a, size_t nails, size_t size)
}

# Added in libtommath 1.2.0
declare 78 {
    int MP_WUR TclBN_mp_to_ubin(const mp_int *a, unsigned char *buf, size_t maxlen, size_t *written)
}
# Removed in 9.0
#declare 79 {

Changes to generic/tclTomMath.h.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26








27
28
29
30
31
32
33
#ifndef BN_TCL_H_
#define BN_TCL_H_

#ifdef MP_NO_STDINT
#   ifdef HAVE_STDINT_H
#	include <stdint.h>
#else
#	include "../compat/stdint.h"
#   endif
#endif
#if defined(TCL_NO_TOMMATH_H)
    typedef size_t mp_digit;
    typedef int mp_sign;
#   define MP_ZPOS       0   /* positive integer */
#   define MP_NEG        1   /* negative */
    typedef int mp_ord;
#   define MP_LT        -1   /* less than */
#   define MP_EQ         0   /* equal to */
#   define MP_GT         1   /* greater than */
    typedef int mp_err;
#   define MP_OKAY       0   /* no error */
#   define MP_ERR        -1  /* unknown error */
#   define MP_MEM        -2  /* out of mem */
#   define MP_VAL        -3  /* invalid input */
#   define MP_ITER       -4  /* maximum iterations reached */
#   define MP_BUF        -5  /* buffer overflow, supplied buffer too small */








#   define MP_WUR            /* nothing */
#   define mp_iszero(a) ((a)->used == 0)
#   define mp_isneg(a)  ((a)->sign != 0)

    /* the infamous mp_int structure */
#   ifndef MP_INT_DECLARED
#	define MP_INT_DECLARED



<
<
|
<
<
<
<
















>
>
>
>
>
>
>
>







1
2
3


4




5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
#ifndef BN_TCL_H_
#define BN_TCL_H_



#include <stdint.h>




#if defined(TCL_NO_TOMMATH_H)
    typedef size_t mp_digit;
    typedef int mp_sign;
#   define MP_ZPOS       0   /* positive integer */
#   define MP_NEG        1   /* negative */
    typedef int mp_ord;
#   define MP_LT        -1   /* less than */
#   define MP_EQ         0   /* equal to */
#   define MP_GT         1   /* greater than */
    typedef int mp_err;
#   define MP_OKAY       0   /* no error */
#   define MP_ERR        -1  /* unknown error */
#   define MP_MEM        -2  /* out of mem */
#   define MP_VAL        -3  /* invalid input */
#   define MP_ITER       -4  /* maximum iterations reached */
#   define MP_BUF        -5  /* buffer overflow, supplied buffer too small */
    typedef int mp_order;
#   define MP_LSB_FIRST -1
#   define MP_MSB_FIRST  1
    typedef int mp_endian;
#   define MP_LITTLE_ENDIAN  -1
#   define MP_NATIVE_ENDIAN  0
#   define MP_BIG_ENDIAN     1
#   define MP_DEPRECATED_PRAGMA(s) /* nothing */
#   define MP_WUR            /* nothing */
#   define mp_iszero(a) ((a)->used == 0)
#   define mp_isneg(a)  ((a)->sign != 0)

    /* the infamous mp_int structure */
#   ifndef MP_INT_DECLARED
#	define MP_INT_DECLARED

Changes to generic/tclTomMathDecls.h.

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
#define Tcl_TomMath_InitStubs(interp,version) \
    (TclTomMathInitializeStubs((interp),(version),\
                               TCLTOMMATH_EPOCH,TCLTOMMATH_REVISION))

/* Define custom memory allocation for libtommath */

/* MODULE_SCOPE void* TclBNAlloc( size_t ); */
#define TclBNAlloc(s) ((void*)Tcl_Alloc(s))
/* MODULE_SCOPE void* TclBNCalloc( size_t, size_t ); */
#define TclBNCalloc(m,s) memset(Tcl_Alloc((size_t)(m)*(size_t)(s)),0,(size_t)(m)*(size_t)(s))
/* MODULE_SCOPE void* TclBNRealloc( void*, size_t ); */
#define TclBNRealloc(x,s) ((void*)Tcl_Realloc((char*)(x),(size_t)(s)))
/* MODULE_SCOPE void  TclBNFree( void* ); */
#define TclBNFree(x) (Tcl_Free((char*)(x)))

#undef MP_MALLOC
#undef MP_CALLOC
#undef MP_REALLOC
#undef MP_FREE
#define MP_MALLOC(size)                   TclBNAlloc(size)
#define MP_CALLOC(nmemb, size)            TclBNCalloc(nmemb, size)
#define MP_REALLOC(mem, oldsize, newsize) TclBNRealloc(mem, newsize)
#define MP_FREE(mem, size)                TclBNFree(mem)

#ifndef MODULE_SCOPE
#   ifdef __cplusplus
#	define MODULE_SCOPE extern "C"
#   else
#	define MODULE_SCOPE extern
#   endif







|

|

|

|






|
|
|







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
#define Tcl_TomMath_InitStubs(interp,version) \
    (TclTomMathInitializeStubs((interp),(version),\
                               TCLTOMMATH_EPOCH,TCLTOMMATH_REVISION))

/* Define custom memory allocation for libtommath */

/* MODULE_SCOPE void* TclBNAlloc( size_t ); */
#define TclBNAlloc(s) Tcl_AttemptAlloc((size_t)(s))
/* MODULE_SCOPE void* TclBNCalloc( size_t, size_t ); */
#define TclBNCalloc(m,s) memset(Tcl_AttemptAlloc((size_t)(m)*(size_t)(s)),0,(size_t)(m)*(size_t)(s))
/* MODULE_SCOPE void* TclBNRealloc( void*, size_t ); */
#define TclBNRealloc(x,s) Tcl_AttemptRealloc((x),(size_t)(s))
/* MODULE_SCOPE void  TclBNFree( void* ); */
#define TclBNFree(x) Tcl_Free(x)

#undef MP_MALLOC
#undef MP_CALLOC
#undef MP_REALLOC
#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), ((void)(oldsize), (newsize)))
#define MP_FREE(mem, size)                TclBNFree(((void)(size), (mem)))

#ifndef MODULE_SCOPE
#   ifdef __cplusplus
#	define MODULE_SCOPE extern "C"
#   else
#	define MODULE_SCOPE extern
#   endif
124
125
126
127
128
129
130


131
132
133
134
135
136
137
#define mp_mod_2d TclBN_mp_mod_2d
#define mp_mul TclBN_mp_mul
#define mp_mul_d TclBN_mp_mul_d
#define mp_mul_2 TclBN_mp_mul_2
#define mp_mul_2d TclBN_mp_mul_2d
#define mp_neg TclBN_mp_neg
#define mp_or TclBN_mp_or


#define mp_radix_size TclBN_mp_radix_size
#define mp_read_radix TclBN_mp_read_radix
#define mp_rshd TclBN_mp_rshd
#define mp_s_rmap TclBN_mp_s_rmap
#define mp_s_rmap_reverse TclBN_mp_s_rmap_reverse
#define mp_s_rmap_reverse_sz TclBN_mp_s_rmap_reverse_sz
#define mp_set TclBN_s_mp_set







>
>







124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
#define mp_mod_2d TclBN_mp_mod_2d
#define mp_mul TclBN_mp_mul
#define mp_mul_d TclBN_mp_mul_d
#define mp_mul_2 TclBN_mp_mul_2
#define mp_mul_2d TclBN_mp_mul_2d
#define mp_neg TclBN_mp_neg
#define mp_or TclBN_mp_or
#define mp_pack TclBN_mp_pack
#define mp_pack_count TclBN_mp_pack_count
#define mp_radix_size TclBN_mp_radix_size
#define mp_read_radix TclBN_mp_read_radix
#define mp_rshd TclBN_mp_rshd
#define mp_s_rmap TclBN_mp_s_rmap
#define mp_s_rmap_reverse TclBN_mp_s_rmap_reverse
#define mp_s_rmap_reverse_sz TclBN_mp_s_rmap_reverse_sz
#define mp_set TclBN_s_mp_set
335
336
337
338
339
340
341
342




343
344
345
346
347
348
349


350
351
352
353
354
355
356
/* 70 */
EXTERN void		TclBN_mp_set_i64(mp_int *a, int64_t i);
/* 71 */
EXTERN mp_err		TclBN_mp_unpack(mp_int *rop, size_t count,
				mp_order order, size_t size,
				mp_endian endian, size_t nails,
				const void *op) MP_WUR;
/* Slot 72 is reserved */




/* Slot 73 is reserved */
/* Slot 74 is reserved */
/* Slot 75 is reserved */
/* 76 */
EXTERN mp_err		TclBN_mp_signed_rsh(const mp_int *a, int b,
				mp_int *c) MP_WUR;
/* Slot 77 is reserved */


/* 78 */
EXTERN int		TclBN_mp_to_ubin(const mp_int *a, unsigned char *buf,
				size_t maxlen, size_t *written) MP_WUR;
/* Slot 79 is reserved */
/* 80 */
EXTERN int		TclBN_mp_to_radix(const mp_int *a, char *str,
				size_t maxlen, size_t *written, int radix) MP_WUR;







|
>
>
>
>






|
>
>







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
/* 70 */
EXTERN void		TclBN_mp_set_i64(mp_int *a, int64_t i);
/* 71 */
EXTERN mp_err		TclBN_mp_unpack(mp_int *rop, size_t count,
				mp_order order, size_t size,
				mp_endian endian, size_t nails,
				const void *op) MP_WUR;
/* 72 */
EXTERN mp_err		TclBN_mp_pack(void *rop, size_t maxcount,
				size_t *written, mp_order order, size_t size,
				mp_endian endian, size_t nails,
				const mp_int *op) MP_WUR;
/* 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;
/* 77 */
EXTERN size_t		TclBN_mp_pack_count(const mp_int *a, size_t nails,
				size_t size) MP_WUR;
/* 78 */
EXTERN int		TclBN_mp_to_ubin(const mp_int *a, unsigned char *buf,
				size_t maxlen, size_t *written) MP_WUR;
/* Slot 79 is reserved */
/* 80 */
EXTERN int		TclBN_mp_to_radix(const mp_int *a, char *str,
				size_t maxlen, size_t *written, int radix) MP_WUR;
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
    int (*tclBN_mp_init_i64) (mp_int *bignum, int64_t initVal) MP_WUR; /* 65 */
    int (*tclBN_mp_init_u64) (mp_int *bignum, uint64_t initVal) MP_WUR; /* 66 */
    void (*reserved67)(void);
    void (*tclBN_mp_set_u64) (mp_int *a, uint64_t i); /* 68 */
    uint64_t (*tclBN_mp_get_mag_u64) (const mp_int *a) MP_WUR; /* 69 */
    void (*tclBN_mp_set_i64) (mp_int *a, int64_t i); /* 70 */
    mp_err (*tclBN_mp_unpack) (mp_int *rop, size_t count, mp_order order, size_t size, mp_endian endian, size_t nails, const void *op) MP_WUR; /* 71 */
    void (*reserved72)(void);
    void (*reserved73)(void);
    void (*reserved74)(void);
    void (*reserved75)(void);
    mp_err (*tclBN_mp_signed_rsh) (const mp_int *a, int b, mp_int *c) MP_WUR; /* 76 */
    void (*reserved77)(void);
    int (*tclBN_mp_to_ubin) (const mp_int *a, unsigned char *buf, size_t maxlen, size_t *written) MP_WUR; /* 78 */
    void (*reserved79)(void);
    int (*tclBN_mp_to_radix) (const mp_int *a, char *str, size_t maxlen, size_t *written, int radix) MP_WUR; /* 80 */
} TclTomMathStubs;

extern const TclTomMathStubs *tclTomMathStubsPtr;








|




|







435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
    int (*tclBN_mp_init_i64) (mp_int *bignum, int64_t initVal) MP_WUR; /* 65 */
    int (*tclBN_mp_init_u64) (mp_int *bignum, uint64_t initVal) MP_WUR; /* 66 */
    void (*reserved67)(void);
    void (*tclBN_mp_set_u64) (mp_int *a, uint64_t i); /* 68 */
    uint64_t (*tclBN_mp_get_mag_u64) (const mp_int *a) MP_WUR; /* 69 */
    void (*tclBN_mp_set_i64) (mp_int *a, int64_t i); /* 70 */
    mp_err (*tclBN_mp_unpack) (mp_int *rop, size_t count, mp_order order, size_t size, mp_endian endian, size_t nails, const void *op) MP_WUR; /* 71 */
    mp_err (*tclBN_mp_pack) (void *rop, size_t maxcount, size_t *written, mp_order order, size_t size, mp_endian endian, size_t nails, const mp_int *op) MP_WUR; /* 72 */
    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 */
    size_t (*tclBN_mp_pack_count) (const mp_int *a, size_t nails, size_t size) MP_WUR; /* 77 */
    int (*tclBN_mp_to_ubin) (const mp_int *a, unsigned char *buf, size_t maxlen, size_t *written) MP_WUR; /* 78 */
    void (*reserved79)(void);
    int (*tclBN_mp_to_radix) (const mp_int *a, char *str, size_t maxlen, size_t *written, int radix) MP_WUR; /* 80 */
} TclTomMathStubs;

extern const TclTomMathStubs *tclTomMathStubsPtr;

573
574
575
576
577
578
579
580

581
582
583
584
585
586

587
588
589
590
591
592
593
	(tclTomMathStubsPtr->tclBN_mp_set_u64) /* 68 */
#define TclBN_mp_get_mag_u64 \
	(tclTomMathStubsPtr->tclBN_mp_get_mag_u64) /* 69 */
#define TclBN_mp_set_i64 \
	(tclTomMathStubsPtr->tclBN_mp_set_i64) /* 70 */
#define TclBN_mp_unpack \
	(tclTomMathStubsPtr->tclBN_mp_unpack) /* 71 */
/* Slot 72 is reserved */

/* Slot 73 is reserved */
/* Slot 74 is reserved */
/* Slot 75 is reserved */
#define TclBN_mp_signed_rsh \
	(tclTomMathStubsPtr->tclBN_mp_signed_rsh) /* 76 */
/* Slot 77 is reserved */

#define TclBN_mp_to_ubin \
	(tclTomMathStubsPtr->tclBN_mp_to_ubin) /* 78 */
/* Slot 79 is reserved */
#define TclBN_mp_to_radix \
	(tclTomMathStubsPtr->tclBN_mp_to_radix) /* 80 */

#endif /* defined(USE_TCL_STUBS) */







|
>





|
>







581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
	(tclTomMathStubsPtr->tclBN_mp_set_u64) /* 68 */
#define TclBN_mp_get_mag_u64 \
	(tclTomMathStubsPtr->tclBN_mp_get_mag_u64) /* 69 */
#define TclBN_mp_set_i64 \
	(tclTomMathStubsPtr->tclBN_mp_set_i64) /* 70 */
#define TclBN_mp_unpack \
	(tclTomMathStubsPtr->tclBN_mp_unpack) /* 71 */
#define TclBN_mp_pack \
	(tclTomMathStubsPtr->tclBN_mp_pack) /* 72 */
/* Slot 73 is reserved */
/* Slot 74 is reserved */
/* Slot 75 is reserved */
#define TclBN_mp_signed_rsh \
	(tclTomMathStubsPtr->tclBN_mp_signed_rsh) /* 76 */
#define TclBN_mp_pack_count \
	(tclTomMathStubsPtr->tclBN_mp_pack_count) /* 77 */
#define TclBN_mp_to_ubin \
	(tclTomMathStubsPtr->tclBN_mp_to_ubin) /* 78 */
/* Slot 79 is reserved */
#define TclBN_mp_to_radix \
	(tclTomMathStubsPtr->tclBN_mp_to_radix) /* 80 */

#endif /* defined(USE_TCL_STUBS) */

Changes to generic/tclTrace.c.

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
/*
 * Structures used to hold information about variable traces:
 */

typedef struct {
    int flags;			/* Operations for which Tcl command is to be
				 * invoked. */
    size_t length;		/* Number of non-NUL chars. in command. */
    char command[1];		/* Space for Tcl command to invoke. Actual
				 * size will be as large as necessary to hold
				 * command. This field must be the last in the
				 * structure, so that it can be larger than 1
				 * byte. */
} TraceVarInfo;

typedef struct {
    VarTrace traceInfo;
    TraceVarInfo traceCmdInfo;
} CombinedTraceVarInfo;

/*
 * Structure used to hold information about command traces:
 */

typedef struct {
    int flags;			/* Operations for which Tcl command is to be
				 * invoked. */
    size_t length;		/* Number of non-NUL chars. in command. */
    Tcl_Trace stepTrace;	/* Used for execution traces, when tracing
				 * inside the given command */
    int startLevel;		/* Used for bookkeeping with step execution
				 * traces, store the level at which the step
				 * trace was invoked */
    char *startCmd;		/* Used for bookkeeping with step execution
				 * traces, store the command name which
				 * invoked step trace */
    int curFlags;		/* Trace flags for the current command */
    int curCode;		/* Return code for the current command */
    size_t refCount;		/* Used to ensure this structure is not
				 * deleted too early. Keeps track of how many
				 * pieces of code have a pointer to this
				 * structure. */
    char command[1];		/* Space for Tcl command to invoke. Actual
				 * size will be as large as necessary to hold
				 * command. This field must be the last in the
				 * structure, so that it can be larger than 1
				 * byte. */
} TraceCommandInfo;

/*







|
|


















|


|











|







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
/*
 * Structures used to hold information about variable traces:
 */

typedef struct {
    int flags;			/* Operations for which Tcl command is to be
				 * invoked. */
    Tcl_Size length;		/* Number of non-NUL chars. in command. */
    char command[TCLFLEXARRAY];		/* Space for Tcl command to invoke. Actual
				 * size will be as large as necessary to hold
				 * command. This field must be the last in the
				 * structure, so that it can be larger than 1
				 * byte. */
} TraceVarInfo;

typedef struct {
    VarTrace traceInfo;
    TraceVarInfo traceCmdInfo;
} CombinedTraceVarInfo;

/*
 * Structure used to hold information about command traces:
 */

typedef struct {
    int flags;			/* Operations for which Tcl command is to be
				 * invoked. */
    Tcl_Size length;		/* Number of non-NUL chars. in command. */
    Tcl_Trace stepTrace;	/* Used for execution traces, when tracing
				 * inside the given command */
    Tcl_Size startLevel;		/* Used for bookkeeping with step execution
				 * traces, store the level at which the step
				 * trace was invoked */
    char *startCmd;		/* Used for bookkeeping with step execution
				 * traces, store the command name which
				 * invoked step trace */
    int curFlags;		/* Trace flags for the current command */
    int curCode;		/* Return code for the current command */
    size_t refCount;		/* Used to ensure this structure is not
				 * deleted too early. Keeps track of how many
				 * pieces of code have a pointer to this
				 * structure. */
    char command[TCLFLEXARRAY];		/* Space for Tcl command to invoke. Actual
				 * size will be as large as necessary to hold
				 * command. This field must be the last in the
				 * structure, so that it can be larger than 1
				 * byte. */
} TraceCommandInfo;

/*
88
89
90
91
92
93
94

95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
#define TCL_TRACE_EXEC_IN_PROGRESS	0x10
#define TCL_TRACE_EXEC_DIRECT		0x20

/*
 * Forward declarations for functions defined in this file:
 */


enum traceOptions {
    TRACE_ADD, TRACE_INFO, TRACE_REMOVE
#ifndef TCL_REMOVE_OBSOLETE_TRACES
    ,TRACE_OLD_VARIABLE, TRACE_OLD_VDELETE, TRACE_OLD_VINFO
#endif
};
typedef int (Tcl_TraceTypeObjCmd)(Tcl_Interp *interp, enum traceOptions optionIndex,
	int objc, Tcl_Obj *const objv[]);

static Tcl_TraceTypeObjCmd TraceVariableObjCmd;
static Tcl_TraceTypeObjCmd TraceCommandObjCmd;
static Tcl_TraceTypeObjCmd TraceExecutionObjCmd;

/*
 * Each subcommand has a number of 'types' to which it can apply. Currently







>
|





|
|







88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
#define TCL_TRACE_EXEC_IN_PROGRESS	0x10
#define TCL_TRACE_EXEC_DIRECT		0x20

/*
 * Forward declarations for functions defined in this file:
 */

/* 'OLD' options are pre-Tcl-8.4 style */
enum traceOptionsEnum {
    TRACE_ADD, TRACE_INFO, TRACE_REMOVE
#ifndef TCL_REMOVE_OBSOLETE_TRACES
    ,TRACE_OLD_VARIABLE, TRACE_OLD_VDELETE, TRACE_OLD_VINFO
#endif
};
typedef int (Tcl_TraceTypeObjCmd)(Tcl_Interp *interp, enum traceOptionsEnum optionIndex,
	Tcl_Size objc, Tcl_Obj *const objv[]);

static Tcl_TraceTypeObjCmd TraceVariableObjCmd;
static Tcl_TraceTypeObjCmd TraceCommandObjCmd;
static Tcl_TraceTypeObjCmd TraceExecutionObjCmd;

/*
 * Each subcommand has a number of 'types' to which it can apply. Currently
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
};

/*
 * Declarations for local functions to this file:
 */

static int		CallTraceFunction(Tcl_Interp *interp, Trace *tracePtr,
			    Command *cmdPtr, const char *command, size_t numChars,
			    int objc, Tcl_Obj *const objv[]);
static char *		TraceVarProc(void *clientData, Tcl_Interp *interp,
			    const char *name1, const char *name2, int flags);
static void		TraceCommandProc(void *clientData,
			    Tcl_Interp *interp, const char *oldName,
			    const char *newName, int flags);
static Tcl_CmdObjTraceProc TraceExecutionProc;
static int		StringTraceProc(void *clientData,
			    Tcl_Interp *interp, int level,
			    const char *command, Tcl_Command commandInfo,
			    int objc, Tcl_Obj *const objv[]);
static void		StringTraceDeleteProc(void *clientData);
static void		DisposeTraceResult(int flags, char *result);
static int		TraceVarEx(Tcl_Interp *interp, const char *part1,
			    const char *part2, VarTrace *tracePtr);

/*
 * The following structure holds the client data for string-based







|
|





|

|

|







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

/*
 * Declarations for local functions to this file:
 */

static int		CallTraceFunction(Tcl_Interp *interp, Trace *tracePtr,
			    Command *cmdPtr, const char *command, Tcl_Size numChars,
			    Tcl_Size objc, Tcl_Obj *const objv[]);
static char *		TraceVarProc(void *clientData, Tcl_Interp *interp,
			    const char *name1, const char *name2, int flags);
static void		TraceCommandProc(void *clientData,
			    Tcl_Interp *interp, const char *oldName,
			    const char *newName, int flags);
static Tcl_CmdObjTraceProc2 TraceExecutionProc;
static int		StringTraceProc(void *clientData,
			    Tcl_Interp *interp, Tcl_Size level,
			    const char *command, Tcl_Command commandInfo,
			    Tcl_Size objc, Tcl_Obj *const objv[]);
static void		StringTraceDeleteProc(void *clientData);
static void		DisposeTraceResult(int flags, char *result);
static int		TraceVarEx(Tcl_Interp *interp, const char *part1,
			    const char *part2, VarTrace *tracePtr);

/*
 * The following structure holds the client data for string-based
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
    static const char *const traceOptions[] = {
	"add", "info", "remove",
#ifndef TCL_REMOVE_OBSOLETE_TRACES
	"variable", "vdelete", "vinfo",
#endif
	NULL
    };
    /* 'OLD' options are pre-Tcl-8.4 style */
    enum traceOptions optionIndex;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
	return TCL_ERROR;
    }

    if (Tcl_GetIndexFromObj(interp, objv[1], traceOptions, "option", 0,







<
|







203
204
205
206
207
208
209

210
211
212
213
214
215
216
217
    static const char *const traceOptions[] = {
	"add", "info", "remove",
#ifndef TCL_REMOVE_OBSOLETE_TRACES
	"variable", "vdelete", "vinfo",
#endif
	NULL
    };

    enum traceOptionsEnum optionIndex;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
	return TCL_ERROR;
    }

    if (Tcl_GetIndexFromObj(interp, objv[1], traceOptions, "option", 0,
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280

#ifndef TCL_REMOVE_OBSOLETE_TRACES
    case TRACE_OLD_VARIABLE:
    case TRACE_OLD_VDELETE: {
	Tcl_Obj *copyObjv[6];
	Tcl_Obj *opsList;
	int code;
	size_t numFlags;

	if (objc != 5) {
	    Tcl_WrongNumArgs(interp, 2, objv, "name ops command");
	    return TCL_ERROR;
	}

	TclNewObj(opsList);







|







266
267
268
269
270
271
272
273
274
275
276
277
278
279
280

#ifndef TCL_REMOVE_OBSOLETE_TRACES
    case TRACE_OLD_VARIABLE:
    case TRACE_OLD_VDELETE: {
	Tcl_Obj *copyObjv[6];
	Tcl_Obj *opsList;
	int code;
	Tcl_Size numFlags;

	if (objc != 5) {
	    Tcl_WrongNumArgs(interp, 2, objv, "name ops command");
	    return TCL_ERROR;
	}

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

static int
TraceExecutionObjCmd(
    Tcl_Interp *interp,		/* Current interpreter. */
	enum traceOptions optionIndex,		/* Add, info or remove */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *name, *command;
    size_t commandLength, length;
    static const char *const opStrings[] = {
	"enter", "leave", "enterstep", "leavestep", NULL
    };
    enum operations {
	TRACE_EXEC_ENTER, TRACE_EXEC_LEAVE,
	TRACE_EXEC_ENTER_STEP, TRACE_EXEC_LEAVE_STEP
    } index;

    switch (optionIndex) {
    case TRACE_ADD:
    case TRACE_REMOVE: {
	int flags = 0, result;
	size_t i, listLen;
	Tcl_Obj **elemPtrs;

	if (objc != 6) {
	    Tcl_WrongNumArgs(interp, 3, objv, "name opList command");
	    return TCL_ERROR;
	}

	/*
	 * Make sure the ops argument is a list object; get its length and a
	 * pointer to its array of element pointers.
	 */

	result = TclListObjGetElementsM(interp, objv[4], &listLen, &elemPtrs);
	if (result != TCL_OK) {
	    return result;
	}
	if (listLen == 0) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "bad operation list \"\": must be one or more of"
		    " enter, leave, enterstep, or leavestep", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS",
		    NULL);
	    return TCL_ERROR;




	}
	for (i = 0; i < listLen; i++) {
	    if (Tcl_GetIndexFromObj(interp, elemPtrs[i], opStrings,
		    "operation", TCL_EXACT, &index) != TCL_OK) {
		return TCL_ERROR;
	    }
	    switch (index) {







|
|



|












|












|










>
>
>
>







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

static int
TraceExecutionObjCmd(
    Tcl_Interp *interp,		/* Current interpreter. */
    enum traceOptionsEnum optionIndex,		/* Add, info or remove */
    Tcl_Size objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *name, *command;
    Tcl_Size length;
    static const char *const opStrings[] = {
	"enter", "leave", "enterstep", "leavestep", NULL
    };
    enum operations {
	TRACE_EXEC_ENTER, TRACE_EXEC_LEAVE,
	TRACE_EXEC_ENTER_STEP, TRACE_EXEC_LEAVE_STEP
    } index;

    switch (optionIndex) {
    case TRACE_ADD:
    case TRACE_REMOVE: {
	int flags = 0, result;
	Tcl_Size i, listLen;
	Tcl_Obj **elemPtrs;

	if (objc != 6) {
	    Tcl_WrongNumArgs(interp, 3, objv, "name opList command");
	    return TCL_ERROR;
	}

	/*
	 * Make sure the ops argument is a list object; get its length and a
	 * pointer to its array of element pointers.
	 */

	result = TclListObjLengthM(interp, objv[4], &listLen);
	if (result != TCL_OK) {
	    return result;
	}
	if (listLen == 0) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "bad operation list \"\": must be one or more of"
		    " enter, leave, enterstep, or leavestep", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS",
		    NULL);
	    return TCL_ERROR;
	}
	result = TclListObjGetElementsM(interp, objv[4], &listLen, &elemPtrs);
	if (result != TCL_OK) {
	    return result;
	}
	for (i = 0; i < listLen; i++) {
	    if (Tcl_GetIndexFromObj(interp, elemPtrs[i], opStrings,
		    "operation", TCL_EXACT, &index) != TCL_OK) {
		return TCL_ERROR;
	    }
	    switch (index) {
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
		flags |= TCL_TRACE_ENTER_DURING_EXEC;
		break;
	    case TRACE_EXEC_LEAVE_STEP:
		flags |= TCL_TRACE_LEAVE_DURING_EXEC;
		break;
	    }
	}
	command = Tcl_GetStringFromObj(objv[5], &commandLength);
	length = commandLength;
	if (optionIndex == TRACE_ADD) {
	    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)Tcl_Alloc(
		    offsetof(TraceCommandInfo, command) + 1 + length);

	    tcmdPtr->flags = flags;
	    tcmdPtr->stepTrace = NULL;
	    tcmdPtr->startLevel = 0;







|
<







461
462
463
464
465
466
467
468

469
470
471
472
473
474
475
		flags |= TCL_TRACE_ENTER_DURING_EXEC;
		break;
	    case TRACE_EXEC_LEAVE_STEP:
		flags |= TCL_TRACE_LEAVE_DURING_EXEC;
		break;
	    }
	}
	command = Tcl_GetStringFromObj(objv[5], &length);

	if (optionIndex == TRACE_ADD) {
	    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)Tcl_Alloc(
		    offsetof(TraceCommandInfo, command) + 1 + length);

	    tcmdPtr->flags = flags;
	    tcmdPtr->stepTrace = NULL;
	    tcmdPtr->startLevel = 0;
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581

	if (Tcl_FindCommand(interp, name, NULL, TCL_LEAVE_ERR_MSG) == NULL) {
	    return TCL_ERROR;
	}

	resultListPtr = Tcl_NewListObj(0, NULL);
	FOREACH_COMMAND_TRACE(interp, name, clientData) {
	    size_t numOps = 0;
	    Tcl_Obj *opObj, *eachTraceObjPtr, *elemObjPtr;
	    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData;

	    /*
	     * Build a list with the ops list as the first obj element and the
	     * tcmdPtr->command string as the second obj element. Append this
	     * list (as an element) to the end of the result object list.







|







570
571
572
573
574
575
576
577
578
579
580
581
582
583
584

	if (Tcl_FindCommand(interp, name, NULL, TCL_LEAVE_ERR_MSG) == NULL) {
	    return TCL_ERROR;
	}

	resultListPtr = Tcl_NewListObj(0, NULL);
	FOREACH_COMMAND_TRACE(interp, name, clientData) {
	    Tcl_Size numOps = 0;
	    Tcl_Obj *opObj, *eachTraceObjPtr, *elemObjPtr;
	    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData;

	    /*
	     * Build a list with the ops list as the first obj element and the
	     * tcmdPtr->command string as the second obj element. Append this
	     * list (as an element) to the end of the result object list.
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
 *
 *----------------------------------------------------------------------
 */

static int
TraceCommandObjCmd(
    Tcl_Interp *interp,		/* Current interpreter. */
	enum traceOptions optionIndex,		/* Add, info or remove */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *name, *command;
    size_t commandLength, length;
    static const char *const opStrings[] = { "delete", "rename", NULL };
    enum operations { TRACE_CMD_DELETE, TRACE_CMD_RENAME } index;

    switch (optionIndex) {
    case TRACE_ADD:
    case TRACE_REMOVE: {
	int flags = 0, result;
	size_t i, listLen;
	Tcl_Obj **elemPtrs;

	if (objc != 6) {
	    Tcl_WrongNumArgs(interp, 3, objv, "name opList command");
	    return TCL_ERROR;
	}

	/*
	 * Make sure the ops argument is a list object; get its length and a
	 * pointer to its array of element pointers.
	 */

	result = TclListObjGetElementsM(interp, objv[4], &listLen, &elemPtrs);
	if (result != TCL_OK) {
	    return result;
	}
	if (listLen == 0) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "bad operation list \"\": must be one or more of"
		    " delete or rename", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS",
		    NULL);
	    return TCL_ERROR;
	}




	for (i = 0; i < listLen; i++) {
	    if (Tcl_GetIndexFromObj(interp, elemPtrs[i], opStrings,
		    "operation", TCL_EXACT, &index) != TCL_OK) {
		return TCL_ERROR;
	    }
	    switch (index) {
	    case TRACE_CMD_RENAME:
		flags |= TCL_TRACE_RENAME;
		break;
	    case TRACE_CMD_DELETE:
		flags |= TCL_TRACE_DELETE;
		break;
	    }
	}

	command = Tcl_GetStringFromObj(objv[5], &commandLength);
	length = commandLength;
	if (optionIndex == TRACE_ADD) {
	    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)Tcl_Alloc(
		    offsetof(TraceCommandInfo, command) + 1 + length);

	    tcmdPtr->flags = flags;
	    tcmdPtr->stepTrace = NULL;
	    tcmdPtr->startLevel = 0;







|
|



|







|












|











>
>
>
|















|
<







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

static int
TraceCommandObjCmd(
    Tcl_Interp *interp,		/* Current interpreter. */
    enum traceOptionsEnum optionIndex,		/* Add, info or remove */
    Tcl_Size objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *name, *command;
    Tcl_Size length;
    static const char *const opStrings[] = { "delete", "rename", NULL };
    enum operations { TRACE_CMD_DELETE, TRACE_CMD_RENAME } index;

    switch (optionIndex) {
    case TRACE_ADD:
    case TRACE_REMOVE: {
	int flags = 0, result;
	Tcl_Size i, listLen;
	Tcl_Obj **elemPtrs;

	if (objc != 6) {
	    Tcl_WrongNumArgs(interp, 3, objv, "name opList command");
	    return TCL_ERROR;
	}

	/*
	 * Make sure the ops argument is a list object; get its length and a
	 * pointer to its array of element pointers.
	 */

	result = TclListObjLengthM(interp, objv[4], &listLen);
	if (result != TCL_OK) {
	    return result;
	}
	if (listLen == 0) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "bad operation list \"\": must be one or more of"
		    " delete or rename", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS",
		    NULL);
	    return TCL_ERROR;
	}
	result = TclListObjGetElementsM(interp, objv[4], &listLen, &elemPtrs);
	if (result != TCL_OK) {
	    return result;
	}
	for (i = 0; i < listLen; i++) {
	    if (Tcl_GetIndexFromObj(interp, elemPtrs[i], opStrings,
		    "operation", TCL_EXACT, &index) != TCL_OK) {
		return TCL_ERROR;
	    }
	    switch (index) {
	    case TRACE_CMD_RENAME:
		flags |= TCL_TRACE_RENAME;
		break;
	    case TRACE_CMD_DELETE:
		flags |= TCL_TRACE_DELETE;
		break;
	    }
	}

	command = Tcl_GetStringFromObj(objv[5], &length);

	if (optionIndex == TRACE_ADD) {
	    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)Tcl_Alloc(
		    offsetof(TraceCommandInfo, command) + 1 + length);

	    tcmdPtr->flags = flags;
	    tcmdPtr->stepTrace = NULL;
	    tcmdPtr->startLevel = 0;
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
	name = TclGetString(objv[3]);
	if (Tcl_FindCommand(interp, name, NULL, TCL_LEAVE_ERR_MSG) == NULL) {
	    return TCL_ERROR;
	}

	resultListPtr = Tcl_NewListObj(0, NULL);
	FOREACH_COMMAND_TRACE(interp, name, clientData) {
	    size_t numOps = 0;
	    Tcl_Obj *opObj, *eachTraceObjPtr, *elemObjPtr;
	    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData;

	    /*
	     * Build a list with the ops list as the first obj element and the
	     * tcmdPtr->command string as the second obj element. Append this
	     * list (as an element) to the end of the result object list.







|







777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
	name = TclGetString(objv[3]);
	if (Tcl_FindCommand(interp, name, NULL, TCL_LEAVE_ERR_MSG) == NULL) {
	    return TCL_ERROR;
	}

	resultListPtr = Tcl_NewListObj(0, NULL);
	FOREACH_COMMAND_TRACE(interp, name, clientData) {
	    Tcl_Size numOps = 0;
	    Tcl_Obj *opObj, *eachTraceObjPtr, *elemObjPtr;
	    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData;

	    /*
	     * Build a list with the ops list as the first obj element and the
	     * tcmdPtr->command string as the second obj element. Append this
	     * list (as an element) to the end of the result object list.
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
 *
 *----------------------------------------------------------------------
 */

static int
TraceVariableObjCmd(
    Tcl_Interp *interp,		/* Current interpreter. */
	enum traceOptions optionIndex,		/* Add, info or remove */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *name, *command;
    size_t commandLength, length;
    void *clientData;
    static const char *const opStrings[] = {
	"array", "read", "unset", "write", NULL
    };
    enum operations {
	TRACE_VAR_ARRAY, TRACE_VAR_READ, TRACE_VAR_UNSET, TRACE_VAR_WRITE
    } index;

    switch (optionIndex) {
    case TRACE_ADD:
    case TRACE_REMOVE: {
	int flags = 0, result;
	size_t i, listLen;
	Tcl_Obj **elemPtrs;

	if (objc != 6) {
	    Tcl_WrongNumArgs(interp, 3, objv, "name opList command");
	    return TCL_ERROR;
	}

	/*
	 * Make sure the ops argument is a list object; get its length and a
	 * pointer to its array of element pointers.
	 */

	result = TclListObjGetElementsM(interp, objv[4], &listLen, &elemPtrs);
	if (result != TCL_OK) {
	    return result;
	}
	if (listLen == 0) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "bad operation list \"\": must be one or more of"
		    " array, read, unset, or write", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS",
		    NULL);
	    return TCL_ERROR;




	}
	for (i = 0; i < listLen ; i++) {
	    if (Tcl_GetIndexFromObj(interp, elemPtrs[i], opStrings,
		    "operation", TCL_EXACT, &index) != TCL_OK) {
		return TCL_ERROR;
	    }
	    switch (index) {







|
|



|












|












|










>
>
>
>







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

static int
TraceVariableObjCmd(
    Tcl_Interp *interp,		/* Current interpreter. */
    enum traceOptionsEnum optionIndex,		/* Add, info or remove */
    Tcl_Size objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *name, *command;
    Tcl_Size length;
    void *clientData;
    static const char *const opStrings[] = {
	"array", "read", "unset", "write", NULL
    };
    enum operations {
	TRACE_VAR_ARRAY, TRACE_VAR_READ, TRACE_VAR_UNSET, TRACE_VAR_WRITE
    } index;

    switch (optionIndex) {
    case TRACE_ADD:
    case TRACE_REMOVE: {
	int flags = 0, result;
	Tcl_Size i, listLen;
	Tcl_Obj **elemPtrs;

	if (objc != 6) {
	    Tcl_WrongNumArgs(interp, 3, objv, "name opList command");
	    return TCL_ERROR;
	}

	/*
	 * Make sure the ops argument is a list object; get its length and a
	 * pointer to its array of element pointers.
	 */

	result = TclListObjLengthM(interp, objv[4], &listLen);
	if (result != TCL_OK) {
	    return result;
	}
	if (listLen == 0) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "bad operation list \"\": must be one or more of"
		    " array, read, unset, or write", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS",
		    NULL);
	    return TCL_ERROR;
	}
	result = TclListObjGetElementsM(interp, objv[4], &listLen, &elemPtrs);
	if (result != TCL_OK) {
	    return result;
	}
	for (i = 0; i < listLen ; i++) {
	    if (Tcl_GetIndexFromObj(interp, elemPtrs[i], opStrings,
		    "operation", TCL_EXACT, &index) != TCL_OK) {
		return TCL_ERROR;
	    }
	    switch (index) {
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
		flags |= TCL_TRACE_UNSETS;
		break;
	    case TRACE_VAR_WRITE:
		flags |= TCL_TRACE_WRITES;
		break;
	    }
	}
	command = Tcl_GetStringFromObj(objv[5], &commandLength);
	length = commandLength;
	if (optionIndex == TRACE_ADD) {
	    CombinedTraceVarInfo *ctvarPtr = (CombinedTraceVarInfo *)Tcl_Alloc(
		    offsetof(CombinedTraceVarInfo, traceCmdInfo.command)
		    + 1 + length);

	    ctvarPtr->traceCmdInfo.flags = flags;
#ifndef TCL_REMOVE_OBSOLETE_TRACES







|
<







910
911
912
913
914
915
916
917

918
919
920
921
922
923
924
		flags |= TCL_TRACE_UNSETS;
		break;
	    case TRACE_VAR_WRITE:
		flags |= TCL_TRACE_WRITES;
		break;
	    }
	}
	command = Tcl_GetStringFromObj(objv[5], &length);

	if (optionIndex == TRACE_ADD) {
	    CombinedTraceVarInfo *ctvarPtr = (CombinedTraceVarInfo *)Tcl_Alloc(
		    offsetof(CombinedTraceVarInfo, traceCmdInfo.command)
		    + 1 + length);

	    ctvarPtr->traceCmdInfo.flags = flags;
#ifndef TCL_REMOVE_OBSOLETE_TRACES
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

ClientData
Tcl_CommandTraceInfo(
    Tcl_Interp *interp,		/* Interpreter containing command. */
    const char *cmdName,	/* Name of command. */
    TCL_UNUSED(int) /*flags*/,
    Tcl_CommandTraceProc *proc,	/* Function assocated with trace. */
    void *prevClientData)	/* If non-NULL, gives last value returned by
				 * this function, so this call will return the







|







1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void *
Tcl_CommandTraceInfo(
    Tcl_Interp *interp,		/* Interpreter containing command. */
    const char *cmdName,	/* Name of command. */
    TCL_UNUSED(int) /*flags*/,
    Tcl_CommandTraceProc *proc,	/* Function assocated with trace. */
    void *prevClientData)	/* If non-NULL, gives last value returned by
				 * this function, so this call will return the
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
 *	function to be invoked.
 *
 * Results:
 *	A standard Tcl return value.
 *
 * Side effects:
 *	A trace is set up on the command given by cmdName, such that future
 *	changes to the command will be intermediated by proc. See the manual
 *	entry for complete details on the calling sequence for proc.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_TraceCommand(







|







1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
 *	function to be invoked.
 *
 * Results:
 *	A standard Tcl return value.
 *
 * Side effects:
 *	A trace is set up on the command given by cmdName, such that future
 *	changes to the command will be mediated by proc. See the manual
 *	entry for complete details on the calling sequence for proc.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_TraceCommand(
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
 */

int
TclCheckExecutionTraces(
    Tcl_Interp *interp,		/* The current interpreter. */
    const char *command,	/* Pointer to beginning of the current command
				 * string. */
    TCL_UNUSED(size_t) /*numChars*/,
    Command *cmdPtr,		/* Points to command's Command struct. */
    int code,			/* The current result code. */
    int traceFlags,		/* Current tracing situation. */
    size_t objc,			/* Number of arguments for the command. */
    Tcl_Obj *const objv[])	/* Pointers to Tcl_Obj of each argument. */
{
    Interp *iPtr = (Interp *) interp;
    CommandTrace *tracePtr, *lastTracePtr;
    ActiveCommandTrace active;
    int curLevel;
    int traceCode = TCL_OK;
    Tcl_InterpState state = NULL;

    if (cmdPtr->tracePtr == NULL) {
	return traceCode;
    }








|



|





|







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

int
TclCheckExecutionTraces(
    Tcl_Interp *interp,		/* The current interpreter. */
    const char *command,	/* Pointer to beginning of the current command
				 * string. */
    TCL_UNUSED(Tcl_Size) /*numChars*/,
    Command *cmdPtr,		/* Points to command's Command struct. */
    int code,			/* The current result code. */
    int traceFlags,		/* Current tracing situation. */
    Tcl_Size objc,			/* Number of arguments for the command. */
    Tcl_Obj *const objv[])	/* Pointers to Tcl_Obj of each argument. */
{
    Interp *iPtr = (Interp *) interp;
    CommandTrace *tracePtr, *lastTracePtr;
    ActiveCommandTrace active;
    Tcl_Size curLevel;
    int traceCode = TCL_OK;
    Tcl_InterpState state = NULL;

    if (cmdPtr->tracePtr == NULL) {
	return traceCode;
    }

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

int
TclCheckInterpTraces(
    Tcl_Interp *interp,		/* The current interpreter. */
    const char *command,	/* Pointer to beginning of the current command
				 * string. */
    size_t numChars,		/* The number of characters in 'command' which
				 * are part of the command string. */
    Command *cmdPtr,		/* Points to command's Command struct. */
    int code,			/* The current result code. */
    int traceFlags,		/* Current tracing situation. */
    size_t objc,			/* Number of arguments for the command. */
    Tcl_Obj *const objv[])	/* Pointers to Tcl_Obj of each argument. */
{
    Interp *iPtr = (Interp *) interp;
    Trace *tracePtr, *lastTracePtr;
    ActiveInterpTrace active;
    int curLevel;
    int traceCode = TCL_OK;
    Tcl_InterpState state = NULL;

    if ((iPtr->tracePtr == NULL)
	    || (iPtr->flags & INTERP_TRACE_IN_PROGRESS)) {
	return(traceCode);
    }







|




|





|







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

int
TclCheckInterpTraces(
    Tcl_Interp *interp,		/* The current interpreter. */
    const char *command,	/* Pointer to beginning of the current command
				 * string. */
    Tcl_Size numChars,		/* The number of characters in 'command' which
				 * are part of the command string. */
    Command *cmdPtr,		/* Points to command's Command struct. */
    int code,			/* The current result code. */
    int traceFlags,		/* Current tracing situation. */
    Tcl_Size objc,			/* Number of arguments for the command. */
    Tcl_Obj *const objv[])	/* Pointers to Tcl_Obj of each argument. */
{
    Interp *iPtr = (Interp *) interp;
    Trace *tracePtr, *lastTracePtr;
    ActiveInterpTrace active;
    Tcl_Size curLevel;
    int traceCode = TCL_OK;
    Tcl_InterpState state = NULL;

    if ((iPtr->tracePtr == NULL)
	    || (iPtr->flags & INTERP_TRACE_IN_PROGRESS)) {
	return(traceCode);
    }
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
static int
CallTraceFunction(
    Tcl_Interp *interp,		/* The current interpreter. */
    Trace *tracePtr,	/* Describes the trace function to call. */
    Command *cmdPtr,		/* Points to command's Command struct. */
    const char *command,	/* Points to the first character of the
				 * command's source before substitutions. */
    size_t numChars,		/* The number of characters in the command's
				 * source. */
    int objc,		/* Number of arguments for the command. */
    Tcl_Obj *const objv[])	/* Pointers to Tcl_Obj of each argument. */
{
    Interp *iPtr = (Interp *) interp;
    char *commandCopy;
    int traceCode;

    /*







|

|







1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
static int
CallTraceFunction(
    Tcl_Interp *interp,		/* The current interpreter. */
    Trace *tracePtr,	/* Describes the trace function to call. */
    Command *cmdPtr,		/* Points to command's Command struct. */
    const char *command,	/* Points to the first character of the
				 * command's source before substitutions. */
    Tcl_Size numChars,		/* The number of characters in the command's
				 * source. */
    Tcl_Size objc,		/* Number of arguments for the command. */
    Tcl_Obj *const objv[])	/* Pointers to Tcl_Obj of each argument. */
{
    Interp *iPtr = (Interp *) interp;
    char *commandCopy;
    int traceCode;

    /*
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
 *----------------------------------------------------------------------
 */

static int
TraceExecutionProc(
    void *clientData,
    Tcl_Interp *interp,
    int level,
    const char *command,
    TCL_UNUSED(Tcl_Command),
    int objc,
    Tcl_Obj *const objv[])
{
    int call = 0;
    Interp *iPtr = (Interp *) interp;
    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData;
    int flags = tcmdPtr->curFlags;
    int code = tcmdPtr->curCode;







|


|







1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
 *----------------------------------------------------------------------
 */

static int
TraceExecutionProc(
    void *clientData,
    Tcl_Interp *interp,
    Tcl_Size level,
    const char *command,
    TCL_UNUSED(Tcl_Command),
    Tcl_Size objc,
    Tcl_Obj *const objv[])
{
    int call = 0;
    Interp *iPtr = (Interp *) interp;
    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData;
    int flags = tcmdPtr->curFlags;
    int code = tcmdPtr->curCode;
1814
1815
1816
1817
1818
1819
1820

1821
1822
1823
1824
1825
1826
1827
1828

	/*
	 * Second, create the tcl callback, if required.
	 */

	if (call) {
	    Tcl_DString cmd, sub;

	    int i, saveInterpFlags;

	    Tcl_DStringInit(&cmd);
	    Tcl_DStringAppend(&cmd, tcmdPtr->command, tcmdPtr->length);

	    /*
	     * Append command with arguments.
	     */







>
|







1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837

	/*
	 * Second, create the tcl callback, if required.
	 */

	if (call) {
	    Tcl_DString cmd, sub;
	    Tcl_Size i;
	    int saveInterpFlags;

	    Tcl_DStringInit(&cmd);
	    Tcl_DStringAppend(&cmd, tcmdPtr->command, tcmdPtr->length);

	    /*
	     * Append command with arguments.
	     */
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
			TCL_TRACE_LEAVE_DURING_EXEC))) {
	    unsigned len = strlen(command) + 1;

	    tcmdPtr->startLevel = level;
	    tcmdPtr->startCmd = (char *)Tcl_Alloc(len);
	    memcpy(tcmdPtr->startCmd, command, len);
	    tcmdPtr->refCount++;
	    tcmdPtr->stepTrace = Tcl_CreateObjTrace(interp, 0,
		   (tcmdPtr->flags & TCL_TRACE_ANY_EXEC) >> 2,
		   TraceExecutionProc, tcmdPtr, CommandObjTraceDeleted);
	}
    }
    if (flags & TCL_TRACE_DESTROYED) {
	if (tcmdPtr->stepTrace != NULL) {
	    Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);







|







1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
			TCL_TRACE_LEAVE_DURING_EXEC))) {
	    unsigned len = strlen(command) + 1;

	    tcmdPtr->startLevel = level;
	    tcmdPtr->startCmd = (char *)Tcl_Alloc(len);
	    memcpy(tcmdPtr->startCmd, command, len);
	    tcmdPtr->refCount++;
	    tcmdPtr->stepTrace = Tcl_CreateObjTrace2(interp, 0,
		   (tcmdPtr->flags & TCL_TRACE_ANY_EXEC) >> 2,
		   TraceExecutionProc, tcmdPtr, CommandObjTraceDeleted);
	}
    }
    if (flags & TCL_TRACE_DESTROYED) {
	if (tcmdPtr->stepTrace != NULL) {
	    Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
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
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateObjTrace --
 *
 *	Arrange for a function to be called to trace command execution.
 *
 * Results:
 *	The return value is a token for the trace, which may be passed to
 *	Tcl_DeleteTrace to eliminate the trace.
 *
 * Side effects:
 *	From now on, proc will be called just before a command function is
 *	called to execute a Tcl command. Calls to proc will have the following
 *	form:
 *
 *	void proc(ClientData	 clientData,
 *		  Tcl_Interp *	 interp,
 *		  int		 level,
 *		  const char *	 command,
 *		  Tcl_Command	 commandInfo,
 *		  int		 objc,
 *		  Tcl_Obj *const objv[]);
 *







|












|







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
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateObjTrace/Tcl_CreateObjTrace2 --
 *
 *	Arrange for a function to be called to trace command execution.
 *
 * Results:
 *	The return value is a token for the trace, which may be passed to
 *	Tcl_DeleteTrace to eliminate the trace.
 *
 * Side effects:
 *	From now on, proc will be called just before a command function is
 *	called to execute a Tcl command. Calls to proc will have the following
 *	form:
 *
 *	void proc(void   *	 clientData,
 *		  Tcl_Interp *	 interp,
 *		  int		 level,
 *		  const char *	 command,
 *		  Tcl_Command	 commandInfo,
 *		  int		 objc,
 *		  Tcl_Obj *const objv[]);
 *
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
 *	When the trace is deleted, the 'delProc' function will be invoked,
 *	passing it the original client data.
 *
 *----------------------------------------------------------------------
 */

typedef struct {
    Tcl_CmdObjTraceProc2 *proc;
    Tcl_CmdObjTraceDeleteProc *delProc;
    void *clientData;
} TraceWrapperInfo;

static int traceWrapperProc(
    void *clientData,
    Tcl_Interp *interp,
	int level,
    const char *command,
    Tcl_Command commandInfo,
    int objc,
    Tcl_Obj *const objv[])
{
    TraceWrapperInfo *info = (TraceWrapperInfo *)clientData;



    return info->proc(info->clientData, interp, level, command, commandInfo, objc, objv);
}

static void traceWrapperDelProc(void *clientData)
{
    TraceWrapperInfo *info = (TraceWrapperInfo *)clientData;
    clientData = info->clientData;
    if (info->delProc) {
	info->delProc(clientData);
    }
    Tcl_Free(info);
}

Tcl_Trace
Tcl_CreateObjTrace2(
    Tcl_Interp *interp,		/* Tcl interpreter */
    int level,			/* Maximum nesting level */
    int flags,			/* Flags, see above */
    Tcl_CmdObjTraceProc2 *proc,	/* Trace callback */
    void *clientData,	/* Client data for the callback */
    Tcl_CmdObjTraceDeleteProc *delProc)
				/* Function to call when trace is deleted */
{
    TraceWrapperInfo *info = (TraceWrapperInfo *)Tcl_Alloc(sizeof(TraceWrapperInfo));
    info->proc = proc;
    info->delProc = delProc;
    info->clientData = clientData;
    return Tcl_CreateObjTrace(interp, level, flags,
	    (proc ? traceWrapperProc : NULL),
	    info, traceWrapperDelProc);
}

Tcl_Trace
Tcl_CreateObjTrace(
    Tcl_Interp *interp,		/* Tcl interpreter */
    int level,			/* Maximum nesting level */
    int flags,			/* Flags, see above */
    Tcl_CmdObjTraceProc *proc,	/* Trace callback */
    void *clientData,	/* Client data for the callback */
    Tcl_CmdObjTraceDeleteProc *delProc)
				/* Function to call when trace is deleted */
{
    Trace *tracePtr;
    Interp *iPtr = (Interp *) interp;








|







|


|



>
>
>
|













|

|

|








|





|

|

|







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
 *	When the trace is deleted, the 'delProc' function will be invoked,
 *	passing it the original client data.
 *
 *----------------------------------------------------------------------
 */

typedef struct {
    Tcl_CmdObjTraceProc *proc;
    Tcl_CmdObjTraceDeleteProc *delProc;
    void *clientData;
} TraceWrapperInfo;

static int traceWrapperProc(
    void *clientData,
    Tcl_Interp *interp,
    Tcl_Size level,
    const char *command,
    Tcl_Command commandInfo,
    Tcl_Size objc,
    Tcl_Obj *const objv[])
{
    TraceWrapperInfo *info = (TraceWrapperInfo *)clientData;
    if (objc > INT_MAX) {
	objc = -1; /* Signal Tcl_CmdObjTraceProc that objc is out of range */
    }
    return info->proc(info->clientData, interp, (int)level, command, commandInfo, objc, objv);
}

static void traceWrapperDelProc(void *clientData)
{
    TraceWrapperInfo *info = (TraceWrapperInfo *)clientData;
    clientData = info->clientData;
    if (info->delProc) {
	info->delProc(clientData);
    }
    Tcl_Free(info);
}

Tcl_Trace
Tcl_CreateObjTrace(
    Tcl_Interp *interp,		/* Tcl interpreter */
    Tcl_Size level,			/* Maximum nesting level */
    int flags,			/* Flags, see above */
    Tcl_CmdObjTraceProc *proc,	/* Trace callback */
    void *clientData,	/* Client data for the callback */
    Tcl_CmdObjTraceDeleteProc *delProc)
				/* Function to call when trace is deleted */
{
    TraceWrapperInfo *info = (TraceWrapperInfo *)Tcl_Alloc(sizeof(TraceWrapperInfo));
    info->proc = proc;
    info->delProc = delProc;
    info->clientData = clientData;
    return Tcl_CreateObjTrace2(interp, level, flags,
	    (proc ? traceWrapperProc : NULL),
	    info, traceWrapperDelProc);
}

Tcl_Trace
Tcl_CreateObjTrace2(
    Tcl_Interp *interp,		/* Tcl interpreter */
    Tcl_Size level,			/* Maximum nesting level */
    int flags,			/* Flags, see above */
    Tcl_CmdObjTraceProc2 *proc,	/* Trace callback */
    void *clientData,	/* Client data for the callback */
    Tcl_CmdObjTraceDeleteProc *delProc)
				/* Function to call when trace is deleted */
{
    Trace *tracePtr;
    Interp *iPtr = (Interp *) interp;

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

Tcl_Trace
Tcl_CreateTrace(
    Tcl_Interp *interp,		/* Interpreter in which to create trace. */
    int level,			/* Only call proc for commands at nesting
				 * level<=argument level (1=>top level). */
    Tcl_CmdTraceProc *proc,	/* Function to call before executing each
				 * command. */
    void *clientData)	/* Arbitrary value word to pass to proc. */
{
    StringTraceData *data = (StringTraceData *)Tcl_Alloc(sizeof(StringTraceData));

    data->clientData = clientData;
    data->proc = proc;
    return Tcl_CreateObjTrace(interp, level, 0, StringTraceProc,
	    data, StringTraceDeleteProc);
}

/*
 *----------------------------------------------------------------------
 *
 * StringTraceProc --







|









|







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

Tcl_Trace
Tcl_CreateTrace(
    Tcl_Interp *interp,		/* Interpreter in which to create trace. */
    Tcl_Size level,			/* Only call proc for commands at nesting
				 * level<=argument level (1=>top level). */
    Tcl_CmdTraceProc *proc,	/* Function to call before executing each
				 * command. */
    void *clientData)	/* Arbitrary value word to pass to proc. */
{
    StringTraceData *data = (StringTraceData *)Tcl_Alloc(sizeof(StringTraceData));

    data->clientData = clientData;
    data->proc = proc;
    return Tcl_CreateObjTrace2(interp, level, 0, StringTraceProc,
	    data, StringTraceDeleteProc);
}

/*
 *----------------------------------------------------------------------
 *
 * StringTraceProc --
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
 *----------------------------------------------------------------------
 */

static int
StringTraceProc(
    void *clientData,
    Tcl_Interp *interp,
    int level,
    const char *command,
    Tcl_Command commandInfo,
    int objc,
    Tcl_Obj *const *objv)
{
    StringTraceData *data = (StringTraceData *)clientData;
    Command *cmdPtr = (Command *) commandInfo;
    const char **argv;		/* Args to pass to string trace proc */
    int i;

    /*
     * This is a bit messy because we have to emulate the old trace interface,
     * which uses strings for everything.
     */

    argv = (const char **) TclStackAlloc(interp,







|


|





|







2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
 *----------------------------------------------------------------------
 */

static int
StringTraceProc(
    void *clientData,
    Tcl_Interp *interp,
    Tcl_Size level,
    const char *command,
    Tcl_Command commandInfo,
    Tcl_Size objc,
    Tcl_Obj *const *objv)
{
    StringTraceData *data = (StringTraceData *)clientData;
    Command *cmdPtr = (Command *) commandInfo;
    const char **argv;		/* Args to pass to string trace proc */
    Tcl_Size i;

    /*
     * This is a bit messy because we have to emulate the old trace interface,
     * which uses strings for everything.
     */

    argv = (const char **) TclStackAlloc(interp,
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
    const char *part2,		/* Name of element within array; NULL means
				 * trace applies to scalar variable or array
				 * as-a-whole. */
    int flags,			/* OR-ed collection of bits describing current
				 * trace, including any of TCL_TRACE_READS,
				 * TCL_TRACE_WRITES, TCL_TRACE_UNSETS,
				 * TCL_GLOBAL_ONLY, and TCL_NAMESPACE_ONLY. */
    Tcl_VarTraceProc *proc,	/* Function assocated with trace. */
    void *clientData)	/* Arbitrary argument to pass to proc. */
{
    VarTrace *tracePtr;
    VarTrace *prevPtr, *nextPtr;
    Var *varPtr, *arrayPtr;
    Interp *iPtr = (Interp *) interp;
    ActiveVarTrace *activePtr;







|







2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
    const char *part2,		/* Name of element within array; NULL means
				 * trace applies to scalar variable or array
				 * as-a-whole. */
    int flags,			/* OR-ed collection of bits describing current
				 * trace, including any of TCL_TRACE_READS,
				 * TCL_TRACE_WRITES, TCL_TRACE_UNSETS,
				 * TCL_GLOBAL_ONLY, and TCL_NAMESPACE_ONLY. */
    Tcl_VarTraceProc *proc,	/* Function associated with trace. */
    void *clientData)	/* Arbitrary argument to pass to proc. */
{
    VarTrace *tracePtr;
    VarTrace *prevPtr, *nextPtr;
    Var *varPtr, *arrayPtr;
    Interp *iPtr = (Interp *) interp;
    ActiveVarTrace *activePtr;
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

ClientData
Tcl_VarTraceInfo2(
    Tcl_Interp *interp,		/* Interpreter containing variable. */
    const char *part1,		/* Name of variable or array. */
    const char *part2,		/* Name of element within array; NULL means
				 * trace applies to scalar variable or array
				 * as-a-whole. */
    int flags,			/* OR-ed combination of TCL_GLOBAL_ONLY,
				 * TCL_NAMESPACE_ONLY. */
    Tcl_VarTraceProc *proc,	/* Function assocated with trace. */
    void *prevClientData)	/* If non-NULL, gives last value returned by
				 * this function, so this call will return the
				 * next trace after that one. If NULL, this
				 * call will return the first trace. */
{
    Interp *iPtr = (Interp *) interp;
    Var *varPtr, *arrayPtr;







|








|







3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void *
Tcl_VarTraceInfo2(
    Tcl_Interp *interp,		/* Interpreter containing variable. */
    const char *part1,		/* Name of variable or array. */
    const char *part2,		/* Name of element within array; NULL means
				 * trace applies to scalar variable or array
				 * as-a-whole. */
    int flags,			/* OR-ed combination of TCL_GLOBAL_ONLY,
				 * TCL_NAMESPACE_ONLY. */
    Tcl_VarTraceProc *proc,	/* Function associated with trace. */
    void *prevClientData)	/* If non-NULL, gives last value returned by
				 * this function, so this call will return the
				 * next trace after that one. If NULL, this
				 * call will return the first trace. */
{
    Interp *iPtr = (Interp *) interp;
    Var *varPtr, *arrayPtr;
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
 *	actions.
 *
 * Results:
 *	A standard Tcl return value.
 *
 * Side effects:
 *	A trace is set up on the variable given by part1 and part2, such that
 *	future references to the variable will be intermediated by proc. See
 *	the manual entry for complete details on the calling sequence for
 *	proc. The variable's flags are updated.
 *
 *----------------------------------------------------------------------
 */

int







|







3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
 *	actions.
 *
 * Results:
 *	A standard Tcl return value.
 *
 * Side effects:
 *	A trace is set up on the variable given by part1 and part2, such that
 *	future references to the variable will be mediated by proc. See
 *	the manual entry for complete details on the calling sequence for
 *	proc. The variable's flags are updated.
 *
 *----------------------------------------------------------------------
 */

int
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
 *	actions.
 *
 * Results:
 *	A standard Tcl return value.
 *
 * Side effects:
 *	A trace is set up on the variable given by part1 and part2, such that
 *	future references to the variable will be intermediated by the
 *	traceProc listed in tracePtr. See the manual entry for complete
 *	details on the calling sequence for proc.
 *
 *----------------------------------------------------------------------
 */

static int







|







3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
 *	actions.
 *
 * Results:
 *	A standard Tcl return value.
 *
 * Side effects:
 *	A trace is set up on the variable given by part1 and part2, such that
 *	future references to the variable will be mediated by the
 *	traceProc listed in tracePtr. See the manual entry for complete
 *	details on the calling sequence for proc.
 *
 *----------------------------------------------------------------------
 */

static int

Changes to generic/tclUtf.c.

101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

size_t
TclUtfCount(
    int ch)			/* The Unicode character whose size is returned. */
{
    if ((unsigned)(ch - 1) < (UNICODE_SELF - 1)) {
	return 1;
    }
    if (ch <= 0x7FF) {







|







101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

int
TclUtfCount(
    int ch)			/* The Unicode character whose size is returned. */
{
    if ((unsigned)(ch - 1) < (UNICODE_SELF - 1)) {
	return 1;
    }
    if (ch <= 0x7FF) {
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
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_UniCharToUtf --
 *
 *	Store the given Tcl_UniChar as a sequence of UTF-8 bytes in the
 *	provided buffer. Equivalent to Plan 9 runetochar().
 *
 *	Special handling of Surrogate pairs is handled as follows:
 *	When this function is called for ch being a high surrogate,
 *	the first byte of the 4-byte UTF-8 sequence is produced and
 *	the function returns 1. Calling the function again with a
 *	low surrogate, the remaining 3 bytes of the 4-byte UTF-8
 *	sequence is produced, and the function returns 3. The buffer
 *	is used to remember the high surrogate between the two calls.
 *
 *	If no low surrogate follows the high surrogate (which is actually
 *	illegal), this can be handled reasonably by calling Tcl_UniCharToUtf
 *	again with ch = -1. This will produce a 3-byte UTF-8 sequence
 *	representing the high surrogate.
 *
 * Results:
 *	The return values is the number of bytes in the buffer that were
 *	consumed.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

#undef Tcl_UniCharToUtf
int
Tcl_UniCharToUtf(
    int ch,			/* The Tcl_UniChar to be stored in the
				 * buffer. Can be or'ed with flag TCL_COMBINE */

    char *buf)			/* Buffer in which the UTF-8 representation of
				 * the Tcl_UniChar is stored. Buffer must be
				 * large enough to hold the UTF-8 character
				 * (at most 4 bytes). */

{
#if TCL_UTF_MAX > 3
    int flags = ch;
#endif

    if (ch >= TCL_COMBINE) {
	ch &= (TCL_COMBINE - 1);
    }
    if ((unsigned)(ch - 1) < (UNICODE_SELF - 1)) {
	buf[0] = (char) ch;
	return 1;
    }
    if (ch >= 0) {
	if (ch <= 0x7FF) {
	    buf[1] = (char) ((ch | 0x80) & 0xBF);
	    buf[0] = (char) ((ch >> 6) | 0xC0);
	    return 2;
	}
	if (ch <= 0xFFFF) {
	    if (
#if TCL_UTF_MAX > 3
		    (flags & TCL_COMBINE) &&
#endif
		    ((ch & 0xF800) == 0xD800)) {
		if (ch & 0x0400) {
		    /* Low surrogate */
		    if (((buf[0] & 0xC0) == 0x80) && ((buf[1] & 0xCF) == 0)) {

			/* Previous Tcl_UniChar was a high surrogate, so combine */
			buf[2] = (char) ((ch & 0x3F) | 0x80);
			buf[1] |= (char) (((ch >> 6) & 0x0F) | 0x80);
			return 3;
		    }
		    /* Previous Tcl_UniChar was not a high surrogate, so just output */
		} else {
		    /* High surrogate */




		    ch += 0x40;

		    /* Fill buffer with specific 3-byte (invalid) byte combination,
		       so following low surrogate can recognize it and combine */
		    buf[2] = (char) ((ch << 4) & 0x30);
		    buf[1] = (char) (((ch >> 2) & 0x3F) | 0x80);
		    buf[0] = (char) (((ch >> 8) & 0x07) | 0xF0);
		    return 1;
		}
	    }
	    goto three;
	}
	if (ch <= 0x10FFFF) {
	    buf[3] = (char) ((ch | 0x80) & 0xBF);
	    buf[2] = (char) (((ch >> 6) | 0x80) & 0xBF);
	    buf[1] = (char) (((ch >> 12) | 0x80) & 0xBF);
	    buf[0] = (char) ((ch >> 18) | 0xF0);
	    return 4;
	}
    } else if (ch == -1) {
	if (((buf[0] & 0xC0) == 0x80) && ((buf[1] & 0xCF) == 0)

		&& ((buf[-1] & 0xF8) == 0xF0)) {
	    ch = 0xD7C0 + ((buf[-1] & 0x07) << 8) + ((buf[0] & 0x3F) << 2)


		    + ((buf[1] & 0x30) >> 4);
	    buf[1] = (char) ((ch | 0x80) & 0xBF);
	    buf[0] = (char) (((ch >> 6) | 0x80) & 0xBF);
	    buf[-1] = (char) ((ch >> 12) | 0xE0);
	    return 2;
	}
    }

    ch = 0xFFFD;
three:
    buf[2] = (char) ((ch | 0x80) & 0xBF);
    buf[1] = (char) (((ch >> 6) | 0x80) & 0xBF);
    buf[0] = (char) ((ch >> 12) | 0xE0);
    return 3;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_UniCharToUtfDString --







|
|

|
<
|
|
|
|
<

|
|
<
|


|
<








|

|
|
>
|
<
|
|
>














|
|










|
>

|
|





>
>
>
>

>



|
|






|
|
|
|



|
>
|
|
>
>
|
|
|
|






|
|
|







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
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_UniCharToUtf --
 *
 *	Stores the given Tcl_UniChar as a sequence of UTF-8 bytes in the provided
 *	buffer. Equivalent to Plan 9 runetochar().
 *
 *	Surrogate pairs are handled as follows: When ch is a high surrogate,

 *	the first byte of the 4-byte UTF-8 sequence is stored in the buffer and
 *	the function returns 1. If the function is called again with a low
 *	surrogate and the same buffer, the remaining 3 bytes of the 4-byte
 *	UTF-8 sequence are produced.

 *
 *	If no low surrogate follows the high surrogate (which is actually illegal),
 *	calling Tcl_UniCharToUtf again with ch being -1 produces a 3-byte UTF-8

 *	sequence representing the high surrogate.
 *
 * Results:
 *	Returns the number of bytes stored into the buffer.

 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

#undef Tcl_UniCharToUtf
Tcl_Size
Tcl_UniCharToUtf(
    int ch,	/* The Tcl_UniChar to be stored in the
		 * buffer. Can be or'ed with flag TCL_COMBINE
		 */
    char *buf)	/* Buffer in which the UTF-8 representation of

		 * ch is stored. Must be large enough to hold the UTF-8
		 * character (at most 4 bytes).
		 */
{
#if TCL_UTF_MAX > 3
    int flags = ch;
#endif

    if (ch >= TCL_COMBINE) {
	ch &= (TCL_COMBINE - 1);
    }
    if ((unsigned)(ch - 1) < (UNICODE_SELF - 1)) {
	buf[0] = (char) ch;
	return 1;
    }
    if (ch >= 0) {
	if (ch <= 0x7FF) {
	    buf[1] = (char) (0x80 | (0x3F & ch));
	    buf[0] = (char) (0xC0 | (ch >> 6));
	    return 2;
	}
	if (ch <= 0xFFFF) {
	    if (
#if TCL_UTF_MAX > 3
		    (flags & TCL_COMBINE) &&
#endif
		    ((ch & 0xF800) == 0xD800)) {
		if (ch & 0x0400) {
		    /* Low surrogate */
		    if (   (0x80 == (0xC0 & buf[0]))
			&& (0    == (0xCF & buf[1]))) {
			/* Previous Tcl_UniChar was a high surrogate, so combine */
			buf[2]  = (char) (0x80 | (0x3F & ch));
			buf[1] |= (char) (0x80 | (0x0F & (ch >> 6)));
			return 3;
		    }
		    /* Previous Tcl_UniChar was not a high surrogate, so just output */
		} else {
		    /* High surrogate */

		    /* Add 0x10000 to the raw number encoded in the surrogate
		     * pair in order to get the code point.
		    */
		    ch += 0x40;

		    /* Fill buffer with specific 3-byte (invalid) byte combination,
		       so following low surrogate can recognize it and combine */
		    buf[2] = (char) ((ch << 4) & 0x30);
		    buf[1] = (char) (0x80 | (0x3F & (ch >> 2)));
		    buf[0] = (char) (0xF0 | (0x07 & (ch >> 8)));
		    return 1;
		}
	    }
	    goto three;
	}
	if (ch <= 0x10FFFF) {
	    buf[3] = (char) (0x80 | (0x3F & ch));
	    buf[2] = (char) (0x80 | (0x3F & (ch >> 6)));
	    buf[1] = (char) (0x80 | (0x3F & (ch >> 12)));
	    buf[0] = (char) (0xF0 |         (ch >> 18));
	    return 4;
	}
    } else if (ch == -1) {
	if (   (0x80 == (0xC0 & buf[0]))
	    && (0    == (0xCF & buf[1]))
	    && (0xF0 == (0xF8 & buf[-1]))) {
	    ch = 0xD7C0
		+ ((0x07 & buf[-1]) << 8)
		+ ((0x3F & buf[0])  << 2)
		+ ((0x30 & buf[1])  >> 4);
	    buf[1]  = (char) (0x80 | (0x3F & ch));
	    buf[0]  = (char) (0x80 | (0x3F & (ch >> 6)));
	    buf[-1] = (char) (0xE0 | (ch >> 12));
	    return 2;
	}
    }

    ch = 0xFFFD;
three:
    buf[2] = (char) (0x80 | (0x3F & ch));
    buf[1] = (char) (0x80 | (0x3F & (ch >> 6)));
    buf[0] = (char) (0xE0 |         (ch >> 12));
    return 3;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_UniCharToUtfDString --
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
 *---------------------------------------------------------------------------
 */

#undef Tcl_UniCharToUtfDString
char *
Tcl_UniCharToUtfDString(
    const int *uniStr,	/* Unicode string to convert to UTF-8. */
    size_t uniLength,		/* Length of Unicode string. */

    Tcl_DString *dsPtr)		/* UTF-8 representation of string is appended
				 * to this previously initialized DString. */
{
    const int *w, *wEnd;
    char *p, *string;
    size_t oldLength;

    /*
     * UTF-8 string length in bytes will be <= Unicode string length * 4.
     */

    if (uniStr == NULL) {
	return NULL;
    }
    if (uniLength == TCL_INDEX_NONE) {
	uniLength = 0;
	w = uniStr;
	while (*w != '\0') {
	    uniLength++;
	    w++;
	}
    }
    oldLength = Tcl_DStringLength(dsPtr);
    Tcl_DStringSetLength(dsPtr, oldLength + (uniLength + 1) * 4);
    string = Tcl_DStringValue(dsPtr) + oldLength;

    p = string;
    wEnd = uniStr + uniLength;










    for (w = uniStr; w < wEnd; ) {
	p += Tcl_UniCharToUtf(*w, p);
	w++;
    }
    Tcl_DStringSetLength(dsPtr, oldLength + (p - string));

    return string;
}

char *
Tcl_Char16ToUtfDString(
    const unsigned short *uniStr,/* Utf-16 string to convert to UTF-8. */
    size_t uniLength,		/* Length of Utf-16 string. */
    Tcl_DString *dsPtr)		/* UTF-8 representation of string is appended
				 * to this previously initialized DString. */
{
    const unsigned short *w, *wEnd;
    char *p, *string;
    size_t oldLength;
    int len = 1;

    /*
     * UTF-8 string length in bytes will be <= Utf16 string length * 3.
     */

    if (uniStr == NULL) {
	return NULL;
    }
    if (uniLength == TCL_INDEX_NONE) {

	uniLength = 0;
	w = uniStr;
	while (*w != '\0') {
	    uniLength++;
	    w++;
	}
    }
    oldLength = Tcl_DStringLength(dsPtr);
    Tcl_DStringSetLength(dsPtr, oldLength + (uniLength + 1) * 3);
    string = Tcl_DStringValue(dsPtr) + oldLength;

    p = string;
    wEnd = uniStr + uniLength;










    for (w = uniStr; w < wEnd; ) {
	if (!len && ((*w & 0xFC00) != 0xDC00)) {
	    /* Special case for handling high surrogates. */
	    p += Tcl_UniCharToUtf(-1, p);
	}
	len = Tcl_UniCharToUtf(*w | TCL_COMBINE, p);
	p += len;







|
>





|








|













>
>
>
>
>
>
>
>
>
>












|















|














>
>
>
>
>
>
>
>
>
>







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

#undef Tcl_UniCharToUtfDString
char *
Tcl_UniCharToUtfDString(
    const int *uniStr,	/* Unicode string to convert to UTF-8. */
    Tcl_Size uniLength,		/* Length of Unicode string. Negative for nul
    				 * nul terminated string */
    Tcl_DString *dsPtr)		/* UTF-8 representation of string is appended
				 * to this previously initialized DString. */
{
    const int *w, *wEnd;
    char *p, *string;
    Tcl_Size oldLength;

    /*
     * UTF-8 string length in bytes will be <= Unicode string length * 4.
     */

    if (uniStr == NULL) {
	return NULL;
    }
    if (uniLength < 0) {
	uniLength = 0;
	w = uniStr;
	while (*w != '\0') {
	    uniLength++;
	    w++;
	}
    }
    oldLength = Tcl_DStringLength(dsPtr);
    Tcl_DStringSetLength(dsPtr, oldLength + (uniLength + 1) * 4);
    string = Tcl_DStringValue(dsPtr) + oldLength;

    p = string;
    wEnd = uniStr + uniLength;

#if TCL_UTF_MAX < 4
    /* Initialize the buffer so that some random data doesn't trick
     * Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
     * Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
     * prior non-stateful nature, this call to memset can also be removed.
     */
    memset(p, 0xff, Tcl_DStringLength(dsPtr) - oldLength);
#endif

    for (w = uniStr; w < wEnd; ) {
	p += Tcl_UniCharToUtf(*w, p);
	w++;
    }
    Tcl_DStringSetLength(dsPtr, oldLength + (p - string));

    return string;
}

char *
Tcl_Char16ToUtfDString(
    const unsigned short *uniStr,/* Utf-16 string to convert to UTF-8. */
    Tcl_Size uniLength,		/* Length of Utf-16 string. */
    Tcl_DString *dsPtr)		/* UTF-8 representation of string is appended
				 * to this previously initialized DString. */
{
    const unsigned short *w, *wEnd;
    char *p, *string;
    size_t oldLength;
    int len = 1;

    /*
     * UTF-8 string length in bytes will be <= Utf16 string length * 3.
     */

    if (uniStr == NULL) {
	return NULL;
    }
    if (uniLength < 0) {

	uniLength = 0;
	w = uniStr;
	while (*w != '\0') {
	    uniLength++;
	    w++;
	}
    }
    oldLength = Tcl_DStringLength(dsPtr);
    Tcl_DStringSetLength(dsPtr, oldLength + (uniLength + 1) * 3);
    string = Tcl_DStringValue(dsPtr) + oldLength;

    p = string;
    wEnd = uniStr + uniLength;

#if TCL_UTF_MAX < 4
    /* Initialize the buffer so that some random data doesn't trick
     * Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
	 * Because TCL_COMBINE is used here, memset() is required even when
	 * TCL_UTF_MAX == 4.
     */
    memset(p, 0xff, Tcl_DStringLength(dsPtr) - oldLength);
#endif

    for (w = uniStr; w < wEnd; ) {
	if (!len && ((*w & 0xFC00) != 0xDC00)) {
	    /* Special case for handling high surrogates. */
	    p += Tcl_UniCharToUtf(-1, p);
	}
	len = Tcl_UniCharToUtf(*w | TCL_COMBINE, p);
	p += len;
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
  0x20AC,   0x81, 0x201A, 0x0192, 0x201E, 0x2026, 0x2020, 0x2021,
  0x02C6, 0x2030, 0x0160, 0x2039, 0x0152,   0x8D, 0x017D,   0x8F,
    0x90, 0x2018, 0x2019, 0x201C, 0x201D, 0x2022, 0x2013, 0x2014,
   0x2DC, 0x2122, 0x0161, 0x203A, 0x0153,   0x9D, 0x017E, 0x0178
};

#undef Tcl_UtfToUniChar
int
Tcl_UtfToUniChar(
    const char *src,	/* The UTF-8 string. */
    int *chPtr)/* Filled with the Unicode character represented by
				 * the UTF-8 string. */
{
    int byte;








|







470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
  0x20AC,   0x81, 0x201A, 0x0192, 0x201E, 0x2026, 0x2020, 0x2021,
  0x02C6, 0x2030, 0x0160, 0x2039, 0x0152,   0x8D, 0x017D,   0x8F,
    0x90, 0x2018, 0x2019, 0x201C, 0x201D, 0x2022, 0x2013, 0x2014,
   0x2DC, 0x2122, 0x0161, 0x203A, 0x0153,   0x9D, 0x017E, 0x0178
};

#undef Tcl_UtfToUniChar
Tcl_Size
Tcl_UtfToUniChar(
    const char *src,	/* The UTF-8 string. */
    int *chPtr)/* Filled with the Unicode character represented by
				 * the UTF-8 string. */
{
    int byte;

472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
	if ((unsigned)(byte-0x80) < (unsigned)0x20) {
	    *chPtr = cp1252[byte-0x80];
	} else {
	    *chPtr = byte;
	}
	return 1;
    } else if (byte < 0xE0) {
	if ((src[1] & 0xC0) == 0x80) {
	    /*
	     * Two-byte-character lead-byte followed by a trail-byte.
	     */

	    *chPtr = (((byte & 0x1F) << 6) | (src[1] & 0x3F));
	    if ((unsigned)(*chPtr - 1) >= (UNICODE_SELF - 1)) {
		return 2;







|







499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
	if ((unsigned)(byte-0x80) < (unsigned)0x20) {
	    *chPtr = cp1252[byte-0x80];
	} else {
	    *chPtr = byte;
	}
	return 1;
    } else if (byte < 0xE0) {
	if ((byte != 0xC1) && ((src[1] & 0xC0) == 0x80)) {
	    /*
	     * Two-byte-character lead-byte followed by a trail-byte.
	     */

	    *chPtr = (((byte & 0x1F) << 6) | (src[1] & 0x3F));
	    if ((unsigned)(*chPtr - 1) >= (UNICODE_SELF - 1)) {
		return 2;
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
	 */
    }

    *chPtr = byte;
    return 1;
}

int
Tcl_UtfToChar16(
    const char *src,	/* The UTF-8 string. */
    unsigned short *chPtr)/* Filled with the Tcl_UniChar represented by
				 * the UTF-8 string. This could be a surrogate too. */
{
    unsigned short byte;








|







553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
	 */
    }

    *chPtr = byte;
    return 1;
}

Tcl_Size
Tcl_UtfToChar16(
    const char *src,	/* The UTF-8 string. */
    unsigned short *chPtr)/* Filled with the Tcl_UniChar represented by
				 * the UTF-8 string. This could be a surrogate too. */
{
    unsigned short byte;

567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
	if ((unsigned)(byte-0x80) < (unsigned)0x20) {
	    *chPtr = cp1252[byte-0x80];
	} else {
	    *chPtr = byte;
	}
	return 1;
    } else if (byte < 0xE0) {
	if ((src[1] & 0xC0) == 0x80) {
	    /*
	     * Two-byte-character lead-byte followed by a trail-byte.
	     */

	    *chPtr = (((byte & 0x1F) << 6) | (src[1] & 0x3F));
	    if ((unsigned)(*chPtr - 1) >= (UNICODE_SELF - 1)) {
		return 2;







|







594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
	if ((unsigned)(byte-0x80) < (unsigned)0x20) {
	    *chPtr = cp1252[byte-0x80];
	} else {
	    *chPtr = byte;
	}
	return 1;
    } else if (byte < 0xE0) {
	if ((byte != 0xC1) && ((src[1] & 0xC0) == 0x80)) {
	    /*
	     * Two-byte-character lead-byte followed by a trail-byte.
	     */

	    *chPtr = (((byte & 0x1F) << 6) | (src[1] & 0x3F));
	    if ((unsigned)(*chPtr - 1) >= (UNICODE_SELF - 1)) {
		return 2;
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
 *---------------------------------------------------------------------------
 */

#undef Tcl_UtfToUniCharDString
int *
Tcl_UtfToUniCharDString(
    const char *src,		/* UTF-8 string to convert to Unicode. */
    size_t length,			/* Length of UTF-8 string in bytes, or -1 for
				 * strlen(). */
    Tcl_DString *dsPtr)		/* Unicode representation of string is
				 * appended to this previously initialized
				 * DString. */
{
    int ch = 0, *w, *wString;
    const char *p;
    size_t oldLength;
    /* 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;

    if (src == NULL) {
	return NULL;
    }
    if (length == TCL_INDEX_NONE) {
	length = strlen(src);
    }

    /*
     * Unicode string length in Tcl_UniChars will be <= UTF-8 string length in
     * bytes.
     */







|







|








|







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

#undef Tcl_UtfToUniCharDString
int *
Tcl_UtfToUniCharDString(
    const char *src,		/* UTF-8 string to convert to Unicode. */
    Tcl_Size length,		/* Length of UTF-8 string in bytes, or -1 for
				 * strlen(). */
    Tcl_DString *dsPtr)		/* Unicode representation of string is
				 * appended to this previously initialized
				 * DString. */
{
    int ch = 0, *w, *wString;
    const char *p;
    Tcl_Size oldLength;
    /* 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;

    if (src == NULL) {
	return NULL;
    }
    if (length < 0) {
	length = strlen(src);
    }

    /*
     * Unicode string length in Tcl_UniChars will be <= UTF-8 string length in
     * bytes.
     */
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

    return wString;
}

unsigned short *
Tcl_UtfToChar16DString(
    const char *src,		/* UTF-8 string to convert to Unicode. */
    size_t length,			/* Length of UTF-8 string in bytes, or -1 for
				 * strlen(). */
    Tcl_DString *dsPtr)		/* Unicode representation of string is
				 * appended to this previously initialized
				 * DString. */
{
    unsigned short ch = 0, *w, *wString;
    const char *p;
    size_t oldLength;
    /* 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;

    if (src == NULL) {
	return NULL;
    }
    if (length == TCL_INDEX_NONE) {
	length = strlen(src);
    }

    /*
     * Unicode string length in WCHARs will be <= UTF-8 string length in
     * bytes.
     */







|







|








|







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

    return wString;
}

unsigned short *
Tcl_UtfToChar16DString(
    const char *src,		/* UTF-8 string to convert to Unicode. */
    Tcl_Size length,		/* Length of UTF-8 string in bytes, or -1 for
				 * strlen(). */
    Tcl_DString *dsPtr)		/* Unicode representation of string is
				 * appended to this previously initialized
				 * DString. */
{
    unsigned short ch = 0, *w, *wString;
    const char *p;
    Tcl_Size oldLength;
    /* 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;

    if (src == NULL) {
	return NULL;
    }
    if (length < 0) {
	length = strlen(src);
    }

    /*
     * Unicode string length in WCHARs will be <= UTF-8 string length in
     * bytes.
     */
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
 *---------------------------------------------------------------------------
 */

int
Tcl_UtfCharComplete(
    const char *src,		/* String to check if first few bytes contain
				 * a complete UTF-8 character. */
    size_t length)			/* Length of above string in bytes. */
{
    return length >= complete[UCHAR(*src)];
}

/*
 *---------------------------------------------------------------------------
 *







|







809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
 *---------------------------------------------------------------------------
 */

int
Tcl_UtfCharComplete(
    const char *src,		/* String to check if first few bytes contain
				 * a complete UTF-8 character. */
    Tcl_Size length)		/* Length of above string in bytes. */
{
    return length >= complete[UCHAR(*src)];
}

/*
 *---------------------------------------------------------------------------
 *
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

size_t
Tcl_NumUtfChars(
    const char *src,	/* The UTF-8 string to measure. */
    size_t length)	/* The length of the string in bytes, or
			 * TCL_INDEX_NONE for strlen(src). */
{
    Tcl_UniChar ch = 0;
    size_t i = 0;

    if (length == TCL_INDEX_NONE) {
	/* string is NUL-terminated, so TclUtfToUniChar calls are safe. */
	while (*src != '\0') {
	    src += TclUtfToUniChar(src, &ch);
	    i++;
	}
    } else {
	/* Will return value between 0 and length. No overflow checks. */







|


|
|


|

|







832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Size
Tcl_NumUtfChars(
    const char *src,	/* The UTF-8 string to measure. */
    Tcl_Size length)	/* The length of the string in bytes, or
			 * negative value for strlen(src). */
{
    Tcl_UniChar ch = 0;
    Tcl_Size i = 0;

    if (length < 0) {
	/* string is NUL-terminated, so TclUtfToUniChar calls are safe. */
	while (*src != '\0') {
	    src += TclUtfToUniChar(src, &ch);
	    i++;
	}
    } else {
	/* Will return value between 0 and length. No overflow checks. */
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
	    }
	    i++;
	}
    }
    return i;
}

size_t
TclNumUtfChars(
    const char *src,	/* The UTF-8 string to measure. */
    size_t length)	/* The length of the string in bytes, or
			 * TCL_INDEX_NONE for strlen(src). */
{
    unsigned short ch = 0;
    size_t i = 0;

    if (length == TCL_INDEX_NONE) {
	/* string is NUL-terminated, so TclUtfToUniChar calls are safe. */
	while (*src != '\0') {
	    src += Tcl_UtfToChar16(src, &ch);
	    i++;
	}
    } else {
	/* Will return value between 0 and length. No overflow checks. */







|


|
|


|

|







884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
	    }
	    i++;
	}
    }
    return i;
}

Tcl_Size
TclNumUtfChars(
    const char *src,	/* The UTF-8 string to measure. */
    Tcl_Size length)	/* The length of the string in bytes, or
			 * negative for strlen(src). */
{
    unsigned short ch = 0;
    Tcl_Size i = 0;

    if (length < 0) {
	/* string is NUL-terminated, so TclUtfToUniChar calls are safe. */
	while (*src != '\0') {
	    src += Tcl_UtfToChar16(src, &ch);
	    i++;
	}
    } else {
	/* Will return value between 0 and length. No overflow checks. */
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_UniCharAtIndex(
    const char *src,	/* The UTF-8 string to dereference. */
    size_t index)		/* The position of the desired character. */
{
    Tcl_UniChar ch = 0;
    int i = 0;

    if (index == TCL_INDEX_NONE) {
	return -1;
    }
    while (index--) {
	i = TclUtfToUniChar(src, &ch);
	src += i;
    }
#if TCL_UTF_MAX < 4







|




|







1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_UniCharAtIndex(
    const char *src,	/* The UTF-8 string to dereference. */
    Tcl_Size index)	/* The position of the desired character. */
{
    Tcl_UniChar ch = 0;
    int i = 0;

    if (index < 0) {
	return -1;
    }
    while (index--) {
	i = TclUtfToUniChar(src, &ch);
	src += i;
    }
#if TCL_UTF_MAX < 4
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
 *
 *---------------------------------------------------------------------------
 */

const char *
Tcl_UtfAtIndex(
    const char *src,	/* The UTF-8 string. */
    size_t index)		/* The position of the desired character. */
{
    int ch = 0;

    if (index != TCL_INDEX_NONE) {
	while (index--) {
	    /* Make use of the #undef Tcl_UtfToUniChar above, which already handles UCS4. */
	    src += Tcl_UtfToUniChar(src, &ch);
	}
    }
    return src;
}

const char *
TclUtfAtIndex(
    const char *src,	/* The UTF-8 string. */
    size_t index)		/* The position of the desired character. */
{
    unsigned short ch = 0;
    size_t len = 0;

    if (index != TCL_INDEX_NONE) {
	while (index--) {
	    src += (len = Tcl_UtfToChar16(src, &ch));
	}
	if ((ch >= 0xD800) && (len < 3)) {
	    /* Index points at character following high Surrogate */
	    src += Tcl_UtfToChar16(src, &ch);
	}







|



|











|


|

|







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

const char *
Tcl_UtfAtIndex(
    const char *src,	/* The UTF-8 string. */
    Tcl_Size index)	/* The position of the desired character. */
{
    int ch = 0;

    if (index > 0) {
	while (index--) {
	    /* Make use of the #undef Tcl_UtfToUniChar above, which already handles UCS4. */
	    src += Tcl_UtfToUniChar(src, &ch);
	}
    }
    return src;
}

const char *
TclUtfAtIndex(
    const char *src,	/* The UTF-8 string. */
    Tcl_Size index)	/* The position of the desired character. */
{
    unsigned short ch = 0;
    Tcl_Size len = 0;

    if (index > 0) {
	while (index--) {
	    src += (len = Tcl_UtfToChar16(src, &ch));
	}
	if ((ch >= 0xD800) && (len < 3)) {
	    /* Index points at character following high Surrogate */
	    src += Tcl_UtfToChar16(src, &ch);
	}
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
 *	that represent the Unicode character is at least as large as the
 *	source buffer from which the backslashed sequence was extracted, no
 *	buffer overruns should occur.
 *
 *---------------------------------------------------------------------------
 */

size_t
Tcl_UtfBackslash(
    const char *src,		/* Points to the backslash character of a
				 * backslash sequence. */
    int *readPtr,		/* Fill in with number of characters read from
				 * src, unless NULL. */
    char *dst)			/* Filled with the bytes represented by the
				 * backslash sequence. */
{
#define LINE_LENGTH 128

    size_t numRead, result;

    result = TclParseBackslash(src, LINE_LENGTH, &numRead, dst);
    if (numRead == LINE_LENGTH) {
	/*
	 * We ate a whole line. Pay the price of a strlen()
	 */








|









>
|







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
 *	that represent the Unicode character is at least as large as the
 *	source buffer from which the backslashed sequence was extracted, no
 *	buffer overruns should occur.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Size
Tcl_UtfBackslash(
    const char *src,		/* Points to the backslash character of a
				 * backslash sequence. */
    int *readPtr,		/* Fill in with number of characters read from
				 * src, unless NULL. */
    char *dst)			/* Filled with the bytes represented by the
				 * backslash sequence. */
{
#define LINE_LENGTH 128
    Tcl_Size numRead;
    int result;

    result = TclParseBackslash(src, LINE_LENGTH, &numRead, dst);
    if (numRead == LINE_LENGTH) {
	/*
	 * We ate a whole line. Pay the price of a strlen()
	 */

1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
 *
 * Side effects:
 *	Writes a terminating null after the last converted character.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_UtfToUpper(
    char *str)			/* String to convert in place. */
{
    int ch, upChar;
    char *src, *dst;
    size_t len;

    /*
     * Iterate over the string until we hit the terminating null.
     */

    src = dst = str;
    while (*src) {







|





|







1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
 *
 * Side effects:
 *	Writes a terminating null after the last converted character.
 *
 *----------------------------------------------------------------------
 */

Tcl_Size
Tcl_UtfToUpper(
    char *str)			/* String to convert in place. */
{
    int ch, upChar;
    char *src, *dst;
    Tcl_Size len;

    /*
     * Iterate over the string until we hit the terminating null.
     */

    src = dst = str;
    while (*src) {
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
 *
 * Side effects:
 *	Writes a terminating null after the last converted character.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_UtfToLower(
    char *str)			/* String to convert in place. */
{
    int ch, lowChar;
    char *src, *dst;
    size_t len;

    /*
     * Iterate over the string until we hit the terminating null.
     */

    src = dst = str;
    while (*src) {







|





|







1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
 *
 * Side effects:
 *	Writes a terminating null after the last converted character.
 *
 *----------------------------------------------------------------------
 */

Tcl_Size
Tcl_UtfToLower(
    char *str)			/* String to convert in place. */
{
    int ch, lowChar;
    char *src, *dst;
    Tcl_Size len;

    /*
     * Iterate over the string until we hit the terminating null.
     */

    src = dst = str;
    while (*src) {
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
 *
 * Side effects:
 *	Writes a terminating null after the last converted character.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_UtfToTitle(
    char *str)			/* String to convert in place. */
{
    int ch, titleChar, lowChar;
    char *src, *dst;
    size_t len;

    /*
     * Capitalize the first character and then lowercase the rest of the
     * characters until we get to a null.
     */

    src = dst = str;







|





|







1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
 *
 * Side effects:
 *	Writes a terminating null after the last converted character.
 *
 *----------------------------------------------------------------------
 */

Tcl_Size
Tcl_UtfToTitle(
    char *str)			/* String to convert in place. */
{
    int ch, titleChar, lowChar;
    char *src, *dst;
    Tcl_Size len;

    /*
     * Capitalize the first character and then lowercase the rest of the
     * characters until we get to a null.
     */

    src = dst = str;
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
Tcl_Char16Len(
    const unsigned short *uniStr)	/* Unicode string to find length of. */
{
    size_t len = 0;

    while (*uniStr != '\0') {
	len++;
	uniStr++;
    }
    return len;
}







|



|







1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Size
Tcl_Char16Len(
    const unsigned short *uniStr)	/* Unicode string to find length of. */
{
    Tcl_Size len = 0;

    while (*uniStr != '\0') {
	len++;
	uniStr++;
    }
    return len;
}
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_UniCharLen
size_t
Tcl_UniCharLen(
    const int *uniStr)	/* Unicode string to find length of. */
{
    size_t len = 0;

    while (*uniStr != '\0') {
	len++;
	uniStr++;
    }
    return len;
}







|



|







1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_UniCharLen
Tcl_Size
Tcl_UniCharLen(
    const int *uniStr)	/* Unicode string to find length of. */
{
    Tcl_Size len = 0;

    while (*uniStr != '\0') {
	len++;
	uniStr++;
    }
    return len;
}
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
 *----------------------------------------------------------------------
 */

int
TclUniCharNcasecmp(
    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. */
{
    for ( ; numChars != 0; numChars--, ucs++, uct++) {
	if (*ucs != *uct) {
	    Tcl_UniChar lcs = Tcl_UniCharToLower(*ucs);
	    Tcl_UniChar lct = Tcl_UniCharToLower(*uct);

	    if (lcs != lct) {







|







2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
 *----------------------------------------------------------------------
 */

int
TclUniCharNcasecmp(
    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. */
{
    for ( ; numChars != 0; numChars--, ucs++, uct++) {
	if (*ucs != *uct) {
	    Tcl_UniChar lcs = Tcl_UniCharToLower(*ucs);
	    Tcl_UniChar lct = Tcl_UniCharToLower(*uct);

	    if (lcs != lct) {
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
 *
 *----------------------------------------------------------------------
 */

int
TclUniCharMatch(
    const Tcl_UniChar *string,	/* Unicode String. */
    size_t strLen,			/* Length of String */
    const Tcl_UniChar *pattern,	/* Pattern, which may contain special
				 * characters. */
    size_t ptnLen,			/* Length of Pattern */
    int nocase)			/* 0 for case sensitive, 1 for insensitive */
{
    const Tcl_UniChar *stringEnd, *patternEnd;
    Tcl_UniChar p;

    stringEnd = string + strLen;
    patternEnd = pattern + ptnLen;







|


|







2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
 *
 *----------------------------------------------------------------------
 */

int
TclUniCharMatch(
    const Tcl_UniChar *string,	/* Unicode String. */
    Tcl_Size strLen,		/* Length of String */
    const Tcl_UniChar *pattern,	/* Pattern, which may contain special
				 * characters. */
    Tcl_Size ptnLen,		/* Length of Pattern */
    int nocase)			/* 0 for case sensitive, 1 for insensitive */
{
    const Tcl_UniChar *stringEnd, *patternEnd;
    Tcl_UniChar p;

    stringEnd = string + strLen;
    patternEnd = pattern + ptnLen;
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
}

/*
 *---------------------------------------------------------------------------
 *
 * TclUtfToUCS4 --
 *
 *	Extract the 4-byte codepoint from the leading bytes of the
 *	Modified UTF-8 string "src".  This is a utility routine to
 *	contain the surrogate gymnastics in one place.
 *
 *	The caller must ensure that the source buffer is long enough that this
 *	routine does not run off the end and dereference non-existent memory
 *	looking for trail bytes. If the source buffer is known to be '\0'
 *	terminated, this cannot happen. Otherwise, the caller should call
 *	Tcl_UtfCharComplete() before calling this routine to ensure that
 *	enough bytes remain in the string.
 *
 * Results:
 *	*usc4Ptr is filled with the UCS4 code point, and the return value is
 *	the number of bytes from the UTF-8 string that were consumed.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */








|











|
|







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
}

/*
 *---------------------------------------------------------------------------
 *
 * TclUtfToUCS4 --
 *
 *	Extracts the 4-byte codepoint from the leading bytes of the
 *	Modified UTF-8 string "src".  This is a utility routine to
 *	contain the surrogate gymnastics in one place.
 *
 *	The caller must ensure that the source buffer is long enough that this
 *	routine does not run off the end and dereference non-existent memory
 *	looking for trail bytes. If the source buffer is known to be '\0'
 *	terminated, this cannot happen. Otherwise, the caller should call
 *	Tcl_UtfCharComplete() before calling this routine to ensure that
 *	enough bytes remain in the string.
 *
 * Results:
 *	Fills *usc4Ptr with the UCS4 code point and returns the number of bytes
 *	consumed from the source string.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

Changes to generic/tclUtil.c.

8
9
10
11
12
13
14

15
16
17
18
19
20
21
 * 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"
#include "tclStringTrim.h"
#include "tclTomMath.h"
#include <math.h>

/*







>







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 * 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 <assert.h>
#include "tclInt.h"
#include "tclParse.h"
#include "tclStringTrim.h"
#include "tclTomMath.h"
#include <math.h>

/*
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
 * Prototypes for functions defined later in this file.
 */

static void		ClearHash(Tcl_HashTable *tablePtr);
static void		FreeProcessGlobalValue(void *clientData);
static void		FreeThreadHash(void *clientData);
static int		GetEndOffsetFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    size_t endValue, Tcl_WideInt *indexPtr);
static Tcl_HashTable *	GetThreadHash(Tcl_ThreadDataKey *keyPtr);
static int		GetWideForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    size_t endValue, Tcl_WideInt *widePtr);
static int		FindElement(Tcl_Interp *interp, const char *string,
			    size_t stringLength, const char *typeStr,
			    const char *typeCode, const char **elementPtr,
			    const char **nextPtr, size_t *sizePtr,
			    int *literalPtr);
/*
 * The following is the Tcl object type definition for an object that
 * represents a list index in the form, "end-offset". It is used as a
 * performance optimization in Tcl_GetIntForIndex. The internal rep is
 * stored directly in the wideValue, so no memory management is required
 * for it. This is a caching internalrep, keeping the result of a parse
 * around. This type is only created from a pre-existing string, so an
 * updateStringProc will never be called and need not exist. The type
 * is unregistered, so has no need of a setFromAnyProc either.
 */

static const Tcl_ObjType endOffsetType = {
    "end-offset",			/* name */
    NULL,				/* freeIntRepProc */
    NULL,				/* dupIntRepProc */
    NULL,				/* updateStringProc */
    NULL				/* setFromAnyProc */

};








/*
 *	*	STRING REPRESENTATION OF LISTS	*	*	*
 *
 * The next several routines implement the conversions of strings to and from
 * Tcl lists. To understand their operation, the rules of parsing and
 * generating the string representation of lists must be known.  Here we







|


|

|

|

















|
>

>
>
>
>
>
>
>







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
 * Prototypes for functions defined later in this file.
 */

static void		ClearHash(Tcl_HashTable *tablePtr);
static void		FreeProcessGlobalValue(void *clientData);
static void		FreeThreadHash(void *clientData);
static int		GetEndOffsetFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    Tcl_WideInt endValue, Tcl_WideInt *indexPtr);
static Tcl_HashTable *	GetThreadHash(Tcl_ThreadDataKey *keyPtr);
static int		GetWideForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    Tcl_WideInt endValue, Tcl_WideInt *widePtr);
static int		FindElement(Tcl_Interp *interp, const char *string,
			    Tcl_Size stringLength, const char *typeStr,
			    const char *typeCode, const char **elementPtr,
			    const char **nextPtr, Tcl_Size *sizePtr,
			    int *literalPtr);
/*
 * The following is the Tcl object type definition for an object that
 * represents a list index in the form, "end-offset". It is used as a
 * performance optimization in Tcl_GetIntForIndex. The internal rep is
 * stored directly in the wideValue, so no memory management is required
 * for it. This is a caching internalrep, keeping the result of a parse
 * around. This type is only created from a pre-existing string, so an
 * updateStringProc will never be called and need not exist. The type
 * is unregistered, so has no need of a setFromAnyProc either.
 */

static const Tcl_ObjType endOffsetType = {
    "end-offset",			/* name */
    NULL,				/* freeIntRepProc */
    NULL,				/* dupIntRepProc */
    NULL,				/* updateStringProc */
    NULL,				/* setFromAnyProc */
    TCL_OBJTYPE_V1(TclLengthOne)
};

Tcl_Size
TclLengthOne(
    TCL_UNUSED(Tcl_Obj *))
{
    return 1;
}

/*
 *	*	STRING REPRESENTATION OF LISTS	*	*	*
 *
 * The next several routines implement the conversions of strings to and from
 * Tcl lists. To understand their operation, the rules of parsing and
 * generating the string representation of lists must be known.  Here we
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclMaxListLength(
    const char *bytes,
    size_t numBytes,
    const char **endPtr)
{
    size_t count = 0;

    if ((numBytes == 0) || ((numBytes == TCL_INDEX_NONE) && (*bytes == '\0'))) {
	/* Empty string case - quick exit */
	goto done;
    }

    /*







|


|


|







389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Size
TclMaxListLength(
    const char *bytes,
    Tcl_Size numBytes,
    const char **endPtr)
{
    Tcl_Size count = 0;

    if ((numBytes == 0) || ((numBytes == TCL_INDEX_NONE) && (*bytes == '\0'))) {
	/* Empty string case - quick exit */
	goto done;
    }

    /*
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
TclFindElement(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting. If
				 * NULL, then no error message is left after
				 * errors. */
    const char *list,		/* Points to the first byte of a string
				 * containing a Tcl list with zero or more
				 * elements (possibly in braces). */
    size_t listLength,		/* Number of bytes in the list's string. */
    const char **elementPtr,	/* Where to put address of first significant
				 * character in first element of list. */
    const char **nextPtr,	/* Fill in with location of character just
				 * after all white space following end of
				 * argument (next arg or end of list). */
    size_t *sizePtr,		/* If non-zero, fill in with size of
				 * element. */
    int *literalPtr)		/* If non-zero, fill in with non-zero/zero to
				 * indicate that the substring of *sizePtr
				 * bytes starting at **elementPtr is/is not
				 * the literal list element and therefore
				 * does not/does require a call to
				 * TclCopyAndCollapse() by the caller. */







|





|







498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
TclFindElement(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting. If
				 * NULL, then no error message is left after
				 * errors. */
    const char *list,		/* Points to the first byte of a string
				 * containing a Tcl list with zero or more
				 * elements (possibly in braces). */
    Tcl_Size listLength,	/* Number of bytes in the list's string. */
    const char **elementPtr,	/* Where to put address of first significant
				 * character in first element of list. */
    const char **nextPtr,	/* Fill in with location of character just
				 * after all white space following end of
				 * argument (next arg or end of list). */
    Tcl_Size *sizePtr,		/* If non-zero, fill in with size of
				 * element. */
    int *literalPtr)		/* If non-zero, fill in with non-zero/zero to
				 * indicate that the substring of *sizePtr
				 * bytes starting at **elementPtr is/is not
				 * the literal list element and therefore
				 * does not/does require a call to
				 * TclCopyAndCollapse() by the caller. */
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
    Tcl_Interp *interp,		/* Interpreter to use for error reporting. If
				 * NULL, then no error message is left after
				 * errors. */
    const char *dict,		/* Points to the first byte of a string
				 * containing a Tcl dictionary with zero or
				 * more keys and values (possibly in
				 * braces). */
    size_t dictLength,		/* Number of bytes in the dict's string. */
    const char **elementPtr,	/* Where to put address of first significant
				 * character in the first element (i.e., key
				 * or value) of dict. */
    const char **nextPtr,	/* Fill in with location of character just
				 * after all white space following end of
				 * element (next arg or end of list). */
    size_t *sizePtr,		/* If non-zero, fill in with size of
				 * element. */
    int *literalPtr)		/* If non-zero, fill in with non-zero/zero to
				 * indicate that the substring of *sizePtr
				 * bytes starting at **elementPtr is/is not
				 * the literal key or value and therefore
				 * does not/does require a call to
				 * TclCopyAndCollapse() by the caller. */







|






|







526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
    Tcl_Interp *interp,		/* Interpreter to use for error reporting. If
				 * NULL, then no error message is left after
				 * errors. */
    const char *dict,		/* Points to the first byte of a string
				 * containing a Tcl dictionary with zero or
				 * more keys and values (possibly in
				 * braces). */
    Tcl_Size dictLength,	/* Number of bytes in the dict's string. */
    const char **elementPtr,	/* Where to put address of first significant
				 * character in the first element (i.e., key
				 * or value) of dict. */
    const char **nextPtr,	/* Fill in with location of character just
				 * after all white space following end of
				 * element (next arg or end of list). */
    Tcl_Size *sizePtr,		/* If non-zero, fill in with size of
				 * element. */
    int *literalPtr)		/* If non-zero, fill in with non-zero/zero to
				 * indicate that the substring of *sizePtr
				 * bytes starting at **elementPtr is/is not
				 * the literal key or value and therefore
				 * does not/does require a call to
				 * TclCopyAndCollapse() by the caller. */
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
    Tcl_Interp *interp,		/* Interpreter to use for error reporting. If
				 * NULL, then no error message is left after
				 * errors. */
    const char *string,		/* Points to the first byte of a string
				 * containing a Tcl list or dictionary with
				 * zero or more elements (possibly in
				 * braces). */
    size_t stringLength,		/* Number of bytes in the string. */
    const char *typeStr,	/* The name of the type of thing we are
				 * parsing, for error messages. */
    const char *typeCode,	/* The type code for thing we are parsing, for
				 * error messages. */
    const char **elementPtr,	/* Where to put address of first significant
				 * character in first element. */
    const char **nextPtr,	/* Fill in with location of character just
				 * after all white space following end of
				 * argument (next arg or end of list/dict). */
    size_t *sizePtr,		/* If non-zero, fill in with size of
				 * element. */
    int *literalPtr)		/* If non-zero, fill in with non-zero/zero to
				 * indicate that the substring of *sizePtr
				 * bytes starting at **elementPtr is/is not
				 * the literal list/dict element and therefore
				 * does not/does require a call to
				 * TclCopyAndCollapse() by the caller. */
{
    const char *p = string;
    const char *elemStart;	/* Points to first byte of first element. */
    const char *limit;		/* Points just after list/dict's last byte. */
    size_t openBraces = 0;		/* Brace nesting level during parse. */
    int inQuotes = 0;
    size_t size = 0;
    size_t numChars;
    int literal = 1;
    const char *p2;

    /*
     * Skim off leading white space and check for an opening brace or quote.
     * We treat embedded NULLs in the list/dict as bytes belonging to a list
     * element (or dictionary key or value).







|









|











|

|
|







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
    Tcl_Interp *interp,		/* Interpreter to use for error reporting. If
				 * NULL, then no error message is left after
				 * errors. */
    const char *string,		/* Points to the first byte of a string
				 * containing a Tcl list or dictionary with
				 * zero or more elements (possibly in
				 * braces). */
    Tcl_Size stringLength,	/* Number of bytes in the string. */
    const char *typeStr,	/* The name of the type of thing we are
				 * parsing, for error messages. */
    const char *typeCode,	/* The type code for thing we are parsing, for
				 * error messages. */
    const char **elementPtr,	/* Where to put address of first significant
				 * character in first element. */
    const char **nextPtr,	/* Fill in with location of character just
				 * after all white space following end of
				 * argument (next arg or end of list/dict). */
    Tcl_Size *sizePtr,		/* If non-zero, fill in with size of
				 * element. */
    int *literalPtr)		/* If non-zero, fill in with non-zero/zero to
				 * indicate that the substring of *sizePtr
				 * bytes starting at **elementPtr is/is not
				 * the literal list/dict element and therefore
				 * does not/does require a call to
				 * TclCopyAndCollapse() by the caller. */
{
    const char *p = string;
    const char *elemStart;	/* Points to first byte of first element. */
    const char *limit;		/* Points just after list/dict's last byte. */
    Tcl_Size openBraces = 0;	/* Brace nesting level during parse. */
    int inQuotes = 0;
    Tcl_Size size = 0;
    Tcl_Size numChars;
    int literal = 1;
    const char *p2;

    /*
     * Skim off leading white space and check for an opening brace or quote.
     * We treat embedded NULLs in the list/dict as bytes belonging to a list
     * element (or dictionary key or value).
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
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
TclCopyAndCollapse(
    size_t count,			/* Number of byte to copy from src. */
    const char *src,		/* Copy from here... */
    char *dst)			/* ... to here. */
{
    size_t newCount = 0;

    while (count > 0) {
	char c = *src;

	if (c == '\\') {
	    char buf[4] = "";
	    size_t numRead;
	    size_t backslashCount = TclParseBackslash(src, count, &numRead, buf);

	    memcpy(dst, buf, backslashCount);
	    dst += backslashCount;
	    newCount += backslashCount;
	    src += numRead;
	    count -= numRead;
	} else {







|

|



|






|
|







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

Tcl_Size
TclCopyAndCollapse(
    Tcl_Size count,		/* Number of byte to copy from src. */
    const char *src,		/* Copy from here... */
    char *dst)			/* ... to here. */
{
    Tcl_Size newCount = 0;

    while (count > 0) {
	char c = *src;

	if (c == '\\') {
	    char buf[4] = "";
	    Tcl_Size numRead;
	    Tcl_Size backslashCount = TclParseBackslash(src, count, &numRead, buf);

	    memcpy(dst, buf, backslashCount);
	    dst += backslashCount;
	    newCount += backslashCount;
	    src += numRead;
	    count -= numRead;
	} else {
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868

#undef Tcl_SplitList
int
Tcl_SplitList(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting. If
				 * NULL, no error message is left. */
    const char *list,		/* Pointer to string with list structure. */
    size_t *argcPtr,		/* Pointer to location to fill in with the
				 * number of elements in the list. */
    const char ***argvPtr)	/* Pointer to place to store pointer to array
				 * of pointers to list elements. */
{
    const char **argv, *end, *element;
    char *p;
    int result;
    size_t length, size, i, elSize;

    /*
     * Allocate enough space to work in. A (const char *) for each (possible)
     * list element plus one more for terminating NULL, plus as many bytes as
     * in the original string value, plus one more for a terminating '\0'.
     * Space used to hold element separating white space in the original
     * string gets re-purposed to hold '\0' characters in the argv array.







|







|







855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877

#undef Tcl_SplitList
int
Tcl_SplitList(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting. If
				 * NULL, no error message is left. */
    const char *list,		/* Pointer to string with list structure. */
    Tcl_Size *argcPtr,		/* Pointer to location to fill in with the
				 * number of elements in the list. */
    const char ***argvPtr)	/* Pointer to place to store pointer to array
				 * of pointers to list elements. */
{
    const char **argv, *end, *element;
    char *p;
    int result;
    Tcl_Size length, size, i, elSize;

    /*
     * Allocate enough space to work in. A (const char *) for each (possible)
     * list element plus one more for terminating NULL, plus as many bytes as
     * in the original string value, plus one more for a terminating '\0'.
     * Space used to hold element separating white space in the original
     * string gets re-purposed to hold '\0' characters in the argv array.
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
	if (*element == 0) {
	    break;
	}
	if (i >= size) {
	    Tcl_Free((void *)argv);
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"internal error in Tcl_SplitList", TCL_INDEX_NONE));
		Tcl_SetErrorCode(interp, "TCL", "INTERNAL", "Tcl_SplitList",
			NULL);
	    }
	    return TCL_ERROR;
	}
	argv[i] = p;
	if (literal) {







|







896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
	if (*element == 0) {
	    break;
	}
	if (i >= size) {
	    Tcl_Free((void *)argv);
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"internal error in Tcl_SplitList", -1));
		Tcl_SetErrorCode(interp, "TCL", "INTERNAL", "Tcl_SplitList",
			NULL);
	    }
	    return TCL_ERROR;
	}
	argv[i] = p;
	if (literal) {
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
Tcl_ScanElement(
    const char *src,	/* String to convert to list element. */
    int *flagPtr)	/* Where to store information to guide
			 * Tcl_ConvertCountedElement. */
{
    return Tcl_ScanCountedElement(src, TCL_INDEX_NONE, flagPtr);
}







|







940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Size
Tcl_ScanElement(
    const char *src,	/* String to convert to list element. */
    int *flagPtr)	/* Where to store information to guide
			 * Tcl_ConvertCountedElement. */
{
    return Tcl_ScanCountedElement(src, TCL_INDEX_NONE, flagPtr);
}
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
Tcl_ScanCountedElement(
    const char *src,		/* String to convert to Tcl list element. */
    size_t length,		/* Number of bytes in src, or TCL_INDEX_NONE. */
    int *flagPtr)		/* Where to store information to guide
				 * Tcl_ConvertElement. */
{
    char flags = CONVERT_ANY;
    size_t numBytes = TclScanElement(src, length, &flags);

    *flagPtr = flags;
    return numBytes;
}

/*
 *----------------------------------------------------------------------







|


|




|







972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Size
Tcl_ScanCountedElement(
    const char *src,		/* String to convert to Tcl list element. */
    Tcl_Size length,		/* Number of bytes in src, or TCL_INDEX_NONE. */
    int *flagPtr)		/* Where to store information to guide
				 * Tcl_ConvertElement. */
{
    char flags = CONVERT_ANY;
    Tcl_Size numBytes = TclScanElement(src, length, &flags);

    *flagPtr = flags;
    return numBytes;
}

/*
 *----------------------------------------------------------------------
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
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

TCL_HASH_TYPE
TclScanElement(
    const char *src,		/* String to convert to Tcl list element. */
    size_t length,		/* Number of bytes in src, or TCL_INDEX_NONE. */
    char *flagPtr)		/* Where to store information to guide
				 * Tcl_ConvertElement. */
{
    const char *p = src;
    size_t nestingLevel = 0;	/* Brace nesting count */
    int forbidNone = 0;		/* Do not permit CONVERT_NONE mode. Something
				 * needs protection or escape. */
    int requireEscape = 0;	/* Force use of CONVERT_ESCAPE mode.  For some
				 * reason bare or brace-quoted form fails. */
    int extra = 0;		/* Count of number of extra bytes needed for
				 * formatted element, assuming we use escape
				 * sequences in formatting. */
    TCL_HASH_TYPE bytesNeeded;		/* Buffer length computed to complete the
				 * element formatting in the selected mode. */
#if COMPAT
    int preferEscape = 0;	/* Use preferences to track whether to use */
    int preferBrace = 0;	/* CONVERT_MASK mode. */
    int braceCount = 0;		/* Count of all braces '{' '}' seen. */
#endif /* COMPAT */








|


|




|




|


|







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

Tcl_Size
TclScanElement(
    const char *src,		/* String to convert to Tcl list element. */
    Tcl_Size length,		/* Number of bytes in src, or TCL_INDEX_NONE. */
    char *flagPtr)		/* Where to store information to guide
				 * Tcl_ConvertElement. */
{
    const char *p = src;
    Tcl_Size nestingLevel = 0;	/* Brace nesting count */
    int forbidNone = 0;		/* Do not permit CONVERT_NONE mode. Something
				 * needs protection or escape. */
    int requireEscape = 0;	/* Force use of CONVERT_ESCAPE mode.  For some
				 * reason bare or brace-quoted form fails. */
    Tcl_Size extra = 0;		/* Count of number of extra bytes needed for
				 * formatted element, assuming we use escape
				 * sequences in formatting. */
    Tcl_Size bytesNeeded;		/* Buffer length computed to complete the
				 * element formatting in the selected mode. */
#if COMPAT
    int preferEscape = 0;	/* Use preferences to track whether to use */
    int preferBrace = 0;	/* CONVERT_MASK mode. */
    int braceCount = 0;		/* Count of all braces '{' '}' seen. */
#endif /* COMPAT */

1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
#if COMPAT
		preferBrace = 1;
#endif
	    }
	    break;
	}
      }
	length -= (length+1 > 1);
	p++;
    }

  endOfString:
    if (nestingLevel > 0) {
	/*
	 * Unbalanced braces!  Cannot format with brace quoting.







|







1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
#if COMPAT
		preferBrace = 1;
#endif
	    }
	    break;
	}
      }
	length -= (length > 0);
	p++;
    }

  endOfString:
    if (nestingLevel > 0) {
	/*
	 * Unbalanced braces!  Cannot format with brace quoting.
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238

#if COMPAT
	if (preferEscape && !preferBrace) {
	    /*
	     * If we are quoting solely due to ] or internal " characters use
	     * the CONVERT_MASK mode where we escape all special characters
	     * except for braces. "extra" counted space needed to escape
	     * braces too, so substract "braceCount" to get our actual needs.
	     */

	    bytesNeeded += (extra - braceCount);
	    /* Make room to escape leading #, if needed. */
	    if ((*src == '#') && !(*flagPtr & TCL_DONT_QUOTE_HASH)) {
		bytesNeeded++;
	    }







|







1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247

#if COMPAT
	if (preferEscape && !preferBrace) {
	    /*
	     * If we are quoting solely due to ] or internal " characters use
	     * the CONVERT_MASK mode where we escape all special characters
	     * except for braces. "extra" counted space needed to escape
	     * braces too, so subtract "braceCount" to get our actual needs.
	     */

	    bytesNeeded += (extra - braceCount);
	    /* Make room to escape leading #, if needed. */
	    if ((*src == '#') && !(*flagPtr & TCL_DONT_QUOTE_HASH)) {
		bytesNeeded++;
	    }
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
Tcl_ConvertElement(
    const char *src,	/* Source information for list element. */
    char *dst,		/* Place to put list-ified element. */
    int flags)		/* Flags produced by Tcl_ScanElement. */
{
    return Tcl_ConvertCountedElement(src, TCL_INDEX_NONE, dst, flags);
}







|







1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Size
Tcl_ConvertElement(
    const char *src,	/* Source information for list element. */
    char *dst,		/* Place to put list-ified element. */
    int flags)		/* Flags produced by Tcl_ScanElement. */
{
    return Tcl_ConvertCountedElement(src, TCL_INDEX_NONE, dst, flags);
}
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
Tcl_ConvertCountedElement(
    const char *src,	/* Source information for list element. */
    size_t length,		/* Number of bytes in src, or TCL_INDEX_NONE. */
    char *dst,			/* Place to put list-ified element. */
    int flags)			/* Flags produced by Tcl_ScanElement. */
{
    size_t numBytes = TclConvertElement(src, length, dst, flags);
    dst[numBytes] = '\0';
    return numBytes;
}

/*
 *----------------------------------------------------------------------
 *







|


|



|







1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Size
Tcl_ConvertCountedElement(
    const char *src,	/* Source information for list element. */
    Tcl_Size length,		/* Number of bytes in src, or TCL_INDEX_NONE. */
    char *dst,			/* Place to put list-ified element. */
    int flags)			/* Flags produced by Tcl_ScanElement. */
{
    Tcl_Size numBytes = TclConvertElement(src, length, dst, flags);
    dst[numBytes] = '\0';
    return numBytes;
}

/*
 *----------------------------------------------------------------------
 *
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
TclConvertElement(
    const char *src,	/* Source information for list element. */
    size_t length,		/* Number of bytes in src, or TCL_INDEX_NONE. */
    char *dst,			/* Place to put list-ified element. */
    int flags)			/* Flags produced by Tcl_ScanElement. */
{
    int conversion = flags & CONVERT_MASK;
    char *p = dst;

    /*







|


|







1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Size
TclConvertElement(
    const char *src,	/* Source information for list element. */
    Tcl_Size length,		/* Number of bytes in src, or TCL_INDEX_NONE. */
    char *dst,			/* Place to put list-ified element. */
    int flags)			/* Flags produced by Tcl_ScanElement. */
{
    int conversion = flags & CONVERT_MASK;
    char *p = dst;

    /*
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423

    if ((*src == '#') && !(flags & TCL_DONT_QUOTE_HASH)) {
	if (conversion == CONVERT_ESCAPE) {
	    p[0] = '\\';
	    p[1] = '#';
	    p += 2;
	    src++;
	    length -= (length+1 > 1);
	} else {
	    conversion = CONVERT_BRACE;
	}
    }

    /*
     * No escape or quoting needed.  Copy the literal string value.







|







1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432

    if ((*src == '#') && !(flags & TCL_DONT_QUOTE_HASH)) {
	if (conversion == CONVERT_ESCAPE) {
	    p[0] = '\\';
	    p[1] = '#';
	    p += 2;
	    src++;
	    length -= (length > 0);
	} else {
	    conversion = CONVERT_BRACE;
	}
    }

    /*
     * No escape or quoting needed.  Copy the literal string value.
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
	    }
	} else {
	    memcpy(p, src, length);
	    p += length;
	}
	*p = '}';
	p++;
	return (size_t)(p - dst);
    }

    /* conversion == CONVERT_ESCAPE or CONVERT_MASK */

    /*
     * Formatted string is original string converted to escape sequences.
     */

    for ( ; length; src++, length -= (length+1 > 1)) {
	switch (*src) {
	case ']':
	case '[':
	case '$':
	case ';':
	case ' ':
	case '\\':







|








|







1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
	    }
	} else {
	    memcpy(p, src, length);
	    p += length;
	}
	*p = '}';
	p++;
	return (p - dst);
    }

    /* conversion == CONVERT_ESCAPE or CONVERT_MASK */

    /*
     * Formatted string is original string converted to escape sequences.
     */

    for ( ; length; src++, length -= (length > 0)) {
	switch (*src) {
	case ']':
	case '[':
	case '$':
	case ';':
	case ' ':
	case '\\':
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
	    *p = '\\';
	    p++;
	    *p = 'v';
	    p++;
	    continue;
	case '\0':
	    if (length == TCL_INDEX_NONE) {
		return (size_t)(p - dst);
	    }

	    /*
	     * If we reach this point, there's an embedded NULL in the string
	     * range being processed, which should not happen when the
	     * encoding rules for Tcl strings are properly followed.  If the
	     * day ever comes when we stop tolerating such things, this is
	     * where to put the Tcl_Panic().
	     */

	    break;
	}
	*p = *src;
	p++;
    }
    return (size_t)(p - dst);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Merge --
 *







|















|







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
	    *p = '\\';
	    p++;
	    *p = 'v';
	    p++;
	    continue;
	case '\0':
	    if (length == TCL_INDEX_NONE) {
		return (p - dst);
	    }

	    /*
	     * If we reach this point, there's an embedded NULL in the string
	     * range being processed, which should not happen when the
	     * encoding rules for Tcl strings are properly followed.  If the
	     * day ever comes when we stop tolerating such things, this is
	     * where to put the Tcl_Panic().
	     */

	    break;
	}
	*p = *src;
	p++;
    }
    return (p - dst);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Merge --
 *
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
 *	None.
 *
 *----------------------------------------------------------------------
 */

char *
Tcl_Merge(
    size_t argc,			/* How many strings to merge. */
    const char *const *argv)	/* Array of string values. */
{
#define LOCAL_SIZE 64
    char localFlags[LOCAL_SIZE], *flagPtr = NULL;

    size_t i, bytesNeeded = 0;
    char *result, *dst;

    /*
     * Handle empty list case first, so logic of the general case can be
     * simpler.
     */


    if (argc == 0) {


	result = (char *)Tcl_Alloc(1);
	result[0] = '\0';
	return result;
    }

    /*
     * Pass 1: estimate space, gather flags.







|




>
|







>
|
>
>







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

char *
Tcl_Merge(
    Tcl_Size argc,			/* How many strings to merge. */
    const char *const *argv)	/* Array of string values. */
{
#define LOCAL_SIZE 64
    char localFlags[LOCAL_SIZE], *flagPtr = NULL;
    Tcl_Size i;
    size_t bytesNeeded = 0;
    char *result, *dst;

    /*
     * Handle empty list case first, so logic of the general case can be
     * simpler.
     */

    if (argc <= 0) {
	if (argc < 0) {
	    Tcl_Panic("Tcl_Merge called with negative argc (%" TCL_SIZE_MODIFIER "d)", argc);
	}
	result = (char *)Tcl_Alloc(1);
	result[0] = '\0';
	return result;
    }

    /*
     * Pass 1: estimate space, gather flags.
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
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
TclTrimRight(
    const char *bytes,	/* String to be trimmed... */
    size_t numBytes,	/* ...and its length in bytes */
			/* Calls to TclUtfToUniChar() in this routine
			 * 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 *pp, *p = bytes + numBytes;
    int ch1, ch2;

    /* Empty strings -> nothing to do */
    if ((numBytes == 0) || (numTrim == 0)) {
	return 0;
    }

    /*
     * Outer loop: iterate over string to be trimmed.
     */

    do {
	const char *q = trim;
	size_t pInc = 0, bytesLeft = numTrim;

	pp = Tcl_UtfPrev(p, bytes);
	do {
	    pp += pInc;
 	    pInc = TclUtfToUCS4(pp, &ch1);
	} while (pp + pInc < p);








|


|



|

















|







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

Tcl_Size
TclTrimRight(
    const char *bytes,	/* String to be trimmed... */
    Tcl_Size numBytes,	/* ...and its length in bytes */
			/* Calls to TclUtfToUniChar() in this routine
			 * rely on (bytes[numBytes] == '\0'). */
    const char *trim,	/* String of trim characters... */
    Tcl_Size numTrim)	/* ...and its length in bytes */
			/* Calls to TclUtfToUniChar() in this routine
			 * rely on (trim[numTrim] == '\0'). */
{
    const char *pp, *p = bytes + numBytes;
    int ch1, ch2;

    /* Empty strings -> nothing to do */
    if ((numBytes == 0) || (numTrim == 0)) {
	return 0;
    }

    /*
     * Outer loop: iterate over string to be trimmed.
     */

    do {
	const char *q = trim;
	Tcl_Size pInc = 0, bytesLeft = numTrim;

	pp = Tcl_UtfPrev(p, bytes);
	do {
	    pp += pInc;
 	    pInc = TclUtfToUCS4(pp, &ch1);
	} while (pp + pInc < p);

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

size_t
TclTrimLeft(
    const char *bytes,	/* String to be trimmed... */
    size_t numBytes,	/* ...and its length in bytes */
			/* Calls to TclUtfToUniChar() in this routine
			 * rely on (bytes[numBytes] == '\0'). */
    const char *trim,	/* String of trim characters... */
    size_t numTrim)	/* ...and its length in bytes */
			/* Calls to TclUtfToUniChar() in this routine
			 * rely on (trim[numTrim] == '\0'). */
{
    const char *p = bytes;
    int ch1, ch2;

    /* Empty strings -> nothing to do */
    if ((numBytes == 0) || (numTrim == 0)) {
	return 0;
    }

    /*
     * Outer loop: iterate over string to be trimmed.
     */

    do {
	size_t pInc = TclUtfToUCS4(p, &ch1);
	const char *q = trim;
	size_t bytesLeft = numTrim;

	/*
	 * Inner loop: scan trim string for match to current character.
	 */

	do {
	    size_t qInc = TclUtfToUCS4(q, &ch2);

	    if (ch1 == ch2) {
		break;
	    }

	    q += qInc;
	    bytesLeft -= qInc;







|


|



|
















|

|






|







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

Tcl_Size
TclTrimLeft(
    const char *bytes,	/* String to be trimmed... */
    Tcl_Size numBytes,	/* ...and its length in bytes */
			/* Calls to TclUtfToUniChar() in this routine
			 * rely on (bytes[numBytes] == '\0'). */
    const char *trim,	/* String of trim characters... */
    Tcl_Size numTrim)	/* ...and its length in bytes */
			/* Calls to TclUtfToUniChar() in this routine
			 * rely on (trim[numTrim] == '\0'). */
{
    const char *p = bytes;
    int ch1, ch2;

    /* Empty strings -> nothing to do */
    if ((numBytes == 0) || (numTrim == 0)) {
	return 0;
    }

    /*
     * Outer loop: iterate over string to be trimmed.
     */

    do {
	Tcl_Size pInc = TclUtfToUCS4(p, &ch1);
	const char *q = trim;
	Tcl_Size bytesLeft = numTrim;

	/*
	 * Inner loop: scan trim string for match to current character.
	 */

	do {
	    Tcl_Size qInc = TclUtfToUCS4(q, &ch2);

	    if (ch1 == ch2) {
		break;
	    }

	    q += qInc;
	    bytesLeft -= qInc;
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
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
TclTrim(
    const char *bytes,	/* String to be trimmed... */
    size_t numBytes,	/* ...and its length in bytes */
			/* Calls in this routine
			 * rely on (bytes[numBytes] == '\0'). */
    const char *trim,	/* String of trim characters... */
    size_t numTrim,	/* ...and its length in bytes */
			/* Calls in this routine
			 * rely on (trim[numTrim] == '\0'). */
    size_t *trimRightPtr)	/* Offset from the end of the string. */
{
    size_t trimLeft = 0, trimRight = 0;

    /* Empty strings -> nothing to do */
    if ((numBytes > 0) && (numTrim > 0)) {

	/* When bytes is NUL-terminated, returns 0 <= trimLeft <= numBytes */
	trimLeft = TclTrimLeft(bytes, numBytes, trim, numTrim);
	numBytes -= trimLeft;







|


|



|


|

|







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

Tcl_Size
TclTrim(
    const char *bytes,	/* String to be trimmed... */
    Tcl_Size numBytes,	/* ...and its length in bytes */
			/* Calls in this routine
			 * rely on (bytes[numBytes] == '\0'). */
    const char *trim,	/* String of trim characters... */
    Tcl_Size numTrim,	/* ...and its length in bytes */
			/* Calls in this routine
			 * rely on (trim[numTrim] == '\0'). */
    Tcl_Size *trimRightPtr)	/* Offset from the end of the string. */
{
    Tcl_Size trimLeft = 0, trimRight = 0;

    /* Empty strings -> nothing to do */
    if ((numBytes > 0) && (numTrim > 0)) {

	/* When bytes is NUL-terminated, returns 0 <= trimLeft <= numBytes */
	trimLeft = TclTrimLeft(bytes, numBytes, trim, numTrim);
	numBytes -= trimLeft;
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
 */

/* The whitespace characters trimmed during [concat] operations */
#define CONCAT_WS_SIZE (sizeof(CONCAT_TRIM_SET "") - 1)

char *
Tcl_Concat(
    size_t argc,			/* Number of strings to concatenate. */
    const char *const *argv)	/* Array of strings to concatenate. */
{
    size_t i, needSpace = 0, bytesNeeded = 0;
    char *result, *p;

    /*
     * Dispose of the empty result corner case first to simplify later code.
     */

    if (argc == 0) {
	result = (char *) Tcl_Alloc(1);
	result[0] = '\0';
	return result;
    }

    /*
     * First allocate the result buffer at the size required.
     */

    for (i = 0;  i < argc;  i++) {
	bytesNeeded += strlen(argv[i]);



    }

    /*
     * All element bytes + (argc - 1) spaces + 1 terminating NULL.
     */









    result = (char *)Tcl_Alloc(bytesNeeded + argc);

    for (p = result, i = 0;  i < argc;  i++) {
	size_t triml, trimr, elemLength;
	const char *element;

	element = argv[i];
	elemLength = strlen(argv[i]);

	/* Trim away the leading/trailing whitespace. */
	triml = TclTrim(element, elemLength, CONCAT_TRIM_SET,







|


|


















>
>
>





>
>
>
>
>
>
>
>




|







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

/* The whitespace characters trimmed during [concat] operations */
#define CONCAT_WS_SIZE (sizeof(CONCAT_TRIM_SET "") - 1)

char *
Tcl_Concat(
    Tcl_Size argc,			/* Number of strings to concatenate. */
    const char *const *argv)	/* Array of strings to concatenate. */
{
    Tcl_Size i, needSpace = 0, bytesNeeded = 0;
    char *result, *p;

    /*
     * Dispose of the empty result corner case first to simplify later code.
     */

    if (argc == 0) {
	result = (char *) Tcl_Alloc(1);
	result[0] = '\0';
	return result;
    }

    /*
     * First allocate the result buffer at the size required.
     */

    for (i = 0;  i < argc;  i++) {
	bytesNeeded += strlen(argv[i]);
    	if (bytesNeeded < 0) {
	    Tcl_Panic("Tcl_Concat: max size of Tcl value exceeded");
	}
    }

    /*
     * All element bytes + (argc - 1) spaces + 1 terminating NULL.
     */
    if (bytesNeeded + argc - 1 < 0) {
	/*
	 * Panic test could be tighter, but not going to bother for this
	 * legacy routine.
	 */

	Tcl_Panic("Tcl_Concat: max size of Tcl value exceeded");
    }

    result = (char *)Tcl_Alloc(bytesNeeded + argc);

    for (p = result, i = 0;  i < argc;  i++) {
	Tcl_Size triml, trimr, elemLength;
	const char *element;

	element = argv[i];
	elemLength = strlen(argv[i]);

	/* Trim away the leading/trailing whitespace. */
	triml = TclTrim(element, elemLength, CONCAT_TRIM_SET,
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
 *	A new object is created.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_ConcatObj(
    size_t objc,			/* Number of objects to concatenate. */
    Tcl_Obj *const objv[])	/* Array of objects to concatenate. */
{
    int needSpace = 0;
    size_t i, bytesNeeded = 0, elemLength;
    const char *element;
    Tcl_Obj *objPtr, *resPtr;

    /*
     * Check first to see if all the items are of list type or empty. If so,
     * we will concat them together as lists, and return a list object. This
     * is only valid when the lists are in canonical form.
     */

    for (i = 0;  i < objc;  i++) {
	size_t length;

	objPtr = objv[i];
	if (TclListObjIsCanonical(objPtr)) {

	    continue;
	}
	(void)Tcl_GetStringFromObj(objPtr, &length);
	if (length > 0) {
	    break;
	}
    }
    if (i == objc) {
	resPtr = NULL;
	for (i = 0;  i < objc;  i++) {
	    objPtr = objv[i];
	    if (!TclListObjIsCanonical(objPtr)) {

		continue;
	    }
	    if (resPtr) {
		Tcl_Obj *elemPtr = NULL;

		Tcl_ListObjIndex(NULL, objPtr, 0, &elemPtr);
		if (elemPtr == NULL) {
		    continue;
		}
		if (Tcl_GetString(elemPtr)[0] == '#' || TCL_OK
			!= Tcl_ListObjAppendList(NULL, resPtr, objPtr)) {
		    /* Abandon ship! */
		    Tcl_DecrRefCount(resPtr);
		    goto slow;
		}
	    } else {
		resPtr = TclListObjCopy(NULL, objPtr);




	    }
	}
	if (!resPtr) {
	    TclNewObj(resPtr);
	}
	return resPtr;
    }

  slow:
    /*
     * Something cannot be determined to be safe, so build the concatenation
     * the slow way, using the string representations.
     *
     * First try to pre-allocate the size required.
     */

    for (i = 0;  i < objc;  i++) {
	element = Tcl_GetStringFromObj(objv[i], &elemLength);



	bytesNeeded += elemLength;
    }

    /*
     * Does not matter if this fails, will simply try later to build up the
     * string with each Append reallocating as needed with the usual string
     * append algorithm.  When that fails it will report the error.
     */

    TclNewObj(resPtr);
    (void) Tcl_AttemptSetObjLength(resPtr, bytesNeeded + objc - 1);
    Tcl_SetObjLength(resPtr, 0);

    for (i = 0;  i < objc;  i++) {
	size_t triml, trimr;

	element = Tcl_GetStringFromObj(objv[i], &elemLength);

	/* Trim away the leading/trailing whitespace. */
	triml = TclTrim(element, elemLength, CONCAT_TRIM_SET,
		CONCAT_WS_SIZE, &trimr);
	element += triml;







|



|










|


|
>











|
>
















|
>
>
>
>













|




>
>
>














|







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
 *	A new object is created.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_ConcatObj(
    Tcl_Size objc,		/* Number of objects to concatenate. */
    Tcl_Obj *const objv[])	/* Array of objects to concatenate. */
{
    int needSpace = 0;
    Tcl_Size i, bytesNeeded = 0, elemLength;
    const char *element;
    Tcl_Obj *objPtr, *resPtr;

    /*
     * Check first to see if all the items are of list type or empty. If so,
     * we will concat them together as lists, and return a list object. This
     * is only valid when the lists are in canonical form.
     */

    for (i = 0;  i < objc;  i++) {
	Tcl_Size length;

	objPtr = objv[i];
	if (TclListObjIsCanonical(objPtr) ||
            TclObjTypeHasProc(objPtr,indexProc)) {
	    continue;
	}
	(void)Tcl_GetStringFromObj(objPtr, &length);
	if (length > 0) {
	    break;
	}
    }
    if (i == objc) {
	resPtr = NULL;
	for (i = 0;  i < objc;  i++) {
	    objPtr = objv[i];
	    if (!TclListObjIsCanonical(objPtr) &&
		!TclObjTypeHasProc(objPtr,indexProc)) {
		continue;
	    }
	    if (resPtr) {
		Tcl_Obj *elemPtr = NULL;

		Tcl_ListObjIndex(NULL, objPtr, 0, &elemPtr);
		if (elemPtr == NULL) {
		    continue;
		}
		if (Tcl_GetString(elemPtr)[0] == '#' || TCL_OK
			!= Tcl_ListObjAppendList(NULL, resPtr, objPtr)) {
		    /* Abandon ship! */
		    Tcl_DecrRefCount(resPtr);
		    goto slow;
		}
	    } else {
		resPtr = TclDuplicatePureObj(
		    NULL, objPtr, &tclListType);
		if (!resPtr) {
		    return NULL;
		}
	    }
	}
	if (!resPtr) {
	    TclNewObj(resPtr);
	}
	return resPtr;
    }

  slow:
    /*
     * Something cannot be determined to be safe, so build the concatenation
     * the slow way, using the string representations.
     *
     * First try to preallocate the size required.
     */

    for (i = 0;  i < objc;  i++) {
	element = Tcl_GetStringFromObj(objv[i], &elemLength);
	if (bytesNeeded > (TCL_SIZE_MAX - elemLength)) {
	    break; /* Overflow. Do not preallocate. See comment below. */
	}
	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++) {
	Tcl_Size triml, trimr;

	element = Tcl_GetStringFromObj(objv[i], &elemLength);

	/* Trim away the leading/trailing whitespace. */
	triml = TclTrim(element, elemLength, CONCAT_TRIM_SET,
		CONCAT_WS_SIZE, &trimr);
	element += triml;
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
 *
 *----------------------------------------------------------------------
 */

int
TclByteArrayMatch(
    const unsigned char *string,/* String. */
    size_t strLen,			/* Length of String */
    const unsigned char *pattern,
				/* Pattern, which may contain special
				 * characters. */
    size_t ptnLen,			/* Length of Pattern */
    TCL_UNUSED(int) /*flags*/)
{
    const unsigned char *stringEnd, *patternEnd;
    unsigned char p;

    stringEnd = string + strLen;
    patternEnd = pattern + ptnLen;







|



|







2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
 *
 *----------------------------------------------------------------------
 */

int
TclByteArrayMatch(
    const unsigned char *string,/* String. */
    Tcl_Size strLen,			/* Length of String */
    const unsigned char *pattern,
				/* Pattern, which may contain special
				 * characters. */
    Tcl_Size ptnLen,			/* Length of Pattern */
    TCL_UNUSED(int) /*flags*/)
{
    const unsigned char *stringEnd, *patternEnd;
    unsigned char p;

    stringEnd = string + strLen;
    patternEnd = pattern + ptnLen;
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
TclStringMatchObj(
    Tcl_Obj *strObj,		/* string object. */
    Tcl_Obj *ptnObj,		/* pattern object. */
    int flags)			/* Only TCL_MATCH_NOCASE should be passed, or
				 * 0. */
{
    int match;
    size_t length = 0, plen = 0;

    /*
     * Promote based on the type of incoming object.
     * XXX: Currently doesn't take advantage of exact-ness that
     * XXX: TclReToGlob tells us about
    trivial = nocase ? 0 : TclMatchIsTrivial(TclGetString(ptnObj));
     */







|







2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
TclStringMatchObj(
    Tcl_Obj *strObj,		/* string object. */
    Tcl_Obj *ptnObj,		/* pattern object. */
    int flags)			/* Only TCL_MATCH_NOCASE should be passed, or
				 * 0. */
{
    int match;
    Tcl_Size length = 0, plen = 0;

    /*
     * Promote based on the type of incoming object.
     * XXX: Currently doesn't take advantage of exact-ness that
     * XXX: TclReToGlob tells us about
    trivial = nocase ? 0 : TclMatchIsTrivial(TclGetString(ptnObj));
     */
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
 */

char *
Tcl_DStringAppend(
    Tcl_DString *dsPtr,		/* Structure describing dynamic string. */
    const char *bytes,		/* String to append. If length is
				 * TCL_INDEX_NONE then this must be null-terminated. */
    size_t length)			/* Number of bytes from "bytes" to append. If
				 * TCL_INDEX_NONE, then append all of bytes, up to null
				 * at end. */
{
    size_t newSize;

    if (length == TCL_INDEX_NONE) {
	length = strlen(bytes);
    }







    newSize = length + dsPtr->length;

    /*
     * Allocate a larger buffer for the string if the current one isn't large
     * enough. Allocate extra space in the new buffer so that there will be
     * room to grow before we have to allocate again.
     */

    if (newSize >= dsPtr->spaceAvl) {
	dsPtr->spaceAvl = newSize * 2;
	if (dsPtr->string == dsPtr->staticSpace) {
	    char *newString = (char *)Tcl_Alloc(dsPtr->spaceAvl);

	    memcpy(newString, dsPtr->string, dsPtr->length);
	    dsPtr->string = newString;
	} else {
	    size_t index = TCL_INDEX_NONE;

	    /* See [16896d49fd] */
	    if (bytes >= dsPtr->string
		    && bytes <= dsPtr->string + dsPtr->length) {

		index = bytes - dsPtr->string;
	    }

	    dsPtr->string = (char *)Tcl_Realloc(dsPtr->string, dsPtr->spaceAvl);

	    if (index != TCL_INDEX_NONE) {
		bytes = dsPtr->string + index;
	    }
	}
    }

    /*
     * Copy the new string into the buffer at the end of the old one.
     */







|



|

|


>
>
>
>
>
>
>
|

<
<
<
<
<

|
<

|
|



|




>
|

<
|
|
|
|







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

char *
Tcl_DStringAppend(
    Tcl_DString *dsPtr,		/* Structure describing dynamic string. */
    const char *bytes,		/* String to append. If length is
				 * TCL_INDEX_NONE then this must be null-terminated. */
    Tcl_Size length)		/* Number of bytes from "bytes" to append. If
				 * TCL_INDEX_NONE, then append all of bytes, up to null
				 * at end. */
{
    Tcl_Size newSize;

    if (length < 0) {
	length = strlen(bytes);
    }

    if (length > (TCL_SIZE_MAX - dsPtr->length - 1)) {
	Tcl_Panic("max size for a Tcl value (%" TCL_SIZE_MODIFIER
		  "d bytes) exceeded",
		  TCL_SIZE_MAX);
	return NULL; /* NOTREACHED */
    }
    newSize = length + dsPtr->length + 1;







    if (newSize > dsPtr->spaceAvl) {

	if (dsPtr->string == dsPtr->staticSpace) {
	    char *newString;
	    newString = (char *) TclAllocEx(newSize, &dsPtr->spaceAvl);
	    memcpy(newString, dsPtr->string, dsPtr->length);
	    dsPtr->string = newString;
	} else {
	    Tcl_Size offset = -1;

	    /* See [16896d49fd] */
	    if (bytes >= dsPtr->string
		    && bytes <= dsPtr->string + dsPtr->length) {
		/* Source string is within this DString. Note offset */
		offset = bytes - dsPtr->string;
	    }

	    dsPtr->string =
		(char *)TclReallocEx(dsPtr->string, newSize, &dsPtr->spaceAvl);
	    if (offset >= 0) {
		bytes = dsPtr->string + offset;
	    }
	}
    }

    /*
     * Copy the new string into the buffer at the end of the old one.
     */
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
 */

char *
TclDStringAppendObj(
    Tcl_DString *dsPtr,
    Tcl_Obj *objPtr)
{
    size_t length;
    const char *bytes = Tcl_GetStringFromObj(objPtr, &length);

    return Tcl_DStringAppend(dsPtr, bytes, length);
}

char *
TclDStringAppendDString(







|







2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
 */

char *
TclDStringAppendObj(
    Tcl_DString *dsPtr,
    Tcl_Obj *objPtr)
{
    Tcl_Size length;
    const char *bytes = Tcl_GetStringFromObj(objPtr, &length);

    return Tcl_DStringAppend(dsPtr, bytes, length);
}

char *
TclDStringAppendDString(
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
    const char *element)	/* String to append. Must be
				 * null-terminated. */
{
    char *dst = dsPtr->string + dsPtr->length;
    int needSpace = TclNeedSpace(dsPtr->string, dst);
    char flags = 0;
    int quoteHash = 1;
    size_t newSize;

    if (needSpace) {
	/*
	 * If we need a space to separate the new element from something
	 * already ending the string, we're not appending the first element
	 * of any list, so we need not quote any leading hash character.
	 */







|







2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
    const char *element)	/* String to append. Must be
				 * null-terminated. */
{
    char *dst = dsPtr->string + dsPtr->length;
    int needSpace = TclNeedSpace(dsPtr->string, dst);
    char flags = 0;
    int quoteHash = 1;
    Tcl_Size newSize;

    if (needSpace) {
	/*
	 * If we need a space to separate the new element from something
	 * already ending the string, we're not appending the first element
	 * of any list, so we need not quote any leading hash character.
	 */
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
    /*
     * Allocate a larger buffer for the string if the current one isn't large
     * enough. Allocate extra space in the new buffer so that there will be
     * room to grow before we have to allocate again. SPECIAL NOTE: must use
     * memcpy, not strcpy, to copy the string to a larger buffer, since there
     * may be embedded NULLs in the string in some cases.
     */

    if (newSize >= dsPtr->spaceAvl) {
	dsPtr->spaceAvl = newSize * 2;
	if (dsPtr->string == dsPtr->staticSpace) {
	    char *newString = (char *)Tcl_Alloc(dsPtr->spaceAvl);

	    memcpy(newString, dsPtr->string, dsPtr->length);
	    dsPtr->string = newString;
	} else {
	    int offset = -1;

	    /* See [16896d49fd] */
	    if (element >= dsPtr->string
		    && element <= dsPtr->string + dsPtr->length) {

		offset = element - dsPtr->string;
	    }

	    dsPtr->string = (char *)Tcl_Realloc(dsPtr->string, dsPtr->spaceAvl);

	    if (offset >= 0) {
		element = dsPtr->string + offset;
	    }
	}
    }
    dst = dsPtr->string + dsPtr->length;








|
|
<

|
<








>


<
|
|







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
    /*
     * Allocate a larger buffer for the string if the current one isn't large
     * enough. Allocate extra space in the new buffer so that there will be
     * room to grow before we have to allocate again. SPECIAL NOTE: must use
     * memcpy, not strcpy, to copy the string to a larger buffer, since there
     * may be embedded NULLs in the string in some cases.
     */
    newSize += 1; /* For terminating nul */
    if (newSize > dsPtr->spaceAvl) {

	if (dsPtr->string == dsPtr->staticSpace) {
	    char *newString = (char *) TclAllocEx(newSize, &dsPtr->spaceAvl);

	    memcpy(newString, dsPtr->string, dsPtr->length);
	    dsPtr->string = newString;
	} else {
	    int offset = -1;

	    /* See [16896d49fd] */
	    if (element >= dsPtr->string
		    && element <= dsPtr->string + dsPtr->length) {
		/* Source string is within this DString. Note offset */
		offset = element - dsPtr->string;
	    }

	    dsPtr->string =
		    (char *)TclReallocEx(dsPtr->string, newSize, &dsPtr->spaceAvl);
	    if (offset >= 0) {
		element = dsPtr->string + offset;
	    }
	}
    }
    dst = dsPtr->string + dsPtr->length;

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

void
Tcl_DStringSetLength(
    Tcl_DString *dsPtr,		/* Structure describing dynamic string. */
    size_t length)			/* New length for dynamic string. */
{
    size_t newsize;




    if (length >= dsPtr->spaceAvl) {
	/*
	 * There are two interesting cases here. In the first case, the user
	 * may be trying to allocate a large buffer of a specific size. It
	 * would be wasteful to overallocate that buffer, so we just allocate
	 * enough for the requested size plus the trailing null byte. In the
	 * second case, we are growing the buffer incrementally, so we need
	 * behavior similar to Tcl_DStringAppend. The requested length will
	 * usually be a small delta above the current spaceAvl, so we'll end
	 * up doubling the old size. This won't grow the buffer quite as
	 * quickly, but it should be close enough.
	 */




	newsize = dsPtr->spaceAvl * 2;
	if (length < newsize) {
	    dsPtr->spaceAvl = newsize;
	} else {
	    dsPtr->spaceAvl = length + 1;
	}
	if (dsPtr->string == dsPtr->staticSpace) {
	    char *newString = (char *)Tcl_Alloc(dsPtr->spaceAvl);







|

|

>
>
>







|
|
|
|


>
>
>
|







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

void
Tcl_DStringSetLength(
    Tcl_DString *dsPtr,		/* Structure describing dynamic string. */
    Tcl_Size length)			/* New length for dynamic string. */
{
    Tcl_Size newsize;

    if (length < 0) {
	length = 0;
    }
    if (length >= dsPtr->spaceAvl) {
	/*
	 * There are two interesting cases here. In the first case, the user
	 * may be trying to allocate a large buffer of a specific size. It
	 * would be wasteful to overallocate that buffer, so we just allocate
	 * enough for the requested size plus the trailing null byte. In the
	 * second case, we are growing the buffer incrementally, so we need
	 * behavior similar to Tcl_DStringAppend.
	 * TODO - the above makes no sense to me. How does the code below
	 * translate into distinguishing the two cases above? IMO, if caller
	 * specifically sets the length, there is no cause for overallocation.
	 */

	if (length >= TCL_SIZE_MAX) {
	    Tcl_Panic("Tcl_Concat: max size of Tcl value exceeded");
	}
	newsize = TclUpsizeAlloc(dsPtr->spaceAvl, length + 1, TCL_SIZE_MAX);
	if (length < newsize) {
	    dsPtr->spaceAvl = newsize;
	} else {
	    dsPtr->spaceAvl = length + 1;
	}
	if (dsPtr->string == dsPtr->staticSpace) {
	    char *newString = (char *)Tcl_Alloc(dsPtr->spaceAvl);
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881

void
Tcl_DStringResult(
    Tcl_Interp *interp,		/* Interpreter whose result is to be reset. */
    Tcl_DString *dsPtr)		/* Dynamic string that is to become the
				 * result of interp. */
{
    Tcl_SetObjResult(interp, TclDStringToObj(dsPtr));
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DStringGetResult --
 *







|







2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919

void
Tcl_DStringResult(
    Tcl_Interp *interp,		/* Interpreter whose result is to be reset. */
    Tcl_DString *dsPtr)		/* Dynamic string that is to become the
				 * result of interp. */
{
    Tcl_SetObjResult(interp, Tcl_DStringToObj(dsPtr));
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DStringGetResult --
 *
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
void
Tcl_DStringGetResult(
    Tcl_Interp *interp,		/* Interpreter whose result is to be reset. */
    Tcl_DString *dsPtr)		/* Dynamic string that is to become the result
				 * of interp. */
{
    Tcl_Obj *obj = Tcl_GetObjResult(interp);
    char *bytes = TclGetString(obj);

    Tcl_DStringFree(dsPtr);
    Tcl_DStringAppend(dsPtr, bytes, obj->length);
    Tcl_ResetResult(interp);
}

/*
 *----------------------------------------------------------------------
 *
 * TclDStringToObj --
 *
 *	This function moves a dynamic string's contents to a new Tcl_Obj. Be
 *	aware that this function does *not* check that the encoding of the
 *	contents of the dynamic string is correct; this is the caller's
 *	responsibility to enforce.
 *
 * Results:
 *	The newly-allocated untyped (i.e., typePtr==NULL) Tcl_Obj with a
 *	reference count of zero.
 *
 * Side effects:
 *	The string is "moved" to the object. dsPtr is reinitialized to an
 *	empty string; it does not need to be Tcl_DStringFree'd after this if
 *	not used further.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclDStringToObj(
    Tcl_DString *dsPtr)
{
    Tcl_Obj *result;

    if (dsPtr->string == dsPtr->staticSpace) {
	if (dsPtr->length == 0) {
	    TclNewObj(result);







|









|



















|







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
void
Tcl_DStringGetResult(
    Tcl_Interp *interp,		/* Interpreter whose result is to be reset. */
    Tcl_DString *dsPtr)		/* Dynamic string that is to become the result
				 * of interp. */
{
    Tcl_Obj *obj = Tcl_GetObjResult(interp);
    const char *bytes = TclGetString(obj);

    Tcl_DStringFree(dsPtr);
    Tcl_DStringAppend(dsPtr, bytes, obj->length);
    Tcl_ResetResult(interp);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DStringToObj --
 *
 *	This function moves a dynamic string's contents to a new Tcl_Obj. Be
 *	aware that this function does *not* check that the encoding of the
 *	contents of the dynamic string is correct; this is the caller's
 *	responsibility to enforce.
 *
 * Results:
 *	The newly-allocated untyped (i.e., typePtr==NULL) Tcl_Obj with a
 *	reference count of zero.
 *
 * Side effects:
 *	The string is "moved" to the object. dsPtr is reinitialized to an
 *	empty string; it does not need to be Tcl_DStringFree'd after this if
 *	not used further.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_DStringToObj(
    Tcl_DString *dsPtr)
{
    Tcl_Obj *result;

    if (dsPtr->string == dsPtr->staticSpace) {
	if (dsPtr->length == 0) {
	    TclNewObj(result);
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
	    *dst++ = '.';
	    while (c != '\0') {
		*dst++ = c;
		c = *++p;
	    }
	}

	sprintf(dst, "e%+d", exponent);
    } else {
	/*
	 * F format for others.
	 */

	if (exponent < 0) {
	    *dst++ = '0';







|







3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
	    *dst++ = '.';
	    while (c != '\0') {
		*dst++ = c;
		c = *++p;
	    }
	}

	snprintf(dst, TCL_DOUBLE_SPACE, "e%+d", exponent);
    } else {
	/*
	 * F format for others.
	 */

	if (exponent < 0) {
	    *dst++ = '0';
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
 * Side effects:
 *	The formatted characters are written into the storage pointer to by
 *	the "buffer" argument.
 *
 *----------------------------------------------------------------------
 */

size_t
TclFormatInt(
    char *buffer,		/* Points to the storage into which the
				 * formatted characters are written. */
    Tcl_WideInt n)			/* The integer to format. */
{
    Tcl_WideUInt intVal;
    size_t i = 0, numFormatted, j;
    static const char digits[] = "0123456789";

    /*
     * Generate the characters of the result backwards in the buffer.
     */

    intVal = (n < 0 ? -(Tcl_WideUInt)n : (Tcl_WideUInt)n);







|






|







3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
 * Side effects:
 *	The formatted characters are written into the storage pointer to by
 *	the "buffer" argument.
 *
 *----------------------------------------------------------------------
 */

Tcl_Size
TclFormatInt(
    char *buffer,		/* Points to the storage into which the
				 * formatted characters are written. */
    Tcl_WideInt n)			/* The integer to format. */
{
    Tcl_WideUInt intVal;
    int i = 0, numFormatted, j;
    static const char digits[] = "0123456789";

    /*
     * Generate the characters of the result backwards in the buffer.
     */

    intVal = (n < 0 ? -(Tcl_WideUInt)n : (Tcl_WideUInt)n);
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

static int
GetWideForIndex(
    Tcl_Interp *interp,         /* Interpreter to use for error reporting. If
				 * NULL, then no error message is left after
				 * errors. */
    Tcl_Obj *objPtr,            /* Points to the value to be parsed */
    size_t endValue,            /* The value to be stored at *widePtr if
				 * objPtr holds "end".
                                 * NOTE: this value may be TCL_INDEX_NONE. */
    Tcl_WideInt *widePtr)       /* Location filled in with a wide integer
                                 * representing an index. */
{
    int numType;
    void *cd;
    int code = Tcl_GetNumberFromObj(NULL, objPtr, &cd, &numType);

    if (code == TCL_OK) {
	if (numType == TCL_NUMBER_INT) {
	    /* objPtr holds an integer in the signed wide range */
	    *widePtr = *(Tcl_WideInt *)cd;



	    return TCL_OK;
	}
	if (numType == TCL_NUMBER_BIG) {
	    /* objPtr holds an integer outside the signed wide range */
	    /* Truncate to the signed wide range. */
	    *widePtr = ((mp_isneg((mp_int *)cd)) ? WIDE_MIN : WIDE_MAX);
	    return TCL_OK;
	}
    }

    /* objPtr does not hold a number, check the end+/- format... */
    return GetEndOffsetFromObj(interp, objPtr, endValue, widePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetIntForIndex --
 *
 *	Provides an integer corresponding to the list index held in a Tcl
 *	object. The string value 'objPtr' is expected have the format
 *	integer([+-]integer)? or end([+-]integer)?.
 *





 * Value
 * 	TCL_OK
 *
 * 	    The index is stored at the address given by by 'indexPtr'. If
 * 	    'objPtr' has the value "end", the value stored is 'endValue'.
 *
 * 	TCL_ERROR
 *







|













>
>
>





|

















>
>
>
>
>
|







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

static int
GetWideForIndex(
    Tcl_Interp *interp,         /* Interpreter to use for error reporting. If
				 * NULL, then no error message is left after
				 * errors. */
    Tcl_Obj *objPtr,            /* Points to the value to be parsed */
    Tcl_WideInt endValue,       /* The value to be stored at *widePtr if
				 * objPtr holds "end".
                                 * NOTE: this value may be TCL_INDEX_NONE. */
    Tcl_WideInt *widePtr)       /* Location filled in with a wide integer
                                 * representing an index. */
{
    int numType;
    void *cd;
    int code = Tcl_GetNumberFromObj(NULL, objPtr, &cd, &numType);

    if (code == TCL_OK) {
	if (numType == TCL_NUMBER_INT) {
	    /* objPtr holds an integer in the signed wide range */
	    *widePtr = *(Tcl_WideInt *)cd;
	    if ((*widePtr < 0)) {
		*widePtr = (endValue == -1) ? WIDE_MIN : -1;
	    }
	    return TCL_OK;
	}
	if (numType == TCL_NUMBER_BIG) {
	    /* objPtr holds an integer outside the signed wide range */
	    /* Truncate to the signed wide range. */
	    *widePtr = ((mp_isneg((mp_int *)cd)) ? ((endValue == -1) ? WIDE_MIN : -1) : WIDE_MAX);
	    return TCL_OK;
	}
    }

    /* objPtr does not hold a number, check the end+/- format... */
    return GetEndOffsetFromObj(interp, objPtr, endValue, widePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetIntForIndex --
 *
 *	Provides an integer corresponding to the list index held in a Tcl
 *	object. The string value 'objPtr' is expected have the format
 *	integer([+-]integer)? or end([+-]integer)?.
 *
 *	If the computed index lies within the valid range of Tcl indices
 *	(0..TCL_SIZE_MAX) it is returned. Higher values are returned as
 *	TCL_SIZE_MAX. Negative values are returned as TCL_INDEX_NONE (-1).
 *
 *
 * Results:
 * 	TCL_OK
 *
 * 	    The index is stored at the address given by by 'indexPtr'. If
 * 	    'objPtr' has the value "end", the value stored is 'endValue'.
 *
 * 	TCL_ERROR
 *
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
int
Tcl_GetIntForIndex(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting. If
				 * NULL, then no error message is left after
				 * errors. */
    Tcl_Obj *objPtr,		/* Points to an object containing either "end"
				 * or an integer. */
    size_t endValue,		/* The value to be stored at "indexPtr" if
				 * "objPtr" holds "end". */
    size_t *indexPtr)		/* Location filled in with an integer
				 * representing an index. May be NULL.*/
{
    Tcl_WideInt wide;

    if (GetWideForIndex(interp, objPtr, endValue, &wide) == TCL_ERROR) {
	return TCL_ERROR;
    }
    if (indexPtr != NULL) {
	if ((wide < 0) && (endValue < TCL_INDEX_END)) {
	    *indexPtr = TCL_INDEX_NONE;
	} else if ((Tcl_WideUInt)wide > TCL_INDEX_END && (endValue < TCL_INDEX_END)) {
	    *indexPtr = TCL_INDEX_END;


	} else {
	    *indexPtr = (size_t) wide;
	}
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * GetEndOffsetFromObj --
 *
 *	Look for a string of the form "end[+-]offset" or "offset[+-]offset" and
 *	convert it to an internal representation.
 *
 *	The internal representation (wideValue) uses the following encoding:
 *
 *	WIDE_MIN:   Index value TCL_INDEX_NONE (or -1)
 *	WIDE_MIN+1: Index value n, for any n < -1  (usually same effect as -1)
 *	-$n:        Index "end-[expr {$n-1}]"
 *	-2:         Index "end-1"
 *	-1:         Index "end"
 *	0:          Index "0"
 *	WIDE_MAX-1: Index "end+n", for any n > 1

 *	WIDE_MAX:   Index "end+1"
 *
 * Results:
 *	Tcl return code.
 *
 * Side effects:
 *	May store a Tcl_ObjType.
 *
 *----------------------------------------------------------------------
 */

static int
GetEndOffsetFromObj(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,            /* Pointer to the object to parse */
    size_t endValue,            /* The value to be stored at "indexPtr" if
                                 * "objPtr" holds "end". */
    Tcl_WideInt *widePtr)       /* Location filled in with an integer
                                 * representing an index. */
{
    Tcl_ObjInternalRep *irPtr;
    Tcl_WideInt offset = -1;	/* Offset in the "end-offset" expression - 1 */
    void *cd;

    while ((irPtr = TclFetchInternalRep(objPtr, &endOffsetType)) == NULL) {
	Tcl_ObjInternalRep ir;
	size_t length;
	const char *bytes = Tcl_GetStringFromObj(objPtr, &length);

	if (*bytes != 'e') {
	    int numType;
	    const char *opPtr;
	    int t1 = 0, t2 = 0;








|
<
|








|

|
|
>
>

|




>
















|
>















|










|







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
int
Tcl_GetIntForIndex(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting. If
				 * NULL, then no error message is left after
				 * errors. */
    Tcl_Obj *objPtr,		/* Points to an object containing either "end"
				 * or an integer. */
    Tcl_Size endValue,		/* The value corresponding to the "end" index */

    Tcl_Size *indexPtr)		/* Location filled in with an integer
				 * representing an index. May be NULL.*/
{
    Tcl_WideInt wide;

    if (GetWideForIndex(interp, objPtr, endValue, &wide) == TCL_ERROR) {
	return TCL_ERROR;
    }
    if (indexPtr != NULL) {
	if ((wide < 0) && (endValue >= 0)) {
	    *indexPtr = TCL_INDEX_NONE;
	} else if (wide > TCL_SIZE_MAX) {
	    *indexPtr = TCL_SIZE_MAX;
	} else if (wide < -1-TCL_SIZE_MAX) {
	    *indexPtr = -1-TCL_SIZE_MAX;
	} else {
	    *indexPtr = (Tcl_Size) wide;
	}
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * GetEndOffsetFromObj --
 *
 *	Look for a string of the form "end[+-]offset" or "offset[+-]offset" and
 *	convert it to an internal representation.
 *
 *	The internal representation (wideValue) uses the following encoding:
 *
 *	WIDE_MIN:   Index value TCL_INDEX_NONE (or -1)
 *	WIDE_MIN+1: Index value n, for any n < -1  (usually same effect as -1)
 *	-$n:        Index "end-[expr {$n-1}]"
 *	-2:         Index "end-1"
 *	-1:         Index "end"
 *	0:          Index "0"
 *	WIDE_MAX-1: Index "end+n", for any n > 1. Distinguish from end+1 for
 *                  commands like lset.
 *	WIDE_MAX:   Index "end+1"
 *
 * Results:
 *	Tcl return code.
 *
 * Side effects:
 *	May store a Tcl_ObjType.
 *
 *----------------------------------------------------------------------
 */

static int
GetEndOffsetFromObj(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,            /* Pointer to the object to parse */
    Tcl_WideInt endValue,       /* The value to be stored at "widePtr" if
                                 * "objPtr" holds "end". */
    Tcl_WideInt *widePtr)       /* Location filled in with an integer
                                 * representing an index. */
{
    Tcl_ObjInternalRep *irPtr;
    Tcl_WideInt offset = -1;	/* Offset in the "end-offset" expression - 1 */
    void *cd;

    while ((irPtr = TclFetchInternalRep(objPtr, &endOffsetType)) == NULL) {
	Tcl_ObjInternalRep ir;
	Tcl_Size length;
	const char *bytes = Tcl_GetStringFromObj(objPtr, &length);

	if (*bytes != 'e') {
	    int numType;
	    const char *opPtr;
	    int t1 = 0, t2 = 0;

3642
3643
3644
3645
3646
3647
3648
3649
3650
3651


3652
3653
3654
3655
3656
3657
3658
3659
3660
3661
	ir.wideValue = offset;
	Tcl_StoreInternalRep(objPtr, &endOffsetType, &ir);
    }

    offset = irPtr->wideValue;

    if (offset == WIDE_MAX) {
	*widePtr = endValue + 1;
    } else if (offset == WIDE_MIN) {
	*widePtr = -1;


    } else if (offset < 0) {
	/* Different signs, sum cannot overflow */
	*widePtr = endValue + offset + 1;
    } else if (offset < WIDE_MAX) {
	*widePtr = offset;
    } else {
	*widePtr = WIDE_MAX;
    }
    return TCL_OK;








|


>
>


|







3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
	ir.wideValue = offset;
	Tcl_StoreInternalRep(objPtr, &endOffsetType, &ir);
    }

    offset = irPtr->wideValue;

    if (offset == WIDE_MAX) {
	*widePtr = (endValue == -1) ? WIDE_MAX : endValue + 1;
    } else if (offset == WIDE_MIN) {
	*widePtr = -1;
    } else if (endValue == -1) {
	*widePtr = offset;
    } else if (offset < 0) {
	/* Different signs, sum cannot overflow */
	*widePtr = (size_t)endValue + offset + 1;
    } else if (offset < WIDE_MAX) {
	*widePtr = offset;
    } else {
	*widePtr = WIDE_MAX;
    }
    return TCL_OK;

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

int
TclIndexEncode(
    Tcl_Interp *interp,	/* For error reporting, may be NULL */
    Tcl_Obj *objPtr,	/* Index value to parse */
    size_t before,		/* Value to return for index before beginning */
    size_t after,		/* Value to return for index after end */
    int *indexPtr)	/* Where to write the encoded answer, not NULL */
{
    Tcl_WideInt wide;
    int idx;

    if (TCL_OK == GetWideForIndex(interp, objPtr, (unsigned)TCL_INDEX_END , &wide)) {
	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, &endOffsetType);
	if (irPtr && irPtr->wideValue >= 0) {
	    /* "int[+-]int" syntax, works the same here as "int" */
	    irPtr = NULL;
	}
	/*
	 * We parsed an end+offset index value.
	 * wide holds the offset value in the range WIDE_MIN...WIDE_MAX.
	 */
	if ((irPtr ? ((wide < INT_MIN) && ((size_t)-wide <= LIST_MAX))
		: ((wide > INT_MAX) && ((size_t)wide <= LIST_MAX))) && (sizeof(int) != sizeof(size_t))) {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"index \"%s\" out of range",
			TclGetString(objPtr)));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX"
			"OUTOFRANGE", NULL);
	    }
	    return TCL_ERROR;
	} else if (wide > (unsigned)(irPtr ? TCL_INDEX_END : INT_MAX)) {
	    /*
	     * All end+postive or end-negative expressions
	     * always indicate "after the end".
	     */
	    idx = after;
	} else if (wide <= (irPtr ? INT_MAX : -1)) {
	    /* These indices always indicate "before the beginning */
	    idx = before;
	} else {
	    /* Encoded end-positive (or end+negative) are offset */
	    idx = (int)wide;
	}
    } else {
	return TCL_ERROR;







|
|















|
|















|







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

int
TclIndexEncode(
    Tcl_Interp *interp,	/* For error reporting, may be NULL */
    Tcl_Obj *objPtr,	/* Index value to parse */
    int before,	/* Value to return for index before beginning */
    int after,		/* Value to return for index after end */
    int *indexPtr)	/* Where to write the encoded answer, not NULL */
{
    Tcl_WideInt wide;
    int idx;

    if (TCL_OK == GetWideForIndex(interp, objPtr, (unsigned)TCL_INDEX_END , &wide)) {
	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, &endOffsetType);
	if (irPtr && irPtr->wideValue >= 0) {
	    /* "int[+-]int" syntax, works the same here as "int" */
	    irPtr = NULL;
	}
	/*
	 * We parsed an end+offset index value.
	 * wide holds the offset value in the range WIDE_MIN...WIDE_MAX.
	 */
	if ((irPtr ? ((wide < INT_MIN) && ((Tcl_Size)-wide <= LIST_MAX))
		: ((wide > INT_MAX) && ((Tcl_Size)wide <= LIST_MAX))) && (sizeof(int) != sizeof(Tcl_Size))) {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"index \"%s\" out of range",
			TclGetString(objPtr)));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX"
			"OUTOFRANGE", NULL);
	    }
	    return TCL_ERROR;
	} else if (wide > (unsigned)(irPtr ? TCL_INDEX_END : INT_MAX)) {
	    /*
	     * All end+postive or end-negative expressions
	     * always indicate "after the end".
	     */
	    idx = after;
	} else if (wide <= (irPtr ? INT_MAX : -1)) {
	    /* These indices always indicate "before the beginning" */
	    idx = before;
	} else {
	    /* Encoded end-positive (or end+negative) are offset */
	    idx = (int)wide;
	}
    } else {
	return TCL_ERROR;
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
 *
 * Results:
 *	The decoded index value.
 *
 *----------------------------------------------------------------------
 */

size_t
TclIndexDecode(
    int encoded,	/* Value to decode */
    size_t endValue)	/* Meaning of "end" to use, > TCL_INDEX_END */
{
    if (encoded > (int)TCL_INDEX_END) {
	return encoded;
    }
    if (endValue >= TCL_INDEX_END - encoded) {
	return endValue + encoded - TCL_INDEX_END;
    }
    return TCL_INDEX_NONE;
}







































































/*
 *----------------------------------------------------------------------
 *
 * ClearHash --
 *
 *	Remove all the entries in the hash table *tablePtr.







|


|

|


|




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







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
 *
 * Results:
 *	The decoded index value.
 *
 *----------------------------------------------------------------------
 */

Tcl_Size
TclIndexDecode(
    int encoded,	/* Value to decode */
    Tcl_Size endValue)	/* Meaning of "end" to use, > TCL_INDEX_END */
{
    if (encoded > TCL_INDEX_END) {
	return encoded;
    }
    if ((size_t)endValue >= (size_t)TCL_INDEX_END - encoded) {
	return endValue + encoded - TCL_INDEX_END;
    }
    return TCL_INDEX_NONE;
}

/*
 *------------------------------------------------------------------------
 *
 * TclIndexInvalidError --
 *
 *    Generates an error message including the invalid index.
 *
 * Results:
 *    Always return TCL_ERROR.
 *
 * Side effects:
 *    If interp is not-NULL, an error message is stored in it.
 *
 *------------------------------------------------------------------------
 */
int
TclIndexInvalidError (
    Tcl_Interp *interp,   /* May be NULL */
    const char *idxType,  /* The descriptive string for idx. Defaults to "index" */
    Tcl_Size idx)         /* Invalid index value */
{
    if (interp) {
	Tcl_SetObjResult(interp,
			 Tcl_ObjPrintf("Invalid %s value %" TCL_SIZE_MODIFIER "d.",
				       idxType ? idxType : "index",
				       idx));
    }
    return TCL_ERROR; /* Always */
}

/*
 *------------------------------------------------------------------------
 *
 * TclCommandWordLimitErrpr --
 *
 *    Generates an error message limit on number of command words exceeded.
 *
 * Results:
 *    Always return TCL_ERROR.
 *
 * Side effects:
 *    If interp is not-NULL, an error message is stored in it.
 *
 *------------------------------------------------------------------------
 */
int
TclCommandWordLimitError (
    Tcl_Interp *interp,   /* May be NULL */
    Tcl_Size count)       /* If <= 0, "unknown" */
{
    if (interp) {
	if (count > 0) {
	    Tcl_SetObjResult(
		interp,
		Tcl_ObjPrintf("Number of words (%" TCL_SIZE_MODIFIER
			      "d) in command exceeds limit %" TCL_SIZE_MODIFIER
			      "d.",
			      count,
			      (Tcl_Size)INT_MAX));
	}
	else {
	    Tcl_SetObjResult(interp,
			     Tcl_ObjPrintf("Number of words in command exceeds "
					   "limit %" TCL_SIZE_MODIFIER "d.",
					   (Tcl_Size)INT_MAX));
	}
    }
    return TCL_ERROR; /* Always */
}

/*
 *----------------------------------------------------------------------
 *
 * ClearHash --
 *
 *	Remove all the entries in the hash table *tablePtr.
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
Tcl_Obj *
TclGetProcessGlobalValue(
    ProcessGlobalValue *pgvPtr)
{
    Tcl_Obj *value = NULL;
    Tcl_HashTable *cacheMap;
    Tcl_HashEntry *hPtr;
    size_t epoch = pgvPtr->epoch;

    if (pgvPtr->encoding) {
	Tcl_Encoding current = Tcl_GetEncoding(NULL, NULL);

	if (pgvPtr->encoding != current) {
	    /*
	     * The system encoding has changed since the global string value
	     * was saved. Convert the global value to be based on the new
	     * system encoding.
	     */

	    Tcl_DString native, newValue;

	    Tcl_MutexLock(&pgvPtr->mutex);
	    epoch = ++pgvPtr->epoch;
	    Tcl_UtfToExternalDStringEx(pgvPtr->encoding, pgvPtr->value,
		    pgvPtr->numBytes, TCL_ENCODING_NOCOMPLAIN, &native);
	    Tcl_ExternalToUtfDStringEx(current, Tcl_DStringValue(&native),
	    Tcl_DStringLength(&native), TCL_ENCODING_NOCOMPLAIN, &newValue);

	    Tcl_DStringFree(&native);
	    Tcl_Free(pgvPtr->value);
	    pgvPtr->value = (char *)Tcl_Alloc(Tcl_DStringLength(&newValue) + 1);
	    memcpy(pgvPtr->value, Tcl_DStringValue(&newValue),
		    Tcl_DStringLength(&newValue) + 1);
	    Tcl_DStringFree(&newValue);
	    Tcl_FreeEncoding(pgvPtr->encoding);







|















|
|
|
|
>







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
Tcl_Obj *
TclGetProcessGlobalValue(
    ProcessGlobalValue *pgvPtr)
{
    Tcl_Obj *value = NULL;
    Tcl_HashTable *cacheMap;
    Tcl_HashEntry *hPtr;
    Tcl_Size epoch = pgvPtr->epoch;

    if (pgvPtr->encoding) {
	Tcl_Encoding current = Tcl_GetEncoding(NULL, NULL);

	if (pgvPtr->encoding != current) {
	    /*
	     * The system encoding has changed since the global string value
	     * was saved. Convert the global value to be based on the new
	     * system encoding.
	     */

	    Tcl_DString native, newValue;

	    Tcl_MutexLock(&pgvPtr->mutex);
	    epoch = ++pgvPtr->epoch;
	    Tcl_UtfToExternalDStringEx(NULL, pgvPtr->encoding, pgvPtr->value,
		pgvPtr->numBytes, TCL_ENCODING_PROFILE_TCL8, &native, NULL);
	    Tcl_ExternalToUtfDStringEx(NULL, current, Tcl_DStringValue(&native),
		Tcl_DStringLength(&native), TCL_ENCODING_PROFILE_TCL8,
		&newValue, NULL);
	    Tcl_DStringFree(&native);
	    Tcl_Free(pgvPtr->value);
	    pgvPtr->value = (char *)Tcl_Alloc(Tcl_DStringLength(&newValue) + 1);
	    memcpy(pgvPtr->value, Tcl_DStringValue(&newValue),
		    Tcl_DStringLength(&newValue) + 1);
	    Tcl_DStringFree(&newValue);
	    Tcl_FreeEncoding(pgvPtr->encoding);
4202
4203
4204
4205
4206
4207
4208
4209
4210
4211
4212
4213
4214
4215
4216
 *----------------------------------------------------------------------
 */

int
TclReToGlob(
    Tcl_Interp *interp,
    const char *reStr,
    size_t reStrLen,
    Tcl_DString *dsPtr,
    int *exactPtr,
    int *quantifiersFoundPtr)
{
    int anchorLeft, anchorRight, lastIsStar, numStars;
    char *dsStr, *dsStrStart;
    const char *msg, *p, *strEnd, *code;







|







4324
4325
4326
4327
4328
4329
4330
4331
4332
4333
4334
4335
4336
4337
4338
 *----------------------------------------------------------------------
 */

int
TclReToGlob(
    Tcl_Interp *interp,
    const char *reStr,
    Tcl_Size reStrLen,
    Tcl_DString *dsPtr,
    int *exactPtr,
    int *quantifiersFoundPtr)
{
    int anchorLeft, anchorRight, lastIsStar, numStars;
    char *dsStr, *dsStrStart;
    const char *msg, *p, *strEnd, *code;
4395
4396
4397
4398
4399
4400
4401
4402
4403
4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
	*exactPtr = (anchorLeft && anchorRight);
    }

    return TCL_OK;

  invalidGlob:
    if (interp != NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, TCL_INDEX_NONE));
	Tcl_SetErrorCode(interp, "TCL", "RE2GLOB", code, NULL);
    }
    Tcl_DStringFree(dsPtr);
    return TCL_ERROR;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|













4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
	*exactPtr = (anchorLeft && anchorRight);
    }

    return TCL_OK;

  invalidGlob:
    if (interp != NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1));
	Tcl_SetErrorCode(interp, "TCL", "RE2GLOB", code, NULL);
    }
    Tcl_DStringFree(dsPtr);
    return TCL_ERROR;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclVar.c.

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
 *			scalar variable
 *   twoPtrValue.ptr2:	pointer to the element name string (owned by this
 *			Tcl_Obj), or NULL if it is a scalar variable
 */

static const Tcl_ObjType localVarNameType = {
    "localVarName",
    FreeLocalVarName, DupLocalVarName, NULL, NULL

};

#define LocalSetInternalRep(objPtr, index, namePtr)				\
    do {								\
	Tcl_ObjInternalRep ir;						\
	Tcl_Obj *ptr = (namePtr);					\
	if (ptr) {Tcl_IncrRefCount(ptr);}				\
	ir.twoPtrValue.ptr1 = ptr;					\
	ir.twoPtrValue.ptr2 = INT2PTR(index);				\
	Tcl_StoreInternalRep((objPtr), &localVarNameType, &ir);		\
    } while (0)

#define LocalGetInternalRep(objPtr, index, name)				\
    do {								\
	const Tcl_ObjInternalRep *irPtr;					\
	irPtr = TclFetchInternalRep((objPtr), &localVarNameType);		\
	(name) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr1 : NULL;		\
	(index) = irPtr ? PTR2UINT(irPtr->twoPtrValue.ptr2) : TCL_INDEX_NONE;	\
    } while (0)

static const Tcl_ObjType parsedVarNameType = {
    "parsedVarName",
    FreeParsedVarName, DupParsedVarName, NULL, NULL

};

#define ParsedSetInternalRep(objPtr, arrayPtr, elem)				\
    do {								\
	Tcl_ObjInternalRep ir;						\
	Tcl_Obj *ptr1 = (arrayPtr);					\
	Tcl_Obj *ptr2 = (elem);						\







|
>

















|




|
>







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
 *			scalar variable
 *   twoPtrValue.ptr2:	pointer to the element name string (owned by this
 *			Tcl_Obj), or NULL if it is a scalar variable
 */

static const Tcl_ObjType localVarNameType = {
    "localVarName",
    FreeLocalVarName, DupLocalVarName, NULL, NULL,
    TCL_OBJTYPE_V0
};

#define LocalSetInternalRep(objPtr, index, namePtr)				\
    do {								\
	Tcl_ObjInternalRep ir;						\
	Tcl_Obj *ptr = (namePtr);					\
	if (ptr) {Tcl_IncrRefCount(ptr);}				\
	ir.twoPtrValue.ptr1 = ptr;					\
	ir.twoPtrValue.ptr2 = INT2PTR(index);				\
	Tcl_StoreInternalRep((objPtr), &localVarNameType, &ir);		\
    } while (0)

#define LocalGetInternalRep(objPtr, index, name)				\
    do {								\
	const Tcl_ObjInternalRep *irPtr;					\
	irPtr = TclFetchInternalRep((objPtr), &localVarNameType);		\
	(name) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr1 : NULL;		\
	(index) = irPtr ? PTR2INT(irPtr->twoPtrValue.ptr2) : TCL_INDEX_NONE;	\
    } while (0)

static const Tcl_ObjType parsedVarNameType = {
    "parsedVarName",
    FreeParsedVarName, DupParsedVarName, NULL, NULL,
    TCL_OBJTYPE_V0
};

#define ParsedSetInternalRep(objPtr, arrayPtr, elem)				\
    do {								\
	Tcl_ObjInternalRep ir;						\
	Tcl_Obj *ptr1 = (arrayPtr);					\
	Tcl_Obj *ptr2 = (elem);						\
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
    Var *varPtr,		/* Pointer to variable that may be a candidate
				 * for being expunged. */
    Var *arrayPtr)		/* Array that contains the variable, or NULL
				 * if this variable isn't an array element. */
{
    if (TclIsVarUndefined(varPtr) && TclIsVarInHash(varPtr)
	    && !TclIsVarTraced(varPtr)
	    && (VarHashRefCount(varPtr) == (unsigned)
		    !TclIsVarDeadHash(varPtr))) {
	if (VarHashRefCount(varPtr) == 0) {
	    Tcl_Free(varPtr);
	} else {
	    VarHashDeleteEntry(varPtr);
	}
    }
    if (arrayPtr != NULL && TclIsVarUndefined(arrayPtr) &&
	    TclIsVarInHash(arrayPtr) && !TclIsVarTraced(arrayPtr) &&
	    (VarHashRefCount(arrayPtr) == (unsigned)
		    !TclIsVarDeadHash(arrayPtr))) {
	if (VarHashRefCount(arrayPtr) == 0) {
	    Tcl_Free(arrayPtr);
	} else {
	    VarHashDeleteEntry(arrayPtr);
	}
    }







|









|







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
    Var *varPtr,		/* Pointer to variable that may be a candidate
				 * for being expunged. */
    Var *arrayPtr)		/* Array that contains the variable, or NULL
				 * if this variable isn't an array element. */
{
    if (TclIsVarUndefined(varPtr) && TclIsVarInHash(varPtr)
	    && !TclIsVarTraced(varPtr)
	    && (VarHashRefCount(varPtr) == (Tcl_Size)
		    !TclIsVarDeadHash(varPtr))) {
	if (VarHashRefCount(varPtr) == 0) {
	    Tcl_Free(varPtr);
	} else {
	    VarHashDeleteEntry(varPtr);
	}
    }
    if (arrayPtr != NULL && TclIsVarUndefined(arrayPtr) &&
	    TclIsVarInHash(arrayPtr) && !TclIsVarTraced(arrayPtr) &&
	    (VarHashRefCount(arrayPtr) == (Tcl_Size)
		    !TclIsVarDeadHash(arrayPtr))) {
	if (VarHashRefCount(arrayPtr) == 0) {
	    Tcl_Free(arrayPtr);
	} else {
	    VarHashDeleteEntry(arrayPtr);
	}
    }
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
    Interp *iPtr = (Interp *) interp;
    CallFrame *varFramePtr = iPtr->varFramePtr;
    Var *varPtr;	/* Points to the variable's in-frame Var
				 * structure. */
    const char *errMsg = NULL;
    int index, parsed = 0;

    size_t localIndex;
    Tcl_Obj *namePtr, *arrayPtr, *elem;

    *arrayPtrPtr = NULL;

  restart:
    LocalGetInternalRep(part1Ptr, localIndex, namePtr);
    if (localIndex != TCL_INDEX_NONE) {
	if (HasLocalVars(varFramePtr)
		&& !(flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY))
		&& (localIndex < varFramePtr->numCompiledLocals)) {
	    /*
	     * Use the cached index if the names coincide.
	     */

	    Tcl_Obj *checkNamePtr = localName(varFramePtr, localIndex);

	    if ((!namePtr && (checkNamePtr == part1Ptr)) ||
		    (namePtr && (checkNamePtr == namePtr))) {
		varPtr = (Var *) &(varFramePtr->compiledLocals[localIndex]);
		goto donePart1;
	    }
	}
	goto doneParsing;
    }

    /*
     * If part1Ptr is a parsedVarNameType, retrieve the pre-parsed parts.
     */

    ParsedGetInternalRep(part1Ptr, parsed, arrayPtr, elem);
    if (parsed && arrayPtr) {
	    if (part2Ptr != NULL) {
		/*
		 * ERROR: part1Ptr is already an array element, cannot specify







|






|



















|







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
    Interp *iPtr = (Interp *) interp;
    CallFrame *varFramePtr = iPtr->varFramePtr;
    Var *varPtr;	/* Points to the variable's in-frame Var
				 * structure. */
    const char *errMsg = NULL;
    int index, parsed = 0;

    Tcl_Size localIndex;
    Tcl_Obj *namePtr, *arrayPtr, *elem;

    *arrayPtrPtr = NULL;

  restart:
    LocalGetInternalRep(part1Ptr, localIndex, namePtr);
    if (localIndex >= 0) {
	if (HasLocalVars(varFramePtr)
		&& !(flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY))
		&& (localIndex < varFramePtr->numCompiledLocals)) {
	    /*
	     * Use the cached index if the names coincide.
	     */

	    Tcl_Obj *checkNamePtr = localName(varFramePtr, localIndex);

	    if ((!namePtr && (checkNamePtr == part1Ptr)) ||
		    (namePtr && (checkNamePtr == namePtr))) {
		varPtr = (Var *) &(varFramePtr->compiledLocals[localIndex]);
		goto donePart1;
	    }
	}
	goto doneParsing;
    }

    /*
     * If part1Ptr is a parsedVarNameType, retrieve the preparsed parts.
     */

    ParsedGetInternalRep(part1Ptr, parsed, arrayPtr, elem);
    if (parsed && arrayPtr) {
	    if (part2Ptr != NULL) {
		/*
		 * ERROR: part1Ptr is already an array element, cannot specify
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
    }

    if (!parsed) {
	/*
	 * part1Ptr is possibly an unparsed array element.
	 */

	size_t len;
	const char *part1 = Tcl_GetStringFromObj(part1Ptr, &len);

	if ((len > 1) && (part1[len - 1] == ')')) {
	    const char *part2 = strchr(part1, '(');

	    if (part2) {
		if (part2Ptr != NULL) {







|







657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
    }

    if (!parsed) {
	/*
	 * part1Ptr is possibly an unparsed array element.
	 */

	Tcl_Size len;
	const char *part1 = Tcl_GetStringFromObj(part1Ptr, &len);

	if ((len > 1) && (part1[len - 1] == ')')) {
	    const char *part2 = strchr(part1, '(');

	    if (part2) {
		if (part2Ptr != NULL) {
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
 *
 *	If the current CallFrame corresponds to a proc and the variable found
 *	is one of the compiledLocals, its index is placed in *indexPtr.
 *	Otherwise, *indexPtr will be set to (according to the needs of
 *	TclObjLookupVar):
 *	    -1 a global reference
 *	    -2 a reference to a namespace variable
 *	    -3 a non-cachable reference, i.e., one of:
 *		. non-indexed local var
 *		. a reference of unknown origin;
 *		. resolution by a namespace or interp resolver
 *
 *	If the variable isn't found and creation wasn't specified, or some
 *	other error occurs, NULL is returned and the corresponding error
 *	message is left in *errMsgPtr.







|







790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
 *
 *	If the current CallFrame corresponds to a proc and the variable found
 *	is one of the compiledLocals, its index is placed in *indexPtr.
 *	Otherwise, *indexPtr will be set to (according to the needs of
 *	TclObjLookupVar):
 *	    -1 a global reference
 *	    -2 a reference to a namespace variable
 *	    -3 a non-cacheable reference, i.e., one of:
 *		. non-indexed local var
 *		. a reference of unknown origin;
 *		. resolution by a namespace or interp resolver
 *
 *	If the variable isn't found and creation wasn't specified, or some
 *	other error occurs, NULL is returned and the corresponding error
 *	message is left in *errMsgPtr.
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
    TclVarHashTable *tablePtr;	/* Points to the hashtable, if any, in which
				 * to look up the variable. */
    Tcl_Var var;		/* Used to search for global names. */
    Var *varPtr;		/* Points to the Var structure returned for
				 * the variable. */
    Namespace *varNsPtr, *cxtNsPtr, *dummy1Ptr, *dummy2Ptr;
    ResolverScheme *resPtr;
    int isNew, i, result;
    size_t varLen;
    const char *varName = Tcl_GetStringFromObj(varNamePtr, &varLen);

    varPtr = NULL;
    varNsPtr = NULL;		/* Set non-NULL if a nonlocal variable. */
    *indexPtr = -3;

    if (flags & TCL_GLOBAL_ONLY) {







|
|







839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
    TclVarHashTable *tablePtr;	/* Points to the hashtable, if any, in which
				 * to look up the variable. */
    Tcl_Var var;		/* Used to search for global names. */
    Var *varPtr;		/* Points to the Var structure returned for
				 * the variable. */
    Namespace *varNsPtr, *cxtNsPtr, *dummy1Ptr, *dummy2Ptr;
    ResolverScheme *resPtr;
    int isNew, result;
    Tcl_Size i, varLen;
    const char *varName = Tcl_GetStringFromObj(varNamePtr, &varLen);

    varPtr = NULL;
    varNsPtr = NULL;		/* Set non-NULL if a nonlocal variable. */
    *indexPtr = -3;

    if (flags & TCL_GLOBAL_ONLY) {
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982

		*indexPtr = -1;
	    } else {
		*indexPtr = -2;
	    }
	}
    } else {			/* Local var: look in frame varFramePtr. */
	int localCt = varFramePtr->numCompiledLocals;

	if (localCt > 0) {
	    Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0;
	    const char *localNameStr;
	    size_t localLen;

	    for (i=0 ; i<localCt ; i++, objPtrPtr++) {
		Tcl_Obj *objPtr = *objPtrPtr;

		if (objPtr) {
		    localNameStr = Tcl_GetStringFromObj(objPtr, &localLen);








|




|







965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984

		*indexPtr = -1;
	    } else {
		*indexPtr = -2;
	    }
	}
    } else {			/* Local var: look in frame varFramePtr. */
	Tcl_Size localCt = varFramePtr->numCompiledLocals;

	if (localCt > 0) {
	    Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0;
	    const char *localNameStr;
	    Tcl_Size localLen;

	    for (i=0 ; i<localCt ; i++, objPtrPtr++) {
		Tcl_Obj *objPtr = *objPtrPtr;

		if (objPtr) {
		    localNameStr = Tcl_GetStringFromObj(objPtr, &localLen);

2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
Tcl_LappendObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *varValuePtr, *newValuePtr;
    size_t numElems;
    Var *varPtr, *arrayPtr;
    int result, createdNewObj;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "varName ?value ...?");
	return TCL_ERROR;
    }







|







2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
Tcl_LappendObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *varValuePtr, *newValuePtr;
    Tcl_Size numElems;
    Var *varPtr, *arrayPtr;
    int result, createdNewObj;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "varName ?value ...?");
	return TCL_ERROR;
    }
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *varListObj, *arrayNameObj, *scriptObj;
    ArraySearch *searchPtr = NULL;
    Var *varPtr;
    int isArray;
    size_t numVars;

    /*
     * array for {k v} a body
     */

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "{key value} arrayName script");







|







3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *varListObj, *arrayNameObj, *scriptObj;
    ArraySearch *searchPtr = NULL;
    Var *varPtr;
    int isArray;
    Tcl_Size numVars;

    /*
     * array for {k v} a body
     */

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "{key value} arrayName script");
3093
3094
3095
3096
3097
3098
3099

3100


3101
3102
3103
3104
3105
3106
3107
    ArrayPopulateSearch(interp, arrayNameObj, varPtr, searchPtr);

    /*
     * Make sure that these objects (which we need throughout the body of the
     * loop) don't vanish.
     */


    varListObj = TclListObjCopy(NULL, objv[1]);


    scriptObj = objv[3];
    Tcl_IncrRefCount(scriptObj);

    /*
     * Run the script.
     */








>
|
>
>







3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
    ArrayPopulateSearch(interp, arrayNameObj, varPtr, searchPtr);

    /*
     * Make sure that these objects (which we need throughout the body of the
     * loop) don't vanish.
     */

    varListObj = TclDuplicatePureObj(interp, objv[1], &tclListType);
    if (!varListObj) {
	return TCL_ERROR;
    }
    scriptObj = objv[3];
    Tcl_IncrRefCount(scriptObj);

    /*
     * Run the script.
     */

3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
    Tcl_Obj *arrayNameObj = (Tcl_Obj *)data[2];
    Tcl_Obj *scriptObj = (Tcl_Obj *)data[3];
    Tcl_Obj **varv;
    Tcl_Obj *keyObj, *valueObj;
    Var *varPtr;
    Var *arrayPtr;
    int done;
    size_t varc;

    /*
     * Process the result from the previous execution of the script body.
     */

    done = TCL_ERROR;








|







3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
    Tcl_Obj *arrayNameObj = (Tcl_Obj *)data[2];
    Tcl_Obj *scriptObj = (Tcl_Obj *)data[3];
    Tcl_Obj **varv;
    Tcl_Obj *keyObj, *valueObj;
    Var *varPtr;
    Var *arrayPtr;
    int done;
    Tcl_Size varc;

    /*
     * Process the result from the previous execution of the script body.
     */

    done = TCL_ERROR;

3172
3173
3174
3175
3176
3177
3178
3179



3180
3181
3182
3183
3184
3185
3186
	    Tcl_SetErrorCode(interp, "TCL", "READ", "array", "for", NULL);
	    varPtr->flags |= TCL_LEAVE_ERR_MSG;
	    result = done;
	}
	goto arrayfordone;
    }

    TclListObjGetElementsM(NULL, varListObj, &varc, &varv);



    if (Tcl_ObjSetVar2(interp, varv[0], NULL, keyObj,
	    TCL_LEAVE_ERR_MSG) == NULL) {
	result = TCL_ERROR;
	goto arrayfordone;
    }
    if (valueObj != NULL) {
	if (Tcl_ObjSetVar2(interp, varv[1], NULL, valueObj,







|
>
>
>







3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
	    Tcl_SetErrorCode(interp, "TCL", "READ", "array", "for", NULL);
	    varPtr->flags |= TCL_LEAVE_ERR_MSG;
	    result = done;
	}
	goto arrayfordone;
    }

    result = TclListObjGetElementsM(NULL, varListObj, &varc, &varv);
    if (result != TCL_OK) {
	goto arrayfordone;
    }
    if (Tcl_ObjSetVar2(interp, varv[0], NULL, keyObj,
	    TCL_LEAVE_ERR_MSG) == NULL) {
	result = TCL_ERROR;
	goto arrayfordone;
    }
    if (valueObj != NULL) {
	if (Tcl_ObjSetVar2(interp, varv[1], NULL, valueObj,
3630
3631
3632
3633
3634
3635
3636
3637
3638
3639
3640
3641
3642
3643
3644
    Tcl_Obj *const objv[])
{
    Var *varPtr, *varPtr2;
    Tcl_Obj *varNameObj, *nameObj, *valueObj, *nameLstObj, *tmpResObj;
    Tcl_Obj **nameObjPtr, *patternObj;
    Tcl_HashSearch search;
    const char *pattern;
    size_t i, count;
    int result, isArray;

    switch (objc) {
    case 2:
	varNameObj = objv[1];
	patternObj = NULL;
	break;







|







3638
3639
3640
3641
3642
3643
3644
3645
3646
3647
3648
3649
3650
3651
3652
    Tcl_Obj *const objv[])
{
    Var *varPtr, *varPtr2;
    Tcl_Obj *varNameObj, *nameObj, *valueObj, *nameLstObj, *tmpResObj;
    Tcl_Obj **nameObjPtr, *patternObj;
    Tcl_HashSearch search;
    const char *pattern;
    Tcl_Size i, count;
    int result, isArray;

    switch (objc) {
    case 2:
	varNameObj = objv[1];
	patternObj = NULL;
	break;
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *arrayNameObj;
    Tcl_Obj *arrayElemObj;
    Var *varPtr, *arrayPtr;
    int result;
    size_t i;

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

    if (TCL_ERROR == LocateArray(interp, objv[1], NULL, NULL)) {







<







3964
3965
3966
3967
3968
3969
3970

3971
3972
3973
3974
3975
3976
3977
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *arrayNameObj;
    Tcl_Obj *arrayElemObj;
    Var *varPtr, *arrayPtr;
    int result;


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

    if (TCL_ERROR == LocateArray(interp, objv[1], NULL, NULL)) {
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000
4001
4002
4003
4004
4005
     */

    arrayElemObj = objv[2];
    if (TclHasInternalRep(arrayElemObj, &tclDictType) && arrayElemObj->bytes == NULL) {
	Tcl_Obj *keyPtr, *valuePtr;
	Tcl_DictSearch search;
	int done;
	size_t size;

	if (Tcl_DictObjSize(interp, arrayElemObj, &size) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (size == 0) {
	    /*
	     * Empty, so we'll just force the array to be properly existing







|







3998
3999
4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
     */

    arrayElemObj = objv[2];
    if (TclHasInternalRep(arrayElemObj, &tclDictType) && arrayElemObj->bytes == NULL) {
	Tcl_Obj *keyPtr, *valuePtr;
	Tcl_DictSearch search;
	int done;
	Tcl_Size size;

	if (Tcl_DictObjSize(interp, arrayElemObj, &size) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (size == 0) {
	    /*
	     * Empty, so we'll just force the array to be properly existing
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
	return TCL_OK;
    } else {
	/*
	 * Not a dictionary, so assume (and convert to, for backward-
	 * -compatibility reasons) a list.
	 */

	size_t elemLen;
	Tcl_Obj **elemPtrs, *copyListObj;


	result = TclListObjGetElementsM(interp, arrayElemObj,
		&elemLen, &elemPtrs);
	if (result != TCL_OK) {
	    return result;
	}
	if (elemLen & 1) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "list must have an even number of elements", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "FORMAT", NULL);
	    return TCL_ERROR;
	}
	if (elemLen == 0) {
	    goto ensureArray;
	}






	/*
	 * We needn't worry about traces invalidating arrayPtr: should that be
	 * the case, TclPtrSetVarIdx will return NULL so that we break out of
	 * the loop and return an error.
	 */

	copyListObj = TclListObjCopy(NULL, arrayElemObj);




	for (i=0 ; i<elemLen ; i+=2) {
	    Var *elemVarPtr = TclLookupArrayElement(interp, arrayNameObj,
		    elemPtrs[i], TCL_LEAVE_ERR_MSG, "set", 1, 1, varPtr, -1);

	    if ((elemVarPtr == NULL) ||
		    (TclPtrSetVarIdx(interp, elemVarPtr, varPtr, arrayNameObj,
			    elemPtrs[i], elemPtrs[i+1], TCL_LEAVE_ERR_MSG,







|

>

|
<












>
>
>
>
>







|
>
>
>
>







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
	return TCL_OK;
    } else {
	/*
	 * Not a dictionary, so assume (and convert to, for backward-
	 * -compatibility reasons) a list.
	 */

	Tcl_Size elemLen;
	Tcl_Obj **elemPtrs, *copyListObj;
	Tcl_Size i;

	result = TclListObjLengthM(interp, arrayElemObj, &elemLen);

	if (result != TCL_OK) {
	    return result;
	}
	if (elemLen & 1) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "list must have an even number of elements", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "FORMAT", NULL);
	    return TCL_ERROR;
	}
	if (elemLen == 0) {
	    goto ensureArray;
	}
	result = TclListObjGetElementsM(interp, arrayElemObj,
		&elemLen, &elemPtrs);
	if (result != TCL_OK) {
	    return result;
	}

	/*
	 * We needn't worry about traces invalidating arrayPtr: should that be
	 * the case, TclPtrSetVarIdx will return NULL so that we break out of
	 * the loop and return an error.
	 */

	copyListObj =
	    TclDuplicatePureObj(interp, arrayElemObj, &tclListType);
	if (!copyListObj) {
	    return TCL_ERROR;
	}
	for (i=0 ; i<elemLen ; i+=2) {
	    Var *elemVarPtr = TclLookupArrayElement(interp, arrayNameObj,
		    elemPtrs[i], TCL_LEAVE_ERR_MSG, "set", 1, 1, varPtr, -1);

	    if ((elemVarPtr == NULL) ||
		    (TclPtrSetVarIdx(interp, elemVarPtr, varPtr, arrayNameObj,
			    elemPtrs[i], elemPtrs[i+1], TCL_LEAVE_ERR_MSG,
4777
4778
4779
4780
4781
4782
4783
4784
4785
4786
4787
4788
4789
4790
4791
    }
    if (TclIsVarInHash(varPtr)) {
	if (!TclIsVarDeadHash(varPtr)) {
	    namePtr = VarHashGetKey(varPtr);
	    Tcl_AppendObjToObj(objPtr, namePtr);
	}
    } else if (iPtr->varFramePtr->procPtr) {
	size_t index = varPtr - iPtr->varFramePtr->compiledLocals;

	if (index < iPtr->varFramePtr->numCompiledLocals) {
	    namePtr = localName(iPtr->varFramePtr, index);
	    Tcl_AppendObjToObj(objPtr, namePtr);
	}
    }
}







|







4793
4794
4795
4796
4797
4798
4799
4800
4801
4802
4803
4804
4805
4806
4807
    }
    if (TclIsVarInHash(varPtr)) {
	if (!TclIsVarDeadHash(varPtr)) {
	    namePtr = VarHashGetKey(varPtr);
	    Tcl_AppendObjToObj(objPtr, namePtr);
	}
    } else if (iPtr->varFramePtr->procPtr) {
	Tcl_Size index = varPtr - iPtr->varFramePtr->compiledLocals;

	if (index < iPtr->varFramePtr->numCompiledLocals) {
	    namePtr = localName(iPtr->varFramePtr, index);
	    Tcl_AppendObjToObj(objPtr, namePtr);
	}
    }
}
5403
5404
5405
5406
5407
5408
5409
5410
5411
5412
5413
5414
5415
5416
5417
void
TclDeleteCompiledLocalVars(
    Interp *iPtr,		/* Interpreter to which variables belong. */
    CallFrame *framePtr)	/* Procedure call frame containing compiler-
				 * assigned local variables to delete. */
{
    Var *varPtr;
    size_t numLocals, i;
    Tcl_Obj **namePtrPtr;

    numLocals = framePtr->numCompiledLocals;
    varPtr = framePtr->compiledLocals;
    namePtrPtr = &localName(framePtr, 0);
    for (i=0 ; i<numLocals ; i++, namePtrPtr++, varPtr++) {
	UnsetVarStruct(varPtr, NULL, iPtr, *namePtrPtr, NULL,







|







5419
5420
5421
5422
5423
5424
5425
5426
5427
5428
5429
5430
5431
5432
5433
void
TclDeleteCompiledLocalVars(
    Interp *iPtr,		/* Interpreter to which variables belong. */
    CallFrame *framePtr)	/* Procedure call frame containing compiler-
				 * assigned local variables to delete. */
{
    Var *varPtr;
    Tcl_Size numLocals, i;
    Tcl_Obj **namePtrPtr;

    numLocals = framePtr->numCompiledLocals;
    varPtr = framePtr->compiledLocals;
    namePtrPtr = &localName(framePtr, 0);
    for (i=0 ; i<numLocals ; i++, namePtrPtr++, varPtr++) {
	UnsetVarStruct(varPtr, NULL, iPtr, *namePtrPtr, NULL,
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
 *   twoPtrValue.ptr2: index into locals table
 */

static void
FreeLocalVarName(
    Tcl_Obj *objPtr)
{
    size_t index;
    Tcl_Obj *namePtr;

    LocalGetInternalRep(objPtr, index, namePtr);

    index++;	/* Compiler warning bait. */
    if (namePtr) {
	Tcl_DecrRefCount(namePtr);
    }
}

static void
DupLocalVarName(
    Tcl_Obj *srcPtr,
    Tcl_Obj *dupPtr)
{
    size_t index;
    Tcl_Obj *namePtr;

    LocalGetInternalRep(srcPtr, index, namePtr);
    if (!namePtr) {
	namePtr = srcPtr;
    }
    LocalSetInternalRep(dupPtr, index, namePtr);







|















|







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
 *   twoPtrValue.ptr2: index into locals table
 */

static void
FreeLocalVarName(
    Tcl_Obj *objPtr)
{
    Tcl_Size index;
    Tcl_Obj *namePtr;

    LocalGetInternalRep(objPtr, index, namePtr);

    index++;	/* Compiler warning bait. */
    if (namePtr) {
	Tcl_DecrRefCount(namePtr);
    }
}

static void
DupLocalVarName(
    Tcl_Obj *srcPtr,
    Tcl_Obj *dupPtr)
{
    Tcl_Size index;
    Tcl_Obj *namePtr;

    LocalGetInternalRep(srcPtr, index, namePtr);
    if (!namePtr) {
	namePtr = srcPtr;
    }
    LocalSetInternalRep(dupPtr, index, namePtr);
6201
6202
6203
6204
6205
6206
6207
6208
6209
6210
6211
6212
6213
6214
6215
    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Obj *listPtr,		/* List object to append names to. */
    Tcl_Obj *patternPtr,	/* Pattern to match against. */
    int includeLinks)		/* 1 if upvars should be included, else 0. */
{
    Interp *iPtr = (Interp *) interp;
    Var *varPtr;
    size_t i, localVarCt;
    int added;
    Tcl_Obj *objNamePtr;
    const char *varName;
    TclVarHashTable *localVarTablePtr;
    Tcl_HashSearch search;
    Tcl_HashTable addedTable;
    const char *pattern = patternPtr? TclGetString(patternPtr) : NULL;







|







6217
6218
6219
6220
6221
6222
6223
6224
6225
6226
6227
6228
6229
6230
6231
    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Obj *listPtr,		/* List object to append names to. */
    Tcl_Obj *patternPtr,	/* Pattern to match against. */
    int includeLinks)		/* 1 if upvars should be included, else 0. */
{
    Interp *iPtr = (Interp *) interp;
    Var *varPtr;
    Tcl_Size i, localVarCt;
    int added;
    Tcl_Obj *objNamePtr;
    const char *varName;
    TclVarHashTable *localVarTablePtr;
    Tcl_HashSearch search;
    Tcl_HashTable addedTable;
    const char *pattern = patternPtr? TclGetString(patternPtr) : NULL;

Changes to generic/tclZipfs.c.

665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static inline int
CountSlashes(
    const char *string)
{
    int count = 0;
    const char *p = string;

    while (*p != '\0') {
	if (*p == '/') {
	    count++;
	}
	p++;







|



|







665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static inline size_t
CountSlashes(
    const char *string)
{
    size_t count = 0;
    const char *p = string;

    while (*p != '\0') {
	if (*p == '/') {
	    count++;
	}
	p++;
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
    } 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_INDEX_NONE) {
	    ZIPFS_POSIX_ERROR(interp, "seek error");
	    goto error;
	}
	if ((zf->length - ZIP_CENTRAL_END_LEN)
		> (64 * 1024 * 1024 - ZIP_CENTRAL_END_LEN)) {
	    ZIPFS_ERROR(interp, "illegal file size");
	    ZIPFS_ERROR_CODE(interp, "FILE_SIZE");







|







1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
    } 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 == (size_t) TCL_INDEX_NONE) {
	    ZIPFS_POSIX_ERROR(interp, "seek error");
	    goto error;
	}
	if ((zf->length - ZIP_CENTRAL_END_LEN)
		> (64 * 1024 * 1024 - ZIP_CENTRAL_END_LEN)) {
	    ZIPFS_ERROR(interp, "illegal file size");
	    ZIPFS_ERROR_CODE(interp, "FILE_SIZE");
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
    int fd = PTR2INT(handle);

    /*
     * Determine the file size.
     */

    zf->length = lseek(fd, 0, SEEK_END);
    if (zf->length == TCL_INDEX_NONE || 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);







|







1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
    int fd = PTR2INT(handle);

    /*
     * Determine the file size.
     */

    zf->length = lseek(fd, 0, SEEK_END);
    if (zf->length == (size_t) TCL_INDEX_NONE || 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);
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
 *-------------------------------------------------------------------------
 */

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;







|







1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
 *-------------------------------------------------------------------------
 */

static inline int
IsPasswordValid(
    Tcl_Interp *interp,
    const char *passwd,
    size_t pwlen)
{
    if ((pwlen > 255) || strchr(passwd, 0xff)) {
	ZIPFS_ERROR(interp, "illegal password");
	ZIPFS_ERROR_CODE(interp, "BAD_PASS");
	return TCL_ERROR;
    }
    return TCL_OK;
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
    Tcl_Interp *interp,		/* Current interpreter. NULLable. */
    ZipFile *zf,		/* Temporary buffer hold archive descriptors */
    const char *mountPoint,	/* Mount point path. */
    const char *passwd,		/* Password for opening the ZIP, or NULL if
				 * the ZIP is unprotected. */
    const char *zipname)	/* Path to ZIP file to build a catalog of. */
{
    int pwlen, isNew;
    size_t i;
    ZipFile *zf0;
    ZipEntry *z;
    Tcl_HashEntry *hPtr;
    Tcl_DString ds, dsm, fpBuf;
    unsigned char *q;

    /*







|
|







1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
    Tcl_Interp *interp,		/* Current interpreter. NULLable. */
    ZipFile *zf,		/* Temporary buffer hold archive descriptors */
    const char *mountPoint,	/* Mount point path. */
    const char *passwd,		/* Password for opening the ZIP, or NULL if
				 * the ZIP is unprotected. */
    const char *zipname)	/* Path to ZIP file to build a catalog of. */
{
    int isNew;
    size_t i, pwlen;
    ZipFile *zf0;
    ZipEntry *z;
    Tcl_HashEntry *hPtr;
    Tcl_DString ds, dsm, fpBuf;
    unsigned char *q;

    /*
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
	 * 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));







|







1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
	 * Are there any entries in the zipHash? Don't need to enumerate them
	 * all to know.
	 */

	return (ZipFS.zipHash.numEntries ? TCL_OK : TCL_BREAK);
    }

    TclNewObj(resultList);
    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));
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *mountPoint;	/* Mount point path. */
    unsigned char *data;
    size_t length;

    if (objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?mountpoint? ?data?");
	return TCL_ERROR;
    }
    if (objc < 2) {
	int ret;







|







2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
    TCL_UNUSED(void *),
    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;
    Tcl_Size length;

    if (objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?mountpoint? ?data?");
	return TCL_ERROR;
    }
    if (objc < 2) {
	int ret;
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
static int
ZipFSMkKeyObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int len, i = 0;
    const char *pw;
    Tcl_Obj *passObj;
    unsigned char *passBuf;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "password");
	return TCL_ERROR;
    }
    pw = TclGetStringFromObj(objv[1], &len);
    if (len == 0) {
	return TCL_OK;
    }
    if (IsPasswordValid(interp, pw, len) != TCL_OK) {
	return TCL_ERROR;
    }

    passObj = Tcl_NewByteArrayObj(NULL, 264);
    passBuf = Tcl_GetBytesFromObj(NULL, passObj, (size_t *)NULL);
    while (len > 0) {
	int ch = pw[len - 1];

	passBuf[i++] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f];
	len--;
    }
    passBuf[i] = i;







|








|








|







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
static int
ZipFSMkKeyObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Size len, i = 0;
    const char *pw;
    Tcl_Obj *passObj;
    unsigned char *passBuf;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "password");
	return TCL_ERROR;
    }
    pw = Tcl_GetStringFromObj(objv[1], &len);
    if (len == 0) {
	return TCL_OK;
    }
    if (IsPasswordValid(interp, pw, len) != TCL_OK) {
	return TCL_ERROR;
    }

    passObj = Tcl_NewByteArrayObj(NULL, 264);
    passBuf = Tcl_GetByteArrayFromObj(passObj, (Tcl_Size *)NULL);
    while (len > 0) {
	int ch = pw[len - 1];

	passBuf[i++] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f];
	len--;
    }
    passBuf[i] = i;
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
    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);







|







2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
    Tcl_Interp *interp,
    int step,
    int *chPtr)
{
    double r;
    Tcl_Obj *ret;

    if (Tcl_EvalEx(interp, "::tcl::mathfunc::rand", TCL_INDEX_NONE, 0) != TCL_OK) {
	goto failed;
    }
    ret = Tcl_GetObjResult(interp);
    if (Tcl_GetDoubleFromObj(interp, ret, &r) != TCL_OK) {
	goto failed;
    }
    *chPtr = (int) (r * 256);
2512
2513
2514
2515
2516
2517
2518
2519

2520
2521
2522
2523
2524
2525
2526
    ZipEntry *z;
    z_stream stream;
    Tcl_DString zpathDs;	/* Buffer for the encoded filename. */
    const char *zpathExt;	/* Filename in external encoding (true
				 * UTF-8). */
    const char *zpathTcl;	/* Filename in Tcl's internal encoding. */
    int crc, flush, zpathlen;
    size_t nbyte, nbytecompr, len, olen, align = 0;

    long long headerStartOffset, dataStartOffset, dataEndOffset;
    int mtime = 0, isNew, compMeth;
    unsigned long keys[3], keys0[3];
    char obuf[4096];

    /*
     * Trim leading '/' characters. If this results in an empty string, we've







|
>







2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
    ZipEntry *z;
    z_stream stream;
    Tcl_DString zpathDs;	/* Buffer for the encoded filename. */
    const char *zpathExt;	/* Filename in external encoding (true
				 * UTF-8). */
    const char *zpathTcl;	/* Filename in Tcl's internal encoding. */
    int crc, flush, zpathlen;
    size_t nbyte, nbytecompr;
    Tcl_Size len, olen, align = 0;
    long long headerStartOffset, dataStartOffset, dataEndOffset;
    int mtime = 0, isNew, compMeth;
    unsigned long keys[3], keys0[3];
    char obuf[4096];

    /*
     * Trim leading '/' characters. If this results in an empty string, we've
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
     * Compute the CRC.
     */

    crc = 0;
    nbyte = nbytecompr = 0;
    while (1) {
	len = Tcl_Read(in, buf, bufsize);
	if (len == TCL_INDEX_NONE) {
	    Tcl_DStringFree(&zpathDs);
	    if (nbyte == 0 && errno == EISDIR) {
		Tcl_Close(interp, in);
		return TCL_OK;
	    }
	readErrorWithChannelOpen:
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf("read error on \"%s\": %s",







|







2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
     * Compute the CRC.
     */

    crc = 0;
    nbyte = nbytecompr = 0;
    while (1) {
	len = Tcl_Read(in, buf, bufsize);
	if (len < 0) {
	    Tcl_DStringFree(&zpathDs);
	    if (nbyte == 0 && errno == EISDIR) {
		Tcl_Close(interp, in);
		return TCL_OK;
	    }
	readErrorWithChannelOpen:
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf("read error on \"%s\": %s",
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
     * Reserve space for the per-file header. Includes writing the file name
     * as we already know that.
     */

    memset(buf, '\0', ZIP_LOCAL_HEADER_LEN);
    memcpy(buf + ZIP_LOCAL_HEADER_LEN, zpathExt, zpathlen);
    len = zpathlen + ZIP_LOCAL_HEADER_LEN;
    if ((size_t) Tcl_Write(out, buf, len) != len) {
    writeErrorWithChannelOpen:
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"write error on \"%s\": %s",
		TclGetString(pathObj), Tcl_PosixError(interp)));
	Tcl_Close(interp, in);
	Tcl_DStringFree(&zpathDs);
	return TCL_ERROR;







|







2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
     * Reserve space for the per-file header. Includes writing the file name
     * as we already know that.
     */

    memset(buf, '\0', ZIP_LOCAL_HEADER_LEN);
    memcpy(buf + ZIP_LOCAL_HEADER_LEN, zpathExt, zpathlen);
    len = zpathlen + ZIP_LOCAL_HEADER_LEN;
    if (Tcl_Write(out, buf, len) != len) {
    writeErrorWithChannelOpen:
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"write error on \"%s\": %s",
		TclGetString(pathObj), Tcl_PosixError(interp)));
	Tcl_Close(interp, in);
	Tcl_DStringFree(&zpathDs);
	return TCL_ERROR;
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
	const unsigned char *astart = abuf;
	const unsigned char *aend = abuf + 8;

	align = 4 + ((len + headerStartOffset) & 3);
	ZipWriteShort(astart, aend, abuf, 0xffff);
	ZipWriteShort(astart, aend, abuf + 2, align - 4);
	ZipWriteInt(astart, aend, abuf + 4, 0x03020100);
	if ((size_t) Tcl_Write(out, (const char *) abuf, align) != align) {
	    goto writeErrorWithChannelOpen;
	}
    }

    /*
     * Set up encryption if we were asked to.
     */







|







2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
	const unsigned char *astart = abuf;
	const unsigned char *aend = abuf + 8;

	align = 4 + ((len + headerStartOffset) & 3);
	ZipWriteShort(astart, aend, abuf, 0xffff);
	ZipWriteShort(astart, aend, abuf + 2, align - 4);
	ZipWriteInt(astart, aend, abuf + 4, 0x03020100);
	if (Tcl_Write(out, (const char *) abuf, align) != align) {
	    goto writeErrorWithChannelOpen;
	}
    }

    /*
     * Set up encryption if we were asked to.
     */
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
	Tcl_Close(interp, in);
	Tcl_DStringFree(&zpathDs);
	return TCL_ERROR;
    }

    do {
	len = Tcl_Read(in, buf, bufsize);
	if (len == TCL_INDEX_NONE) {
	    deflateEnd(&stream);
	    goto readErrorWithChannelOpen;
	}
	stream.avail_in = len;
	stream.next_in = (unsigned char *) buf;
	flush = Tcl_Eof(in) ? Z_FINISH : Z_NO_FLUSH;
	do {
	    stream.avail_out = sizeof(obuf);
	    stream.next_out = (unsigned char *) obuf;
	    len = deflate(&stream, flush);
	    if (len == (size_t) Z_STREAM_ERROR) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"deflate error on \"%s\"", TclGetString(pathObj)));
		ZIPFS_ERROR_CODE(interp, "DEFLATE");
		deflateEnd(&stream);
		Tcl_Close(interp, in);
		Tcl_DStringFree(&zpathDs);
		return TCL_ERROR;
	    }
	    olen = sizeof(obuf) - stream.avail_out;
	    if (passwd) {
		size_t i;
		int tmp;

		for (i = 0; i < olen; i++) {
		    obuf[i] = (char) zencode(keys, crc32tab, obuf[i], tmp);
		}
	    }
	    if (olen && ((size_t) Tcl_Write(out, obuf, olen) != olen)) {
		deflateEnd(&stream);
		goto writeErrorWithChannelOpen;
	    }
	    nbytecompr += olen;
	} while (stream.avail_out == 0);
    } while (flush != Z_FINISH);
    deflateEnd(&stream);







|










|










|






|







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
	Tcl_Close(interp, in);
	Tcl_DStringFree(&zpathDs);
	return TCL_ERROR;
    }

    do {
	len = Tcl_Read(in, buf, bufsize);
	if (len < 0) {
	    deflateEnd(&stream);
	    goto readErrorWithChannelOpen;
	}
	stream.avail_in = len;
	stream.next_in = (unsigned char *) buf;
	flush = Tcl_Eof(in) ? Z_FINISH : Z_NO_FLUSH;
	do {
	    stream.avail_out = sizeof(obuf);
	    stream.next_out = (unsigned char *) obuf;
	    len = deflate(&stream, flush);
	    if (len == Z_STREAM_ERROR) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"deflate error on \"%s\"", TclGetString(pathObj)));
		ZIPFS_ERROR_CODE(interp, "DEFLATE");
		deflateEnd(&stream);
		Tcl_Close(interp, in);
		Tcl_DStringFree(&zpathDs);
		return TCL_ERROR;
	    }
	    olen = sizeof(obuf) - stream.avail_out;
	    if (passwd) {
		Tcl_Size 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)) {
		deflateEnd(&stream);
		goto writeErrorWithChannelOpen;
	    }
	    nbytecompr += olen;
	} while (stream.avail_out == 0);
    } while (flush != Z_FINISH);
    deflateEnd(&stream);
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
	    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_INDEX_NONE) {
		goto readErrorWithChannelOpen;
	    } else if (len == 0) {
		break;
	    }
	    if (passwd) {
		size_t i;
		int tmp;

		for (i = 0; i < len; i++) {
		    buf[i] = (char) zencode(keys0, crc32tab, buf[i], tmp);
		}
	    }
	    if ((size_t) Tcl_Write(out, buf, len) != len) {
		goto writeErrorWithChannelOpen;
	    }
	    nbytecompr += len;
	}
	compMeth = ZIP_COMPMETH_STORED;

	/*







|





|






|







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
	    Tcl_Close(interp, in);
	    Tcl_DStringFree(&zpathDs);
	    return TCL_ERROR;
	}
	nbytecompr = (passwd ? 12 : 0);
	while (1) {
	    len = Tcl_Read(in, buf, bufsize);
	    if (len < 0) {
		goto readErrorWithChannelOpen;
	    } else if (len == 0) {
		break;
	    }
	    if (passwd) {
		Tcl_Size 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) {
		goto writeErrorWithChannelOpen;
	    }
	    nbytecompr += len;
	}
	compMeth = ZIP_COMPMETH_STORED;

	/*
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
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.
		 */








|



|




|







2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
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. */
    Tcl_Size slen)			/* The length of the prefix; must be 0 if no
				 * stripping need be done. */
{
    const char *name;
    Tcl_Size len;

    if (directNameObj) {
	name = TclGetString(directNameObj);
    } else {
	name = Tcl_GetStringFromObj(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.
		 */

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
				 * filenames found beneath dirRoot? If NULL,
				 * do not strip anything (except for dirRoot
				 * itself). */
    Tcl_Obj *passwordObj)	/* The password for encoding things. NULL if
				 * there's no password protection. */
{
    Tcl_Channel out;
    int pwlen = 0, slen = 0, count, ret = TCL_ERROR;

    size_t lobjc, len, i = 0;
    long long directoryStartOffset;
				/* The overall file offset of the start of the
				 * central directory. */
    long long suffixStartOffset;/* The overall file offset of the start of the
				 * suffix of the central directory (i.e.,
				 * where this data will be written). */
    Tcl_Obj **lobjv, *list = mappingList;
    ZipEntry *z;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    Tcl_HashTable fileHash;
    char *strip = NULL, *pw = NULL, passBuf[264], buf[4096];
    unsigned char *start = (unsigned char *) buf;
    unsigned char *end = start + sizeof(buf);

    /*
     * Caller has verified that the number of arguments is correct.
     */

    passBuf[0] = 0;
    if (passwordObj != NULL) {
	pw = TclGetStringFromObj(passwordObj, &pwlen);
	if (IsPasswordValid(interp, pw, pwlen) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (pwlen <= 0) {
	    pw = NULL;
	    pwlen = 0;
	}
    }
    if (dirRoot != NULL) {
	list = ZipFSFind(interp, dirRoot);
	if (!list) {
	    return TCL_ERROR;
	}
    }
    Tcl_IncrRefCount(list);
    if (TclListObjGetElementsM(interp, list, &lobjc, &lobjv) != TCL_OK) {
	Tcl_DecrRefCount(list);
	return TCL_ERROR;
    }
    if (mappingList && (lobjc % 2)) {
	Tcl_DecrRefCount(list);
	ZIPFS_ERROR(interp, "need even number of elements");
	ZIPFS_ERROR_CODE(interp, "LIST_LENGTH");
	return TCL_ERROR;
    }
    if (lobjc == 0) {
	Tcl_DecrRefCount(list);
	ZIPFS_ERROR(interp, "empty archive");
	ZIPFS_ERROR_CODE(interp, "EMPTY");
	return TCL_ERROR;




    }
    out = Tcl_FSOpenFileChannel(interp, targetFile, "wb", 0755);
    if (out == NULL) {
	Tcl_DecrRefCount(list);
	return TCL_ERROR;
    }








|
>
|

|
|


















|



|

<









|














>
>
>
>







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
				 * 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 count, ret = TCL_ERROR;
    Tcl_Size pwlen = 0, slen = 0, len, i = 0;
    Tcl_Size lobjc;
    long long directoryStartOffset;
    /* The overall file offset of the start of the
     * central directory. */
    long long suffixStartOffset;/* The overall file offset of the start of the
				 * suffix of the central directory (i.e.,
				 * where this data will be written). */
    Tcl_Obj **lobjv, *list = mappingList;
    ZipEntry *z;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    Tcl_HashTable fileHash;
    char *strip = NULL, *pw = NULL, passBuf[264], buf[4096];
    unsigned char *start = (unsigned char *) buf;
    unsigned char *end = start + sizeof(buf);

    /*
     * Caller has verified that the number of arguments is correct.
     */

    passBuf[0] = 0;
    if (passwordObj != NULL) {
	pw = Tcl_GetStringFromObj(passwordObj, &pwlen);
	if (IsPasswordValid(interp, pw, pwlen) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (pwlen == 0) {
	    pw = NULL;

	}
    }
    if (dirRoot != NULL) {
	list = ZipFSFind(interp, dirRoot);
	if (!list) {
	    return TCL_ERROR;
	}
    }
    Tcl_IncrRefCount(list);
    if (TclListObjLengthM(interp, list, &lobjc) != TCL_OK) {
	Tcl_DecrRefCount(list);
	return TCL_ERROR;
    }
    if (mappingList && (lobjc % 2)) {
	Tcl_DecrRefCount(list);
	ZIPFS_ERROR(interp, "need even number of elements");
	ZIPFS_ERROR_CODE(interp, "LIST_LENGTH");
	return TCL_ERROR;
    }
    if (lobjc == 0) {
	Tcl_DecrRefCount(list);
	ZIPFS_ERROR(interp, "empty archive");
	ZIPFS_ERROR_CODE(interp, "EMPTY");
	return TCL_ERROR;
    }
    if (TclListObjGetElementsM(interp, list, &lobjc, &lobjv) != TCL_OK) {
	Tcl_DecrRefCount(list);
	return TCL_ERROR;
    }
    out = Tcl_FSOpenFileChannel(interp, targetFile, "wb", 0755);
    if (out == NULL) {
	Tcl_DecrRefCount(list);
	return TCL_ERROR;
    }

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

    /*
     * Prepare the contents of the ZIP archive.
     */

    Tcl_InitHashTable(&fileHash, TCL_STRING_KEYS);
    if (mappingList == NULL && stripPrefix != NULL) {
	strip = TclGetStringFromObj(stripPrefix, &slen);
	if (!slen) {
	    strip = NULL;
	}
    }
    for (i = 0; i < (size_t) lobjc; i += (mappingList ? 2 : 1)) {
	Tcl_Obj *pathObj = lobjv[i];
	const char *name = ComputeNameInArchive(pathObj,
		(mappingList ? lobjv[i + 1] : NULL), strip, slen);

	if (name[0] == '\0') {
	    continue;
	}
	if (ZipAddFile(interp, pathObj, name, out, pw, buf, sizeof(buf),
		&fileHash) != TCL_OK) {
	    goto done;
	}
    }

    /*
     * Construct the contents of the ZIP central directory.
     */

    directoryStartOffset = Tcl_Tell(out);
    count = 0;
    for (i = 0; i < (size_t) lobjc; i += (mappingList ? 2 : 1)) {
	const char *name = ComputeNameInArchive(lobjv[i],
		(mappingList ? lobjv[i + 1] : NULL), strip, slen);
	Tcl_DString ds;

	hPtr = Tcl_FindHashEntry(&fileHash, name);
	if (!hPtr) {
	    continue;
	}
	z = (ZipEntry *) Tcl_GetHashValue(hPtr);

	name = Tcl_UtfToExternalDString(ZipFS.utf8, z->name, -1, &ds);
	len = Tcl_DStringLength(&ds);
	SerializeCentralDirectoryEntry(start, end, (unsigned char *) buf,
		z, len);
	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++;







|




|



















|










|





|







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

    /*
     * Prepare the contents of the ZIP archive.
     */

    Tcl_InitHashTable(&fileHash, TCL_STRING_KEYS);
    if (mappingList == NULL && stripPrefix != NULL) {
	strip = Tcl_GetStringFromObj(stripPrefix, &slen);
	if (!slen) {
	    strip = NULL;
	}
    }
    for (i = 0; i < lobjc; i += (mappingList ? 2 : 1)) {
	Tcl_Obj *pathObj = lobjv[i];
	const char *name = ComputeNameInArchive(pathObj,
		(mappingList ? lobjv[i + 1] : NULL), strip, slen);

	if (name[0] == '\0') {
	    continue;
	}
	if (ZipAddFile(interp, pathObj, name, out, pw, buf, sizeof(buf),
		&fileHash) != TCL_OK) {
	    goto done;
	}
    }

    /*
     * Construct the contents of the ZIP central directory.
     */

    directoryStartOffset = Tcl_Tell(out);
    count = 0;
    for (i = 0; i < lobjc; i += (mappingList ? 2 : 1)) {
	const char *name = ComputeNameInArchive(lobjv[i],
		(mappingList ? lobjv[i + 1] : NULL), strip, slen);
	Tcl_DString ds;

	hPtr = Tcl_FindHashEntry(&fileHash, name);
	if (!hPtr) {
	    continue;
	}
	z = (ZipEntry *) Tcl_GetHashValue(hPtr);

	name = Tcl_UtfToExternalDString(ZipFS.utf8, z->name, TCL_INDEX_NONE, &ds);
	len = Tcl_DStringLength(&ds);
	SerializeCentralDirectoryEntry(start, end, (unsigned char *) buf,
		z, len);
	if ((Tcl_Write(out, buf, ZIP_CENTRAL_HEADER_LEN)
		!= ZIP_CENTRAL_HEADER_LEN)
		|| (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++;
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
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 == TCL_INDEX_NONE) {
	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;







|
|















|












|
|







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
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. */
{
    Tcl_WideInt i, k;
    Tcl_Size 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 == -1) {
	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 > (Tcl_Size) sizeof(buf)) {
	    m = sizeof(buf);
	}
	n = Tcl_Read(in, buf, m);
	if (n == -1) {
	    errMsg = "read error";
	    goto copyError;
	} else if (n == 0) {
	    break;
4388
4389
4390
4391
4392
4393
4394
4395
4396
4397
4398
4399
4400
4401
4402
	}
    }

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







|







4393
4394
4395
4396
4397
4398
4399
4400
4401
4402
4403
4404
4405
4406
4407
	}
    }

    /*
     * Wrap the ZipChannel into a Tcl_Channel.
     */

    snprintf(cname, sizeof(cname), "zipfs_%" TCL_Z_MODIFIER "x_%d", z->offset,
	    ZipFS.idCount++);
    z->zipFilePtr->numOpen++;
    Unlock();
    return Tcl_CreateChannel(&ZipChannelType, cname, info, flags);

  error:
    Unlock();
4949
4950
4951
4952
4953
4954
4955
4956
4957
4958
4959
4960
4961
4962
4963
4964
4965
4966
4967

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







|



|







4954
4955
4956
4957
4958
4959
4960
4961
4962
4963
4964
4965
4966
4967
4968
4969
4970
4971
4972

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. */
    size_t nameLen)		/* The length of the name. May be TCL_INDEX_NONE for
				 * append-up-to-NUL-byte. */
{
    if (prefix) {
	size_t 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));
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
    Tcl_Obj *pathPtr,		/* Where we are looking. */
    const char *pattern,	/* What names we are looking for. */
    Tcl_GlobTypeData *types)	/* What types we are looking for. */
{
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    Tcl_Obj *normPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
    int scnt, l, dirOnly = -1, prefixLen, strip = 0, mounts = 0, len;

    char *pat, *prefix, *path;
    Tcl_DString dsPref, *prefixBuf = NULL;

    if (!normPathPtr) {
	return -1;
    }
    if (types) {
	dirOnly = (types->type & TCL_GLOB_TYPE_DIR) == TCL_GLOB_TYPE_DIR;
	mounts = (types->type == TCL_GLOB_TYPE_MOUNT);
    }

    /*
     * The prefix that gets prepended to results.
     */

    prefix = TclGetStringFromObj(pathPtr, &prefixLen);

    /*
     * The (normalized) path we're searching.
     */

    path = TclGetStringFromObj(normPathPtr, &len);

    Tcl_DStringInit(&dsPref);
    if (strcmp(prefix, path) == 0) {
	prefixBuf = NULL;
    } else {
	/*
	 * We need to strip the normalized prefix of the filenames and replace







|
>















|





|







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
    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, mounts = 0;
    Tcl_Size prefixLen, len, strip = 0;
    char *pat, *prefix, *path;
    Tcl_DString dsPref, *prefixBuf = NULL;

    if (!normPathPtr) {
	return -1;
    }
    if (types) {
	dirOnly = (types->type & TCL_GLOB_TYPE_DIR) == TCL_GLOB_TYPE_DIR;
	mounts = (types->type == TCL_GLOB_TYPE_MOUNT);
    }

    /*
     * The prefix that gets prepended to results.
     */

    prefix = Tcl_GetStringFromObj(pathPtr, &prefixLen);

    /*
     * The (normalized) path we're searching.
     */

    path = Tcl_GetStringFromObj(normPathPtr, &len);

    Tcl_DStringInit(&dsPref);
    if (strcmp(prefix, path) == 0) {
	prefixBuf = NULL;
    } else {
	/*
	 * We need to strip the normalized prefix of the filenames and replace
5130
5131
5132
5133
5134
5135
5136

5137
5138
5139
5140
5141
5142
5143
5144
5145
5146
				 * 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;







>
|
|
|







5136
5137
5138
5139
5140
5141
5142
5143
5144
5145
5146
5147
5148
5149
5150
5151
5152
5153
				 * 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;
    size_t l;
    Tcl_Size normLength;
    const char *path = Tcl_GetStringFromObj(normPathPtr, &normLength);
    size_t len = normLength;

    if (len < 1) {
	/*
	 * Shouldn't happen. But "shouldn't"...
	 */

	return;
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
static int
ZipFSPathInFilesystemProc(
    Tcl_Obj *pathPtr,
    TCL_UNUSED(void **))
{
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    int ret = -1, len;

    char *path;

    pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
    if (!pathPtr) {
	return -1;
    }
    path = TclGetStringFromObj(pathPtr, &len);
    if (strncmp(path, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN) != 0) {
	return -1;
    }

    ReadLock();
    hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, path);
    if (hPtr) {
	ret = TCL_OK;
	goto endloop;
    }

    for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr;
	    hPtr = Tcl_NextHashEntry(&search)) {
	ZipFile *zf = (ZipFile *) Tcl_GetHashValue(hPtr);

	if (zf->mountPointLen == 0) {
	    ZipEntry *z;

	    for (z = zf->topEnts; z != NULL; z = z->tnext) {
		size_t lenz = strlen(z->name);

		if (((size_t) len >= lenz) &&
			(strncmp(path, z->name, lenz) == 0)) {
		    ret = TCL_OK;
		    goto endloop;
		}
	    }
	} else if (((size_t) len >= zf->mountPointLen) &&
		(strncmp(path, zf->mountPoint, zf->mountPointLen) == 0)) {







|
>






|



















|

|







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
static int
ZipFSPathInFilesystemProc(
    Tcl_Obj *pathPtr,
    TCL_UNUSED(void **))
{
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    int ret = -1;
    Tcl_Size len;
    char *path;

    pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
    if (!pathPtr) {
	return -1;
    }
    path = Tcl_GetStringFromObj(pathPtr, &len);
    if (strncmp(path, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN) != 0) {
	return -1;
    }

    ReadLock();
    hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, path);
    if (hPtr) {
	ret = TCL_OK;
	goto endloop;
    }

    for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr;
	    hPtr = Tcl_NextHashEntry(&search)) {
	ZipFile *zf = (ZipFile *) Tcl_GetHashValue(hPtr);

	if (zf->mountPointLen == 0) {
	    ZipEntry *z;

	    for (z = zf->topEnts; z != NULL; z = z->tnext) {
		Tcl_Size lenz = strlen(z->name);

		if ((len >= lenz) &&
			(strncmp(path, z->name, lenz) == 0)) {
		    ret = TCL_OK;
		    goto endloop;
		}
	    }
	} else if (((size_t) len >= zf->mountPointLen) &&
		(strncmp(path, zf->mountPoint, zf->mountPointLen) == 0)) {
5358
5359
5360
5361
5362
5363
5364

5365
5366
5367
5368
5369
5370
5371
5372
5373
5374
5375
5376
5377
5378
5379
5380
static int
ZipFSFileAttrsGetProc(
    Tcl_Interp *interp,		/* Current interpreter. */
    int index,
    Tcl_Obj *pathPtr,
    Tcl_Obj **objPtrRef)
{

    int len, ret = TCL_OK;
    char *path;
    ZipEntry *z;

    pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
    if (!pathPtr) {
	return -1;
    }
    path = TclGetStringFromObj(pathPtr, &len);
    ReadLock();
    z = ZipFSLookup(path);
    if (!z) {
	Tcl_SetErrno(ENOENT);
	ZIPFS_POSIX_ERROR(interp, "file not found");
	ret = TCL_ERROR;
	goto done;







>
|







|







5366
5367
5368
5369
5370
5371
5372
5373
5374
5375
5376
5377
5378
5379
5380
5381
5382
5383
5384
5385
5386
5387
5388
5389
static int
ZipFSFileAttrsGetProc(
    Tcl_Interp *interp,		/* Current interpreter. */
    int index,
    Tcl_Obj *pathPtr,
    Tcl_Obj **objPtrRef)
{
    Tcl_Size len;
    int ret = TCL_OK;
    char *path;
    ZipEntry *z;

    pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
    if (!pathPtr) {
	return -1;
    }
    path = Tcl_GetStringFromObj(pathPtr, &len);
    ReadLock();
    z = ZipFSLookup(path);
    if (!z) {
	Tcl_SetErrno(ENOENT);
	ZIPFS_POSIX_ERROR(interp, "file not found");
	ret = TCL_ERROR;
	goto done;
5651
5652
5653
5654
5655
5656
5657
5658
5659
5660
5661
5662
5663
5664
5665
    }
    Unlock();

    if (interp) {
	Tcl_Command ensemble;
	Tcl_Obj *mapObj;

	Tcl_EvalEx(interp, findproc, -1, TCL_EVAL_GLOBAL);
	if (!Tcl_IsSafe(interp)) {
	    Tcl_LinkVar(interp, "::tcl::zipfs::wrmax", (char *) &ZipFS.wrmax,
		    TCL_LINK_INT);
	    Tcl_LinkVar(interp, "::tcl::zipfs::fallbackEntryEncoding",
		    (char *) &ZipFS.fallbackEntryEncoding, TCL_LINK_STRING);
	}
	ensemble = TclMakeEnsemble(interp, "zipfs",







|







5660
5661
5662
5663
5664
5665
5666
5667
5668
5669
5670
5671
5672
5673
5674
    }
    Unlock();

    if (interp) {
	Tcl_Command ensemble;
	Tcl_Obj *mapObj;

	Tcl_EvalEx(interp, findproc, TCL_INDEX_NONE, TCL_EVAL_GLOBAL);
	if (!Tcl_IsSafe(interp)) {
	    Tcl_LinkVar(interp, "::tcl::zipfs::wrmax", (char *) &ZipFS.wrmax,
		    TCL_LINK_INT);
	    Tcl_LinkVar(interp, "::tcl::zipfs::fallbackEntryEncoding",
		    (char *) &ZipFS.fallbackEntryEncoding, TCL_LINK_STRING);
	}
	ensemble = TclMakeEnsemble(interp, "zipfs",
5849
5850
5851
5852
5853
5854
5855
5856
5857
5858
5859
5860
5861
5862
5863
	 * script.
	 */

#ifdef _WIN32
	Tcl_DString ds;

	Tcl_DStringInit(&ds);
	archive = Tcl_WCharToUtfDString((*argvPtr)[1], -1, &ds);
#else /* !_WIN32 */
	archive = (*argvPtr)[1];
#endif /* _WIN32 */
	if (strcmp(archive, "install") == 0) {
	    Tcl_Obj *vfsInitScript;

	    /*







|







5858
5859
5860
5861
5862
5863
5864
5865
5866
5867
5868
5869
5870
5871
5872
	 * script.
	 */

#ifdef _WIN32
	Tcl_DString ds;

	Tcl_DStringInit(&ds);
	archive = Tcl_WCharToUtfDString((*argvPtr)[1], TCL_INDEX_NONE, &ds);
#else /* !_WIN32 */
	archive = (*argvPtr)[1];
#endif /* _WIN32 */
	if (strcmp(archive, "install") == 0) {
	    Tcl_Obj *vfsInitScript;

	    /*

Changes to generic/tclZlib.c.

60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
typedef struct {
    Tcl_Interp *interp;
    z_stream stream;		/* The interface to the zlib library. */
    int streamEnd;		/* If we've got to end-of-stream. */
    Tcl_Obj *inData, *outData;	/* Input / output buffers (lists) */
    Tcl_Obj *currentInput;	/* Pointer to what is currently being
				 * inflated. */
    size_t outPos;
    int mode;			/* Either TCL_ZLIB_STREAM_DEFLATE or
				 * TCL_ZLIB_STREAM_INFLATE. */
    int format;			/* Flags from the TCL_ZLIB_FORMAT_* */
    int level;			/* Default 5, 0-9 */
    int flush;			/* Stores the flush param for deferred the
				 * decompression. */
    int wbits;			/* The encoded compression mode, so we can







|







60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
typedef struct {
    Tcl_Interp *interp;
    z_stream stream;		/* The interface to the zlib library. */
    int streamEnd;		/* If we've got to end-of-stream. */
    Tcl_Obj *inData, *outData;	/* Input / output buffers (lists) */
    Tcl_Obj *currentInput;	/* Pointer to what is currently being
				 * inflated. */
    Tcl_Size outPos;
    int mode;			/* Either TCL_ZLIB_STREAM_DEFLATE or
				 * TCL_ZLIB_STREAM_INFLATE. */
    int format;			/* Flags from the TCL_ZLIB_FORMAT_* */
    int level;			/* Default 5, 0-9 */
    int flush;			/* Stores the flush param for deferred the
				 * decompression. */
    int wbits;			/* The encoded compression mode, so we can
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
	break;
    case Z_VERSION_ERROR:
	codeStr = "VERSION";
	break;
    case Z_NEED_DICT:
	codeStr = "NEED_DICT";
	codeStr2 = codeStrBuf;
	sprintf(codeStrBuf, "%lu", adler);
	break;

	/*
	 * These should _not_ happen! This function is for dealing with error
	 * cases, not non-errors!
	 */

    case Z_OK:
	Tcl_Panic("unexpected zlib result in error handler: Z_OK");
    case Z_STREAM_END:
	Tcl_Panic("unexpected zlib result in error handler: Z_STREAM_END");

	/*
	 * Anything else is bad news; it's unexpected. Convert to generic
	 * error.
	 */

    default:
	codeStr = "UNKNOWN";
	codeStr2 = codeStrBuf;
	sprintf(codeStrBuf, "%d", code);
	break;
    }
    Tcl_SetObjResult(interp, Tcl_NewStringObj(zError(code), -1));

    /*
     * Tricky point! We might pass NULL twice here (and will when the error
     * type is known).







|




















|







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
	break;
    case Z_VERSION_ERROR:
	codeStr = "VERSION";
	break;
    case Z_NEED_DICT:
	codeStr = "NEED_DICT";
	codeStr2 = codeStrBuf;
	snprintf(codeStrBuf, sizeof(codeStrBuf), "%lu", adler);
	break;

	/*
	 * These should _not_ happen! This function is for dealing with error
	 * cases, not non-errors!
	 */

    case Z_OK:
	Tcl_Panic("unexpected zlib result in error handler: Z_OK");
    case Z_STREAM_END:
	Tcl_Panic("unexpected zlib result in error handler: Z_STREAM_END");

	/*
	 * Anything else is bad news; it's unexpected. Convert to generic
	 * error.
	 */

    default:
	codeStr = "UNKNOWN";
	codeStr2 = codeStrBuf;
	snprintf(codeStrBuf, sizeof(codeStrBuf), "%d", code);
	break;
    }
    Tcl_SetObjResult(interp, Tcl_NewStringObj(zError(code), -1));

    /*
     * Tricky point! We might pass NULL twice here (and will when the error
     * type is known).
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
				 * parsed. */
    GzipHeader *headerPtr,	/* Where to store the parsed-out values. */
    int *extraSizePtr)		/* Variable to add the length of header
				 * strings (filename, comment) to. */
{
    Tcl_Obj *value;
    int len, result = TCL_ERROR;
    size_t length;
    Tcl_WideInt wideValue = 0;
    const char *valueStr;
    Tcl_Encoding latin1enc;
    static const char *const types[] = {
	"binary", "text"
    };

    /*
     * RFC 1952 says that header strings are in ISO 8859-1 (LATIN-1).
     */

    latin1enc = Tcl_GetEncoding(NULL, "iso8859-1");
    if (latin1enc == NULL) {
	Tcl_Panic("no latin-1 encoding");
    }

    if (GetValue(interp, dictObj, "comment", &value) != TCL_OK) {
	goto error;
    } else if (value != NULL) {

	valueStr = Tcl_GetStringFromObj(value, &length);
	Tcl_UtfToExternal(NULL, latin1enc, valueStr, length, 0, NULL,

		headerPtr->nativeCommentBuf, MAX_COMMENT_LEN-1, NULL, &len,
		NULL);












	headerPtr->nativeCommentBuf[len] = '\0';
	headerPtr->header.comment = (Bytef *) headerPtr->nativeCommentBuf;
	if (extraSizePtr != NULL) {
	    *extraSizePtr += len;
	}
    }

    if (GetValue(interp, dictObj, "crc", &value) != TCL_OK) {
	goto error;
    } else if (value != NULL &&
	    Tcl_GetBooleanFromObj(interp, value, &headerPtr->header.hcrc)) {
	goto error;
    }

    if (GetValue(interp, dictObj, "filename", &value) != TCL_OK) {
	goto error;
    } else if (value != NULL) {

	valueStr = Tcl_GetStringFromObj(value, &length);
	Tcl_UtfToExternal(NULL, latin1enc, valueStr, length, 0, NULL,

		headerPtr->nativeFilenameBuf, MAXPATHLEN-1, NULL, &len, NULL);














	headerPtr->nativeFilenameBuf[len] = '\0';
	headerPtr->header.name = (Bytef *) headerPtr->nativeFilenameBuf;
	if (extraSizePtr != NULL) {
	    *extraSizePtr += len;
	}
    }








|



















>

|
>


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

















>

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







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
				 * parsed. */
    GzipHeader *headerPtr,	/* Where to store the parsed-out values. */
    int *extraSizePtr)		/* Variable to add the length of header
				 * strings (filename, comment) to. */
{
    Tcl_Obj *value;
    int len, result = TCL_ERROR;
    Tcl_Size length;
    Tcl_WideInt wideValue = 0;
    const char *valueStr;
    Tcl_Encoding latin1enc;
    static const char *const types[] = {
	"binary", "text"
    };

    /*
     * RFC 1952 says that header strings are in ISO 8859-1 (LATIN-1).
     */

    latin1enc = Tcl_GetEncoding(NULL, "iso8859-1");
    if (latin1enc == NULL) {
	Tcl_Panic("no latin-1 encoding");
    }

    if (GetValue(interp, dictObj, "comment", &value) != TCL_OK) {
	goto error;
    } else if (value != NULL) {
	Tcl_EncodingState state;
	valueStr = Tcl_GetStringFromObj(value, &length);
	result = Tcl_UtfToExternal(NULL, latin1enc, valueStr, length,
		TCL_ENCODING_START|TCL_ENCODING_END|TCL_ENCODING_PROFILE_STRICT, &state,
		headerPtr->nativeCommentBuf, MAX_COMMENT_LEN-1, NULL, &len,
		NULL);
	if (result != TCL_OK) {
	    if (interp) {
		if (result == TCL_CONVERT_UNKNOWN) {
		    Tcl_AppendResult(
			interp, "Comment contains characters > 0xFF", NULL);
		} else {
		    Tcl_AppendResult(interp, "Comment too large for zip", NULL);
		}
	    }
	    result = TCL_ERROR; /* TCL_CONVERT_* -> TCL_ERROR*/
	    goto error;
	}
	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) {
	Tcl_EncodingState state;
	valueStr = Tcl_GetStringFromObj(value, &length);
	result = Tcl_UtfToExternal(NULL, latin1enc, valueStr, length,
		TCL_ENCODING_START|TCL_ENCODING_END|TCL_ENCODING_PROFILE_STRICT, &state,
		headerPtr->nativeFilenameBuf, MAXPATHLEN-1, NULL, &len,
		NULL);
	if (result != TCL_OK) {
	    if (interp) {
		if (result == TCL_CONVERT_UNKNOWN) {
		    Tcl_AppendResult(
			interp, "Filename contains characters > 0xFF", NULL);
		} else {
		    Tcl_AppendResult(
			interp, "Filename too large for zip", NULL);
		}
	    }
	    result = TCL_ERROR; /* TCL_CONVERT_* -> TCL_ERROR*/
	    goto error;
	}
	headerPtr->nativeFilenameBuf[len] = '\0';
	headerPtr->header.name = (Bytef *) headerPtr->nativeFilenameBuf;
	if (extraSizePtr != NULL) {
	    *extraSizePtr += len;
	}
    }

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

	    latin1enc = Tcl_GetEncoding(NULL, "iso8859-1");
	    if (latin1enc == NULL) {
		Tcl_Panic("no latin-1 encoding");
	    }
	}

	Tcl_ExternalToUtfDStringEx(latin1enc, (char *) headerPtr->comment, -1,
		TCL_ENCODING_NOCOMPLAIN, &tmp);
	SetValue(dictObj, "comment", TclDStringToObj(&tmp));
    }
    SetValue(dictObj, "crc", Tcl_NewBooleanObj(headerPtr->hcrc));
    if (headerPtr->name != Z_NULL) {
	if (latin1enc == NULL) {
	    /*
	     * RFC 1952 says that header strings are in ISO 8859-1 (LATIN-1).
	     */

	    latin1enc = Tcl_GetEncoding(NULL, "iso8859-1");
	    if (latin1enc == NULL) {
		Tcl_Panic("no latin-1 encoding");
	    }
	}

	Tcl_ExternalToUtfDStringEx(latin1enc, (char *) headerPtr->name, -1,
		TCL_ENCODING_NOCOMPLAIN, &tmp);
	SetValue(dictObj, "filename", TclDStringToObj(&tmp));
    }
    if (headerPtr->os != 255) {
	SetValue(dictObj, "os", Tcl_NewWideIntObj(headerPtr->os));
    }
    if (headerPtr->time != 0 /* magic - no time */) {
	SetValue(dictObj, "time", Tcl_NewWideIntObj(headerPtr->time));
    }







|
|
|














|
|
|







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

	    latin1enc = Tcl_GetEncoding(NULL, "iso8859-1");
	    if (latin1enc == NULL) {
		Tcl_Panic("no latin-1 encoding");
	    }
	}

	(void)Tcl_ExternalToUtfDString(latin1enc, (char *) headerPtr->comment, TCL_INDEX_NONE,
		&tmp);
	SetValue(dictObj, "comment", Tcl_DStringToObj(&tmp));
    }
    SetValue(dictObj, "crc", Tcl_NewBooleanObj(headerPtr->hcrc));
    if (headerPtr->name != Z_NULL) {
	if (latin1enc == NULL) {
	    /*
	     * RFC 1952 says that header strings are in ISO 8859-1 (LATIN-1).
	     */

	    latin1enc = Tcl_GetEncoding(NULL, "iso8859-1");
	    if (latin1enc == NULL) {
		Tcl_Panic("no latin-1 encoding");
	    }
	}

	(void)Tcl_ExternalToUtfDString(latin1enc, (char *) headerPtr->name, TCL_INDEX_NONE,
		&tmp);
	SetValue(dictObj, "filename", Tcl_DStringToObj(&tmp));
    }
    if (headerPtr->os != 255) {
	SetValue(dictObj, "os", Tcl_NewWideIntObj(headerPtr->os));
    }
    if (headerPtr->time != 0 /* magic - no time */) {
	SetValue(dictObj, "time", Tcl_NewWideIntObj(headerPtr->time));
    }
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

static int
SetInflateDictionary(
    z_streamp strm,
    Tcl_Obj *compDictObj)
{
    if (compDictObj != NULL) {
	size_t length = 0;
	unsigned char *bytes = Tcl_GetByteArrayFromObj(compDictObj, &length);




	return inflateSetDictionary(strm, bytes, length);
    }
    return Z_OK;
}

static int
SetDeflateDictionary(
    z_streamp strm,
    Tcl_Obj *compDictObj)
{
    if (compDictObj != NULL) {
	size_t length = 0;
	unsigned char *bytes = Tcl_GetByteArrayFromObj(compDictObj, &length);




	return deflateSetDictionary(strm, bytes, length);
    }
    return Z_OK;
}

static inline int
Deflate(







|


>
>
>











|


>
>
>







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

static int
SetInflateDictionary(
    z_streamp strm,
    Tcl_Obj *compDictObj)
{
    if (compDictObj != NULL) {
	Tcl_Size length = 0;
	unsigned char *bytes = Tcl_GetByteArrayFromObj(compDictObj, &length);

	if (bytes == NULL) {
	    return Z_DATA_ERROR;
	}
	return inflateSetDictionary(strm, bytes, length);
    }
    return Z_OK;
}

static int
SetDeflateDictionary(
    z_streamp strm,
    Tcl_Obj *compDictObj)
{
    if (compDictObj != NULL) {
	Tcl_Size length = 0;
	unsigned char *bytes = Tcl_GetByteArrayFromObj(compDictObj, &length);

	if (bytes == NULL) {
	    return Z_DATA_ERROR;
	}
	return deflateSetDictionary(strm, bytes, length);
    }
    return Z_OK;
}

static inline int
Deflate(
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
    }

    /*
     * I could do all this in C, but this is easier.
     */

    if (interp != NULL) {
	if (Tcl_EvalEx(interp, "::incr ::tcl::zlib::cmdcounter", -1, 0) != TCL_OK) {
	    goto error;
	}
	Tcl_DStringInit(&cmdname);
	TclDStringAppendLiteral(&cmdname, "::tcl::zlib::streamcmd_");
	TclDStringAppendObj(&cmdname, Tcl_GetObjResult(interp));
	if (Tcl_FindCommand(interp, Tcl_DStringValue(&cmdname),
		NULL, 0) != NULL) {







|







836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
    }

    /*
     * I could do all this in C, but this is easier.
     */

    if (interp != NULL) {
	if (Tcl_EvalEx(interp, "::incr ::tcl::zlib::cmdcounter", TCL_INDEX_NONE, 0) != TCL_OK) {
	    goto error;
	}
	Tcl_DStringInit(&cmdname);
	TclDStringAppendLiteral(&cmdname, "::tcl::zlib::streamcmd_");
	TclDStringAppendObj(&cmdname, Tcl_GetObjResult(interp));
	if (Tcl_FindCommand(interp, Tcl_DStringValue(&cmdname),
		NULL, 0) != NULL) {
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
void
Tcl_ZlibStreamSetCompressionDictionary(
    Tcl_ZlibStream zshandle,
    Tcl_Obj *compressionDictionaryObj)
{
    ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle;

    if (compressionDictionaryObj && (NULL == Tcl_GetBytesFromObj(NULL,
	    compressionDictionaryObj, (size_t *)NULL))) {
	/* Missing or invalid compression dictionary */
	compressionDictionaryObj = NULL;
    }
    if (compressionDictionaryObj != NULL) {
	if (Tcl_IsShared(compressionDictionaryObj)) {
	    compressionDictionaryObj =
		    Tcl_DuplicateObj(compressionDictionaryObj);







|
|







1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
void
Tcl_ZlibStreamSetCompressionDictionary(
    Tcl_ZlibStream zshandle,
    Tcl_Obj *compressionDictionaryObj)
{
    ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle;

    if (compressionDictionaryObj && (NULL == Tcl_GetByteArrayFromObj(
	    compressionDictionaryObj, (Tcl_Size *)NULL))) {
	/* Missing or invalid compression dictionary */
	compressionDictionaryObj = NULL;
    }
    if (compressionDictionaryObj != NULL) {
	if (Tcl_IsShared(compressionDictionaryObj)) {
	    compressionDictionaryObj =
		    Tcl_DuplicateObj(compressionDictionaryObj);
1194
1195
1196
1197
1198
1199
1200

1201
1202
1203
1204
1205
1206
1207
1208
    Tcl_Obj *data,		/* Data to compress/decompress */
    int flush)			/* TCL_ZLIB_NO_FLUSH, TCL_ZLIB_FLUSH,
				 * TCL_ZLIB_FULLFLUSH, or TCL_ZLIB_FINALIZE */
{
    ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle;
    char *dataTmp = NULL;
    int e;

    size_t size = 0, outSize, toStore;
    unsigned char *bytes;

    if (zshPtr->streamEnd) {
	if (zshPtr->interp) {
	    Tcl_SetObjResult(zshPtr->interp, Tcl_NewStringObj(
		    "already past compressed stream end", -1));
	    Tcl_SetErrorCode(zshPtr->interp, "TCL", "ZIP", "CLOSED", NULL);







>
|







1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
    Tcl_Obj *data,		/* Data to compress/decompress */
    int flush)			/* TCL_ZLIB_NO_FLUSH, TCL_ZLIB_FLUSH,
				 * TCL_ZLIB_FULLFLUSH, or TCL_ZLIB_FINALIZE */
{
    ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle;
    char *dataTmp = NULL;
    int e;
    Tcl_Size size = 0;
    size_t outSize, toStore;
    unsigned char *bytes;

    if (zshPtr->streamEnd) {
	if (zshPtr->interp) {
	    Tcl_SetObjResult(zshPtr->interp, Tcl_NewStringObj(
		    "already past compressed stream end", -1));
	    Tcl_SetErrorCode(zshPtr->interp, "TCL", "ZIP", "CLOSED", NULL);
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
 *----------------------------------------------------------------------
 */

int
Tcl_ZlibStreamGet(
    Tcl_ZlibStream zshandle,	/* As obtained from Tcl_ZlibStreamInit */
    Tcl_Obj *data,		/* A place to append the data. */
    size_t count)			/* Number of bytes to grab as a maximum, you
				 * may get less! */
{
    ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle;
    int e;
    size_t listLen, i, itemLen = 0, dataPos = 0;
    Tcl_Obj *itemObj;
    unsigned char *dataPtr, *itemPtr;
    size_t existing = 0;

    /*
     * Getting beyond the of stream, just return empty string.
     */

    if (zshPtr->streamEnd) {
	return TCL_OK;
    }

    if (NULL == Tcl_GetBytesFromObj(zshPtr->interp, data, &existing)) {
	return TCL_ERROR;
    }

    if (zshPtr->mode == TCL_ZLIB_STREAM_INFLATE) {
	if (count == TCL_INDEX_NONE) {
	    /*
	     * The only safe thing to do is restict to 65k. We might cause a
	     * panic for out of memory if we just kept growing the buffer.
	     */

	    count = MAX_BUFFER_SIZE;
	}







|




|


|














|







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

int
Tcl_ZlibStreamGet(
    Tcl_ZlibStream zshandle,	/* As obtained from Tcl_ZlibStreamInit */
    Tcl_Obj *data,		/* A place to append the data. */
    Tcl_Size count)			/* Number of bytes to grab as a maximum, you
				 * may get less! */
{
    ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle;
    int e;
    Tcl_Size listLen, i, itemLen = 0, dataPos = 0;
    Tcl_Obj *itemObj;
    unsigned char *dataPtr, *itemPtr;
    Tcl_Size existing = 0;

    /*
     * Getting beyond the of stream, just return empty string.
     */

    if (zshPtr->streamEnd) {
	return TCL_OK;
    }

    if (NULL == Tcl_GetBytesFromObj(zshPtr->interp, data, &existing)) {
	return TCL_ERROR;
    }

    if (zshPtr->mode == TCL_ZLIB_STREAM_INFLATE) {
	if (count < 0) {
	    /*
	     * The only safe thing to do is restict to 65k. We might cause a
	     * panic for out of memory if we just kept growing the buffer.
	     */

	    count = MAX_BUFFER_SIZE;
	}
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
		Tcl_DecrRefCount(zshPtr->currentInput);
		zshPtr->currentInput = 0;
	    }
	    inflateEnd(&zshPtr->stream);
	}
    } else {
	TclListObjLengthM(NULL, zshPtr->outData, &listLen);
	if (count == TCL_INDEX_NONE) {
	    count = 0;
	    for (i=0; i<listLen; i++) {
		Tcl_ListObjIndex(NULL, zshPtr->outData, i, &itemObj);
		(void) Tcl_GetByteArrayFromObj(itemObj, &itemLen);
		if (i == 0) {
		    count += itemLen - zshPtr->outPos;
		} else {







|







1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
		Tcl_DecrRefCount(zshPtr->currentInput);
		zshPtr->currentInput = 0;
	    }
	    inflateEnd(&zshPtr->stream);
	}
    } else {
	TclListObjLengthM(NULL, zshPtr->outData, &listLen);
	if (count < 0) {
	    count = 0;
	    for (i=0; i<listLen; i++) {
		Tcl_ListObjIndex(NULL, zshPtr->outData, i, &itemObj);
		(void) Tcl_GetByteArrayFromObj(itemObj, &itemLen);
		if (i == 0) {
		    count += itemLen - zshPtr->outPos;
		} else {
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
	    /*
	     * Get the next chunk off our list of chunks and grab the data out
	     * of it.
	     */

	    Tcl_ListObjIndex(NULL, zshPtr->outData, 0, &itemObj);
	    itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen);
	    if (itemLen-zshPtr->outPos + dataPos >= count) {
		size_t len = count - dataPos;

		memcpy(dataPtr + dataPos, itemPtr + zshPtr->outPos, len);
		zshPtr->outPos += len;
		dataPos += len;
		if (zshPtr->outPos == itemLen) {
		    zshPtr->outPos = 0;
		}
	    } else {
		size_t len = itemLen - zshPtr->outPos;

		memcpy(dataPtr + dataPos, itemPtr + zshPtr->outPos, len);
		dataPos += len;
		zshPtr->outPos = 0;
	    }
	    if (zshPtr->outPos == 0) {
		Tcl_ListObjReplace(NULL, zshPtr->outData, 0, 1, 0, NULL);







|
|








|







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
	    /*
	     * Get the next chunk off our list of chunks and grab the data out
	     * of it.
	     */

	    Tcl_ListObjIndex(NULL, zshPtr->outData, 0, &itemObj);
	    itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen);
	    if ((itemLen-zshPtr->outPos) >= count-dataPos) {
		Tcl_Size len = count - dataPos;

		memcpy(dataPtr + dataPos, itemPtr + zshPtr->outPos, len);
		zshPtr->outPos += len;
		dataPos += len;
		if (zshPtr->outPos == itemLen) {
		    zshPtr->outPos = 0;
		}
	    } else {
		Tcl_Size len = itemLen - zshPtr->outPos;

		memcpy(dataPtr + dataPos, itemPtr + zshPtr->outPos, len);
		dataPos += len;
		zshPtr->outPos = 0;
	    }
	    if (zshPtr->outPos == 0) {
		Tcl_ListObjReplace(NULL, zshPtr->outData, 0, 1, 0, NULL);
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
    Tcl_Interp *interp,
    int format,
    Tcl_Obj *data,
    int level,
    Tcl_Obj *gzipHeaderDictObj)
{
    int wbits = 0, e = 0, extraSize = 0;
    size_t inLen = 0;
    Byte *inData = NULL;
    z_stream stream;
    GzipHeader header;
    gz_header *headerPtr = NULL;
    Tcl_Obj *obj;

    if (!interp) {







|







1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
    Tcl_Interp *interp,
    int format,
    Tcl_Obj *data,
    int level,
    Tcl_Obj *gzipHeaderDictObj)
{
    int wbits = 0, e = 0, extraSize = 0;
    Tcl_Size inLen = 0;
    Byte *inData = NULL;
    z_stream stream;
    GzipHeader header;
    gz_header *headerPtr = NULL;
    Tcl_Obj *obj;

    if (!interp) {
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
    }

    if (e != Z_OK) {
	goto error;
    }

    /*
     * Reduce the bytearray length to the actual data length produced by
     * deflate.
     */

    Tcl_SetByteArrayLength(obj, stream.total_out);
    Tcl_SetObjResult(interp, obj);
    return TCL_OK;








|







1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
    }

    if (e != Z_OK) {
	goto error;
    }

    /*
     * Reduce the ByteArray length to the actual data length produced by
     * deflate.
     */

    Tcl_SetByteArrayLength(obj, stream.total_out);
    Tcl_SetObjResult(interp, obj);
    return TCL_OK;

1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
 */

int
Tcl_ZlibInflate(
    Tcl_Interp *interp,
    int format,
    Tcl_Obj *data,
    size_t bufferSize,
    Tcl_Obj *gzipHeaderDictObj)
{
    int wbits = 0, e = 0;
    size_t inLen = 0, newBufferSize;
    Byte *inData = NULL, *outData = NULL, *newOutData = NULL;
    z_stream stream;
    gz_header header, *headerPtr = NULL;
    Tcl_Obj *obj;
    char *nameBuf = NULL, *commentBuf = NULL;

    if (!interp) {







|



|







1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
 */

int
Tcl_ZlibInflate(
    Tcl_Interp *interp,
    int format,
    Tcl_Obj *data,
    Tcl_Size bufferSize,
    Tcl_Obj *gzipHeaderDictObj)
{
    int wbits = 0, e = 0;
    Tcl_Size inLen = 0, newBufferSize;
    Byte *inData = NULL, *outData = NULL, *newOutData = NULL;
    z_stream stream;
    gz_header header, *headerPtr = NULL;
    Tcl_Obj *obj;
    char *nameBuf = NULL, *commentBuf = NULL;

    if (!interp) {
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
 *----------------------------------------------------------------------
 */

unsigned int
Tcl_ZlibCRC32(
    unsigned int crc,
    const unsigned char *buf,
    size_t len)
{
    /* Nothing much to do, just wrap the crc32(). */
    return crc32(crc, (Bytef *) buf, len);
}

unsigned int
Tcl_ZlibAdler32(
    unsigned int adler,
    const unsigned char *buf,
    size_t len)
{
    return adler32(adler, (Bytef *) buf, len);
}

/*
 *----------------------------------------------------------------------
 *







|









|







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

unsigned int
Tcl_ZlibCRC32(
    unsigned int crc,
    const unsigned char *buf,
    Tcl_Size len)
{
    /* Nothing much to do, just wrap the crc32(). */
    return crc32(crc, (Bytef *) buf, len);
}

unsigned int
Tcl_ZlibAdler32(
    unsigned int adler,
    const unsigned char *buf,
    Tcl_Size len)
{
    return adler32(adler, (Bytef *) buf, len);
}

/*
 *----------------------------------------------------------------------
 *
1949
1950
1951
1952
1953
1954
1955
1956


1957
1958
1959
1960
1961
1962
1963
ZlibCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    int i, option, level = -1;
    size_t dlen = 0, start, buffersize = 0;


    Tcl_WideInt wideLen;
    Byte *data;
    Tcl_Obj *headerDictObj;
    const char *extraInfoStr = NULL;
    static const char *const commands[] = {
	"adler32", "compress", "crc32", "decompress", "deflate", "gunzip",
	"gzip", "inflate", "push", "stream",







|
>
>







1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
ZlibCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    int i, option, level = -1;
    size_t buffersize = 0;
    Tcl_Size dlen = 0;
    unsigned int start;
    Tcl_WideInt wideLen;
    Byte *data;
    Tcl_Obj *headerDictObj;
    const char *extraInfoStr = NULL;
    static const char *const commands[] = {
	"adler32", "compress", "crc32", "decompress", "deflate", "gunzip",
	"gzip", "inflate", "push", "stream",
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
	Tcl_SetObjResult(interp, Tcl_NewStringObj("level must be 0 to 9",-1));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMPRESSIONLEVEL", NULL);
	Tcl_AddErrorInfo(interp, "\n    (in -level option)");
	return TCL_ERROR;
    }

    if (compDictObj) {
	if (NULL == Tcl_GetBytesFromObj(interp, compDictObj, (size_t *)NULL)) {
	    return TCL_ERROR;
	}
    }

    /*
     * Construct the stream now we know its configuration.
     */







|







2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
	Tcl_SetObjResult(interp, Tcl_NewStringObj("level must be 0 to 9",-1));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMPRESSIONLEVEL", NULL);
	Tcl_AddErrorInfo(interp, "\n    (in -level option)");
	return TCL_ERROR;
    }

    if (compDictObj) {
	if (NULL == Tcl_GetBytesFromObj(interp, compDictObj, (Tcl_Size *)NULL)) {
	    return TCL_ERROR;
	}
    }

    /*
     * Construct the stream now we know its configuration.
     */
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
    static const char *const pushDecompressOptions[] = {
	"-dictionary", "-header", "-level", "-limit", NULL
    };
    const char *const *pushOptions = pushDecompressOptions;
    enum pushOptionsEnum {poDictionary, poHeader, poLevel, poLimit} option;
    Tcl_Obj *headerObj = NULL, *compDictObj = NULL;
    int limit = DEFAULT_BUFFER_SIZE;
    size_t dummy;

    if (objc < 4) {
	Tcl_WrongNumArgs(interp, 2, objv, "mode channel ?options...?");
	return TCL_ERROR;
    }

    if (Tcl_GetIndexFromObj(interp, objv[2], stream_formats, "mode", 0,







|







2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
    static const char *const pushDecompressOptions[] = {
	"-dictionary", "-header", "-level", "-limit", NULL
    };
    const char *const *pushOptions = pushDecompressOptions;
    enum pushOptionsEnum {poDictionary, poHeader, poLevel, poLimit} option;
    Tcl_Obj *headerObj = NULL, *compDictObj = NULL;
    int limit = DEFAULT_BUFFER_SIZE;
    Tcl_Size dummy;

    if (objc < 4) {
	Tcl_WrongNumArgs(interp, 2, objv, "mode channel ?options...?");
	return TCL_ERROR;
    }

    if (Tcl_GetIndexFromObj(interp, objv[2], stream_formats, "mode", 0,
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"compression may only be applied to writable channels", -1));
	Tcl_SetErrorCode(interp, "TCL", "ZIP", "UNWRITABLE", NULL);
	return TCL_ERROR;
    }
    if (mode == TCL_ZLIB_STREAM_INFLATE && !(chanMode & TCL_READABLE)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"decompression may only be applied to readable channels",-1));
	Tcl_SetErrorCode(interp, "TCL", "ZIP", "UNREADABLE", NULL);
	return TCL_ERROR;
    }

    /*
     * Parse options.
     */







|







2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"compression may only be applied to writable channels", -1));
	Tcl_SetErrorCode(interp, "TCL", "ZIP", "UNWRITABLE", NULL);
	return TCL_ERROR;
    }
    if (mode == TCL_ZLIB_STREAM_INFLATE && !(chanMode & TCL_READABLE)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"decompression may only be applied to readable channels",TCL_INDEX_NONE));
	Tcl_SetErrorCode(interp, "TCL", "ZIP", "UNREADABLE", NULL);
	return TCL_ERROR;
    }

    /*
     * Parse options.
     */
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
		goto genericOptionError;
	    }
	    compDictObj = objv[i];
	    break;
	}
    }

    if (compDictObj && (NULL == Tcl_GetBytesFromObj(interp, compDictObj, (size_t *)NULL))) {
	return TCL_ERROR;
    }

    if (ZlibStackChannelTransform(interp, mode, format, level, limit, chan,
	    headerObj, compDictObj) == NULL) {
	return TCL_ERROR;
    }







|







2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
		goto genericOptionError;
	    }
	    compDictObj = objv[i];
	    break;
	}
    }

    if (compDictObj && (NULL == Tcl_GetBytesFromObj(interp, compDictObj, (Tcl_Size *)NULL))) {
	return TCL_ERROR;
    }

    if (ZlibStackChannelTransform(interp, mode, format, level, limit, chan,
	    headerObj, compDictObj) == NULL) {
	return TCL_ERROR;
    }
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
    }

    /*
     * Set the compression dictionary if requested.
     */

    if (compDictObj != NULL) {
	size_t len = 0;

	if (NULL == Tcl_GetBytesFromObj(interp, compDictObj, &len)) {
	    return TCL_ERROR;
	}

	if (len == 0) {
	    compDictObj = NULL;







|







2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
    }

    /*
     * Set the compression dictionary if requested.
     */

    if (compDictObj != NULL) {
	Tcl_Size len = 0;

	if (NULL == Tcl_GetBytesFromObj(interp, compDictObj, &len)) {
	    return TCL_ERROR;
	}

	if (len == 0) {
	    compDictObj = NULL;
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
    }

    /*
     * Set the compression dictionary if requested.
     */

    if (compDictObj != NULL) {
	size_t len = 0;

	if (NULL == Tcl_GetBytesFromObj(interp, compDictObj, &len)) {
	    return TCL_ERROR;
	}
	if (len == 0) {
	    compDictObj = NULL;
	}







|







2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
    }

    /*
     * Set the compression dictionary if requested.
     */

    if (compDictObj != NULL) {
	Tcl_Size len = 0;

	if (NULL == Tcl_GetBytesFromObj(interp, compDictObj, &len)) {
	    return TCL_ERROR;
	}
	if (len == 0) {
	    compDictObj = NULL;
	}
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
    if (optionName && (strcmp(optionName, "-dictionary") == 0)
	    && (cd->format != TCL_ZLIB_FORMAT_GZIP)) {
	Tcl_Obj *compDictObj;
	int code;

	TclNewStringObj(compDictObj, value, strlen(value));
	Tcl_IncrRefCount(compDictObj);
	if (NULL == Tcl_GetBytesFromObj(interp, compDictObj, (size_t *)NULL)) {
	    Tcl_DecrRefCount(compDictObj);
	    return TCL_ERROR;
	}
	if (cd->compDictObj) {
	    TclDecrRefCount(cd->compDictObj);
	}
	cd->compDictObj = compDictObj;







|







3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
    if (optionName && (strcmp(optionName, "-dictionary") == 0)
	    && (cd->format != TCL_ZLIB_FORMAT_GZIP)) {
	Tcl_Obj *compDictObj;
	int code;

	TclNewStringObj(compDictObj, value, strlen(value));
	Tcl_IncrRefCount(compDictObj);
	if (NULL == Tcl_GetBytesFromObj(interp, compDictObj, (Tcl_Size *)NULL)) {
	    Tcl_DecrRefCount(compDictObj);
	    return TCL_ERROR;
	}
	if (cd->compDictObj) {
	    TclDecrRefCount(cd->compDictObj);
	}
	cd->compDictObj = compDictObj;
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465

	if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) {
	    crc = cd->outStream.adler;
	} else {
	    crc = cd->inStream.adler;
	}

	sprintf(buf, "%lu", crc);
	if (optionName == NULL) {
	    Tcl_DStringAppendElement(dsPtr, "-checksum");
	    Tcl_DStringAppendElement(dsPtr, buf);
	} else {
	    Tcl_DStringAppend(dsPtr, buf, -1);
	    return TCL_OK;
	}







|







3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
3504

	if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) {
	    crc = cd->outStream.adler;
	} else {
	    crc = cd->inStream.adler;
	}

	snprintf(buf, sizeof(buf), "%lu", crc);
	if (optionName == NULL) {
	    Tcl_DStringAppendElement(dsPtr, "-checksum");
	    Tcl_DStringAppendElement(dsPtr, buf);
	} else {
	    Tcl_DStringAppend(dsPtr, buf, -1);
	    return TCL_OK;
	}
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
		Tcl_DStringAppendElement(dsPtr,
			TclGetString(cd->compDictObj));
	    } else {
		Tcl_DStringAppendElement(dsPtr, "");
	    }
	} else {
	    if (cd->compDictObj) {
		size_t length;
		const char *str = Tcl_GetStringFromObj(cd->compDictObj, &length);

		Tcl_DStringAppend(dsPtr, str, length);
	    }
	    return TCL_OK;
	}
    }







|







3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
		Tcl_DStringAppendElement(dsPtr,
			TclGetString(cd->compDictObj));
	    } else {
		Tcl_DStringAppendElement(dsPtr, "");
	    }
	} else {
	    if (cd->compDictObj) {
		Tcl_Size length;
		const char *str = Tcl_GetStringFromObj(cd->compDictObj, &length);

		Tcl_DStringAppend(dsPtr, str, length);
	    }
	    return TCL_OK;
	}
    }
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732
	    cd->inHeader.header.comm_max = MAX_COMMENT_LEN - 1;
	}
    }

    if (compDictObj != NULL) {
	cd->compDictObj = Tcl_DuplicateObj(compDictObj);
	Tcl_IncrRefCount(cd->compDictObj);
	Tcl_GetBytesFromObj(NULL, cd->compDictObj, (size_t *)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) {







|







3757
3758
3759
3760
3761
3762
3763
3764
3765
3766
3767
3768
3769
3770
3771
	    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, (Tcl_Size *)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) {
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950

    /*
     * This does two things. It creates a counter used in the creation of
     * stream commands, and it creates the namespace that will contain those
     * commands.
     */

    Tcl_EvalEx(interp, "namespace eval ::tcl::zlib {variable cmdcounter 0}", -1, 0);

    /*
     * Create the public scripted interface to this file's functionality.
     */

    Tcl_CreateObjCommand(interp, "zlib", ZlibCmd, 0, 0);








|







3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989

    /*
     * This does two things. It creates a counter used in the creation of
     * stream commands, and it creates the namespace that will contain those
     * commands.
     */

    Tcl_EvalEx(interp, "namespace eval ::tcl::zlib {variable cmdcounter 0}", TCL_INDEX_NONE, 0);

    /*
     * Create the public scripted interface to this file's functionality.
     */

    Tcl_CreateObjCommand(interp, "zlib", ZlibCmd, 0, 0);

Changes to library/auto.tcl.

176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
	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]
	}
    }
    # uniquify $dirs in order
    array set seen {}
    foreach i $dirs {
	# Make sure $i is unique under normalization. Avoid repeated [source].
	if {[interp issafe]} {
	    # Safe interps have no [file normalize].
	    set norm $i
	} else {







|







176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
	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]
	}
    }
    # make $dirs unique, preserving order
    array set seen {}
    foreach i $dirs {
	# Make sure $i is unique under normalization. Avoid repeated [source].
	if {[interp issafe]} {
	    # Safe interps have no [file normalize].
	    set norm $i
	} else {
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
	    # interp.  Put it back, but move it out of the way.

	    $parser expose namespace
	    $parser invokehidden rename namespace _%@namespace
	    $parser expose eval
	    $parser invokehidden rename eval _%@eval

	    # Install all the registered psuedo-command implementations

	    foreach cmd $initCommands {
		eval $cmd
	    }
	}
    }
    proc cleanup {} {







|







376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
	    # interp.  Put it back, but move it out of the way.

	    $parser expose namespace
	    $parser invokehidden rename namespace _%@namespace
	    $parser expose eval
	    $parser invokehidden rename eval _%@eval

	    # Install all the registered pseudo-command implementations

	    foreach cmd $initCommands {
		eval $cmd
	    }
	}
    }
    proc cleanup {} {
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
    } on ok {} {
	if {[namespace which -command tbcload::bcproc] eq ""} {
	    auto_load tbcload::bcproc
	}
	load {} tbcload $auto_mkindex_parser::parser

	# AUTO MKINDEX:  tbcload::bcproc name arglist body
	# Adds an entry to the auto index list for the given pre-compiled
	# procedure name.

	auto_mkindex_parser::commandInit tbcload::bcproc {name args} {
	    indexEntry $name
	}
    }
}







|







629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
    } on ok {} {
	if {[namespace which -command tbcload::bcproc] eq ""} {
	    auto_load tbcload::bcproc
	}
	load {} tbcload $auto_mkindex_parser::parser

	# AUTO MKINDEX:  tbcload::bcproc name arglist body
	# Adds an entry to the auto index list for the given precompiled
	# procedure name.

	auto_mkindex_parser::commandInit tbcload::bcproc {name args} {
	    indexEntry $name
	}
    }
}
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
		catch {
		    set name [dict get [lrange $args 1 end] -command]
		    if {![string match ::* $name]} {
			set name ::[join [lreverse $contextStack] ::]$name
		    }
		    regsub -all ::+ $name :: name
		}
		# create artifical proc to force an entry in the tclIndex
		$parser eval [list ::proc $name {} {}]
	    }
	}
    }
}

# AUTO MKINDEX:  oo::class create name ?definition?







|







684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
		catch {
		    set name [dict get [lrange $args 1 end] -command]
		    if {![string match ::* $name]} {
			set name ::[join [lreverse $contextStack] ::]$name
		    }
		    regsub -all ::+ $name :: name
		}
		# create artificial proc to force an entry in the tclIndex
		$parser eval [list ::proc $name {} {}]
	    }
	}
    }
}

# AUTO MKINDEX:  oo::class create name ?definition?

Changes to library/clock.tcl.

219
220
221
222
223
224
225
226
227
228
229
230
231
232
233

    ::msgcat::mcset sv GREGORIAN_CHANGE_DATE 2361390

    # Russia

    ::msgcat::mcset ru GREGORIAN_CHANGE_DATE 2421639

    # Romania (Transylvania changed earler - perhaps de_RO should show the
    # earlier date?)

    ::msgcat::mcset ro GREGORIAN_CHANGE_DATE 2422063

    # Greece

    ::msgcat::mcset el GREGORIAN_CHANGE_DATE 2423480







|







219
220
221
222
223
224
225
226
227
228
229
230
231
232
233

    ::msgcat::mcset sv GREGORIAN_CHANGE_DATE 2361390

    # Russia

    ::msgcat::mcset ru GREGORIAN_CHANGE_DATE 2421639

    # Romania (Transylvania changed earlier - perhaps de_RO should show the
    # earlier date?)

    ::msgcat::mcset ro GREGORIAN_CHANGE_DATE 2422063

    # Greece

    ::msgcat::mcset el GREGORIAN_CHANGE_DATE 2423480
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
    # make a reasonable guess, but this table needs to be taken with a grain
    # of salt.

    variable WinZoneInfo [dict create {*}{
	{-43200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}  :Pacific/Kwajalein
	{-39600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}	 :Pacific/Midway
	{-36000 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}  :Pacific/Honolulu
        {-32400 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Anchorage
        {-28800 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Los_Angeles
        {-28800 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Tijuana
        {-25200 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Denver
        {-25200 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Chihuahua
	{-25200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}  :America/Phoenix
	{-21600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}  :America/Regina
	{-21600 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Chicago
        {-21600 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Mexico_City
	{-18000 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/New_York
	{-18000 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}  :America/Indianapolis
	{-14400 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}  :America/Caracas
        {-14400 0 3600 0 3 6 2 23 59 59 999 0 10 6 2 23 59 59 999}
							 :America/Santiago
        {-14400 0 3600 0 2 0 5 2 0 0 0 0 11 0 1 2 0 0 0} :America/Manaus
        {-14400 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Halifax
	{-12600 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/St_Johns
	{-10800 0 3600 0 2 0 2 2 0 0 0 0 10 0 3 2 0 0 0} :America/Sao_Paulo
	{-10800 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Godthab
	{-10800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}  :America/Buenos_Aires
        {-10800 0 3600 0 2 0 5 2 0 0 0 0 11 0 1 2 0 0 0} :America/Bahia
        {-10800 0 3600 0 3 0 2 2 0 0 0 0 10 0 1 2 0 0 0} :America/Montevideo
	{-7200 0 3600 0 9 0 5 2 0 0 0 0 3 0 5 2 0 0 0}   :America/Noronha
	{-3600 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0}  :Atlantic/Azores
	{-3600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}   :Atlantic/Cape_Verde
	{0 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}       :UTC
	{0 0 3600 0 10 0 5 2 0 0 0 0 3 0 5 1 0 0 0}      :Europe/London
	{3600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}    :Africa/Kinshasa
	{3600 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0}   :CET
        {7200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}    :Africa/Harare
        {7200 0 3600 0 9 4 5 23 59 59 0 0 4 4 5 23 59 59 0}
			      				 :Africa/Cairo
	{7200 0 3600 0 10 0 5 4 0 0 0 0 3 0 5 3 0 0 0}   :Europe/Helsinki
        {7200 0 3600 0 9 0 3 2 0 0 0 0 3 5 5 2 0 0 0}    :Asia/Jerusalem
	{7200 0 3600 0 9 0 5 1 0 0 0 0 3 0 5 0 0 0 0}    :Europe/Bucharest
	{7200 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0}   :Europe/Athens
        {7200 0 3600 0 9 5 5 1 0 0 0 0 3 4 5 0 0 0 0}    :Asia/Amman
        {7200 0 3600 0 10 6 5 23 59 59 999 0 3 0 5 0 0 0 0}
							 :Asia/Beirut
        {7200 0 -3600 0 4 0 1 2 0 0 0 0 9 0 1 2 0 0 0}   :Africa/Windhoek
	{10800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}   :Asia/Riyadh
	{10800 0 3600 0 10 0 1 4 0 0 0 0 4 0 1 3 0 0 0}  :Asia/Baghdad
	{10800 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0}  :Europe/Moscow
	{12600 0 3600 0 9 2 4 2 0 0 0 0 3 0 1 2 0 0 0}   :Asia/Tehran
        {14400 0 3600 0 10 0 5 5 0 0 0 0 3 0 5 4 0 0 0}  :Asia/Baku
	{14400 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}   :Asia/Muscat
	{14400 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0}  :Asia/Tbilisi
	{16200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}   :Asia/Kabul
	{18000 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}   :Asia/Karachi
	{18000 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0}  :Asia/Yekaterinburg
	{19800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}   :Asia/Calcutta
	{20700 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}   :Asia/Katmandu







|
|
|
|
|



|



|

|
|




|
|







|
|


|


|
|

|




|







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
    # make a reasonable guess, but this table needs to be taken with a grain
    # of salt.

    variable WinZoneInfo [dict create {*}{
	{-43200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}  :Pacific/Kwajalein
	{-39600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}	 :Pacific/Midway
	{-36000 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}  :Pacific/Honolulu
	{-32400 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Anchorage
	{-28800 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Los_Angeles
	{-28800 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Tijuana
	{-25200 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Denver
	{-25200 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Chihuahua
	{-25200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}  :America/Phoenix
	{-21600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}  :America/Regina
	{-21600 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Chicago
	{-21600 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Mexico_City
	{-18000 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/New_York
	{-18000 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}  :America/Indianapolis
	{-14400 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}  :America/Caracas
	{-14400 0 3600 0 3 6 2 23 59 59 999 0 10 6 2 23 59 59 999}
							 :America/Santiago
	{-14400 0 3600 0 2 0 5 2 0 0 0 0 11 0 1 2 0 0 0} :America/Manaus
	{-14400 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Halifax
	{-12600 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/St_Johns
	{-10800 0 3600 0 2 0 2 2 0 0 0 0 10 0 3 2 0 0 0} :America/Sao_Paulo
	{-10800 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Godthab
	{-10800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}  :America/Buenos_Aires
	{-10800 0 3600 0 2 0 5 2 0 0 0 0 11 0 1 2 0 0 0} :America/Bahia
	{-10800 0 3600 0 3 0 2 2 0 0 0 0 10 0 1 2 0 0 0} :America/Montevideo
	{-7200 0 3600 0 9 0 5 2 0 0 0 0 3 0 5 2 0 0 0}   :America/Noronha
	{-3600 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0}  :Atlantic/Azores
	{-3600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}   :Atlantic/Cape_Verde
	{0 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}       :UTC
	{0 0 3600 0 10 0 5 2 0 0 0 0 3 0 5 1 0 0 0}      :Europe/London
	{3600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}    :Africa/Kinshasa
	{3600 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0}   :CET
	{7200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}    :Africa/Harare
	{7200 0 3600 0 9 4 5 23 59 59 0 0 4 4 5 23 59 59 0}
			      				 :Africa/Cairo
	{7200 0 3600 0 10 0 5 4 0 0 0 0 3 0 5 3 0 0 0}   :Europe/Helsinki
	{7200 0 3600 0 9 0 3 2 0 0 0 0 3 5 5 2 0 0 0}    :Asia/Jerusalem
	{7200 0 3600 0 9 0 5 1 0 0 0 0 3 0 5 0 0 0 0}    :Europe/Bucharest
	{7200 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0}   :Europe/Athens
	{7200 0 3600 0 9 5 5 1 0 0 0 0 3 4 5 0 0 0 0}    :Asia/Amman
	{7200 0 3600 0 10 6 5 23 59 59 999 0 3 0 5 0 0 0 0}
							 :Asia/Beirut
	{7200 0 -3600 0 4 0 1 2 0 0 0 0 9 0 1 2 0 0 0}   :Africa/Windhoek
	{10800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}   :Asia/Riyadh
	{10800 0 3600 0 10 0 1 4 0 0 0 0 4 0 1 3 0 0 0}  :Asia/Baghdad
	{10800 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0}  :Europe/Moscow
	{12600 0 3600 0 9 2 4 2 0 0 0 0 3 0 1 2 0 0 0}   :Asia/Tehran
	{14400 0 3600 0 10 0 5 5 0 0 0 0 3 0 5 4 0 0 0}  :Asia/Baku
	{14400 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}   :Asia/Muscat
	{14400 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0}  :Asia/Tbilisi
	{16200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}   :Asia/Kabul
	{18000 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}   :Asia/Karachi
	{18000 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0}  :Asia/Yekaterinburg
	{19800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}   :Asia/Calcutta
	{20700 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}   :Asia/Katmandu
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
	wast	+0700 \
	wadt	+0800 \
	jt	+0730 \
	cct	+0800 \
	jst	+0900 \
	kst     +0900 \
	cast	+0930 \
        jdt     +1000 \
        kdt     +1000 \
	cadt	+1030 \
	east	+1000 \
	eadt	+1030 \
	gst	+1000 \
	nzt	+1200 \
	nzst	+1200 \
	nzdt	+1300 \







|
|







580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
	wast	+0700 \
	wadt	+0800 \
	jt	+0730 \
	cct	+0800 \
	jst	+0900 \
	kst     +0900 \
	cast	+0930 \
	jdt     +1000 \
	kdt     +1000 \
	cadt	+1030 \
	east	+1000 \
	eadt	+1030 \
	gst	+1000 \
	nzt	+1200 \
	nzst	+1200 \
	nzdt	+1300 \
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
	}
	percentO {
	    append retval %%O
	}
    }

    proc $procName {clockval timezone} "
        $preFormatCode
        return \[::format [list $formatString] $substituents\]
    "

    #    puts [list $procName [info args $procName] [info body $procName]]

    return $procName
}

#----------------------------------------------------------------------
#
# clock scan --
#
#	Inputs a count of seconds since the Posix Epoch as a time of day.
#
# The 'clock format' command scans times of day on input.  Refer to the user
# documentation to see what it does.
#
#----------------------------------------------------------------------

proc ::tcl::clock::scan { args } {

    set format {}

    # Check the count of args

    if { [llength $args] < 1 || [llength $args] % 2 != 1 } {
	set cmdName "clock scan"
	return -code error \
	    -errorcode [list CLOCK wrongNumArgs] \
	    "wrong \# args: should be\
             \"$cmdName string\
             ?-base seconds?\
             ?-format string? ?-gmt boolean?\
             ?-locale LOCALE? ?-timezone ZONE?\""
    }

    # Set defaults

    set base [clock seconds]
    set string [lindex $args 0]
    set format {}
    set gmt 0
    set locale c
    set timezone [GetSystemTimeZone]

    # Pick up command line options.

    foreach { flag value } [lreplace $args 0 0] {
	set saw($flag) {}
	switch -exact -- $flag {
	    -b - -ba - -bas - -base {
		set base $value
	    }
	    -f - -fo - -for - -form - -forma - -format {

		set format $value
	    }
	    -g - -gm - -gmt {

		set gmt $value
	    }
	    -l - -lo - -loc - -loca - -local - -locale {

		set locale [string tolower $value]
	    }
	    -t - -ti - -tim - -time - -timez - -timezo - -timezon - -timezone {

		set timezone $value
	    }
	    default {
		return -code error \
		    -errorcode [list CLOCK badOption $flag] \
		    "bad option \"$flag\",\
                     must be -base, -format, -gmt, -locale or -timezone"
	    }
	}
    }

    # Check options for validity

    if { [info exists saw(-gmt)] && [info exists saw(-timezone)] } {







|
|













|















|
|
|
|














<





>



>



>



>






|







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
	}
	percentO {
	    append retval %%O
	}
    }

    proc $procName {clockval timezone} "
	$preFormatCode
	return \[::format [list $formatString] $substituents\]
    "

    #    puts [list $procName [info args $procName] [info body $procName]]

    return $procName
}

#----------------------------------------------------------------------
#
# clock scan --
#
#	Inputs a count of seconds since the Posix Epoch as a time of day.
#
# The 'clock scan' command scans times of day on input.  Refer to the user
# documentation to see what it does.
#
#----------------------------------------------------------------------

proc ::tcl::clock::scan { args } {

    set format {}

    # Check the count of args

    if { [llength $args] < 1 || [llength $args] % 2 != 1 } {
	set cmdName "clock scan"
	return -code error \
	    -errorcode [list CLOCK wrongNumArgs] \
	    "wrong \# args: should be\
	     \"$cmdName string\
	     ?-base seconds?\
	     ?-format string? ?-gmt boolean?\
	     ?-locale LOCALE? ?-timezone ZONE?\""
    }

    # Set defaults

    set base [clock seconds]
    set string [lindex $args 0]
    set format {}
    set gmt 0
    set locale c
    set timezone [GetSystemTimeZone]

    # Pick up command line options.

    foreach { flag value } [lreplace $args 0 0] {

	switch -exact -- $flag {
	    -b - -ba - -bas - -base {
		set base $value
	    }
	    -f - -fo - -for - -form - -forma - -format {
		set saw(-format) {}
		set format $value
	    }
	    -g - -gm - -gmt {
		set saw(-gmt) {}
		set gmt $value
	    }
	    -l - -lo - -loc - -loca - -local - -locale {
		set saw(-locale) {}
		set locale [string tolower $value]
	    }
	    -t - -ti - -tim - -time - -timez - -timezo - -timezon - -timezone {
		set saw(-timezone) {}
		set timezone $value
	    }
	    default {
		return -code error \
		    -errorcode [list CLOCK badOption $flag] \
		    "bad option \"$flag\",\
		     must be -base, -format, -gmt, -locale or -timezone"
	    }
	}
    }

    # Check options for validity

    if { [info exists saw(-gmt)] && [info exists saw(-timezone)] } {
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
    append procBody [MakeParseCodeFromFields $fieldSet $TimeParseActions]

    # Assemble seconds from the Julian day and second of the day.
    # Convert to local time unless epoch seconds or stardate are
    # being processed - they're always absolute

    if { ![dict exists $fieldSet seconds]
         && ![dict exists $fieldSet starDate] } {
	append procBody {
	    if { [dict get $date julianDay] > 5373484 } {
		return -code error -errorcode [list CLOCK dateTooLarge] \
		    "requested date too large to represent"
	    }
	    dict set date localSeconds [expr {
		-210866803200







|







1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
    append procBody [MakeParseCodeFromFields $fieldSet $TimeParseActions]

    # Assemble seconds from the Julian day and second of the day.
    # Convert to local time unless epoch seconds or stardate are
    # being processed - they're always absolute

    if { ![dict exists $fieldSet seconds]
	 && ![dict exists $fieldSet starDate] } {
	append procBody {
	    if { [dict get $date julianDay] > 5373484 } {
		return -code error -errorcode [list CLOCK dateTooLarge] \
		    "requested date too large to represent"
	    }
	    dict set date localSeconds [expr {
		-210866803200
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
# Parameters:
#	locale -- Desired locale
#
# Results:
#	Returns the locale that was previously current.
#
# Side effects:
#	Does [mclocale].  If necessary, loades the designated locale's files.
#
#----------------------------------------------------------------------

proc ::tcl::clock::EnterLocale { locale } {
    if { $locale eq {system} } {
	if { $::tcl_platform(platform) ne {windows} } {
	    # On a non-windows platform, the 'system' locale is the same as







|







2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
# Parameters:
#	locale -- Desired locale
#
# Results:
#	Returns the locale that was previously current.
#
# Side effects:
#	Does [mclocale].  If necessary, loads the designated locale's files.
#
#----------------------------------------------------------------------

proc ::tcl::clock::EnterLocale { locale } {
    if { $locale eq {system} } {
	if { $::tcl_platform(platform) ne {windows} } {
	    # On a non-windows platform, the 'system' locale is the same as
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
		d    %e
		MMMM %B
		MMM  %b
		MM   %m
		M    %N
		yyyy %Y
		yy   %y
                y    %y
                gg   {}
	    } $unquoted]
	    if { $quoted eq {} } {
		set quote '
	    } else {
		set quote $quoted
	    }
	}







|
|







2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
		d    %e
		MMMM %B
		MMM  %b
		MM   %m
		M    %N
		yyyy %Y
		yy   %y
		y    %y
		gg   {}
	    } $unquoted]
	    if { $quoted eq {} } {
		set quote '
	    } else {
		set quote $quoted
	    }
	}
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
		d    %e
		MMMM %B
		MMM  %b
		MM   %m
		M    %N
		yyyy %Y
		yy   %y
                y    %y
                gg   {}
	    } $unquoted]
	    if { $quoted eq {} } {
		set quote '
	    } else {
		set quote $quoted
	    }
	}







|
|







2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
		d    %e
		MMMM %B
		MMM  %b
		MM   %m
		M    %N
		yyyy %Y
		yy   %y
		y    %y
		gg   {}
	    } $unquoted]
	    if { $quoted eq {} } {
		set quote '
	    } else {
		set quote $quoted
	    }
	}
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
#
# ParseStarDate --
#
#	Parses a StarDate
#
# Parameters:
#	year - Year from the Roddenberry epoch
#	fractYear - Fraction of a year specifiying the day of year.
#	fractDay - Fraction of a day
#
# Results:
#	Returns a count of seconds from the Posix epoch.
#
# Side effects:
#	None.







|







2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
#
# ParseStarDate --
#
#	Parses a StarDate
#
# Parameters:
#	year - Year from the Roddenberry epoch
#	fractYear - Fraction of a year specifying the day of year.
#	fractDay - Fraction of a day
#
# Results:
#	Returns a count of seconds from the Posix epoch.
#
# Side effects:
#	None.
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
# Parameters:
#	None.
#
# Results:
#	Returns the system time zone.
#
# Side effects:
#	Stores the sustem time zone in the 'CachedSystemTimeZone'
#	variable, since determining it may be an expensive process.
#
#----------------------------------------------------------------------

proc ::tcl::clock::GetSystemTimeZone {} {
    variable CachedSystemTimeZone
    variable TimeZoneBad

    if {[set result [getenv TCL_TZ]] ne {}} {
	set timezone $result
    } elseif {[set result [getenv TZ]] ne {}} {
	set timezone $result
    } else {
        # Cache the time zone only if it was detected by one of the
        # expensive methods.
        if { [info exists CachedSystemTimeZone] } {
            set timezone $CachedSystemTimeZone
        } elseif { $::tcl_platform(platform) eq {windows} } {
            set timezone [GuessWindowsTimeZone]
        } elseif { [file exists /etc/localtime]
                   && ![catch {ReadZoneinfoFile \
                                   Tcl/Localtime /etc/localtime}] } {
            set timezone :Tcl/Localtime
        } else {
            set timezone :localtime
        }
	set CachedSystemTimeZone $timezone
    }
    if { ![dict exists $TimeZoneBad $timezone] } {
	dict set TimeZoneBad $timezone [catch {SetupTimeZone $timezone}]
    }
    if { [dict get $TimeZoneBad $timezone] } {
	return :localtime







|













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







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
# Parameters:
#	None.
#
# Results:
#	Returns the system time zone.
#
# Side effects:
#	Stores the system time zone in the 'CachedSystemTimeZone'
#	variable, since determining it may be an expensive process.
#
#----------------------------------------------------------------------

proc ::tcl::clock::GetSystemTimeZone {} {
    variable CachedSystemTimeZone
    variable TimeZoneBad

    if {[set result [getenv TCL_TZ]] ne {}} {
	set timezone $result
    } elseif {[set result [getenv TZ]] ne {}} {
	set timezone $result
    } else {
	# Cache the time zone only if it was detected by one of the
	# expensive methods.
	if { [info exists CachedSystemTimeZone] } {
	    set timezone $CachedSystemTimeZone
	} elseif { $::tcl_platform(platform) eq {windows} } {
	    set timezone [GuessWindowsTimeZone]
	} elseif { [file exists /etc/localtime]
		   && ![catch {ReadZoneinfoFile \
				   Tcl/Localtime /etc/localtime}] } {
	    set timezone :Tcl/Localtime
	} else {
	    set timezone :localtime
	}
	set CachedSystemTimeZone $timezone
    }
    if { ![dict exists $TimeZoneBad $timezone] } {
	dict set TimeZoneBad $timezone [catch {SetupTimeZone $timezone}]
    }
    if { [dict get $TimeZoneBad $timezone] } {
	return :localtime
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411

    set f [open $fname r]
    fconfigure $f -translation binary
    set d [read $f]
    close $f

    # The file begins with a magic number, sixteen reserved bytes, and then
    # six 4-byte integers giving counts of fileds in the file.

    binary scan $d a4a1x15IIIIII \
	magic version nIsGMT nIsStd nLeap nTime nType nChar
    set seek 44
    set ilen 4
    set iformat I
    if { $magic != {TZif} } {







|







3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414

    set f [open $fname r]
    fconfigure $f -translation binary
    set d [read $f]
    close $f

    # The file begins with a magic number, sixteen reserved bytes, and then
    # six 4-byte integers giving counts of fields in the file.

    binary scan $d a4a1x15IIIIII \
	magic version nIsGMT nIsStd nLeap nTime nType nChar
    set seek 44
    set ilen 4
    set iformat I
    if { $magic != {TZif} } {
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
	([-+]?)
	# 3 - Standard time zone offset, hours
	([[:digit:]]{1,2})
	(?:
	    # 4 - Standard time zone offset, minutes
	    : ([[:digit:]]{1,2})
	    (?:
	        # 5 - Standard time zone offset, seconds
		: ([[:digit:]]{1,2} )
	    )?
	)?
	(?:
	    # 6 - DST time zone name
	    ([[:alpha:]]+ | <[-+[:alnum:]]+>)
	    (?:
	        (?:
		    # 7 - DST time zone offset, signum
		    ([-+]?)
		    # 8 - DST time zone offset, hours
		    ([[:digit:]]{1,2})
		    (?:
			# 9 - DST time zone offset, minutes
			: ([[:digit:]]{1,2})
			(?:
		            # 10 - DST time zone offset, seconds
			    : ([[:digit:]]{1,2})
			)?
		    )?
		)?
	        (?:
		    ,
		    (?:
			# 11 - Optional J in n and Jn form 12 - Day of year
		        ( J ? )	( [[:digit:]]+ )
                        | M
			# 13 - Month number 14 - Week of month 15 - Day of week
			( [[:digit:]] + )
			[.] ( [[:digit:]] + )
			[.] ( [[:digit:]] + )
		    )
		    (?:
			# 16 - Start time of DST - hours
			/ ( [[:digit:]]{1,2} )
		        (?:
			    # 17 - Start time of DST - minutes
			    : ( [[:digit:]]{1,2} )
			    (?:
				# 18 - Start time of DST - seconds
				: ( [[:digit:]]{1,2} )
			    )?
			)?
		    )?
		    ,
		    (?:
			# 19 - Optional J in n and Jn form 20 - Day of year
		        ( J ? )	( [[:digit:]]+ )
                        | M
			# 21 - Month number 22 - Week of month 23 - Day of week
			( [[:digit:]] + )
			[.] ( [[:digit:]] + )
			[.] ( [[:digit:]] + )
		    )
		    (?:
			# 24 - End time of DST - hours
			/ ( [[:digit:]]{1,2} )
		        (?:
			    # 25 - End time of DST - minutes
			    : ( [[:digit:]]{1,2} )
			    (?:
				# 26 - End time of DST - seconds
				: ( [[:digit:]]{1,2} )
			    )?
			)?
		    )?
                )?
	    )?
        )?
	$
    } $tz -> x(stdName) x(stdSignum) x(stdHours) x(stdMinutes) x(stdSeconds) \
	     x(dstName) x(dstSignum) x(dstHours) x(dstMinutes) x(dstSeconds) \
	     x(startJ) x(startDayOfYear) \
	     x(startMonth) x(startWeekOfMonth) x(startDayOfWeek) \
	     x(startHours) x(startMinutes) x(startSeconds) \
	     x(endJ) x(endDayOfYear) \







|







|








|




|



|
|








|











|
|








|








|

|







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
	([-+]?)
	# 3 - Standard time zone offset, hours
	([[:digit:]]{1,2})
	(?:
	    # 4 - Standard time zone offset, minutes
	    : ([[:digit:]]{1,2})
	    (?:
		# 5 - Standard time zone offset, seconds
		: ([[:digit:]]{1,2} )
	    )?
	)?
	(?:
	    # 6 - DST time zone name
	    ([[:alpha:]]+ | <[-+[:alnum:]]+>)
	    (?:
		(?:
		    # 7 - DST time zone offset, signum
		    ([-+]?)
		    # 8 - DST time zone offset, hours
		    ([[:digit:]]{1,2})
		    (?:
			# 9 - DST time zone offset, minutes
			: ([[:digit:]]{1,2})
			(?:
			    # 10 - DST time zone offset, seconds
			    : ([[:digit:]]{1,2})
			)?
		    )?
		)?
		(?:
		    ,
		    (?:
			# 11 - Optional J in n and Jn form 12 - Day of year
			( J ? )	( [[:digit:]]+ )
			| M
			# 13 - Month number 14 - Week of month 15 - Day of week
			( [[:digit:]] + )
			[.] ( [[:digit:]] + )
			[.] ( [[:digit:]] + )
		    )
		    (?:
			# 16 - Start time of DST - hours
			/ ( [[:digit:]]{1,2} )
			(?:
			    # 17 - Start time of DST - minutes
			    : ( [[:digit:]]{1,2} )
			    (?:
				# 18 - Start time of DST - seconds
				: ( [[:digit:]]{1,2} )
			    )?
			)?
		    )?
		    ,
		    (?:
			# 19 - Optional J in n and Jn form 20 - Day of year
			( J ? )	( [[:digit:]]+ )
			| M
			# 21 - Month number 22 - Week of month 23 - Day of week
			( [[:digit:]] + )
			[.] ( [[:digit:]] + )
			[.] ( [[:digit:]] + )
		    )
		    (?:
			# 24 - End time of DST - hours
			/ ( [[:digit:]]{1,2} )
			(?:
			    # 25 - End time of DST - minutes
			    : ( [[:digit:]]{1,2} )
			    (?:
				# 26 - End time of DST - seconds
				: ( [[:digit:]]{1,2} )
			    )?
			)?
		    )?
		)?
	    )?
	)?
	$
    } $tz -> x(stdName) x(stdSignum) x(stdHours) x(stdMinutes) x(stdSeconds) \
	     x(dstName) x(dstSignum) x(dstHours) x(dstMinutes) x(dstSeconds) \
	     x(startJ) x(startDayOfYear) \
	     x(startMonth) x(startWeekOfMonth) x(startDayOfWeek) \
	     x(startHours) x(startMinutes) x(startSeconds) \
	     x(endJ) x(endDayOfYear) \
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

proc ::tcl::clock::add { clockval args } {
    if { [llength $args] % 2 != 0 } {
	set cmdName "clock add"
	return -code error \
	    -errorcode [list CLOCK wrongNumArgs] \
	    "wrong \# args: should be\
             \"$cmdName clockval ?number units?...\
             ?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?\""
    }
    if { [catch { expr {wide($clockval)} } result] } {
	return -code error $result
    }

    set offsets {}
    set gmt 0
    set locale c
    set timezone [GetSystemTimeZone]

    foreach { a b } $args {
	if { [string is integer -strict $a] } {
	    lappend offsets $a $b
	} else {
	    switch -exact -- $a {
		-g - -gm - -gmt {

		    set gmt $b
		}
		-l - -lo - -loc - -loca - -local - -locale {
		    set locale [string tolower $b]
		}
		-t - -ti - -tim - -time - -timez - -timezo - -timezon -
		-timezone {

		    set timezone $b
		}
		default {
		    throw [list CLOCK badOption $a] \
			"bad option \"$a\",\
                         must be -gmt, -locale or -timezone"
		}
	    }
	}
    }

    # Check options for validity








|
|
















>







>





|







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

proc ::tcl::clock::add { clockval args } {
    if { [llength $args] % 2 != 0 } {
	set cmdName "clock add"
	return -code error \
	    -errorcode [list CLOCK wrongNumArgs] \
	    "wrong \# args: should be\
	     \"$cmdName clockval ?number units?...\
	     ?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?\""
    }
    if { [catch { expr {wide($clockval)} } result] } {
	return -code error $result
    }

    set offsets {}
    set gmt 0
    set locale c
    set timezone [GetSystemTimeZone]

    foreach { a b } $args {
	if { [string is integer -strict $a] } {
	    lappend offsets $a $b
	} else {
	    switch -exact -- $a {
		-g - -gm - -gmt {
		    set saw(-gmt) {}
		    set gmt $b
		}
		-l - -lo - -loc - -loca - -local - -locale {
		    set locale [string tolower $b]
		}
		-t - -ti - -tim - -time - -timez - -timezo - -timezon -
		-timezone {
		    set saw(-timezone) {}
		    set timezone $b
		}
		default {
		    throw [list CLOCK badOption $a] \
			"bad option \"$a\",\
			 must be -gmt, -locale or -timezone"
		}
	    }
	}
    }

    # Check options for validity

4334
4335
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
		seconds - second {
		    set clockval [expr { $quantity + $clockval }]
		}

		default {
		    throw [list CLOCK badUnit $unit] \
			"unknown unit \"$unit\", must be \
                        years, months, weeks, days, hours, minutes or seconds"
		}
	    }
	}
	return $clockval
    } trap CLOCK {result opts} {
	# Conceal the innards of [clock] when it's an expected error
	dict unset opts -errorinfo







|







4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
		seconds - second {
		    set clockval [expr { $quantity + $clockval }]
		}

		default {
		    throw [list CLOCK badUnit $unit] \
			"unknown unit \"$unit\", must be \
			years, months, weeks, days, hours, minutes or seconds"
		}
	    }
	}
	return $clockval
    } trap CLOCK {result opts} {
	# Conceal the innards of [clock] when it's an expected error
	dict unset opts -errorinfo
4494
4495
4496
4497
4498
4499
4500
4501
4502
4503
4504
4505
4506
4507
4508
4509
4510
4511
proc ::tcl::clock::ChangeCurrentLocale {args} {
    variable FormatProc
    variable LocaleNumeralCache
    variable CachedSystemTimeZone
    variable TimeZoneBad

    foreach p [info procs [namespace current]::scanproc'*'current] {
        rename $p {}
    }
    foreach p [info procs [namespace current]::formatproc'*'current] {
        rename $p {}
    }

    catch {array unset FormatProc *'current}
    set LocaleNumeralCache {}
}

#----------------------------------------------------------------------







|


|







4499
4500
4501
4502
4503
4504
4505
4506
4507
4508
4509
4510
4511
4512
4513
4514
4515
4516
proc ::tcl::clock::ChangeCurrentLocale {args} {
    variable FormatProc
    variable LocaleNumeralCache
    variable CachedSystemTimeZone
    variable TimeZoneBad

    foreach p [info procs [namespace current]::scanproc'*'current] {
	rename $p {}
    }
    foreach p [info procs [namespace current]::formatproc'*'current] {
	rename $p {}
    }

    catch {array unset FormatProc *'current}
    set LocaleNumeralCache {}
}

#----------------------------------------------------------------------

Changes to library/cookiejar/idna.tcl.

1
2
3
4
5
6
7
8
# 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
|







1
2
3
4
5
6
7
8
# idna.tcl --
#
#	Implementation of IDNA (Internationalized Domain Names for
#	Applications) encoding/decoding system, built on a punycode engine
#	developed directly from the code in RFC 3492, Appendix C (with
#	substantial modifications).
#
# This implementation includes code from that RFC, translated to Tcl; the

Changes to library/dde/pkgIndex.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
if {[info sharedlibextension] != ".dll"} return
if {[package vsatisfies [package provide Tcl] 9.0-]} {
    package ifneeded dde 1.4.4 \
	    [list load [file join $dir tcl9dde14.dll] Dde]
} elseif {![package vsatisfies [package provide Tcl] 8.7]
	&& [::tcl::pkgconfig get debug]} {
    package ifneeded dde 1.4.4 \
	    [list load [file join $dir tcldde14g.dll] Dde]
} else {
    package ifneeded dde 1.4.4 \
	    [list load [file join $dir tcldde14.dll] Dde]
}


|



|


|


1
2
3
4
5
6
7
8
9
10
11
12
if {[info sharedlibextension] != ".dll"} return
if {[package vsatisfies [package provide Tcl] 9.0-]} {
    package ifneeded dde 1.4.5 \
	    [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.5 \
	    [list load [file join $dir tcldde14g.dll] Dde]
} else {
    package ifneeded dde 1.4.5 \
	    [list load [file join $dir tcldde14.dll] Dde]
}

Changes to library/encoding/ascii.enc.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
# Encoding file: ascii, single-byte
S
003F 0 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000











|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
# Encoding file: ascii, single-byte
S
003F 0 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000

Changes to library/encoding/big5.enc.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
# Encoding file: big5, multi-byte
M
003F 0 89
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
0080008100820083008400850086008700880089008A008B008C008D008E008F
0090009100920093009400950096009700980099009A009B009C009D009E009F
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
A1












|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
# Encoding file: big5, multi-byte
M
003F 0 89
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
A1

Changes to library/encoding/cp1250.enc.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# Encoding file: cp1250, single-byte
S
003F 0 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
20AC0081201A0083201E2026202020210088203001602039015A0164017D0179
009020182019201C201D202220132014009821220161203A015B0165017E017A
00A002C702D8014100A4010400A600A700A800A9015E00AB00AC00AD00AE017B
00B000B102DB014200B400B500B600B700B80105015F00BB013D02DD013E017C
015400C100C2010200C40139010600C7010C00C9011800CB011A00CD00CE010E
01100143014700D300D4015000D600D70158016E00DA017000DC00DD016200DF
015500E100E2010300E4013A010700E7010D00E9011900EB011B00ED00EE010F
01110144014800F300F4015100F600F70159016F00FA017100FC00FD016302D9












|
|






1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# Encoding file: cp1250, single-byte
S
003F 0 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
20AC0000201A0000201E2026202020210000203001602039015A0164017D0179
000020182019201C201D202220132014000021220161203A015B0165017E017A
00A002C702D8014100A4010400A600A700A800A9015E00AB00AC00AD00AE017B
00B000B102DB014200B400B500B600B700B80105015F00BB013D02DD013E017C
015400C100C2010200C40139010600C7010C00C9011800CB011A00CD00CE010E
01100143014700D300D4015000D600D70158016E00DA017000DC00DD016200DF
015500E100E2010300E4013A010700E7010D00E9011900EB011B00ED00EE010F
01110144014800F300F4015100F600F70159016F00FA017100FC00FD016302D9

Changes to library/encoding/cp1251.enc.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# Encoding file: cp1251, single-byte
S
003F 0 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
04020403201A0453201E20262020202120AC203004092039040A040C040B040F
045220182019201C201D202220132014009821220459203A045A045C045B045F
00A0040E045E040800A4049000A600A7040100A9040400AB00AC00AD00AE0407
00B000B104060456049100B500B600B704512116045400BB0458040504550457
0410041104120413041404150416041704180419041A041B041C041D041E041F
0420042104220423042404250426042704280429042A042B042C042D042E042F
0430043104320433043404350436043704380439043A043B043C043D043E043F
0440044104420443044404450446044704480449044A044B044C044D044E044F













|






1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# Encoding file: cp1251, single-byte
S
003F 0 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
04020403201A0453201E20262020202120AC203004092039040A040C040B040F
045220182019201C201D202220132014000021220459203A045A045C045B045F
00A0040E045E040800A4049000A600A7040100A9040400AB00AC00AD00AE0407
00B000B104060456049100B500B600B704512116045400BB0458040504550457
0410041104120413041404150416041704180419041A041B041C041D041E041F
0420042104220423042404250426042704280429042A042B042C042D042E042F
0430043104320433043404350436043704380439043A043B043C043D043E043F
0440044104420443044404450446044704480449044A044B044C044D044E044F

Changes to library/encoding/cp1252.enc.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# Encoding file: cp1252, single-byte
S
003F 0 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
20AC0081201A0192201E20262020202102C62030016020390152008D017D008F
009020182019201C201D20222013201402DC21220161203A0153009D017E0178
00A000A100A200A300A400A500A600A700A800A900AA00AB00AC00AD00AE00AF
00B000B100B200B300B400B500B600B700B800B900BA00BB00BC00BD00BE00BF
00C000C100C200C300C400C500C600C700C800C900CA00CB00CC00CD00CE00CF
00D000D100D200D300D400D500D600D700D800D900DA00DB00DC00DD00DE00DF
00E000E100E200E300E400E500E600E700E800E900EA00EB00EC00ED00EE00EF
00F000F100F200F300F400F500F600F700F800F900FA00FB00FC00FD00FE00FF












|
|






1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# Encoding file: cp1252, single-byte
S
003F 0 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
20AC0000201A0192201E20262020202102C620300160203901520000017D0000
000020182019201C201D20222013201402DC21220161203A01530000017E0178
00A000A100A200A300A400A500A600A700A800A900AA00AB00AC00AD00AE00AF
00B000B100B200B300B400B500B600B700B800B900BA00BB00BC00BD00BE00BF
00C000C100C200C300C400C500C600C700C800C900CA00CB00CC00CD00CE00CF
00D000D100D200D300D400D500D600D700D800D900DA00DB00DC00DD00DE00DF
00E000E100E200E300E400E500E600E700E800E900EA00EB00EC00ED00EE00EF
00F000F100F200F300F400F500F600F700F800F900FA00FB00FC00FD00FE00FF

Changes to library/encoding/cp1253.enc.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# Encoding file: cp1253, single-byte
S
003F 0 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
20AC0081201A0192201E20262020202100882030008A2039008C008D008E008F
009020182019201C201D20222013201400982122009A203A009C009D009E009F
00A00385038600A300A400A500A600A700A800A9000000AB00AC00AD00AE2015
00B000B100B200B3038400B500B600B703880389038A00BB038C00BD038E038F
0390039103920393039403950396039703980399039A039B039C039D039E039F
03A003A1000003A303A403A503A603A703A803A903AA03AB03AC03AD03AE03AF
03B003B103B203B303B403B503B603B703B803B903BA03BB03BC03BD03BE03BF
03C003C103C203C303C403C503C603C703C803C903CA03CB03CC03CD03CE0000












|
|






1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# Encoding file: cp1253, single-byte
S
003F 0 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
20AC0000201A0192201E20262020202100002030000020390000000000000000
000020182019201C201D202220132014000021220000203A0000000000000000
00A00385038600A300A400A500A600A700A800A9000000AB00AC00AD00AE2015
00B000B100B200B3038400B500B600B703880389038A00BB038C00BD038E038F
0390039103920393039403950396039703980399039A039B039C039D039E039F
03A003A1000003A303A403A503A603A703A803A903AA03AB03AC03AD03AE03AF
03B003B103B203B303B403B503B603B703B803B903BA03BB03BC03BD03BE03BF
03C003C103C203C303C403C503C603C703C803C903CA03CB03CC03CD03CE0000

Changes to library/encoding/cp1254.enc.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# Encoding file: cp1254, single-byte
S
003F 0 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
20AC0081201A0192201E20262020202102C62030016020390152008D008E008F
009020182019201C201D20222013201402DC21220161203A0153009D009E0178
00A000A100A200A300A400A500A600A700A800A900AA00AB00AC00AD00AE00AF
00B000B100B200B300B400B500B600B700B800B900BA00BB00BC00BD00BE00BF
00C000C100C200C300C400C500C600C700C800C900CA00CB00CC00CD00CE00CF
011E00D100D200D300D400D500D600D700D800D900DA00DB00DC0130015E00DF
00E000E100E200E300E400E500E600E700E800E900EA00EB00EC00ED00EE00EF
011F00F100F200F300F400F500F600F700F800F900FA00FB00FC0131015F00FF












|
|






1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# Encoding file: cp1254, single-byte
S
003F 0 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
20AC0000201A0192201E20262020202102C62030016020390152000000000000
000020182019201C201D20222013201402DC21220161203A0153000000000178
00A000A100A200A300A400A500A600A700A800A900AA00AB00AC00AD00AE00AF
00B000B100B200B300B400B500B600B700B800B900BA00BB00BC00BD00BE00BF
00C000C100C200C300C400C500C600C700C800C900CA00CB00CC00CD00CE00CF
011E00D100D200D300D400D500D600D700D800D900DA00DB00DC0130015E00DF
00E000E100E200E300E400E500E600E700E800E900EA00EB00EC00ED00EE00EF
011F00F100F200F300F400F500F600F700F800F900FA00FB00FC0131015F00FF

Changes to library/encoding/cp1255.enc.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# Encoding file: cp1255, single-byte
S
003F 0 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
20AC0081201A0192201E20262020202102C62030008A2039008C008D008E008F
009020182019201C201D20222013201402DC2122009A203A009C009D009E009F
00A000A100A200A320AA00A500A600A700A800A900D700AB00AC00AD00AE00AF
00B000B100B200B300B400B500B600B700B800B900F700BB00BC00BD00BE00BF
05B005B105B205B305B405B505B605B705B805B9000005BB05BC05BD05BE05BF
05C005C105C205C305F005F105F205F305F40000000000000000000000000000
05D005D105D205D305D405D505D605D705D805D905DA05DB05DC05DD05DE05DF
05E005E105E205E305E405E505E605E705E805E905EA00000000200E200F0000












|
|






1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# Encoding file: cp1255, single-byte
S
003F 0 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
20AC0000201A0192201E20262020202102C62030000020390000000000000000
000020182019201C201D20222013201402DC21220000203A0000000000000000
00A000A100A200A320AA00A500A600A700A800A900D700AB00AC00AD00AE00AF
00B000B100B200B300B400B500B600B700B800B900F700BB00BC00BD00BE00BF
05B005B105B205B305B405B505B605B705B805B9000005BB05BC05BD05BE05BF
05C005C105C205C305F005F105F205F305F40000000000000000000000000000
05D005D105D205D305D405D505D605D705D805D905DA05DB05DC05DD05DE05DF
05E005E105E205E305E405E505E605E705E805E905EA00000000200E200F0000

Changes to library/encoding/cp1257.enc.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# Encoding file: cp1257, single-byte
S
003F 0 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
20AC0081201A0083201E20262020202100882030008A2039008C00A802C700B8
009020182019201C201D20222013201400982122009A203A009C00AF02DB009F
00A0000000A200A300A4000000A600A700D800A9015600AB00AC00AD00AE00C6
00B000B100B200B300B400B500B600B700F800B9015700BB00BC00BD00BE00E6
0104012E0100010600C400C501180112010C00C90179011601220136012A013B
01600143014500D3014C00D500D600D701720141015A016A00DC017B017D00DF
0105012F0101010700E400E501190113010D00E9017A011701230137012B013C
01610144014600F3014D00F500F600F701730142015B016B00FC017C017E02D9












|
|






1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# Encoding file: cp1257, single-byte
S
003F 0 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
20AC0000201A0000201E2026202020210000203000002039000000A802C700B8
000020182019201C201D202220132014000021220000203A000000AF02DB0000
00A0000000A200A300A4000000A600A700D800A9015600AB00AC00AD00AE00C6
00B000B100B200B300B400B500B600B700F800B9015700BB00BC00BD00BE00E6
0104012E0100010600C400C501180112010C00C90179011601220136012A013B
01600143014500D3014C00D500D600D701720141015A016A00DC017B017D00DF
0105012F0101010700E400E501190113010D00E9017A011701230137012B013C
01610144014600F3014D00F500F600F701730142015B016B00FC017C017E02D9

Changes to library/encoding/cp1258.enc.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# Encoding file: cp1258, single-byte
S
003F 0 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
20AC0081201A0192201E20262020202102C62030008A20390152008D008E008F
009020182019201C201D20222013201402DC2122009A203A0153009D009E0178
00A000A100A200A300A400A500A600A700A800A900AA00AB00AC00AD00AE00AF
00B000B100B200B300B400B500B600B700B800B900BA00BB00BC00BD00BE00BF
00C000C100C2010200C400C500C600C700C800C900CA00CB030000CD00CE00CF
011000D1030900D300D401A000D600D700D800D900DA00DB00DC01AF030300DF
00E000E100E2010300E400E500E600E700E800E900EA00EB030100ED00EE00EF
011100F1032300F300F401A100F600F700F800F900FA00FB00FC01B020AB00FF












|
|






1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# Encoding file: cp1258, single-byte
S
003F 0 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
20AC0000201A0192201E20262020202102C62030000020390152000000000000
000020182019201C201D20222013201402DC21220000203A0153000000000178
00A000A100A200A300A400A500A600A700A800A900AA00AB00AC00AD00AE00AF
00B000B100B200B300B400B500B600B700B800B900BA00BB00BC00BD00BE00BF
00C000C100C2010200C400C500C600C700C800C900CA00CB030000CD00CE00CF
011000D1030900D300D401A000D600D700D800D900DA00DB00DC01AF030300DF
00E000E100E2010300E400E500E600E700E800E900EA00EB030100ED00EE00EF
011100F1032300F300F401A100F600F700F800F900FA00FB00FC01B020AB00FF

Changes to library/encoding/cp864.enc.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# Encoding file: cp864, single-byte
S
003F 0 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
00200021002200230024066A0026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
00B000B72219221A259225002502253C2524252C251C25342510250C25142518
03B2221E03C600B100BD00BC224800AB00BBFEF7FEF8009B009CFEFBFEFC009F
00A000ADFE8200A300A4FE8400000000FE8EFE8FFE95FE99060CFE9DFEA1FEA5
0660066106620663066406650666066706680669FED1061BFEB1FEB5FEB9061F
00A2FE80FE81FE83FE85FECAFE8BFE8DFE91FE93FE97FE9BFE9FFEA3FEA7FEA9
FEABFEADFEAFFEB3FEB7FEBBFEBFFEC1FEC5FECBFECF00A600AC00F700D7FEC9
0640FED3FED7FEDBFEDFFEE3FEE7FEEBFEEDFEEFFEF3FEBDFECCFECEFECDFEE1
FE7D0651FEE5FEE9FEECFEF0FEF2FED0FED5FEF5FEF6FEDDFED9FEF125A00000













|






1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# Encoding file: cp864, single-byte
S
003F 0 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
00200021002200230024066A0026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
00B000B72219221A259225002502253C2524252C251C25342510250C25142518
03B2221E03C600B100BD00BC224800AB00BBFEF7FEF800000000FEFBFEFC0000
00A000ADFE8200A300A4FE8400000000FE8EFE8FFE95FE99060CFE9DFEA1FEA5
0660066106620663066406650666066706680669FED1061BFEB1FEB5FEB9061F
00A2FE80FE81FE83FE85FECAFE8BFE8DFE91FE93FE97FE9BFE9FFEA3FEA7FEA9
FEABFEADFEAFFEB3FEB7FEBBFEBFFEC1FEC5FECBFECF00A600AC00F700D7FEC9
0640FED3FED7FEDBFEDFFEE3FEE7FEEBFEEDFEEFFEF3FEBDFECCFECEFECDFEE1
FE7D0651FEE5FEE9FEECFEF0FEF2FED0FED5FEF5FEF6FEDDFED9FEF125A00000

Changes to library/encoding/cp869.enc.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# Encoding file: cp869, single-byte
S
003F 0 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
0080008100820083008400850386008700B700AC00A620182019038820150389
038A03AA038C00930094038E03AB00A9038F00B200B303AC00A303AD03AE03AF
03CA039003CC03CD039103920393039403950396039700BD0398039900AB00BB
25912592259325022524039A039B039C039D256325512557255D039E039F2510
25142534252C251C2500253C03A003A1255A25542569256625602550256C03A3
03A403A503A603A703A803A903B103B203B32518250C2588258403B403B52580
03B603B703B803B903BA03BB03BC03BD03BE03BF03C003C103C303C203C40384
00AD00B103C503C603C700A703C8038500B000A803C903CB03B003CE25A000A0












|
|






1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# Encoding file: cp869, single-byte
S
003F 0 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
0000000000000000000000000386000000B700AC00A620182019038820150389
038A03AA038C00000000038E03AB00A9038F00B200B303AC00A303AD03AE03AF
03CA039003CC03CD039103920393039403950396039700BD0398039900AB00BB
25912592259325022524039A039B039C039D256325512557255D039E039F2510
25142534252C251C2500253C03A003A1255A25542569256625602550256C03A3
03A403A503A603A703A803A903B103B203B32518250C2588258403B403B52580
03B603B703B803B903BA03BB03BC03BD03BE03BF03C003C103C303C203C40384
00AD00B103C503C603C700A703C8038500B000A803C903CB03B003CE25A000A0

Changes to library/encoding/cp874.enc.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# Encoding file: cp874, single-byte
S
003F 0 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
20AC008100820083008420260086008700880089008A008B008C008D008E008F
009020182019201C201D20222013201400980099009A009B009C009D009E009F
00A00E010E020E030E040E050E060E070E080E090E0A0E0B0E0C0E0D0E0E0E0F
0E100E110E120E130E140E150E160E170E180E190E1A0E1B0E1C0E1D0E1E0E1F
0E200E210E220E230E240E250E260E270E280E290E2A0E2B0E2C0E2D0E2E0E2F
0E300E310E320E330E340E350E360E370E380E390E3A00000000000000000E3F
0E400E410E420E430E440E450E460E470E480E490E4A0E4B0E4C0E4D0E4E0E4F
0E500E510E520E530E540E550E560E570E580E590E5A0E5B0000000000000000












|
|






1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# Encoding file: cp874, single-byte
S
003F 0 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
20AC000000000000000020260000000000000000000000000000000000000000
000020182019201C201D20222013201400000000000000000000000000000000
00A00E010E020E030E040E050E060E070E080E090E0A0E0B0E0C0E0D0E0E0E0F
0E100E110E120E130E140E150E160E170E180E190E1A0E1B0E1C0E1D0E1E0E1F
0E200E210E220E230E240E250E260E270E280E290E2A0E2B0E2C0E2D0E2E0E2F
0E300E310E320E330E340E350E360E370E380E390E3A00000000000000000E3F
0E400E410E420E430E440E450E460E470E480E490E4A0E4B0E4C0E4D0E4E0E4F
0E500E510E520E530E540E550E560E570E580E590E5A0E5B0000000000000000

Changes to library/encoding/cp932.enc.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# Encoding file: cp932, multi-byte
M
003F 0 46
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
0080000000000000000000850086000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000FF61FF62FF63FF64FF65FF66FF67FF68FF69FF6AFF6BFF6CFF6DFF6EFF6F
FF70FF71FF72FF73FF74FF75FF76FF77FF78FF79FF7AFF7BFF7CFF7DFF7EFF7F
FF80FF81FF82FF83FF84FF85FF86FF87FF88FF89FF8AFF8BFF8CFF8DFF8EFF8F
FF90FF91FF92FF93FF94FF95FF96FF97FF98FF99FF9AFF9BFF9CFF9DFF9EFF9F
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000












|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# Encoding file: cp932, multi-byte
M
003F 0 46
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000FF61FF62FF63FF64FF65FF66FF67FF68FF69FF6AFF6BFF6CFF6DFF6EFF6F
FF70FF71FF72FF73FF74FF75FF76FF77FF78FF79FF7AFF7BFF7CFF7DFF7EFF7F
FF80FF81FF82FF83FF84FF85FF86FF87FF88FF89FF8AFF8BFF8CFF8DFF8EFF8F
FF90FF91FF92FF93FF94FF95FF96FF97FF98FF99FF9AFF9BFF9CFF9DFF9EFF9F
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000

Changes to library/encoding/cp949.enc.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# Encoding file: cp949, multi-byte
M
003F 0 125
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
0080000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000












|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# Encoding file: cp949, multi-byte
M
003F 0 125
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000

Changes to library/encoding/cp950.enc.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
# Encoding file: cp950, multi-byte
M
003F 0 88
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
0080008100820083008400850086008700880089008A008B008C008D008E008F
0090009100920093009400950096009700980099009A009B009C009D009E009F
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
A1












|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
# Encoding file: cp950, multi-byte
M
003F 0 88
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
A1

Changes to library/encoding/dingbats.enc.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# Encoding file: dingbats, single-byte
S
003F 1 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
00202701270227032704260E2706270727082709261B261E270C270D270E270F
2710271127122713271427152716271727182719271A271B271C271D271E271F
2720272127222723272427252726272726052729272A272B272C272D272E272F
2730273127322733273427352736273727382739273A273B273C273D273E273F
2740274127422743274427452746274727482749274A274B25CF274D25A0274F
27502751275225B225BC25C6275625D727582759275A275B275C275D275E007F
0080008100820083008400850086008700880089008A008B008C008D008E008F
0090009100920093009400950096009700980099009A009B009C009D009E009F
0000276127622763276427652766276726632666266526602460246124622463
2464246524662467246824692776277727782779277A277B277C277D277E277F
2780278127822783278427852786278727882789278A278B278C278D278E278F
2790279127922793279421922194219527982799279A279B279C279D279E279F
27A027A127A227A327A427A527A627A727A827A927AA27AB27AC27AD27AE27AF
000027B127B227B327B427B527B627B727B827B927BA27BB27BC27BD27BE0000












|
|






1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# Encoding file: dingbats, single-byte
S
003F 1 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
00202701270227032704260E2706270727082709261B261E270C270D270E270F
2710271127122713271427152716271727182719271A271B271C271D271E271F
2720272127222723272427252726272726052729272A272B272C272D272E272F
2730273127322733273427352736273727382739273A273B273C273D273E273F
2740274127422743274427452746274727482749274A274B25CF274D25A0274F
27502751275225B225BC25C6275625D727582759275A275B275C275D275E007F
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000276127622763276427652766276726632666266526602460246124622463
2464246524662467246824692776277727782779277A277B277C277D277E277F
2780278127822783278427852786278727882789278A278B278C278D278E278F
2790279127922793279421922194219527982799279A279B279C279D279E279F
27A027A127A227A327A427A527A627A727A827A927AA27AB27AC27AD27AE27AF
000027B127B227B327B427B527B627B727B827B927BA27BB27BC27BD27BE0000

Changes to library/encoding/ebcdic.enc.


1
2
3
4
5
6
7

S
006F 0 1
00
0000000100020003008500090086007F0087008D008E000B000C000D000E000F
0010001100120013008F000A0008009700180019009C009D001C001D001E001F
0080008100820083008400920017001B00880089008A008B008C000500060007
0090009100160093009400950096000400980099009A009B00140015009E001A
>







1
2
3
4
5
6
7
8
# Encoding file: ebcdic, single-byte
S
006F 0 1
00
0000000100020003008500090086007F0087008D008E000B000C000D000E000F
0010001100120013008F000A0008009700180019009C009D001C001D001E001F
0080008100820083008400920017001B00880089008A008B008C000500060007
0090009100160093009400950096000400980099009A009B00140015009E001A

Changes to library/encoding/euc-cn.enc.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
# Encoding file: euc-cn, multi-byte
M
003F 0 82
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
0080008100820083008400850086008700880089008A008B008C008D008E008F
0090009100920093009400950096009700980099009A009B009C009D009E009F
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
A1












|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
# Encoding file: euc-cn, multi-byte
M
003F 0 82
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
A1

Changes to library/encoding/euc-jp.enc.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
# Encoding file: euc-jp, multi-byte
M
003F 0 79
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
0080008100820083008400850086008700880089008A008B008C008D0000008F
0090009100920093009400950096009700980099009A009B009C009D009E009F
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
8E












|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
# Encoding file: euc-jp, multi-byte
M
003F 0 79
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
8E

Changes to library/encoding/euc-kr.enc.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
# Encoding file: euc-kr, multi-byte
M
003F 0 90
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
0080008100820083008400850086008700880089008A008B008C008D008E008F
0090009100920093009400950096009700980099009A009B009C009D009E009F
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
A1












|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
# Encoding file: euc-kr, multi-byte
M
003F 0 90
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
A1

Changes to library/encoding/gb1988.enc.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# Encoding file: gb1988, single-byte
S
003F 0 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
002000210022002300A500250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D203E007F
0080008100820083008400850086008700880089008A008B008C008D008E008F
0090009100920093009400950096009700980099009A009B009C009D009E009F
0000FF61FF62FF63FF64FF65FF66FF67FF68FF69FF6AFF6BFF6CFF6DFF6EFF6F
FF70FF71FF72FF73FF74FF75FF76FF77FF78FF79FF7AFF7BFF7CFF7DFF7EFF7F
FF80FF81FF82FF83FF84FF85FF86FF87FF88FF89FF8AFF8BFF8CFF8DFF8EFF8F
FF90FF91FF92FF93FF94FF95FF96FF97FF98FF99FF9AFF9BFF9CFF9DFF9EFF9F
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000












|
|






1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# Encoding file: gb1988, single-byte
S
003F 0 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
002000210022002300A500250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D203E007F
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000FF61FF62FF63FF64FF65FF66FF67FF68FF69FF6AFF6BFF6CFF6DFF6EFF6F
FF70FF71FF72FF73FF74FF75FF76FF77FF78FF79FF7AFF7BFF7CFF7DFF7EFF7F
FF80FF81FF82FF83FF84FF85FF86FF87FF88FF89FF8AFF8BFF8CFF8DFF8EFF8F
FF90FF91FF92FF93FF94FF95FF96FF97FF98FF99FF9AFF9BFF9CFF9DFF9EFF9F
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000

Changes to library/encoding/jis0201.enc.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# Encoding file: jis0201, single-byte
S
003F 0 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D203E007F
0080008100820083008400850086008700880089008A008B008C008D008E008F
0090009100920093009400950096009700980099009A009B009C009D009E009F
0000FF61FF62FF63FF64FF65FF66FF67FF68FF69FF6AFF6BFF6CFF6DFF6EFF6F
FF70FF71FF72FF73FF74FF75FF76FF77FF78FF79FF7AFF7BFF7CFF7DFF7EFF7F
FF80FF81FF82FF83FF84FF85FF86FF87FF88FF89FF8AFF8BFF8CFF8DFF8EFF8F
FF90FF91FF92FF93FF94FF95FF96FF97FF98FF99FF9AFF9BFF9CFF9DFF9EFF9F
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000












|
|






1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# Encoding file: jis0201, single-byte
S
003F 0 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D203E007F
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000FF61FF62FF63FF64FF65FF66FF67FF68FF69FF6AFF6BFF6CFF6DFF6EFF6F
FF70FF71FF72FF73FF74FF75FF76FF77FF78FF79FF7AFF7BFF7CFF7DFF7EFF7F
FF80FF81FF82FF83FF84FF85FF86FF87FF88FF89FF8AFF8BFF8CFF8DFF8EFF8F
FF90FF91FF92FF93FF94FF95FF96FF97FF98FF99FF9AFF9BFF9CFF9DFF9EFF9F
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000

Changes to library/encoding/macDingbats.enc.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# Encoding file: macDingbats, single-byte
S
003F 1 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
00202701270227032704260E2706270727082709261B261E270C270D270E270F
2710271127122713271427152716271727182719271A271B271C271D271E271F
2720272127222723272427252726272726052729272A272B272C272D272E272F
2730273127322733273427352736273727382739273A273B273C273D273E273F
2740274127422743274427452746274727482749274A274B25CF274D25A0274F
27502751275225B225BC25C6275625D727582759275A275B275C275D275E007F
F8D7F8D8F8D9F8DAF8DBF8DCF8DDF8DEF8DFF8E0F8E1F8E2F8E3F8E4008E008F
0090009100920093009400950096009700980099009A009B009C009D009E009F
0000276127622763276427652766276726632666266526602460246124622463
2464246524662467246824692776277727782779277A277B277C277D277E277F
2780278127822783278427852786278727882789278A278B278C278D278E278F
2790279127922793279421922194219527982799279A279B279C279D279E279F
27A027A127A227A327A427A527A627A727A827A927AA27AB27AC27AD27AE27AF
000027B127B227B327B427B527B627B727B827B927BA27BB27BC27BD27BE0000












|
|






1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# Encoding file: macDingbats, single-byte
S
003F 1 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
00202701270227032704260E2706270727082709261B261E270C270D270E270F
2710271127122713271427152716271727182719271A271B271C271D271E271F
2720272127222723272427252726272726052729272A272B272C272D272E272F
2730273127322733273427352736273727382739273A273B273C273D273E273F
2740274127422743274427452746274727482749274A274B25CF274D25A0274F
27502751275225B225BC25C6275625D727582759275A275B275C275D275E007F
F8D7F8D8F8D9F8DAF8DBF8DCF8DDF8DEF8DFF8E0F8E1F8E2F8E3F8E400000000
0000000000000000000000000000000000000000000000000000000000000000
0000276127622763276427652766276726632666266526602460246124622463
2464246524662467246824692776277727782779277A277B277C277D277E277F
2780278127822783278427852786278727882789278A278B278C278D278E278F
2790279127922793279421922194219527982799279A279B279C279D279E279F
27A027A127A227A327A427A527A627A727A827A927AA27AB27AC27AD27AE27AF
000027B127B227B327B427B527B627B727B827B927BA27BB27BC27BD27BE0000

Changes to library/encoding/macJapan.enc.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# Encoding file: macJapan, multi-byte
M
003F 0 46
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
0080000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00A0FF61FF62FF63FF64FF65FF66FF67FF68FF69FF6AFF6BFF6CFF6DFF6EFF6F
FF70FF71FF72FF73FF74FF75FF76FF77FF78FF79FF7AFF7BFF7CFF7DFF7EFF7F
FF80FF81FF82FF83FF84FF85FF86FF87FF88FF89FF8AFF8BFF8CFF8DFF8EFF8F
FF90FF91FF92FF93FF94FF95FF96FF97FF98FF99FF9AFF9BFF9CFF9DFF9EFF9F
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000000000000000A921222026












|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# Encoding file: macJapan, multi-byte
M
003F 0 46
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00A0FF61FF62FF63FF64FF65FF66FF67FF68FF69FF6AFF6BFF6CFF6DFF6EFF6F
FF70FF71FF72FF73FF74FF75FF76FF77FF78FF79FF7AFF7BFF7CFF7DFF7EFF7F
FF80FF81FF82FF83FF84FF85FF86FF87FF88FF89FF8AFF8BFF8CFF8DFF8EFF8F
FF90FF91FF92FF93FF94FF95FF96FF97FF98FF99FF9AFF9BFF9CFF9DFF9EFF9F
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000000000000000A921222026

Changes to library/encoding/shiftjis.enc.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# Encoding file: shiftjis, multi-byte
M
003F 0 40
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
0080000000000000000000850086008700000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000FF61FF62FF63FF64FF65FF66FF67FF68FF69FF6AFF6BFF6CFF6DFF6EFF6F
FF70FF71FF72FF73FF74FF75FF76FF77FF78FF79FF7AFF7BFF7CFF7DFF7EFF7F
FF80FF81FF82FF83FF84FF85FF86FF87FF88FF89FF8AFF8BFF8CFF8DFF8EFF8F
FF90FF91FF92FF93FF94FF95FF96FF97FF98FF99FF9AFF9BFF9CFF9DFF9EFF9F
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000












|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# Encoding file: shiftjis, multi-byte
M
003F 0 40
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000FF61FF62FF63FF64FF65FF66FF67FF68FF69FF6AFF6BFF6CFF6DFF6EFF6F
FF70FF71FF72FF73FF74FF75FF76FF77FF78FF79FF7AFF7BFF7CFF7DFF7EFF7F
FF80FF81FF82FF83FF84FF85FF86FF87FF88FF89FF8AFF8BFF8CFF8DFF8EFF8F
FF90FF91FF92FF93FF94FF95FF96FF97FF98FF99FF9AFF9BFF9CFF9DFF9EFF9F
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000

Changes to library/encoding/symbol.enc.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# Encoding file: symbol, single-byte
S
003F 1 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002122000023220300250026220D002800292217002B002C2212002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
22450391039203A70394039503A603930397039903D1039A039B039C039D039F
03A0039803A103A303A403A503C203A9039E03A80396005B2234005D22A5005F
F8E503B103B203C703B403B503C603B303B703B903D503BA03BB03BC03BD03BF
03C003B803C103C303C403C503D603C903BE03C803B6007B007C007D223C007F
0080008100820083008400850086008700880089008A008B008C008D008E008F
0090009100920093009400950096009700980099009A009B009C009D009E009F
000003D2203222642044221E0192266326662665266021942190219121922193
00B000B12033226500D7221D2202202200F72260226122482026F8E6F8E721B5
21352111211C21182297229522052229222A2283228722842282228622082209
2220220700AE00A92122220F221A22C500AC2227222821D421D021D121D221D3
22C42329F8E8F8E9F8EA2211F8EBF8ECF8EDF8EEF8EFF8F0F8F1F8F2F8F3F8F4
F8FF232A222B2320F8F52321F8F6F8F7F8F8F8F9F8FAF8FBF8FCF8FDF8FE0000












|
|






1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# Encoding file: symbol, single-byte
S
003F 1 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002122000023220300250026220D002800292217002B002C2212002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
22450391039203A70394039503A603930397039903D1039A039B039C039D039F
03A0039803A103A303A403A503C203A9039E03A80396005B2234005D22A5005F
F8E503B103B203C703B403B503C603B303B703B903D503BA03BB03BC03BD03BF
03C003B803C103C303C403C503D603C903BE03C803B6007B007C007D223C007F
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000003D2203222642044221E0192266326662665266021942190219121922193
00B000B12033226500D7221D2202202200F72260226122482026F8E6F8E721B5
21352111211C21182297229522052229222A2283228722842282228622082209
2220220700AE00A92122220F221A22C500AC2227222821D421D021D121D221D3
22C42329F8E8F8E9F8EA2211F8EBF8ECF8EDF8EEF8EFF8F0F8F1F8F2F8F3F8F4
F8FF232A222B2320F8F52321F8F6F8F7F8F8F8F9F8FAF8FBF8FCF8FDF8FE0000

Changes to library/encoding/tis-620.enc.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
# Encoding file: tis-620, single-byte
S
003F 0 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000E010E020E030E040E050E060E070E080E090E0A0E0B0E0C0E0D0E0E0E0F
0E100E110E120E130E140E150E160E170E180E190E1A0E1B0E1C0E1D0E1E0E1F
0E200E210E220E230E240E250E260E270E280E290E2A0E2B0E2C0E2D0E2E0E2F
0E300E310E320E330E340E350E360E370E380E390E3A00000000000000000E3F
0E400E410E420E430E440E450E460E470E480E490E4A0E4B0E4C0E4D0E4E0E4F











|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
# Encoding file: tis-620, single-byte
S
003F 0 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000E010E020E030E040E050E060E070E080E090E0A0E0B0E0C0E0D0E0E0E0F
0E100E110E120E130E140E150E160E170E180E190E1A0E1B0E1C0E1D0E1E0E1F
0E200E210E220E230E240E250E260E270E280E290E2A0E2B0E2C0E2D0E2E0E2F
0E300E310E320E330E340E350E360E370E380E390E3A00000000000000000E3F
0E400E410E420E430E440E450E460E470E480E490E4A0E4B0E4C0E4D0E4E0E4F

Changes to library/history.tcl.

264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
    } else {
	set i $event
    }
    if {$i <= $history(oldest)} {
	return -code error "event \"$event\" is too far in the past"
    }
    if {$i > $history(nextid)} {
	return -code error "event \"$event\" hasn't occured yet"
    }
    return $i
}

# tcl::HistEvent --
#
#	Map from an event specifier to the value in the history list.







|







264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
    } else {
	set i $event
    }
    if {$i <= $history(oldest)} {
	return -code error "event \"$event\" is too far in the past"
    }
    if {$i > $history(nextid)} {
	return -code error "event \"$event\" hasn't occurred yet"
    }
    return $i
}

# tcl::HistEvent --
#
#	Map from an event specifier to the value in the history list.

Changes to library/http/http.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
# http.tcl --
#
#	Client-side HTTP for GET, POST, and HEAD commands. These routines can
#	be used in untrusted code that uses the Safesock security policy.
#	These procedures use a callback interface to avoid using vwait, which
#	is not defined in the safe base.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require Tcl 8.6-
# Keep this in sync with pkgIndex.tcl and with the install directories in
# Makefiles
package provide http 2.10a4

namespace eval http {
    # Allow resourcing to not clobber existing data

    variable http
    if {![info exists http]} {
	array set http {













|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
# http.tcl --
#
#	Client-side HTTP for GET, POST, and HEAD commands. These routines can
#	be used in untrusted code that uses the Safesock security policy.
#	These procedures use a callback interface to avoid using vwait, which
#	is not defined in the safe base.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require Tcl 8.6-
# Keep this in sync with pkgIndex.tcl and with the install directories in
# Makefiles
package provide http 2.10b1

namespace eval http {
    # Allow resourcing to not clobber existing data

    variable http
    if {![info exists http]} {
	array set http {
73
74
75
76
77
78
79

80
81
82
83
84
85
86
	variable socketWrState
	variable socketRdQueue
	variable socketWrQueue
	variable socketPhQueue
	variable socketClosing
	variable socketPlayCmd
	variable socketCoEvent

	if {[info exists socketMapping]} {
	    # Close open sockets on re-init.  Do not permit retries.
	    foreach {url sock} [array get socketMapping] {
		unset -nocomplain socketClosing($url)
		unset -nocomplain socketPlayCmd($url)
		CloseSocket $sock
	    }







>







73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
	variable socketWrState
	variable socketRdQueue
	variable socketWrQueue
	variable socketPhQueue
	variable socketClosing
	variable socketPlayCmd
	variable socketCoEvent
	variable socketProxyId
	if {[info exists socketMapping]} {
	    # Close open sockets on re-init.  Do not permit retries.
	    foreach {url sock} [array get socketMapping] {
		unset -nocomplain socketClosing($url)
		unset -nocomplain socketPlayCmd($url)
		CloseSocket $sock
	    }
97
98
99
100
101
102
103

104
105
106
107
108
109
110
111
112

113
114
115
116
117
118
119
	array unset socketWrState
	array unset socketRdQueue
	array unset socketWrQueue
	array unset socketPhQueue
	array unset socketClosing
	array unset socketPlayCmd
	array unset socketCoEvent

	array set socketMapping {}
	array set socketRdState {}
	array set socketWrState {}
	array set socketRdQueue {}
	array set socketWrQueue {}
	array set socketPhQueue {}
	array set socketClosing {}
	array set socketPlayCmd {}
	array set socketCoEvent {}

	return
    }
    init

    variable urlTypes
    if {![info exists urlTypes]} {
	set urlTypes(http) [list 80 ::http::socket]







>









>







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
	array unset socketWrState
	array unset socketRdQueue
	array unset socketWrQueue
	array unset socketPhQueue
	array unset socketClosing
	array unset socketPlayCmd
	array unset socketCoEvent
	array unset socketProxyId
	array set socketMapping {}
	array set socketRdState {}
	array set socketWrState {}
	array set socketRdQueue {}
	array set socketWrQueue {}
	array set socketPhQueue {}
	array set socketClosing {}
	array set socketPlayCmd {}
	array set socketCoEvent {}
	array set socketProxyId {}
	return
    }
    init

    variable urlTypes
    if {![info exists urlTypes]} {
	set urlTypes(http) [list 80 ::http::socket]
214
215
216
217
218
219
220



























221
222
223
224
225
226
227
        505 {HTTP Version Not Supported}
        506 {Variant Also Negotiates}
        507 {Insufficient Storage}
        508 {Loop Detected}
        510 {Not Extended (OBSOLETED)}
        511 {Network Authentication Required}
    }]




























    namespace export geturl config reset wait formatQuery postError quoteString
    namespace export register unregister registerError
    namespace export requestLine requestHeaders requestHeaderValue
    namespace export responseLine responseHeaders responseHeaderValue
    namespace export responseCode responseBody responseInfo reasonPhrase
    # - Legacy aliases, were never exported:







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







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
        505 {HTTP Version Not Supported}
        506 {Variant Also Negotiates}
        507 {Insufficient Storage}
        508 {Loop Detected}
        510 {Not Extended (OBSOLETED)}
        511 {Network Authentication Required}
    }]

    variable failedProxyValues {
	binary
	body
	charset
	coding
	connection
	connectionRespFlag
	currentsize
	host
	http
	httpResponse
	meta
	method
	querylength
	queryoffset
	reasonPhrase
	requestHeaders
	requestLine
	responseCode
	state
	status
	tid
	totalsize
	transfer
	type
    }

    namespace export geturl config reset wait formatQuery postError quoteString
    namespace export register unregister registerError
    namespace export requestLine requestHeaders requestHeaderValue
    namespace export responseLine responseHeaders responseHeaderValue
    namespace export responseCode responseBody responseInfo reasonPhrase
    # - Legacy aliases, were never exported:
376
377
378
379
380
381
382

383
384
385
386
387
388
389
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketPhQueue
    variable socketClosing
    variable socketPlayCmd
    variable socketCoEvent


    variable $token
    upvar 0 $token state
    global errorInfo errorCode
    set closeQueue 0
    if {$errormsg ne ""} {
	set state(error) [list $errormsg $errorInfo $errorCode]







>







406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketPhQueue
    variable socketClosing
    variable socketPlayCmd
    variable socketCoEvent
    variable socketProxyId

    variable $token
    upvar 0 $token state
    global errorInfo errorCode
    set closeQueue 0
    if {$errormsg ne ""} {
	set state(error) [list $errormsg $errorInfo $errorCode]
509
510
511
512
513
514
515

516
517
518
519
520
521
522
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketPhQueue
    variable socketClosing
    variable socketPlayCmd
    variable socketCoEvent


    variable $token
    upvar 0 $token state
    set tk [namespace tail $token]

    # Keep this socket open for another request ("Keep-Alive").
    # React if the server half-closes the socket.







>







540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketPhQueue
    variable socketClosing
    variable socketPlayCmd
    variable socketCoEvent
    variable socketProxyId

    variable $token
    upvar 0 $token state
    set tk [namespace tail $token]

    # Keep this socket open for another request ("Keep-Alive").
    # React if the server half-closes the socket.
711
712
713
714
715
716
717

718
719
720
721
722
723
724
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketPhQueue
    variable socketClosing
    variable socketPlayCmd
    variable socketCoEvent


    set tk [namespace tail $token]

    catch {fileevent $s readable {}}
    set connId {}
    if {$token ne ""} {
	variable $token







>







743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketPhQueue
    variable socketClosing
    variable socketPlayCmd
    variable socketCoEvent
    variable socketProxyId

    set tk [namespace tail $token]

    catch {fileevent $s readable {}}
    set connId {}
    if {$token ne ""} {
	variable $token
773
774
775
776
777
778
779

780
781
782
783
784
785
786
787
788
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketPhQueue
    variable socketClosing
    variable socketPlayCmd
    variable socketCoEvent


    ##Log CloseQueuedQueries $connId
    if {![info exists socketMapping($connId)]} {
	# Command has already been called.
	# Don't come here again - especially recursively.
	return
    }

    # Used only for logging.







>

|







806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketPhQueue
    variable socketClosing
    variable socketPlayCmd
    variable socketCoEvent
    variable socketProxyId

    ##Log CloseQueuedQueries $connId $token
    if {![info exists socketMapping($connId)]} {
	# Command has already been called.
	# Don't come here again - especially recursively.
	return
    }

    # Used only for logging.
834
835
836
837
838
839
840

841
842
843
844
845
846
847
848

849
850
851
852
853
854
855
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketPhQueue
    variable socketClosing
    variable socketPlayCmd
    variable socketCoEvent


    unset socketMapping($connId)
    unset socketRdState($connId)
    unset socketWrState($connId)
    unset -nocomplain socketRdQueue($connId)
    unset -nocomplain socketWrQueue($connId)
    unset -nocomplain socketClosing($connId)
    unset -nocomplain socketPlayCmd($connId)

    return
}

# http::reset --
#
#	See documentation for details.
#







>








>







868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketPhQueue
    variable socketClosing
    variable socketPlayCmd
    variable socketCoEvent
    variable socketProxyId

    unset socketMapping($connId)
    unset socketRdState($connId)
    unset socketWrState($connId)
    unset -nocomplain socketRdQueue($connId)
    unset -nocomplain socketWrQueue($connId)
    unset -nocomplain socketClosing($connId)
    unset -nocomplain socketPlayCmd($connId)
    unset -nocomplain socketProxyId($connId)
    return
}

# http::reset --
#
#	See documentation for details.
#
867
868
869
870
871
872
873

874
875
876
877
878
879
880
    catch {fileevent $state(sock) readable {}}
    catch {fileevent $state(sock) writable {}}
    Finish $token
    if {[info exists state(error)]} {
	set errorlist $state(error)
	unset state
	eval ::error $errorlist

    }
    return
}

# http::geturl --
#
#	Establishes a connection to a remote url via http.







>







903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
    catch {fileevent $state(sock) readable {}}
    catch {fileevent $state(sock) writable {}}
    Finish $token
    if {[info exists state(error)]} {
	set errorlist $state(error)
	unset state
	eval ::error $errorlist
	# i.e. error msg errorInfo errorCode
    }
    return
}

# http::geturl --
#
#	Establishes a connection to a remote url via http.
1312
1313
1314
1315
1316
1317
1318





1319
1320
1321
1322
1323
1324
1325
    # including the server name.
    # The *tls* test below attempts to describe protocols in addition to
    # "https on port 443" that use HTTP over TLS.
    if {($phost ne "") && (![string match -nocase *tls* $defcmd])} {
	set srvurl $url
	set targetAddr [list $phost $pport]
	set state(proxyUsed) HttpProxy





    } else {
	set targetAddr [list $host $port]
    }

    set sockopts [list -async]

    # Pass -myaddr directly to the socket command







>
>
>
>
>







1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
    # including the server name.
    # The *tls* test below attempts to describe protocols in addition to
    # "https on port 443" that use HTTP over TLS.
    if {($phost ne "") && (![string match -nocase *tls* $defcmd])} {
	set srvurl $url
	set targetAddr [list $phost $pport]
	set state(proxyUsed) HttpProxy
	# The value of state(proxyUsed) none|HttpProxy depends only on the
	# all-transactions http::config settings and on the target URL.
	# Even if this is a persistent socket there is no need to change the
	# value of state(proxyUsed) for other transactions that use the socket:
	# they have the same value already.
    } else {
	set targetAddr [list $host $port]
    }

    set sockopts [list -async]

    # Pass -myaddr directly to the socket command
1347
1348
1349
1350
1351
1352
1353

1354
1355
1356
1357
1358
1359
1360
	variable socketWrState
	variable socketRdQueue
	variable socketWrQueue
	variable socketPhQueue
	variable socketClosing
	variable socketPlayCmd
	variable socketCoEvent


	if {[info exists socketMapping($state(socketinfo))]} {
	    # - If the connection is idle, it has a "fileevent readable" binding
	    #   to http::CheckEof, in case the server times out and half-closes
	    #   the socket (http::CheckEof closes the other half).
	    # - We leave this binding in place until just before the last
	    #   puts+flush in http::Connected (GET/HEAD) or http::Write (POST),







>







1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
	variable socketWrState
	variable socketRdQueue
	variable socketWrQueue
	variable socketPhQueue
	variable socketClosing
	variable socketPlayCmd
	variable socketCoEvent
	variable socketProxyId

	if {[info exists socketMapping($state(socketinfo))]} {
	    # - If the connection is idle, it has a "fileevent readable" binding
	    #   to http::CheckEof, in case the server times out and half-closes
	    #   the socket (http::CheckEof closes the other half).
	    # - We leave this binding in place until just before the last
	    #   puts+flush in http::Connected (GET/HEAD) or http::Write (POST),
1369
1370
1371
1372
1373
1374
1375

1376
1377
1378
1379
1380
1381
1382
		# Since we have only one persistent socket per server, and the
		# old socket is not yet dead, add the request to the write queue
		# of the dying socket, which will be replayed by ReplayIfClose.
		# Also add it to socketWrQueue(*) which is used only if an error
		# causes a call to Finish.
		set reusing 1
		set sock $socketMapping($state(socketinfo))

		Log "reusing closing socket $sock for $state(socketinfo) - token $token"

		set state(alreadyQueued) 1
		lassign $socketPlayCmd($state(socketinfo)) com0 com1 com2 com3
		lappend com3 $token
		set socketPlayCmd($state(socketinfo)) [list $com0 $com1 $com2 $com3]
		lappend socketWrQueue($state(socketinfo)) $token







>







1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
		# Since we have only one persistent socket per server, and the
		# old socket is not yet dead, add the request to the write queue
		# of the dying socket, which will be replayed by ReplayIfClose.
		# Also add it to socketWrQueue(*) which is used only if an error
		# causes a call to Finish.
		set reusing 1
		set sock $socketMapping($state(socketinfo))
		set state(proxyUsed) $socketProxyId($state(socketinfo))
		Log "reusing closing socket $sock for $state(socketinfo) - token $token"

		set state(alreadyQueued) 1
		lassign $socketPlayCmd($state(socketinfo)) com0 com1 com2 com3
		lappend com3 $token
		set socketPlayCmd($state(socketinfo)) [list $com0 $com1 $com2 $com3]
		lappend socketWrQueue($state(socketinfo)) $token
1403
1404
1405
1406
1407
1408
1409

1410
1411
1412
1413
1414
1415
1416
		# - The socket may not be ready to write: an earlier request might
		#   still be still writing (in the pipelined case) or
		#   writing/reading (in the nonpipeline case). This possibility
		#   is handled by socketWrQueue later in this command.
		# - The socket may not yet exist, and be defined with a placeholder.
		set reusing 1
		set sock $socketMapping($state(socketinfo))

		if {[SockIsPlaceHolder $sock]} {
		    set state(ReusingPlaceholder) 1
		    lappend socketPhQueue($sock) $token
		} else {
		}
		Log "reusing open socket $sock for $state(socketinfo) - token $token"
	    }







>







1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
		# - The socket may not be ready to write: an earlier request might
		#   still be still writing (in the pipelined case) or
		#   writing/reading (in the nonpipeline case). This possibility
		#   is handled by socketWrQueue later in this command.
		# - The socket may not yet exist, and be defined with a placeholder.
		set reusing 1
		set sock $socketMapping($state(socketinfo))
		set state(proxyUsed) $socketProxyId($state(socketinfo))
		if {[SockIsPlaceHolder $sock]} {
		    set state(ReusingPlaceholder) 1
		    lappend socketPhQueue($sock) $token
		} else {
		}
		Log "reusing open socket $sock for $state(socketinfo) - token $token"
	    }
1501
1502
1503
1504
1505
1506
1507

1508
1509
1510
1511
1512
1513
1514
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketPhQueue
    variable socketClosing
    variable socketPlayCmd
    variable socketCoEvent


    set sock $state(sock)

    # See comments above re the start of this timeout in other cases.
    if {(!$state(reusing)) && ($state(-timeout) > 0)} {
	set state(after) [after $state(-timeout) \
		[list http::reset $token timeout]]







>







1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketPhQueue
    variable socketClosing
    variable socketPlayCmd
    variable socketCoEvent
    variable socketProxyId

    set sock $state(sock)

    # See comments above re the start of this timeout in other cases.
    if {(!$state(reusing)) && ($state(-timeout) > 0)} {
	set state(after) [after $state(-timeout) \
		[list http::reset $token timeout]]
1577
1578
1579
1580
1581
1582
1583

1584
1585
1586





1587
1588
1589
1590
1591
1592
1593
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketPhQueue
    variable socketClosing
    variable socketPlayCmd
    variable socketCoEvent


    set DoLater {-traceread 0 -tracewrite 0}
    set socketMapping($state(socketinfo)) $state(sock)






    if {![info exists socketRdState($state(socketinfo))]} {
        set socketRdState($state(socketinfo)) {}
        # set varName ::http::socketRdState($state(socketinfo))
        # trace add variable $varName unset ::http::CancelReadPipeline
        dict set DoLater -traceread 1
    }







>



>
>
>
>
>







1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketPhQueue
    variable socketClosing
    variable socketPlayCmd
    variable socketCoEvent
    variable socketProxyId

    set DoLater {-traceread 0 -tracewrite 0}
    set socketMapping($state(socketinfo)) $state(sock)
    set socketProxyId($state(socketinfo)) $state(proxyUsed)
    # - The value of state(proxyUsed) was set in http::CreateToken to either
    #   "none" or "HttpProxy".
    # - $token is the first transaction to use this placeholder, so there are
    #   no other tokens whose (proxyUsed) must be modified.

    if {![info exists socketRdState($state(socketinfo))]} {
        set socketRdState($state(socketinfo)) {}
        # set varName ::http::socketRdState($state(socketinfo))
        # trace add variable $varName unset ::http::CancelReadPipeline
        dict set DoLater -traceread 1
    }
1609
1610
1611
1612
1613
1614
1615




1616
1617
1618
1619
1620
1621

1622
1623
1624
1625
1626
1627
1628
        # http::geturl with a pipelined transaction would conclude that the
        # socket is available for writing.
        #Log new, init for nonpipeline, GRANT r/w access to $token in geturl
        set socketRdState($state(socketinfo)) $token
        set socketWrState($state(socketinfo)) $token
    }





    set socketRdQueue($state(socketinfo)) {}
    set socketWrQueue($state(socketinfo)) {}
    set socketPhQueue($state(socketinfo)) {}
    set socketClosing($state(socketinfo)) 0
    set socketPlayCmd($state(socketinfo)) {ReplayIfClose Wready {} {}}
    set socketCoEvent($state(socketinfo)) {}


    return $DoLater
}

# ------------------------------------------------------------------------------
#  Proc ::http::OpenSocket
# ------------------------------------------------------------------------------







>
>
>
>


<



>







1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673

1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
        # http::geturl with a pipelined transaction would conclude that the
        # socket is available for writing.
        #Log new, init for nonpipeline, GRANT r/w access to $token in geturl
        set socketRdState($state(socketinfo)) $token
        set socketWrState($state(socketinfo)) $token
    }

    # Value of socketPhQueue() may have already been set by ReplayCore.
    if {![info exists socketPhQueue($state(sock))]} {
        set socketPhQueue($state(sock))   {}
    }
    set socketRdQueue($state(socketinfo)) {}
    set socketWrQueue($state(socketinfo)) {}

    set socketClosing($state(socketinfo)) 0
    set socketPlayCmd($state(socketinfo)) {ReplayIfClose Wready {} {}}
    set socketCoEvent($state(socketinfo)) {}
    set socketProxyId($state(socketinfo)) {}

    return $DoLater
}

# ------------------------------------------------------------------------------
#  Proc ::http::OpenSocket
# ------------------------------------------------------------------------------
1647
1648
1649
1650
1651
1652
1653

1654
1655
1656
1657
1658
1659
1660
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketPhQueue
    variable socketClosing
    variable socketPlayCmd
    variable socketCoEvent


    Log >K$tk Start OpenSocket coroutine

    if {![info exists state(-keepalive)]} {
        # The request has already been cancelled by the calling script.
        return
    }







>







1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketPhQueue
    variable socketClosing
    variable socketPlayCmd
    variable socketCoEvent
    variable socketProxyId

    Log >K$tk Start OpenSocket coroutine

    if {![info exists state(-keepalive)]} {
        # The request has already been cancelled by the calling script.
        return
    }
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
	    ##Log socket opened, now fconfigure - token $token
	    set delay [expr {[clock milliseconds] - $pre}]
	    if {$delay > 3000} {
		Log socket delay $delay - token $token
	    }
	    fconfigure $sock -translation {auto crlf} \
			     -buffersize $state(-blocksize)



	    ##Log socket opened, DONE fconfigure - token $token
        }

        Log "Using $sock for $state(socketinfo) - token $token" \
	    [expr {$state(-keepalive)?"keepalive":""}]

        # Code above has set state(sock) $sock
        ConfigureNewSocket $token $sockOld $DoLater

    } result errdict]} {














        if {[string range $result 0 20] eq {proxy connect failed:}} {

            # The socket can be persistent: if so it is identified with
            # the https target host, and will be kept open.
            # Results of the failed proxy CONNECT have been copied to $token and



            # are available to the caller.
            Eot $token
        } else {
            Finish $token $result
        }






    }
    ##Log Leaving http::OpenSocket coroutine [info coroutine] - token $token
    return
}


# ------------------------------------------------------------------------------







>
>
>








>

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

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







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
	    ##Log socket opened, now fconfigure - token $token
	    set delay [expr {[clock milliseconds] - $pre}]
	    if {$delay > 3000} {
		Log socket delay $delay - token $token
	    }
	    fconfigure $sock -translation {auto crlf} \
			     -buffersize $state(-blocksize)
	    if {[package vsatisfies [package provide Tcl] 9.0-]} {
		fconfigure $sock -profile tcl8
	    }
	    ##Log socket opened, DONE fconfigure - token $token
        }

        Log "Using $sock for $state(socketinfo) - token $token" \
	    [expr {$state(-keepalive)?"keepalive":""}]

        # Code above has set state(sock) $sock
        ConfigureNewSocket $token $sockOld $DoLater
        ##Log OpenSocket success $sock - token $token
    } result errdict]} {
	##Log OpenSocket failed $result - token $token
	# There may be other requests in the socketPhQueue.
	# Prepare socketPlayCmd so that Finish will replay them.
	if {    ($state(-keepalive)) && (!$state(reusing))
	     && [info exists socketPhQueue($sockOld)]
	     && ($socketPhQueue($sockOld) ne {})
	} {
	    if {$socketMapping($state(socketinfo)) ne $sockOld} {
		Log "WARNING: this code should not be reached.\
			{$socketMapping($state(socketinfo)) ne $sockOld}"
	    }
	    set socketPlayCmd($state(socketinfo)) [list ReplayIfClose Wready {} $socketPhQueue($sockOld)]
	    set socketPhQueue($sockOld) {}
	}
        if {[string range $result 0 20] eq {proxy connect failed:}} {
	    # - The HTTPS proxy did not create a socket.  The pre-existing value
	    #   (a "placeholder socket") is unchanged.

	    # - The proxy returned a valid HTTP response to the failed CONNECT
	    #   request, and http::SecureProxyConnect copied this to $token,
	    #   and also set ${token}(connection) set to "close".
	    # - Remove the error message $result so that Finish delivers this
	    #   HTTP response to the caller.


	    set result {}
	}
	Finish $token $result
	# Because socket creation failed, the placeholder "socket" must be
	# "closed" and (if persistent) removed from the persistent sockets
	# table.  In the {proxy connect failed:} case Finish does this because
	# the value of ${token}(connection) is "close". In the other cases here,
	# it does so because $result is non-empty.
    }
    ##Log Leaving http::OpenSocket coroutine [info coroutine] - token $token
    return
}


# ------------------------------------------------------------------------------
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
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketPhQueue
    variable socketClosing
    variable socketPlayCmd
    variable socketCoEvent


    set reusing $state(reusing)
    set sock $state(sock)

    ##Log "  ConfigureNewSocket" $token $sockOld ... -- $sock

    if {(!$reusing) && ($sock ne $sockOld)} {
        # Replace the placeholder value sockOld with sock.

        if {    [info exists socketMapping($state(socketinfo))]
             && ($socketMapping($state(socketinfo)) eq $sockOld)
        } {
            set socketMapping($state(socketinfo)) $sock


            ##Log set socketMapping($state(socketinfo)) $sock
        }

        # Now finish any tasks left over from PreparePersistentConnection on
        # the connection.
        #
        # The "unset" traces are fired by init (clears entire arrays), and







>



>
|








>
>







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
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketPhQueue
    variable socketClosing
    variable socketPlayCmd
    variable socketCoEvent
    variable socketProxyId

    set reusing $state(reusing)
    set sock $state(sock)
    set proxyUsed $state(proxyUsed)
    ##Log "  ConfigureNewSocket" $token $sockOld ... -- $reusing $sock $proxyUsed

    if {(!$reusing) && ($sock ne $sockOld)} {
        # Replace the placeholder value sockOld with sock.

        if {    [info exists socketMapping($state(socketinfo))]
             && ($socketMapping($state(socketinfo)) eq $sockOld)
        } {
            set socketMapping($state(socketinfo)) $sock
            set socketProxyId($state(socketinfo)) $proxyUsed
            # tokens that use the placeholder $sockOld are updated below.
            ##Log set socketMapping($state(socketinfo)) $sock
        }

        # Now finish any tasks left over from PreparePersistentConnection on
        # the connection.
        #
        # The "unset" traces are fired by init (clears entire arrays), and
1805
1806
1807
1808
1809
1810
1811

1812
1813
1814
1815
1816
1817
1818
         && [info exists socketPhQueue($sockOld)]
    } {
        ##Log "  ConfigureNewSocket" $token scheduled, now do $socketPhQueue($sockOld)
        foreach tok $socketPhQueue($sockOld) {
	    # 1. Amend the token's (sock).
	    ##Log set ${tok}(sock) $sock
	    set ${tok}(sock) $sock


	    # 2. Schedule the token's HTTP request.
	    # Every token in socketPhQueue(*) has reusing 1 alreadyQueued 0.
	    set ${tok}(reusing) 1
	    set ${tok}(alreadyQueued) 0
	    ScheduleRequest $tok
	}







>







1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
         && [info exists socketPhQueue($sockOld)]
    } {
        ##Log "  ConfigureNewSocket" $token scheduled, now do $socketPhQueue($sockOld)
        foreach tok $socketPhQueue($sockOld) {
	    # 1. Amend the token's (sock).
	    ##Log set ${tok}(sock) $sock
	    set ${tok}(sock) $sock
	    set ${tok}(proxyUsed) $proxyUsed

	    # 2. Schedule the token's HTTP request.
	    # Every token in socketPhQueue(*) has reusing 1 alreadyQueued 0.
	    set ${tok}(reusing) 1
	    set ${tok}(alreadyQueued) 0
	    ScheduleRequest $tok
	}
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850





1851
1852
1853
1854
1855
1856
1857
# socketWrState($connId) the token that is currently writing to the socket.
#                        Other values: Wready (ready for next token to write),
#                        peNding (would be ready for next write, except that
#                        the integrity of a non-pipelined transaction requires
#                        waiting until the read(s) in progress are finished).
# socketRdQueue($connId) List of tokens that are queued for reading later.
# socketWrQueue($connId) List of tokens that are queued for writing later.
# socketPhQueue($connId) List of tokens that are queued to use a placeholder
#                        socket, when the real socket has not yet been created.
# socketClosing($connId) (boolean) true iff a server response header indicates
#                        that the server will close the connection at the end of
#                        the current response.
# socketPlayCmd($connId) The command to execute to replay pending and
#                        part-completed transactions if the socket closes early.
# socketCoEvent($connId) Identifier for the "after idle" event that will launch
#                        an OpenSocket coroutine to open or re-use a socket.





# ------------------------------------------------------------------------------


# ------------------------------------------------------------------------------
# Using socketWrState(*), socketWrQueue(*), socketRdState(*), socketRdQueue(*)
# ------------------------------------------------------------------------------
# The element socketWrState($connId) has a value which is either the name of







|








>
>
>
>
>







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
# socketWrState($connId) the token that is currently writing to the socket.
#                        Other values: Wready (ready for next token to write),
#                        peNding (would be ready for next write, except that
#                        the integrity of a non-pipelined transaction requires
#                        waiting until the read(s) in progress are finished).
# socketRdQueue($connId) List of tokens that are queued for reading later.
# socketWrQueue($connId) List of tokens that are queued for writing later.
# socketPhQueue($sock)   List of tokens that are queued to use a placeholder
#                        socket, when the real socket has not yet been created.
# socketClosing($connId) (boolean) true iff a server response header indicates
#                        that the server will close the connection at the end of
#                        the current response.
# socketPlayCmd($connId) The command to execute to replay pending and
#                        part-completed transactions if the socket closes early.
# socketCoEvent($connId) Identifier for the "after idle" event that will launch
#                        an OpenSocket coroutine to open or re-use a socket.
# socketProxyId($connId) The type of proxy that this socket uses: values are
#                        those of state(proxyUsed) i.e. none, HttpProxy,
#                        SecureProxy, and SecureProxyFailed.
#                        The value is not used for anything by http, its purpose
#                        is to set the value of state() for caller information.
# ------------------------------------------------------------------------------


# ------------------------------------------------------------------------------
# Using socketWrState(*), socketWrQueue(*), socketRdState(*), socketRdQueue(*)
# ------------------------------------------------------------------------------
# The element socketWrState($connId) has a value which is either the name of
1899
1900
1901
1902
1903
1904
1905

1906
1907
1908
1909
1910
1911
1912
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketPhQueue
    variable socketClosing
    variable socketPlayCmd
    variable socketCoEvent


    set Unfinished 0

    set reusing $state(reusing)
    set sockNew $state(sock)

    # The "if" tests below: must test against the current values of







>







1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketPhQueue
    variable socketClosing
    variable socketPlayCmd
    variable socketCoEvent
    variable socketProxyId

    set Unfinished 0

    set reusing $state(reusing)
    set sockNew $state(sock)

    # The "if" tests below: must test against the current values of
2044
2045
2046
2047
2048
2049
2050

2051
2052
2053
2054
2055
2056
2057
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketPhQueue
    variable socketClosing
    variable socketPlayCmd
    variable socketCoEvent


    variable $token
    upvar 0 $token state
    set tk [namespace tail $token]

    if {$state(reusing) && (!$state(-pipeline)) && ($state(-timeout) > 0)} {
	set state(after) [after $state(-timeout) \







>







2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketPhQueue
    variable socketClosing
    variable socketPlayCmd
    variable socketCoEvent
    variable socketProxyId

    variable $token
    upvar 0 $token state
    set tk [namespace tail $token]

    if {$state(reusing) && (!$state(-pipeline)) && ($state(-timeout) > 0)} {
	set state(after) [after $state(-timeout) \
2069
2070
2071
2072
2073
2074
2075



2076
2077
2078
2079
2080
2081
2082

    # Send data in cr-lf format, but accept any line terminators.
    # Initialisation to {auto *} now done in geturl, KeepSocket and DoneRequest.
    # We are concerned here with the request (write) not the response (read).
    lassign [fconfigure $sock -translation] trRead trWrite
    fconfigure $sock -translation [list $trRead crlf] \
		     -buffersize $state(-blocksize)




    # The following is disallowed in safe interpreters, but the socket is
    # already in non-blocking mode in that case.

    catch {fconfigure $sock -blocking off}
    set how GET
    if {$isQuery} {







>
>
>







2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179

    # Send data in cr-lf format, but accept any line terminators.
    # Initialisation to {auto *} now done in geturl, KeepSocket and DoneRequest.
    # We are concerned here with the request (write) not the response (read).
    lassign [fconfigure $sock -translation] trRead trWrite
    fconfigure $sock -translation [list $trRead crlf] \
		     -buffersize $state(-blocksize)
    if {[package vsatisfies [package provide Tcl] 9.0-]} {
	fconfigure $sock -profile tcl8
    }

    # The following is disallowed in safe interpreters, but the socket is
    # already in non-blocking mode in that case.

    catch {fconfigure $sock -blocking off}
    set how GET
    if {$isQuery} {
2321
2322
2323
2324
2325
2326
2327
2328

2329
2330
2331
2332
2333
2334
2335

	    # else:
	    # This is NOT a persistent socket that has been closed since its
	    # last use.
	    # If any other requests are in flight or pipelined/queued, they will
	    # be discarded.
	} elseif {$state(status) eq ""} {
	    # ...https handshake errors come here.

	    set msg [registerError $sock]
	    registerError $sock {}
	    if {$msg eq {}} {
		set msg {failed to use socket}
	    }
	    Finish $token $msg
	} elseif {$state(status) ne "error"} {







|
>







2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433

	    # else:
	    # This is NOT a persistent socket that has been closed since its
	    # last use.
	    # If any other requests are in flight or pipelined/queued, they will
	    # be discarded.
	} elseif {$state(status) eq ""} {
	    # https handshake errors come here, for
	    # Tcl 8.7 without http::SecureProxyConnect, and for Tcl 8.6.
	    set msg [registerError $sock]
	    registerError $sock {}
	    if {$msg eq {}} {
		set msg {failed to use socket}
	    }
	    Finish $token $msg
	} elseif {$state(status) ne "error"} {
2382
2383
2384
2385
2386
2387
2388

2389
2390
2391
2392
2393
2394
2395
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketPhQueue
    variable socketClosing
    variable socketPlayCmd
    variable socketCoEvent


    variable $token
    upvar 0 $token state
    set tk [namespace tail $token]
    set sock $state(sock)

    # If pipelined, connect the next HTTP request to the socket.







>







2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketPhQueue
    variable socketClosing
    variable socketPlayCmd
    variable socketCoEvent
    variable socketProxyId

    variable $token
    upvar 0 $token state
    set tk [namespace tail $token]
    set sock $state(sock)

    # If pipelined, connect the next HTTP request to the socket.
2457
2458
2459
2460
2461
2462
2463



2464
2465
2466
2467
2468
2469
2470
    set tk [namespace tail $token]
    set sock $state(sock)

    #Log ---- $state(socketinfo) >> conn to $token for HTTP response
    lassign [fconfigure $sock -translation] trRead trWrite
    fconfigure $sock -translation [list auto $trWrite] \
		     -buffersize $state(-blocksize)



    Log ^D$tk begin receiving response - token $token

    coroutine ${token}--EventCoroutine http::Event $sock $token
    if {[info exists state(-handler)] || [info exists state(-progress)]} {
        fileevent $sock readable [list http::EventGateway $sock $token]
    } else {
        fileevent $sock readable ${token}--EventCoroutine







>
>
>







2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
    set tk [namespace tail $token]
    set sock $state(sock)

    #Log ---- $state(socketinfo) >> conn to $token for HTTP response
    lassign [fconfigure $sock -translation] trRead trWrite
    fconfigure $sock -translation [list auto $trWrite] \
		     -buffersize $state(-blocksize)
    if {[package vsatisfies [package provide Tcl] 9.0-]} {
	fconfigure $sock -profile tcl8
    }
    Log ^D$tk begin receiving response - token $token

    coroutine ${token}--EventCoroutine http::Event $sock $token
    if {[info exists state(-handler)] || [info exists state(-progress)]} {
        fileevent $sock readable [list http::EventGateway $sock $token]
    } else {
        fileevent $sock readable ${token}--EventCoroutine
2713
2714
2715
2716
2717
2718
2719

2720
2721
2722
2723
2724
2725
2726
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketPhQueue
    variable socketClosing
    variable socketPlayCmd
    variable socketCoEvent


    variable $token
    upvar 0 $token state

    Log running http::ReplayIfDead for $token $doing

    # 1. Merge the tokens for transactions in flight, the read (response) queue,







>







2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketPhQueue
    variable socketClosing
    variable socketPlayCmd
    variable socketCoEvent
    variable socketProxyId

    variable $token
    upvar 0 $token state

    Log running http::ReplayIfDead for $token $doing

    # 1. Merge the tokens for transactions in flight, the read (response) queue,
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
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketPhQueue
    variable socketClosing
    variable socketPlayCmd
    variable socketCoEvent


    if {[llength $newQueue] == 0} {
	# Nothing to do.
	return
    }

    ##Log running ReplayCore for {*}$newQueue
    set newToken [lindex $newQueue 0]
    set newQueue [lrange $newQueue 1 end]

    # 3. Use newToken, and restore its values of state(*).  Do not restore
    #    elements tmp* - we try again only once.

    set token $newToken
    variable $token
    upvar 0 $token state

    if {![ReInit $token]} {
	Log FAILED in http::ReplayCore - NO tmp vars

	Finish $token {cannot send this request again}
	return
    }

    set tmpState    $state(tmpState)
    set tmpOpenCmd  $state(tmpOpenCmd)
    set tmpConnArgs $state(tmpConnArgs)
    unset state(tmpState)
    unset state(tmpOpenCmd)
    unset state(tmpConnArgs)

    set state(reusing) 0
    set state(ReusingPlaceholder) 0
    set state(alreadyQueued) 0


    # Give the socket a placeholder name before it is created.
    set sock HTTP_PLACEHOLDER_[incr TmpSockCounter]
    set state(sock) $sock

    # Move the $newQueue into the placeholder socket's socketPhQueue.
    set socketPhQueue($sock) {}
    foreach tok $newQueue {
	if {[ReInit $tok]} {
	    set ${tok}(reusing) 1
	    set ${tok}(sock) $sock
	    lappend socketPhQueue($sock) $tok

	} else {

	    set ${tok}(reusing) 1
	    set ${tok}(sock) NONE
	    Finish $tok {cannot send this request again}
	}
    }

    AsyncTransaction $token







>



















>














>












>

>







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
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketPhQueue
    variable socketClosing
    variable socketPlayCmd
    variable socketCoEvent
    variable socketProxyId

    if {[llength $newQueue] == 0} {
	# Nothing to do.
	return
    }

    ##Log running ReplayCore for {*}$newQueue
    set newToken [lindex $newQueue 0]
    set newQueue [lrange $newQueue 1 end]

    # 3. Use newToken, and restore its values of state(*).  Do not restore
    #    elements tmp* - we try again only once.

    set token $newToken
    variable $token
    upvar 0 $token state

    if {![ReInit $token]} {
	Log FAILED in http::ReplayCore - NO tmp vars
	Log ReplayCore reject $token
	Finish $token {cannot send this request again}
	return
    }

    set tmpState    $state(tmpState)
    set tmpOpenCmd  $state(tmpOpenCmd)
    set tmpConnArgs $state(tmpConnArgs)
    unset state(tmpState)
    unset state(tmpOpenCmd)
    unset state(tmpConnArgs)

    set state(reusing) 0
    set state(ReusingPlaceholder) 0
    set state(alreadyQueued) 0
    Log ReplayCore replay $token

    # Give the socket a placeholder name before it is created.
    set sock HTTP_PLACEHOLDER_[incr TmpSockCounter]
    set state(sock) $sock

    # Move the $newQueue into the placeholder socket's socketPhQueue.
    set socketPhQueue($sock) {}
    foreach tok $newQueue {
	if {[ReInit $tok]} {
	    set ${tok}(reusing) 1
	    set ${tok}(sock) $sock
	    lappend socketPhQueue($sock) $tok
	    Log ReplayCore replay $tok
	} else {
	    Log ReplayCore reject $tok
	    set ${tok}(reusing) 1
	    set ${tok}(sock) NONE
	    Finish $tok {cannot send this request again}
	}
    }

    AsyncTransaction $token
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
#
#	Garbage collect the state associated with a transaction
#
# Arguments
#	token	The token returned from http::geturl
#
# Side Effects
#	unsets the state array

proc http::cleanup {token} {
    variable $token
    upvar 0 $token state
    if {[info commands ${token}--EventCoroutine] ne {}} {
	rename ${token}--EventCoroutine {}
    }







|







3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
#
#	Garbage collect the state associated with a transaction
#
# Arguments
#	token	The token returned from http::geturl
#
# Side Effects
#	Unsets the state array.

proc http::cleanup {token} {
    variable $token
    upvar 0 $token state
    if {[info commands ${token}--EventCoroutine] ne {}} {
	rename ${token}--EventCoroutine {}
    }
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
	unset state
    }
    return
}

# http::Connect
#
#	This callback is made when an asyncronous connection completes.
#
# Arguments
#	token	The token returned from http::geturl
#
# Side Effects
#	Sets the status of the connection, which unblocks
# 	the waiting geturl call







|







3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
	unset state
    }
    return
}

# http::Connect
#
#	This callback is made when an asynchronous connection completes.
#
# Arguments
#	token	The token returned from http::geturl
#
# Side Effects
#	Sets the status of the connection, which unblocks
# 	the waiting geturl call
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294

	    # else:
	    # This is NOT a persistent socket that has been closed since its
	    # last use.
	    # If any other requests are in flight or pipelined/queued, they will
	    # be discarded.
	}
	Finish $token "connect failed $err"
    return
}

# http::Write
#
#	Write POST query data to the socket
#







|







3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402

	    # else:
	    # This is NOT a persistent socket that has been closed since its
	    # last use.
	    # If any other requests are in flight or pipelined/queued, they will
	    # be discarded.
	}
	Finish $token "connect failed: $err"
    return
}

# http::Write
#
#	Write POST query data to the socket
#
3305
3306
3307
3308
3309
3310
3311

3312
3313
3314
3315
3316
3317
3318
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketPhQueue
    variable socketClosing
    variable socketPlayCmd
    variable socketCoEvent


    variable $token
    upvar 0 $token state
    set tk [namespace tail $token]
    set sock $state(sock)

    # Output a block.  Tcl will buffer this if the socket blocks







>







3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketPhQueue
    variable socketClosing
    variable socketPlayCmd
    variable socketCoEvent
    variable socketProxyId

    variable $token
    upvar 0 $token state
    set tk [namespace tail $token]
    set sock $state(sock)

    # Output a block.  Tcl will buffer this if the socket blocks
3417
3418
3419
3420
3421
3422
3423

3424
3425
3426
3427
3428
3429
3430
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketPhQueue
    variable socketClosing
    variable socketPlayCmd
    variable socketCoEvent


    variable $token
    upvar 0 $token state
    set tk [namespace tail $token]
    while 1 {
	yield
	##Log Event call - token $token







>







3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
3538
3539
3540
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketPhQueue
    variable socketClosing
    variable socketPlayCmd
    variable socketCoEvent
    variable socketProxyId

    variable $token
    upvar 0 $token state
    set tk [namespace tail $token]
    while 1 {
	yield
	##Log Event call - token $token
3469
3470
3471
3472
3473
3474
3475







3476
3477
3478
3479
3480
3481
3482
3483
3484
		    }
		    # else:
		    # This is NOT a persistent socket that has been closed since
		    # its last use.
		    # If any other requests are in flight or pipelined/queued,
		    # they will be discarded.
		} else {







		    Log ^X$tk end of response (error) - token $token
		    Finish $token $nsl
		    return
		}
	    } elseif {$nsl >= 0} {
		##Log - connecting 1 - token $token
		set state(state) "header"
	    } elseif {    ([catch {eof $sock} tmp] || $tmp)
		       && [info exists state(reusing)]







>
>
>
>
>
>
>

|







3579
3580
3581
3582
3583
3584
3585
3586
3587
3588
3589
3590
3591
3592
3593
3594
3595
3596
3597
3598
3599
3600
3601
		    }
		    # else:
		    # This is NOT a persistent socket that has been closed since
		    # its last use.
		    # If any other requests are in flight or pipelined/queued,
		    # they will be discarded.
		} else {
		    # https handshake errors come here, for
		    # Tcl 8.7 with http::SecureProxyConnect.
		    set msg [registerError $sock]
		    registerError $sock {}
		    if {$msg eq {}} {
			set msg $nsl
		    }
		    Log ^X$tk end of response (error) - token $token
		    Finish $token $msg
		    return
		}
	    } elseif {$nsl >= 0} {
		##Log - connecting 1 - token $token
		set state(state) "header"
	    } elseif {    ([catch {eof $sock} tmp] || $tmp)
		       && [info exists state(reusing)]
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350

# http::CopyDone
#
#	fcopy completion callback
#
# Arguments
#	token	The token returned from http::geturl
#	count	The amount transfered
#
# Side Effects
#	Invokes callbacks

proc http::CopyDone {token count {error {}}} {
    variable $token
    upvar 0 $token state







|







4453
4454
4455
4456
4457
4458
4459
4460
4461
4462
4463
4464
4465
4466
4467

# http::CopyDone
#
#	fcopy completion callback
#
# Arguments
#	token	The token returned from http::geturl
#	count	The amount transferred
#
# Side Effects
#	Invokes callbacks

proc http::CopyDone {token count {error {}}} {
    variable $token
    upvar 0 $token state
4433
4434
4435
4436
4437
4438
4439



4440

4441
4442
4443
4444
4445
4446
4447
	    # If we are getting text, set the incoming channel's encoding
	    # correctly.  iso8859-1 is the RFC default, but this could be any
	    # IANA charset.  However, we only know how to convert what we have
	    # encodings for.

	    set enc [CharsetToEncoding $state(charset)]
	    if {$enc ne "binary"} {



		set state(body) [encoding convertfrom $enc $state(body)]

	    }

	    # Translate text line endings.
	    set state(body) [string map {\r\n \n \r \n} $state(body)]
	}
	if {[info exists state(-guesstype)] && $state(-guesstype)} {
	    GuessType $token







>
>
>
|
>







4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
4564
4565
4566
4567
4568
	    # If we are getting text, set the incoming channel's encoding
	    # correctly.  iso8859-1 is the RFC default, but this could be any
	    # IANA charset.  However, we only know how to convert what we have
	    # encodings for.

	    set enc [CharsetToEncoding $state(charset)]
	    if {$enc ne "binary"} {
		if {[package vsatisfies [package provide Tcl] 9.0-]} {
		    set state(body) [encoding convertfrom -profile tcl8 $enc $state(body)]
		} else {
		    set state(body) [encoding convertfrom $enc $state(body)]
		}
	    }

	    # Translate text line endings.
	    set state(body) [string map {\r\n \n \r \n} $state(body)]
	}
	if {[info exists state(-guesstype)] && $state(-guesstype)} {
	    GuessType $token
4516
4517
4518
4519
4520
4521
4522



4523

4524
4525
4526
4527
4528
4529
4530
            set res $value
        }
    }
    set enc [CharsetToEncoding $res]
    if {$enc eq "binary"} {
        return 0
    }



    set state(body) [encoding convertfrom $enc $state(body)]

    set state(body) [string map {\r\n \n \r \n} $state(body)]
    set state(type) application/xml
    set state(binary) 0
    set state(charset) $res
    return 1
}








>
>
>
|
>







4637
4638
4639
4640
4641
4642
4643
4644
4645
4646
4647
4648
4649
4650
4651
4652
4653
4654
4655
            set res $value
        }
    }
    set enc [CharsetToEncoding $res]
    if {$enc eq "binary"} {
        return 0
    }
    if {[package vsatisfies [package provide Tcl] 9.0-]} {
	set state(body) [encoding convertfrom -profile tcl8 $enc $state(body)]
    } else {
	set state(body) [encoding convertfrom $enc $state(body)]
    }
    set state(body) [string map {\r\n \n \r \n} $state(body)]
    set state(type) application/xml
    set state(binary) 0
    set state(charset) $res
    return 1
}

4597
4598
4599
4600
4601
4602
4603



4604

4605
4606
4607
4608
4609
4610
4611
    variable http
    variable formMap

    # The spec says: "non-alphanumeric characters are replaced by '%HH'". Use
    # a pre-computed map and [string map] to do the conversion (much faster
    # than [regsub]/[subst]). [Bug 1020491]




    set string [encoding convertto $http(-urlencoding) $string]

    return [string map $formMap $string]
}

# http::ProxyRequired --
#	Default proxy filter.
#
# Arguments:







>
>
>
|
>







4722
4723
4724
4725
4726
4727
4728
4729
4730
4731
4732
4733
4734
4735
4736
4737
4738
4739
4740
    variable http
    variable formMap

    # The spec says: "non-alphanumeric characters are replaced by '%HH'". Use
    # a pre-computed map and [string map] to do the conversion (much faster
    # than [regsub]/[subst]). [Bug 1020491]

    if {[package vsatisfies [package provide Tcl] 9.0-]} {
	set string [encoding convertto -profile tcl8 $http(-urlencoding) $string]
    } else {
	set string [encoding convertto $http(-urlencoding) $string]
    }
    return [string map $formMap $string]
}

# http::ProxyRequired --
#	Default proxy filter.
#
# Arguments:
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
#
# Arguments:
# args        - as for ::socket, ending in host, port; with proxy host, proxy
#               port appended.
#
# Return Value: a socket identifier
# ------------------------------------------------------------------------------
proc http::AllDone {varName args} {
    set $varName done
    return
}

proc http::SecureProxyConnect {args} {
    variable http
    variable ConnectVar
    variable ConnectCounter

    set varName ::http::ConnectVar([incr ConnectCounter])

    # Extract (non-proxy) target from args.
    set host [lindex $args end-3]
    set port [lindex $args end-2]
    set args [lremove $args end-3 end-2]

    # Proxy server URL for connection.
    # This determines where the socket is opened.
    set phost [lindex $args end-1]
    set pport [lindex $args end]
    if {[string first : $phost] != -1} {
        # IPv6 address, wrap it in [] so we can append :pport







<
<
<
<





>





|







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
#
# Arguments:
# args        - as for ::socket, ending in host, port; with proxy host, proxy
#               port appended.
#
# Return Value: a socket identifier
# ------------------------------------------------------------------------------





proc http::SecureProxyConnect {args} {
    variable http
    variable ConnectVar
    variable ConnectCounter
    variable failedProxyValues
    set varName ::http::ConnectVar([incr ConnectCounter])

    # Extract (non-proxy) target from args.
    set host [lindex $args end-3]
    set port [lindex $args end-2]
    set args [lreplace $args end-3 end-2]

    # Proxy server URL for connection.
    # This determines where the socket is opened.
    set phost [lindex $args end-1]
    set pport [lindex $args end]
    if {[string first : $phost] != -1} {
        # IPv6 address, wrap it in [] so we can append :pport
4914
4915
4916
4917
4918
4919
4920
4921
4922





4923
4924
4925
4926
4927
4928
4929
    # the proxy request adds its own -type value.

    set targ [lsearch -exact $args -type]
    if {$targ != -1} {
        # Record in the token that this is a proxy call.
        set token [lindex $args $targ+1]
        upvar 0 ${token} state
        set state(proxyUsed) SecureProxy
        set tim $state(-timeout)





    } else {
        set tim 0
    }
    if {$tim == 0} {
        # Do not use infinite timeout for the proxy.
        set tim 30000
    }







<

>
>
>
>
>







5040
5041
5042
5043
5044
5045
5046

5047
5048
5049
5050
5051
5052
5053
5054
5055
5056
5057
5058
5059
    # the proxy request adds its own -type value.

    set targ [lsearch -exact $args -type]
    if {$targ != -1} {
        # Record in the token that this is a proxy call.
        set token [lindex $args $targ+1]
        upvar 0 ${token} state

        set tim $state(-timeout)
        set state(proxyUsed) SecureProxyFailed
        # This value is overwritten with "SecureProxy" below if the CONNECT is
        # successful.  If it is unsuccessful, the socket will be closed
        # below, and so in this unsuccessful case there are no other transactions
        # whose (proxyUsed) must be updated.
    } else {
        set tim 0
    }
    if {$tim == 0} {
        # Do not use infinite timeout for the proxy.
        set tim 30000
    }
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
    }

    set token2 [CreateToken $url -keepalive 0 -timeout $tim \
            -headers $requestHeaders -command [list http::AllDone $varName]]
    variable $token2
    upvar 0 $token2 state2


    # Setting this variable overrides the HTTP request line and allows
    # -headers to override the Connection: header set by -keepalive.


    set state2(bypass) "CONNECT $host:$port HTTP/1.1"

    AsyncTransaction $token2

    if {[info coroutine] ne {}} {
        # All callers in the http package are coroutines launched by
        # the event loop.
        # The cwait command requires a coroutine because it yields
        # to the caller; $varName is traced and the coroutine resumes
        # when the variable is written.
        cwait $varName
    } else {
        return -code error {code must run in a coroutine}
        # For testing with a non-coroutine caller outside the http package.
        # vwait $varName
    }
    unset $varName


    set sock $state2(sock)











    set code $state2(responseCode)

    if {[string is integer -strict $code] && ($code >= 200) && ($code < 300)} {
        # All OK.  The caller in tls will now call "tls::import $sock".
        # Do not use Finish, which will close (sock).

        # Other tidying done in http::Event.
        array unset state2
    } elseif {$targ != -1} {
        # Bad HTTP status code; token is known.
        # Copy from state2 to state, including (sock).
        foreach name [array names state2] {
            set state($name) $state2($name)
        }



        set state(proxyUsed) SecureProxy
        set state(proxyFail) failed



        # Do not use Finish, which will close (sock).
        # Other tidying done in http::Event.








        array unset state2




        # Error message detected by http::OpenSocket.














        return -code error "proxy connect failed: $code"










    } else {
        # Bad HTTP status code; token is not known because option -type
        # (cf. targ) was not passed through tcltls, and so the script
        # cannot write to state(*).
        # Do not use Finish, which will close (sock).
        # Other tidying done in http::Event.
        array unset state2

        # Error message detected by http::OpenSocket.

        return -code error "proxy connect failed: $code\n$block"
    }










    return $sock
}


# ------------------------------------------------------------------------------
#  Proc http::socket
# ------------------------------------------------------------------------------
# This command is a drop-in replacement for ::socket.







>
|

>
>


















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

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

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


>
>
>
>
>
>
>
>
>
|







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
    }

    set token2 [CreateToken $url -keepalive 0 -timeout $tim \
            -headers $requestHeaders -command [list http::AllDone $varName]]
    variable $token2
    upvar 0 $token2 state2

    # Kludges:
    # Setting this variable overrides the HTTP request line and also allows
    # -headers to override the Connection: header set by -keepalive.
    # The arguments "-keepalive 0" ensure that when Finish is called for an
    # unsuccessful request, the socket is always closed.
    set state2(bypass) "CONNECT $host:$port HTTP/1.1"

    AsyncTransaction $token2

    if {[info coroutine] ne {}} {
        # All callers in the http package are coroutines launched by
        # the event loop.
        # The cwait command requires a coroutine because it yields
        # to the caller; $varName is traced and the coroutine resumes
        # when the variable is written.
        cwait $varName
    } else {
        return -code error {code must run in a coroutine}
        # For testing with a non-coroutine caller outside the http package.
        # vwait $varName
    }
    unset $varName

    if {    ($state2(state) ne "complete")
         || ($state2(status) ne "ok")
         || (![string is integer -strict $state2(responseCode)])
    } {
        set msg {the HTTP request to the proxy server did not return a valid\
                and complete response}
        if {[info exists state2(error)]} {
            append msg ": " [lindex $state2(error) 0]
        }
        cleanup $token2
        return -code error $msg
    }

    set code $state2(responseCode)

    if {($code >= 200) && ($code < 300)} {
        # All OK.  The caller in package tls will now call "tls::import $sock".

        # The cleanup command does not close $sock.
        # Other tidying was done in http::Event.







        # If this is a persistent socket, any other transactions that are
        # already marked to use the socket will have their (proxyUsed) updated
        # when http::OpenSocket calls http::ConfigureNewSocket.
        set state(proxyUsed) SecureProxy
        set sock $state2(sock)
        cleanup $token2
        return $sock
    }


    if {$targ != -1} {
        # Non-OK HTTP status code; token is known because option -type
        # (cf. targ) was passed through tcltls, and so the useful
        # parts of the proxy's response can be copied to state(*).
        # Do not copy state2(sock).
        # Return the proxy response to the caller of geturl.
        foreach name $failedProxyValues {
            if {[info exists state2($name)]} {
                set state($name) $state2($name)
            }
        }
        set state(connection) close
        set msg "proxy connect failed: $code"
	# - This error message will be detected by http::OpenSocket and will
	#   cause it to present the proxy's HTTP response as that of the
	#   original $token transaction, identified only by state(proxyUsed)
	#   as the response of the proxy.
	# - The cases where this would mislead the caller of http::geturl are
	#   given a different value of msg (below) so that http::OpenSocket will
	#   treat them as errors, but will preserve the $token array for
	#   inspection by the caller.
	# - Status code 305 (Proxy Required) was deprecated for security reasons
	#   in RFC 2616 (June 1999) and in any case should never be served by a
	#   proxy.
	# - Other 3xx responses from the proxy are inappropriate, and should not
	#   occur.
	# - A 401 response from the proxy is inappropriate, and should not
	#   occur.  It would be confusing if returned to the caller.

	if {($code >= 300) && ($code < 400)} {
	    set msg "the proxy server responded to the HTTP request with an\
		    inappropriate $code redirect"
	    set loc [responseHeaderValue $token2 location]
	    if {$loc ne {}} {
		append msg "to " $loc
	    }
	} elseif {($code == 401)} {
	    set msg "the proxy server responded to the HTTP request with an\
		    inappropriate 401 request for target-host credentials"
	} else {






	}

    } else {
	set msg "connection to proxy failed with status code $code"
    }

    # - ${token2}(sock) has already been closed because -keepalive 0.
    # - Error return does not pass the socket ID to the
    #   $token transaction, which retains its socket placeholder.
    cleanup $token2
    return -code error $msg
}

proc http::AllDone {varName args} {
    set $varName done
    return
}


# ------------------------------------------------------------------------------
#  Proc http::socket
# ------------------------------------------------------------------------------
# This command is a drop-in replacement for ::socket.

Changes to library/http/pkgIndex.tcl.

1
2
if {![package vsatisfies [package provide Tcl] 8.6-]} {return}
package ifneeded http 2.10a4 [list tclPkgSetup $dir http 2.10a4 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]

|
1
2
if {![package vsatisfies [package provide Tcl] 8.6-]} {return}
package ifneeded http 2.10b1 [list tclPkgSetup $dir http 2.10b1 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]

Changes to library/init.tcl.

136
137
138
139
140
141
142
143
144
145
146
147
148
149
150

    # Some machines do not have exec. Also, on all
    # platforms, safe interpreters do not have exec.

    set auto_noexec 1
}

# Define a log command (which can be overwitten to log errors
# differently, specially when stderr is not available)

if {[namespace which -command tclLog] eq ""} {
    proc tclLog {string} {
	catch {puts stderr $string}
    }
}







|







136
137
138
139
140
141
142
143
144
145
146
147
148
149
150

    # Some machines do not have exec. Also, on all
    # platforms, safe interpreters do not have exec.

    set auto_noexec 1
}

# Define a log command (which can be overwritten to log errors
# differently, specially when stderr is not available)

if {[namespace which -command tclLog] eq ""} {
    proc tclLog {string} {
	catch {puts stderr $string}
    }
}
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
	    # We used to throw an error here, but, looking more closely
	    # at the core copy code in tclFCmd.c, if the destination
	    # exists, then we should only call this function if -force
	    # is true, which means we just want to over-write.  So,
	    # the following code is now commented out.
	    #
	    # return -code error "error $action \"$src\" to\
	    # \"$dest\": file already exists"
	} else {
	    # Depending on the platform, and on the current
	    # working directory, the directories '.', '..'
	    # can be returned in various combinations.  Anyway,
	    # if any other file is returned, we must signal an error.
	    set existing [glob -nocomplain -directory $dest * .*]
	    lappend existing {*}[glob -nocomplain -directory $dest \
		    -type hidden * .*]
	    foreach s $existing {
		if {[file tail $s] ni {. ..}} {
		    return -code error "error $action \"$src\" to\
		      \"$dest\": file already exists"
		}
	    }
	}
    } else {
	if {[string first $nsrc $ndest] >= 0} {
	    set srclen [expr {[llength [file split $nsrc]] - 1}]
	    set ndest [lindex [file split $ndest] $srclen]







|











|







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
	    # We used to throw an error here, but, looking more closely
	    # at the core copy code in tclFCmd.c, if the destination
	    # exists, then we should only call this function if -force
	    # is true, which means we just want to over-write.  So,
	    # the following code is now commented out.
	    #
	    # return -code error "error $action \"$src\" to\
	    # \"$dest\": file exists"
	} else {
	    # Depending on the platform, and on the current
	    # working directory, the directories '.', '..'
	    # can be returned in various combinations.  Anyway,
	    # if any other file is returned, we must signal an error.
	    set existing [glob -nocomplain -directory $dest * .*]
	    lappend existing {*}[glob -nocomplain -directory $dest \
		    -type hidden * .*]
	    foreach s $existing {
		if {[file tail $s] ni {. ..}} {
		    return -code error "error $action \"$src\" to\
		      \"$dest\": file exists"
		}
	    }
	}
    } else {
	if {[string first $nsrc $ndest] >= 0} {
	    set srclen [expr {[llength [file split $nsrc]] - 1}]
	    set ndest [lindex [file split $ndest] $srclen]

Changes to library/manifest.txt.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
###
# Package manifest for all Tcl packages included in the /library file system
###
apply {{dir} {
  set ::test [info script]
  set isafe [interp issafe]
  foreach {safe package version file} {
    0 http            2.10a4  {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.19 {platform platform.tcl}
    0 platform::shell 1.1.4  {platform shell.tcl}
    1 tcltest         2.5.5  {tcltest tcltest.tcl}
  } {
    if {$isafe && !$safe} continue
    package ifneeded $package $version  [list source [file join $dir {*}$file]]
  }
}} $dir







|






|





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
###
# Package manifest for all Tcl packages included in the /library file system
###
apply {{dir} {
  set ::test [info script]
  set isafe [interp issafe]
  foreach {safe package version file} {
    0 http            2.10b1  {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.19 {platform platform.tcl}
    0 platform::shell 1.1.4  {platform shell.tcl}
    1 tcltest         2.5.6  {tcltest tcltest.tcl}
  } {
    if {$isafe && !$safe} continue
    package ifneeded $package $version  [list source [file join $dir {*}$file]]
  }
}} $dir

Changes to library/msgcat/msgcat.tcl.

30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
    variable LoadedLocales {}

    # Records the locale of the currently sourced message catalogue file
    variable FileLocale

    # Configuration values per Package (e.g. client namespace).
    # The dict key is of the form "<option> <namespace>" and the value is the
    # configuration option. A nonexisting key is an unset option.
    variable PackageConfig [dict create mcfolder {} loadcmd {} changecmd {}\
	    unknowncmd {} loadedlocales {} loclist {}]

    # Records the mapping between source strings and translated strings.  The
    # dict key is of the form "<namespace> <locale> <src>", where locale and
    # namespace should be themselves dict values and the value is
    # the translated string.







|







30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
    variable LoadedLocales {}

    # Records the locale of the currently sourced message catalogue file
    variable FileLocale

    # Configuration values per Package (e.g. client namespace).
    # The dict key is of the form "<option> <namespace>" and the value is the
    # configuration option. A non-existing key is an unset option.
    variable PackageConfig [dict create mcfolder {} loadcmd {} changecmd {}\
	    unknowncmd {} loadedlocales {} loclist {}]

    # Records the mapping between source strings and translated strings.  The
    # dict key is of the form "<namespace> <locale> <src>", where locale and
    # namespace should be themselves dict values and the value is
    # the translated string.
207
208
209
210
211
212
213

214
215
216
217
218
219
220
# msgcat::mcn --
#
#	Find the translation for the given string based on the current
#	locale setting. Check the passed namespace first, then look in each
#	parent namespace until the source is found.  If additional args are
#	specified, use the format command to work them into the translated
#	string.

#	If no catalog item is found, mcunknown is called in the caller frame
#	and its result is returned.
#
# Arguments:
#	ns	Package namespace of the translation
#	src	The string to translate.
#	args	Args to pass to the format command







>







207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
# msgcat::mcn --
#
#	Find the translation for the given string based on the current
#	locale setting. Check the passed namespace first, then look in each
#	parent namespace until the source is found.  If additional args are
#	specified, use the format command to work them into the translated
#	string.
#
#	If no catalog item is found, mcunknown is called in the caller frame
#	and its result is returned.
#
# Arguments:
#	ns	Package namespace of the translation
#	src	The string to translate.
#	args	Args to pass to the format command
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
#	    unset	Clear option. return "".
#
#	Available options are:
#
#	mcfolder
#	    The message catalog folder of the package.
#	    This is automatically set by mcload.
#	    If the value is changed using the set subcommand, an evntual
#	    loadcmd is invoked and all message files of the package locale are
#	    loaded.
#
#	loadcmd
#	    The command gets executed before a message file would be
#	    sourced for this module.
#	    The command is invoked with the expanded locale list to load.







|







681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
#	    unset	Clear option. return "".
#
#	Available options are:
#
#	mcfolder
#	    The message catalog folder of the package.
#	    This is automatically set by mcload.
#	    If the value is changed using the set subcommand, an eventual
#	    loadcmd is invoked and all message files of the package locale are
#	    loaded.
#
#	loadcmd
#	    The command gets executed before a message file would be
#	    sourced for this module.
#	    The command is invoked with the expanded locale list to load.

Changes to library/opt/optparse.tcl.

71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
    # Array storing the parsed descriptions
    variable OptDesc
    array set OptDesc {}
    # Next potentially free key id (numeric)
    variable OptDescN 0

# Inside algorithm/mechanism description:
# (not for the faint hearted ;-)
#
# The argument description is parsed into a "program tree"
# It is called a "program" because it is the program used by
# the state machine interpreter that use that program to
# actually parse the arguments at run time.
#
# The general structure of a "program" is







|







71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
    # Array storing the parsed descriptions
    variable OptDesc
    array set OptDesc {}
    # Next potentially free key id (numeric)
    variable OptDescN 0

# Inside algorithm/mechanism description:
# (not for the faint-hearted ;-)
#
# The argument description is parsed into a "program tree"
# It is called a "program" because it is the program used by
# the state machine interpreter that use that program to
# actually parse the arguments at run time.
#
# The general structure of a "program" is
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146

# Performance/Implementation issues
# ---------------------------------
# We use tcl lists instead of arrays because with tcl8.0
# they should start to be much faster.
# But this code use a lot of helper procs (like Lvarset)
# which are quite slow and would be helpfully optimized
# for instance by being written in C. Also our struture
# is complex and there is maybe some places where the
# string rep might be calculated at great exense. to be checked.

#
# Parse a given description and saves it here under the given key
# generate a unused keyid if not given
#
proc ::tcl::OptKeyRegister {desc {key ""}} {
    variable OptDesc







|

|







130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146

# Performance/Implementation issues
# ---------------------------------
# We use tcl lists instead of arrays because with tcl8.0
# they should start to be much faster.
# But this code use a lot of helper procs (like Lvarset)
# which are quite slow and would be helpfully optimized
# for instance by being written in C. Also our structure
# is complex and there is maybe some places where the
# string rep might be calculated at great expense. to be checked.

#
# Parse a given description and saves it here under the given key
# generate a unused keyid if not given
#
proc ::tcl::OptKeyRegister {desc {key ""}} {
    variable OptDesc
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
        variable OptDesc
        if {![info exists OptDesc($descKey)]} {
            return -code error "Unknown option description key \"$descKey\""
        }
        set OptDesc($descKey)
    }

# Parse entry point for ppl who don't want to register with a key,
# for instance because the description changes dynamically.
#  (otherwise one should really use OptKeyRegister once + OptKeyParse
#   as it is way faster or simply OptProc which does it all)
# Assign a temporary key, call OptKeyParse and then free the storage
proc ::tcl::OptParse {desc arglist} {
    set tempkey [OptKeyRegister $desc]
    set ret [catch {uplevel 1 [list ::tcl::OptKeyParse $tempkey $arglist]} res]







|







222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
        variable OptDesc
        if {![info exists OptDesc($descKey)]} {
            return -code error "Unknown option description key \"$descKey\""
        }
        set OptDesc($descKey)
    }

# Parse entry point for people who don't want to register with a key,
# for instance because the description changes dynamically.
#  (otherwise one should really use OptKeyRegister once + OptKeyParse
#   as it is way faster or simply OptProc which does it all)
# Assign a temporary key, call OptKeyParse and then free the storage
proc ::tcl::OptParse {desc arglist} {
    set tempkey [OptKeyRegister $desc]
    set ret [catch {uplevel 1 [list ::tcl::OptKeyParse $tempkey $arglist]} res]
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
	set item [lindex $descriptions $adress]
	if {[OptIsPrg $item]} {
	    return [OptCurAddr $item $start]
	} else {
	    return $start
	}
    }
    # Set the value field of the current instruction
    proc OptCurSetValue {descriptionsName value} {
	upvar $descriptionsName descriptions
	# get the current item full adress
        set adress [OptCurAddr $descriptions]
	# use the 3th field of the item  (see OptValue / OptNewInst)
	lappend adress 2
	Lvarset descriptions $adress [list 1 $value]
	#                                  ^hasBeenSet flag
    }

    # empty state means done/paste the end of the program
    proc OptState {item} {
        lindex $item 0
    }

    # current state
    proc OptCurState {descriptions} {
        OptState [OptCurDesc $descriptions]
    }

    #######
    # Arguments manipulation

    # Returns the argument that has to be processed now
    proc OptCurrentArg {lst} {
        lindex $lst 0
    }
    # Advance to next argument
    proc OptNextArg {argsName} {
        uplevel 1 [list Lvarpop1 $argsName]
    }
    #######










|


|

|





|












|



|







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
	set item [lindex $descriptions $adress]
	if {[OptIsPrg $item]} {
	    return [OptCurAddr $item $start]
	} else {
	    return $start
	}
    }
    # Set the value field of the current instruction.
    proc OptCurSetValue {descriptionsName value} {
	upvar $descriptionsName descriptions
	# Get the current item full address.
        set adress [OptCurAddr $descriptions]
	# Use the 3rd field of the item  (see OptValue / OptNewInst).
	lappend adress 2
	Lvarset descriptions $adress [list 1 $value]
	#                                  ^hasBeenSet flag
    }

    # Empty state means done/paste the end of the program.
    proc OptState {item} {
        lindex $item 0
    }

    # current state
    proc OptCurState {descriptions} {
        OptState [OptCurDesc $descriptions]
    }

    #######
    # Arguments manipulation

    # Returns the argument that has to be processed now.
    proc OptCurrentArg {lst} {
        lindex $lst 0
    }
    # Advance to next argument.
    proc OptNextArg {argsName} {
        uplevel 1 [list Lvarpop1 $argsName]
    }
    #######



549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
		set vnamesLst [OptTreeVars $item $level $vnamesLst]
	    } else {
		set vname [OptVarName $item]
		upvar $level $vname var
		if {[OptHasBeenSet $item]} {
#		    puts "adding $vname"
		    # lets use the input name for the returned list
		    # it is more usefull, for instance you can check that
		    # no flags at all was given with expr
		    # {![string match "*-*" $Args]}
		    lappend vnamesLst [OptName $item]
		    set var [OptValue $item]
		} else {
		    set var [OptDefaultValue $item]
		}







|







549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
		set vnamesLst [OptTreeVars $item $level $vnamesLst]
	    } else {
		set vname [OptVarName $item]
		upvar $level $vname var
		if {[OptHasBeenSet $item]} {
#		    puts "adding $vname"
		    # lets use the input name for the returned list
		    # it is more useful, for instance you can check that
		    # no flags at all was given with expr
		    # {![string match "*-*" $Args]}
		    lappend vnamesLst [OptName $item]
		    set var [OptValue $item]
		} else {
		    set var [OptDefaultValue $item]
		}

Changes to library/package.tcl.

65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
# Arguments:
# -direct		(optional) If this flag is present, the generated
#			code in pkgMkIndex.tcl will cause the package to be
#			loaded when "package require" is executed, rather
#			than lazily when the first reference to an exported
#			procedure in the package is made.
# -verbose		(optional) Verbose output; the name of each file that
#			was successfully rocessed is printed out. Additionally,
#			if processing of a file failed a message is printed.
# -load pat		(optional) Preload any packages whose names match
#			the pattern.  Used to handle DLLs that depend on
#			other packages during their Init procedure.
# dir -			Name of the directory in which to create the index.
# args -		Any number of additional arguments, each giving
#			a glob pattern that matches the names of one or







|







65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
# Arguments:
# -direct		(optional) If this flag is present, the generated
#			code in pkgMkIndex.tcl will cause the package to be
#			loaded when "package require" is executed, rather
#			than lazily when the first reference to an exported
#			procedure in the package is made.
# -verbose		(optional) Verbose output; the name of each file that
#			was successfully processed is printed out. Additionally,
#			if processing of a file failed a message is printed.
# -load pat		(optional) Preload any packages whose names match
#			the pattern.  Used to handle DLLs that depend on
#			other packages during their Init procedure.
# dir -			Name of the directory in which to create the index.
# args -		Any number of additional arguments, each giving
#			a glob pattern that matches the names of one or
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
		    }
		}
	    }
	    proc tclPkgUnknown args {}
	    package unknown tclPkgUnknown

	    # Stub out the unknown command so package can call into each other
	    # during their initialilzation.

	    proc unknown {args} {}

	    # Stub out the auto_import mechanism

	    proc auto_import {args} {}








|







205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
		    }
		}
	    }
	    proc tclPkgUnknown args {}
	    package unknown tclPkgUnknown

	    # Stub out the unknown command so package can call into each other
	    # during their initialization.

	    proc unknown {args} {}

	    # Stub out the auto_import mechanism

	    proc auto_import {args} {}

732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
	error [format $err(valueMissing) "-version"]
    }

    if {!([llength $opts(-source)] || [llength $opts(-load)])} {
	error $err(noLoadOrSource)
    }

    # OK, now everything is good.  Generate the package ifneeded statment.
    set cmdline "package ifneeded $opts(-name) $opts(-version) "

    set cmdList {}
    set lazyFileList {}

    # Handle -load and -source specs
    foreach key {load source} {







|







732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
	error [format $err(valueMissing) "-version"]
    }

    if {!([llength $opts(-source)] || [llength $opts(-load)])} {
	error $err(noLoadOrSource)
    }

    # OK, now everything is good.  Generate the package ifneeded statement.
    set cmdline "package ifneeded $opts(-name) $opts(-version) "

    set cmdList {}
    set lazyFileList {}

    # Handle -load and -source specs
    foreach key {load source} {

Changes to library/platform/platform.tcl.

261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
    upvar 1 $vv v
    set libclist [lsort [glob -nocomplain -directory $base libc*]]

    if {![llength $libclist]} { return 0 }

    set libc [lindex $libclist 0]

    # Try executing the library first. This should suceed
    # for a glibc library, and return the version
    # information.

    if {![catch {
	set vdata [lindex [split [exec $libc] \n] 0]
    }]} {
	regexp {version ([0-9]+(\.[0-9]+)*)} $vdata -> v







|







261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
    upvar 1 $vv v
    set libclist [lsort [glob -nocomplain -directory $base libc*]]

    if {![llength $libclist]} { return 0 }

    set libc [lindex $libclist 0]

    # Try executing the library first. This should succeed
    # for a glibc library, and return the version
    # information.

    if {![catch {
	set vdata [lindex [split [exec $libc] \n] 0]
    }]} {
	regexp {version ([0-9]+(\.[0-9]+)*)} $vdata -> v

Changes to library/platform/shell.tcl.

23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
proc ::platform::shell::generic {shell} {
    # Argument is the path to a tcl shell.

    CHECK $shell
    LOCATE base out

    set     code {}
    # Forget any pre-existing platform package, it might be in
    # conflict with this one.
    lappend code {package forget platform}
    # Inject our platform package
    lappend code [list source $base]
    # Query and print the architecture
    lappend code {puts [platform::generic]}
    # And done







|







23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
proc ::platform::shell::generic {shell} {
    # Argument is the path to a tcl shell.

    CHECK $shell
    LOCATE base out

    set     code {}
    # Forget any preexisting platform package, it might be in
    # conflict with this one.
    lappend code {package forget platform}
    # Inject our platform package
    lappend code [list source $base]
    # Query and print the architecture
    lappend code {puts [platform::generic]}
    # And done
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
proc ::platform::shell::identify {shell} {
    # Argument is the path to a tcl shell.

    CHECK $shell
    LOCATE base out

    set     code {}
    # Forget any pre-existing platform package, it might be in
    # conflict with this one.
    lappend code {package forget platform}
    # Inject our platform package
    lappend code [list source $base]
    # Query and print the architecture
    lappend code {puts [platform::identify]}
    # And done







|







48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
proc ::platform::shell::identify {shell} {
    # Argument is the path to a tcl shell.

    CHECK $shell
    LOCATE base out

    set     code {}
    # Forget any preexisting platform package, it might be in
    # conflict with this one.
    lappend code {package forget platform}
    # Inject our platform package
    lappend code [list source $base]
    # Query and print the architecture
    lappend code {puts [platform::identify]}
    # And done
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
    return
}

proc ::platform::shell::LOCATE {bv ov} {
    upvar 1 $bv base $ov out

    # Locate the platform package for injection into the specified
    # shell. We are using package management to find it, whereever it
    # is, instead of using hardwired relative paths. This allows us to
    # install the two packages as TMs without breaking the code
    # here. If the found package is wrapped we copy the code somewhere
    # where the spawned shell will be able to read it.

    # This code is brittle, it needs has to adapt to whatever changes
    # are made to the TM code, i.e. the provide statement generated by
    # tm.tcl

    set pl [package ifneeded platform [package require platform]]
    set base [lindex $pl end]

    set out 0
    if {[lindex [file system $base]] ne "native"} {







|






|







95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
    return
}

proc ::platform::shell::LOCATE {bv ov} {
    upvar 1 $bv base $ov out

    # Locate the platform package for injection into the specified
    # shell. We are using package management to find it, wherever it
    # is, instead of using hardwired relative paths. This allows us to
    # install the two packages as TMs without breaking the code
    # here. If the found package is wrapped we copy the code somewhere
    # where the spawned shell will be able to read it.

    # This code is brittle, it needs has to adapt to whatever changes
    # are made to the TM code, i.e. the "provide" statement generated by
    # tm.tcl

    set pl [package ifneeded platform [package require platform]]
    set base [lindex $pl end]

    set out 0
    if {[lindex [file system $base]] ne "native"} {

Changes to 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]
}



|


|


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.7 \
	    [list load [file join $dir tcl9registry13.dll] Registry]
} else {
    package ifneeded registry 1.3.7 \
	    [list load [file join $dir tclregistry13.dll] Registry]
}

Changes to library/safe.tcl.

190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
		-deleteHook {
		    return [list -deleteHook $state(cleanupHook)]
		}
		-noStatics {
		    # it is most probably a set in fact but we would need
		    # then to jump to the set part and it is not *sure*
		    # that it is a set action that the user want, so force
		    # it to use the unambigous -statics ?value? instead:
		    return -code error\
			"ambigous query (get or set -noStatics ?)\
				use -statics instead"
		}
		-nestedLoadOk {
		    return -code error\
			"ambigous query (get or set -nestedLoadOk ?)\







|







190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
		-deleteHook {
		    return [list -deleteHook $state(cleanupHook)]
		}
		-noStatics {
		    # it is most probably a set in fact but we would need
		    # then to jump to the set part and it is not *sure*
		    # that it is a set action that the user want, so force
		    # it to use the unambiguous -statics ?value? instead:
		    return -code error\
			"ambigous query (get or set -noStatics ?)\
				use -statics instead"
		}
		-nestedLoadOk {
		    return -code error\
			"ambigous query (get or set -nestedLoadOk ?)\
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
		set nested     [InterpNested]
	    } else {
		set nested     $state(nestedok)
	    }
	    if {![::tcl::OptProcArgGiven -deleteHook]} {
		set deleteHook $state(cleanupHook)
	    }
	    # we can now reconfigure :
	    set withAutoPath [::tcl::OptProcArgGiven -autoPath]
	    InterpSetConfig $child $accessPath $statics $nested $deleteHook $autoPath $withAutoPath

	    # auto_reset the child (to completely synch the new access_path) tests safe-9.8 safe-9.9
	    if {$doreset} {
		if {[catch {::interp eval $child {auto_reset}} msg]} {
		    Log $child "auto_reset failed: $msg"
		} else {
		    Log $child "successful auto_reset" NOTICE
		}








|



|







245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
		set nested     [InterpNested]
	    } else {
		set nested     $state(nestedok)
	    }
	    if {![::tcl::OptProcArgGiven -deleteHook]} {
		set deleteHook $state(cleanupHook)
	    }
	    # Now reconfigure
	    set withAutoPath [::tcl::OptProcArgGiven -autoPath]
	    InterpSetConfig $child $accessPath $statics $nested $deleteHook $autoPath $withAutoPath

	    # auto_reset the child (to completely sync the new access_path) tests safe-9.8 safe-9.9
	    if {$doreset} {
		if {[catch {::interp eval $child {auto_reset}} msg]} {
		    Log $child "auto_reset failed: $msg"
		} else {
		    Log $child "successful auto_reset" NOTICE
		}

371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
				 0 [info library]]
	    Log $child "tcl_libray was not in first in auto_path,\
			moved it to front of child's access_path" NOTICE
	}

	set raw_auto_path $access_path

	# Add 1st level sub dirs (will searched by auto loading from tcl
	# code in the child using glob and thus fail, so we add them here
	# so by default it works the same).
	set access_path [AddSubDirs $access_path]
    } else {
        set raw_auto_path $autoPath
    }








|







371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
				 0 [info library]]
	    Log $child "tcl_libray was not in first in auto_path,\
			moved it to front of child's access_path" NOTICE
	}

	set raw_auto_path $access_path

	# Add 1st level subdirs (will searched by auto loading from tcl
	# code in the child using glob and thus fail, so we add them here
	# so by default it works the same).
	set access_path [AddSubDirs $access_path]
    } else {
        set raw_auto_path $autoPath
    }

689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
    foreach sub [interp children $child] {
        if {[info exists ::safe::[VarName [list $child $sub]]]} {
            ::safe::interpDelete [list $child $sub]
        }
    }

    # If the child has a cleanup hook registered, call it.  Check the
    # existance because we might be called to delete an interp which has
    # not been registered with us at all

    if {[info exists state(cleanupHook)]} {
	set hook $state(cleanupHook)
	if {[llength $hook]} {
	    # remove the hook now, otherwise if the hook calls us somehow,
	    # we'll loop







|







689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
    foreach sub [interp children $child] {
        if {[info exists ::safe::[VarName [list $child $sub]]]} {
            ::safe::interpDelete [list $child $sub]
        }
    }

    # If the child has a cleanup hook registered, call it.  Check the
    # existence because we might be called to delete an interp which has
    # not been registered with us at all

    if {[info exists state(cleanupHook)]} {
	set hook $state(cleanupHook)
	if {[llength $hook]} {
	    # remove the hook now, otherwise if the hook calls us somehow,
	    # we'll loop
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
	::interp delete $child
	Log $child "Deleted" NOTICE
    }

    return
}

# Set (or get) the logging mecanism

proc ::safe::setLogCmd {args} {
    variable Log
    set la [llength $args]
    if {$la == 0} {
	return $Log
    } elseif {$la == 1} {







|







723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
	::interp delete $child
	Log $child "Deleted" NOTICE
    }

    return
}

# Set (or get) the logging mechanism

proc ::safe::setLogCmd {args} {
    variable Log
    set la [llength $args]
    if {$la == 0} {
	return $Log
    } elseif {$la == 1} {

Changes to library/tcltest/pkgIndex.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
# Tcl package index file, version 1.1
# This file is generated by the "pkg_mkIndex -direct" command
# and sourced either when an application starts up or
# by a "package unknown" script.  It invokes the
# "package ifneeded" command to set up package-related
# information so that packages will be loaded automatically
# in response to "package require" commands.  When this
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.

if {![package vsatisfies [package provide Tcl] 8.5-]} {return}
package ifneeded tcltest 2.5.5 [list source [file join $dir tcltest.tcl]]











|
1
2
3
4
5
6
7
8
9
10
11
12
# Tcl package index file, version 1.1
# This file is generated by the "pkg_mkIndex -direct" command
# and sourced either when an application starts up or
# by a "package unknown" script.  It invokes the
# "package ifneeded" command to set up package-related
# information so that packages will be loaded automatically
# in response to "package require" commands.  When this
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.

if {![package vsatisfies [package provide Tcl] 8.5-]} {return}
package ifneeded tcltest 2.5.6 [list source [file join $dir tcltest.tcl]]

Changes to library/tcltest/tcltest.tcl.

18
19
20
21
22
23
24
25
26
27
28
29
30
31

32
33
34
35
36
37
38

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

    # 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








|






>







18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39

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

    # 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]
    variable fullutf [package vsatisfies $version 8.7-]

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

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
	if {![file isdir $directory]} {
	    return -code error "\"$directory\" is not a directory"
	}
	return [AcceptReadable $directory]
    }

##### Initialize internal arrays of tcltest, but only if the caller
    # has not already pre-initialized them.  This is done to support
    # compatibility with older tests that directly access internals
    # rather than go through command interfaces.
    #
    proc ArrayDefault {varName value} {
	variable $varName
	if {[array exists $varName]} {
	    return
	}
	if {[info exists $varName]} {
	    # Pre-initialized value is a scalar: destroy it!
	    unset $varName
	}
	array set $varName $value
    }

    # save the original environment so that it can be restored later
    ArrayDefault originalEnv [array get ::env]







|









|







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
	if {![file isdir $directory]} {
	    return -code error "\"$directory\" is not a directory"
	}
	return [AcceptReadable $directory]
    }

##### Initialize internal arrays of tcltest, but only if the caller
    # has not already preinitialized them.  This is done to support
    # compatibility with older tests that directly access internals
    # rather than go through command interfaces.
    #
    proc ArrayDefault {varName value} {
	variable $varName
	if {[array exists $varName]} {
	    return
	}
	if {[info exists $varName]} {
	    # Preinitialized value is a scalar:  Destroy it!
	    unset $varName
	}
	array set $varName $value
    }

    # save the original environment so that it can be restored later
    ArrayDefault originalEnv [array get ::env]
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206

    # initialize the testConstraints array to keep track of valid
    # predefined constraints (see the explanation for the
    # InitConstraints proc for more details).
    ArrayDefault testConstraints {}

##### Initialize internal variables of tcltest, but only if the caller
    # has not already pre-initialized them.  This is done to support
    # compatibility with older tests that directly access internals
    # rather than go through command interfaces.
    #
    proc Default {varName value {verify AcceptAll}} {
	variable $varName
	if {![info exists $varName]} {
	    variable $varName [$verify $value]







|







193
194
195
196
197
198
199
200
201
202
203
204
205
206
207

    # initialize the testConstraints array to keep track of valid
    # predefined constraints (see the explanation for the
    # InitConstraints proc for more details).
    ArrayDefault testConstraints {}

##### Initialize internal variables of tcltest, but only if the caller
    # has not already preinitialized them.  This is done to support
    # compatibility with older tests that directly access internals
    # rather than go through command interfaces.
    #
    proc Default {varName value {verify AcceptAll}} {
	variable $varName
	if {![info exists $varName]} {
	    variable $varName [$verify $value]
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
    Default currentFailure false AcceptBoolean
    Default failFiles {} AcceptList

    # Tests should remove all files they create.  The test suite will
    # check the current working dir for files created by the tests.
    # filesMade keeps track of such files created using the makeFile and
    # makeDirectory procedures.  filesExisted stores the names of
    # pre-existing files.
    #
    # Note that $filesExisted lists only those files that exist in
    # the original [temporaryDirectory].
    Default filesMade {} AcceptList
    Default filesExisted {} AcceptList
    proc FillFilesExisted {} {
	variable filesExisted







|







226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
    Default currentFailure false AcceptBoolean
    Default failFiles {} AcceptList

    # Tests should remove all files they create.  The test suite will
    # check the current working dir for files created by the tests.
    # filesMade keeps track of such files created using the makeFile and
    # makeDirectory procedures.  filesExisted stores the names of
    # preexisting files.
    #
    # Note that $filesExisted lists only those files that exist in
    # the original [temporaryDirectory].
    Default filesMade {} AcceptList
    Default filesExisted {} AcceptList
    proc FillFilesExisted {} {
	variable filesExisted
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
    # stdout and stderr buffers for use when we want to store them
    Default outData {}
    Default errData {}

    # keep track of test level for nested test commands
    variable testLevel 0

    # the variables and procs that existed when saveState was called are
    # stored in a variable of the same name
    Default saveState {}

    # Internationalization support -- used in [SetIso8859_1_Locale] and
    # [RestoreLocale]. Those commands are used in cmdIL.test.

    if {![info exists [namespace current]::isoLocale]} {







|







295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
    # stdout and stderr buffers for use when we want to store them
    Default outData {}
    Default errData {}

    # keep track of test level for nested test commands
    variable testLevel 0

    # the variables and procedures that existed when saveState was called are
    # stored in a variable of the same name
    Default saveState {}

    # Internationalization support -- used in [SetIso8859_1_Locale] and
    # [RestoreLocale]. Those commands are used in cmdIL.test.

    if {![info exists [namespace current]::isoLocale]} {
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
	# (Hopefully this longer comment will be clear when I come
	# back in a few months, unlike its predecessor :) )
	#
	# The [outputChannel] command (and underlying variable) have to
	# be kept in sync with the [configure -outfile] configuration
	# option ( and underlying variable Option(-outfile) ).  This is
	# accomplished with a write trace on Option(-outfile) that will
	# update [outputChannel] whenver a new value is written.  That
	# much is easy.
	#
	# The trick is that in order to maintain compatibility with
	# version 1 of tcltest, we must allow every configuration option
	# to get its inital value from command line arguments.  This is
	# accomplished by setting initial read traces on all the
	# configuration options to parse the command line option the first
	# time they are read.  These traces are cancelled whenever the
	# program itself calls [configure].
	#
	# OK, then so to support tcltest 1 compatibility, it seems we want
	# to get the return from [outputFile] to trigger the read traces,







|




|







351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
	# (Hopefully this longer comment will be clear when I come
	# back in a few months, unlike its predecessor :) )
	#
	# The [outputChannel] command (and underlying variable) have to
	# be kept in sync with the [configure -outfile] configuration
	# option ( and underlying variable Option(-outfile) ).  This is
	# accomplished with a write trace on Option(-outfile) that will
	# update [outputChannel] whenever a new value is written.  That
	# much is easy.
	#
	# The trick is that in order to maintain compatibility with
	# version 1 of tcltest, we must allow every configuration option
	# to get its initial value from command line arguments.  This is
	# accomplished by setting initial read traces on all the
	# configuration options to parse the command line option the first
	# time they are read.  These traces are cancelled whenever the
	# program itself calls [configure].
	#
	# OK, then so to support tcltest 1 compatibility, it seems we want
	# to get the return from [outputFile] to trigger the read traces,
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
	    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 \







|







397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
	    stderr -
	    stdout {
		set outputChannel $filename
	    }
	    default {
		set outputChannel [open $filename a]
		if {[package vsatisfies [package provide Tcl] 8.7-]} {
		    fconfigure $outputChannel -profile tcl8 -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 \
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
	    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 \







|







444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
	    stderr -
	    stdout {
		set errorChannel $filename
	    }
	    default {
		set errorChannel [open $filename a]
		if {[package vsatisfies [package provide Tcl] 8.7-]} {
		    fconfigure $errorChannel -profile tcl8 -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 \
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
    variable Usage; array set Usage {}

    # Verification commands for those options
    variable Verify; array set Verify {}

    # Initialize the default values of the configurable options that are
    # historically associated with an exported variable.  If that variable
    # is already set, support compatibility by accepting its pre-set value.
    # Use [trace] to establish ongoing connection between the deprecated
    # exported variable and the modern option kept as a true internal var.
    # Also set up usage string and value testing for the option.
    proc Option {option value usage {verify AcceptAll} {varName {}}} {
	variable Option
	variable Verify
	variable Usage







|







479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
    variable Usage; array set Usage {}

    # Verification commands for those options
    variable Verify; array set Verify {}

    # Initialize the default values of the configurable options that are
    # historically associated with an exported variable.  If that variable
    # is already set, support compatibility by accepting its preset value.
    # Use [trace] to establish ongoing connection between the deprecated
    # exported variable and the modern option kept as a true internal var.
    # Also set up usage string and value testing for the option.
    proc Option {option value usage {verify AcceptAll} {varName {}}} {
	variable Option
	variable Verify
	variable Usage
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
	set directory [AcceptDirectory $directory]
	if {![file writable $directory]} {
	    if {[workingDirectory] eq $directory} {
		# Special exception: accept the default value
		# even if the directory is not writable
		return $directory
	    }
	    return -code error "\"$directory\" is not writeable"
	}
	return $directory
    }

    # Directory where files should be created
    Option -tmpdir [workingDirectory] {
	Save temporary files in the specified directory.







|







758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
	set directory [AcceptDirectory $directory]
	if {![file writable $directory]} {
	    if {[workingDirectory] eq $directory} {
		# Special exception: accept the default value
		# even if the directory is not writable
		return $directory
	    }
	    return -code error "\"$directory\" is not writable"
	}
	return $directory
    }

    # Directory where files should be created
    Option -tmpdir [workingDirectory] {
	Save temporary files in the specified directory.
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
	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







|







789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
	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 -profile tcl8 -encoding utf-8
	}
	loadScript [read $tmp]
	close $tmp
    }
    Option -loadfile {} {
	Read the script to load the tested commands from the specified file.
    } AcceptLoadFile loadFile
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
}

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

# tcltest::Debug* --
#
#     Internal helper procedures to write out debug information
#     dependent on the chosen level. A test shell may overide
#     them, f.e. to redirect the output into a different
#     channel, or even into a GUI.

# tcltest::DebugPuts --
#
#     Prints the specified string if the current debug level is
#     higher than the provided level argument.







|







849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
}

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

# tcltest::Debug* --
#
#     Internal helper procedures to write out debug information
#     dependent on the chosen level. A test shell may override
#     them, f.e. to redirect the output into a different
#     channel, or even into a GUI.

# tcltest::DebugPuts --
#
#     Prints the specified string if the current debug level is
#     higher than the provided level argument.
1129
1130
1131
1132
1133
1134
1135
































1136
1137
1138
1139
1140
1141
1142
    if {$n2 eq {}} {return}
    if {![info exists testConstraints($n2)]} {
	if {[catch {testConstraint $n2 [eval [ConstraintInitializer $n2]]}]} {
	    testConstraint $n2 0
	}
    }
}

































# tcltest::ConstraintInitializer --
#
#	Get or set a script that when evaluated in the tcltest namespace
#	will return a boolean value with which to initialize the
#	associated constraint.
#







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







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
    if {$n2 eq {}} {return}
    if {![info exists testConstraints($n2)]} {
	if {[catch {testConstraint $n2 [eval [ConstraintInitializer $n2]]}]} {
	    testConstraint $n2 0
	}
    }
}

# tcltest::Asciify --
#
#       Transforms the passed string to contain only printable ascii characters.
#       Useful for printing to terminals. Non-printables are mapped to
#       \x, \u or \U sequences.
#
# Arguments:
#       s - string to transform
#
# Results:
#       The transformed strings
#
# Side effects:
#       None.

proc tcltest::Asciify {s} {
    variable fullutf
    set print ""
    foreach c [split $s ""] {
        if {[string is print $c] && (($c <= "\x7E") || ($c == "\n"))} {
            append print $c
        } elseif {$c < "\u0100"} {
            append print \\x[format %02X [scan $c %c]]
        } elseif {$fullutf && ($c >= "\U10000")} {
            append print \\U[format %08X [scan $c %c]]
        } else {
            append print \\u[format %04X [scan $c %c]]
        }
    }
    return $print
}

# tcltest::ConstraintInitializer --
#
#	Get or set a script that when evaluated in the tcltest namespace
#	will return a boolean value with which to initialize the
#	associated constraint.
#
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
	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
		}
	    }
	}







|







1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
	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 -profile tcl8 -encoding utf-8
	    }
	    if {![catch {puts $f exit}]} {
		if {![catch {close $f}]} {
		    set code 1
		}
	    }
	}
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
#

proc tcltest::SubstArguments {argList} {

    # We need to split the argList up into tokens but cannot use list
    # operations as they throw away some significant quoting, and
    # [split] ignores braces as it should.  Therefore what we do is
    # gradually build up a string out of whitespace seperated strings.
    # We cannot use [split] to split the argList into whitespace
    # separated strings as it throws away the whitespace which maybe
    # important so we have to do it all by hand.

    set result {}
    set token ""








|







1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
#

proc tcltest::SubstArguments {argList} {

    # We need to split the argList up into tokens but cannot use list
    # operations as they throw away some significant quoting, and
    # [split] ignores braces as it should.  Therefore what we do is
    # gradually build up a string out of whitespace-separated strings.
    # We cannot use [split] to split the argList into whitespace
    # separated strings as it throws away the whitespace which maybe
    # important so we have to do it all by hand.

    set result {}
    set token ""

1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
#   setup -             Code to run before $script (above).  This
#                       attribute is optional; default is {}.
#   cleanup -           Code to run after $script (above).  This
#                       attribute is optional; default is {}.
#   match -             specifies type of matching to do on result,
#                       output, errorOutput; this must be a string
#			previously registered by a call to [customMatch].
#			The strings exact, glob, and regexp are pre-registered
#			by the tcltest package.  Default value is exact.
#
# Arguments:
#   name -		Name of test, in the form foo-1.2.
#   description -	Short textual description of the test, to
#  		  	help humans understand what it does.
#







|







1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
#   setup -             Code to run before $script (above).  This
#                       attribute is optional; default is {}.
#   cleanup -           Code to run after $script (above).  This
#                       attribute is optional; default is {}.
#   match -             specifies type of matching to do on result,
#                       output, errorOutput; this must be a string
#			previously registered by a call to [customMatch].
#			The strings exact, glob, and regexp are preregistered
#			by the tcltest package.  Default value is exact.
#
# Arguments:
#   name -		Name of test, in the form foo-1.2.
#   description -	Short textual description of the test, to
#  		  	help humans understand what it does.
#
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
	}
	set TestNames($name) [info script]
    }

    FillFilesExisted
    incr testLevel

    # Pre-define everything to null except output and errorOutput.  We
    # determine whether or not to trap output based on whether or not
    # these variables (output & errorOutput) are defined.
    lassign {} constraints setup cleanup body result returnCodes errorCode match

    # Set the default match mode
    set match exact








|







1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
	}
	set TestNames($name) [info script]
    }

    FillFilesExisted
    incr testLevel

    # Predefine everything to null except output and errorOutput.  We
    # determine whether or not to trap output based on whether or not
    # these variables (output & errorOutput) are defined.
    lassign {} constraints setup cleanup body result returnCodes errorCode match

    # Set the default match mode
    set match exact

2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
	    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
	    }
	}







|







2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
	    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 -profile tcl8 -encoding utf-8
		}
		set testLine [expr {[lsearch -regexp \
			[split [read $testFd] "\n"] \
			"^\[ \t\]*test [string map {. \\.} $name] "] + 1}]
		close $testFd
	    }
	}
2217
2218
2219
2220
2221
2222
2223

2224



2225
2226
2227
2228
2229
2230
2231
2232
2233
	    puts [outputChannel] "---- errorCode(setup): $errorCodeRes(setup)"
	}
    }
    if {$processTest && $scriptFailure} {
	if {$scriptCompare} {
	    puts [outputChannel] "---- Error testing result: $scriptMatch"
	} else {

	    puts [outputChannel] "---- Result was:\n$actualAnswer"



	    puts [outputChannel] "---- Result should have been\
		    ($match matching):\n$result"
	}
    }
    if {$errorCodeFailure} {
	puts [outputChannel] "---- Error code was: '$errorCodeRes(body)'"
	puts [outputChannel] "---- Error code should have been: '$errorCode'"
    }
    if {$codeFailure} {







>
|
>
>
>

|







2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
	    puts [outputChannel] "---- errorCode(setup): $errorCodeRes(setup)"
	}
    }
    if {$processTest && $scriptFailure} {
	if {$scriptCompare} {
	    puts [outputChannel] "---- Error testing result: $scriptMatch"
	} else {
	    if {[catch {
		puts [outputChannel] "---- Result was:\n[Asciify $actualAnswer]"
	    } errMsg]} {
		puts [outputChannel] "\n---- Result was:\n<error printing result: $errMsg>"
	    }
	    puts [outputChannel] "---- Result should have been\
		    ($match matching):\n[Asciify $result]"
	}
    }
    if {$errorCodeFailure} {
	puts [outputChannel] "---- Error code was: '$errorCodeRes(body)'"
	puts [outputChannel] "---- Error code should have been: '$errorCode'"
    }
    if {$codeFailure} {
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
    }

    # Call the cleanup hook
    cleanupTestsHook

    # Remove files and directories created by the makeFile and
    # makeDirectory procedures.  Record the names of files in
    # workingDirectory that were not pre-existing, and associate them
    # with the test file that created them.

    if {!$calledFromAllFile} {
	foreach file $filesMade {
	    if {[file exists $file]} {
		DebugDo 1 {Warn "cleanupTests deleting $file..."}
		catch {file delete -force -- $file}







|







2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
    }

    # Call the cleanup hook
    cleanupTestsHook

    # Remove files and directories created by the makeFile and
    # makeDirectory procedures.  Record the names of files in
    # workingDirectory that were not preexisting, and associate them
    # with the test file that created them.

    if {!$calledFromAllFile} {
	foreach file $filesMade {
	    if {[file exists $file]} {
		DebugDo 1 {Warn "cleanupTests deleting $file..."}
		catch {file delete -force -- $file}
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
		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}







|







2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
		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 -profile tcl8 -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}
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111

    DebugPuts 3 "[lindex [info level 0] 0]:\
	     putting ``$contents'' into $fullName"

    set fd [open $fullName w]
    fconfigure $fd -translation lf
    if {[package vsatisfies [package provide Tcl] 8.7-]} {
	fconfigure $fd -encoding utf-8
    }
    if {[string index $contents end] eq "\n"} {
	puts -nonewline $fd $contents
    } else {
	puts $fd $contents
    }
    close $fd







|







3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148

    DebugPuts 3 "[lindex [info level 0] 0]:\
	     putting ``$contents'' into $fullName"

    set fd [open $fullName w]
    fconfigure $fd -translation lf
    if {[package vsatisfies [package provide Tcl] 8.7-]} {
	fconfigure $fd -profile tcl8 -encoding utf-8
    }
    if {[string index $contents end] eq "\n"} {
	puts -nonewline $fd $contents
    } else {
	puts $fd $contents
    }
    close $fd
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
    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 --







|







3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
    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 -profile tcl8 -encoding utf-8
    }
    set data [read -nonewline $f]
    close $f
    return $data
}

# tcltest::bytestring --
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
	return 1
    }
    return 0
}

# Initialize the constraints and set up command line arguments
namespace eval tcltest {
    # Define initializers for all the built-in contraint definitions
    DefineConstraintInitializers

    # Set up the constraints in the testConstraints array to be lazily
    # initialized by a registered initializer, or by "false" if no
    # initializer is registered.
    trace add variable testConstraints read [namespace code SafeFetch]

    # Only initialize constraints at package load time if an
    # [initConstraintsHook] has been pre-defined.  This is only
    # for compatibility support.  The modern way to add a custom
    # test constraint is to just call the [testConstraint] command
    # straight away, without all this "hook" nonsense.
    if {[namespace current] eq
	    [namespace qualifiers [namespace which initConstraintsHook]]} {
	InitConstraints
    } else {







|








|







3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
	return 1
    }
    return 0
}

# Initialize the constraints and set up command line arguments
namespace eval tcltest {
    # Define initializers for all the built-in constraint definitions
    DefineConstraintInitializers

    # Set up the constraints in the testConstraints array to be lazily
    # initialized by a registered initializer, or by "false" if no
    # initializer is registered.
    trace add variable testConstraints read [namespace code SafeFetch]

    # Only initialize constraints at package load time if an
    # [initConstraintsHook] has been predefined.  This is only
    # for compatibility support.  The modern way to add a custom
    # test constraint is to just call the [testConstraint] command
    # straight away, without all this "hook" nonsense.
    if {[namespace current] eq
	    [namespace qualifiers [namespace which initConstraintsHook]]} {
	InitConstraints
    } else {

Changes to library/tm.tcl.

18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
#   [package require] something that wasn't there on the first scan.
#
#   Either
#   1) It is there now:  If we rescan, you get it; if not you don't.
#
#      This covers the possibility that the application asked for a package
#      late, and the package was actually added to the installation after the
#      application was started. It shoukld still be able to find it.
#
#   2) It still is not there: Either way, you don't get it, but the rescan
#      takes time. This is however an error case and we dont't care that much
#      about it
#
#   3) It was there the first time; but for some reason a "package forget" has
#      been run, and "package" doesn't know about it anymore.
#
#      This can be an indication that the application wishes to reload some
#      functionality. And should work as well.







|


|







18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
#   [package require] something that wasn't there on the first scan.
#
#   Either
#   1) It is there now:  If we rescan, you get it; if not you don't.
#
#      This covers the possibility that the application asked for a package
#      late, and the package was actually added to the installation after the
#      application was started. It should still be able to find it.
#
#   2) It still is not there: Either way, you don't get it, but the rescan
#      takes time. This is however an error case and we don't care that much
#      about it
#
#   3) It was there the first time; but for some reason a "package forget" has
#      been run, and "package" doesn't know about it anymore.
#
#      This can be an indication that the application wishes to reload some
#      functionality. And should work as well.
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
#	args -	The paths to add/remove. Must not appear querying the
#		path with 'list'.
#
# Results
#	No result for subcommands 'add' and 'remove'. A list of paths for
#	'list'.
#
# Sideeffects
#	The subcommands 'add' and 'remove' manipulate the list of paths to
#	search for Tcl Modules. The subcommand 'list' has no sideeffects.

proc ::tcl::tm::add {args} {
    # PART OF THE ::tcl::tm::path ENSEMBLE
    #
    # The path is added at the head to the list of module paths.
    #
    # The command enforces the restriction that no path may be an ancestor
    # directory of any other path on the list. If the new path violates this
    # restriction an error wil be raised.
    #
    # If the path is already present as is no error will be raised and no
    # action will be taken.

    variable paths

    # We use a copy of the path as source during validation, and extend it as







|

|








|







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
#	args -	The paths to add/remove. Must not appear querying the
#		path with 'list'.
#
# Results
#	No result for subcommands 'add' and 'remove'. A list of paths for
#	'list'.
#
# Side effects
#	The subcommands 'add' and 'remove' manipulate the list of paths to
#	search for Tcl Modules. The subcommand 'list' has no side effects.

proc ::tcl::tm::add {args} {
    # PART OF THE ::tcl::tm::path ENSEMBLE
    #
    # The path is added at the head to the list of module paths.
    #
    # The command enforces the restriction that no path may be an ancestor
    # directory of any other path on the list. If the new path violates this
    # restriction an error will be raised.
    #
    # If the path is already present as is no error will be raised and no
    # action will be taken.

    variable paths

    # We use a copy of the path as source during validation, and extend it as
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
#	Unknown handler for Tcl Modules, i.e. packages in module form.
#
# Arguments
#	original	- Original [package unknown] procedure.
#	name		- Name of desired package.
#	version		- Version of desired package. Can be the
#			  empty string.
#	exact		- Either -exact or ommitted.
#
#	Name, version, and exact are used to determine satisfaction. The
#	original is called iff no satisfaction was achieved. The name is also
#	used to compute the directory to target in the search.
#
# Results
#	None.
#
# Sideeffects
#	May populate the package ifneeded database with additional provide
#	scripts.

proc ::tcl::tm::UnknownHandler {original name args} {
    # Import the list of paths to search for packages in module form.
    # Import the pattern used to check package names in detail.








|








|







162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
#	Unknown handler for Tcl Modules, i.e. packages in module form.
#
# Arguments
#	original	- Original [package unknown] procedure.
#	name		- Name of desired package.
#	version		- Version of desired package. Can be the
#			  empty string.
#	exact		- Either -exact or omitted.
#
#	Name, version, and exact are used to determine satisfaction. The
#	original is called iff no satisfaction was achieved. The name is also
#	used to compute the directory to target in the search.
#
# Results
#	None.
#
# Side effects
#	May populate the package ifneeded database with additional provide
#	scripts.

proc ::tcl::tm::UnknownHandler {original name args} {
    # Import the list of paths to search for packages in module form.
    # Import the pattern used to check package names in detail.

306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
#
# Arguments
#	None
#
# Results
#	None.
#
# Sideeffects
#	May add paths to the list of defaults.

proc ::tcl::tm::Defaults {} {
    global env tcl_platform

    regexp {^(\d+)\.(\d+)} [package provide tcl] - major minor
    set exe [file normalize [info nameofexecutable]]







|







306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
#
# Arguments
#	None
#
# Results
#	None.
#
# Side effects
#	May add paths to the list of defaults.

proc ::tcl::tm::Defaults {} {
    global env tcl_platform

    regexp {^(\d+)\.(\d+)} [package provide tcl] - major minor
    set exe [file normalize [info nameofexecutable]]
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
#
# Arguments
#	paths -	List of 'root' paths to derive search paths from.
#
# Results
#	No result.
#
# Sideeffects
#	Calls 'path add' to paths to the list of module search paths.

proc ::tcl::tm::roots {paths} {
    regexp {^(\d+)\.(\d+)} [package provide tcl] - major minor
    foreach pa $paths {
	set p [file join $pa tcl$major]
	for {set n $minor} {$n >= 0} {incr n -1} {







|







354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
#
# Arguments
#	paths -	List of 'root' paths to derive search paths from.
#
# Results
#	No result.
#
# Side effects
#	Calls 'path add' to paths to the list of module search paths.

proc ::tcl::tm::roots {paths} {
    regexp {^(\d+)\.(\d+)} [package provide tcl] - major minor
    foreach pa $paths {
	set p [file join $pa tcl$major]
	for {set n $minor} {$n >= 0} {incr n -1} {

Changes to library/tzdata/Africa/Cairo.

125
126
127
128
129
130
131


























































































































































132
    {1281474000 7200 0 EET}
    {1284069600 10800 1 EEST}
    {1285880400 7200 0 EET}
    {1400191200 10800 1 EEST}
    {1403816400 7200 0 EET}
    {1406844000 10800 1 EEST}
    {1411678800 7200 0 EET}


























































































































































}







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

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
    {1281474000 7200 0 EET}
    {1284069600 10800 1 EEST}
    {1285880400 7200 0 EET}
    {1400191200 10800 1 EEST}
    {1403816400 7200 0 EET}
    {1406844000 10800 1 EEST}
    {1411678800 7200 0 EET}
    {1682632800 10800 1 EEST}
    {1698354000 7200 0 EET}
    {1714082400 10800 1 EEST}
    {1730408400 7200 0 EET}
    {1745532000 10800 1 EEST}
    {1761858000 7200 0 EET}
    {1776981600 10800 1 EEST}
    {1793307600 7200 0 EET}
    {1809036000 10800 1 EEST}
    {1824757200 7200 0 EET}
    {1840485600 10800 1 EEST}
    {1856206800 7200 0 EET}
    {1871935200 10800 1 EEST}
    {1887656400 7200 0 EET}
    {1903384800 10800 1 EEST}
    {1919710800 7200 0 EET}
    {1934834400 10800 1 EEST}
    {1951160400 7200 0 EET}
    {1966888800 10800 1 EEST}
    {1982610000 7200 0 EET}
    {1998338400 10800 1 EEST}
    {2014059600 7200 0 EET}
    {2029788000 10800 1 EEST}
    {2045509200 7200 0 EET}
    {2061237600 10800 1 EEST}
    {2076958800 7200 0 EET}
    {2092687200 10800 1 EEST}
    {2109013200 7200 0 EET}
    {2124136800 10800 1 EEST}
    {2140462800 7200 0 EET}
    {2156191200 10800 1 EEST}
    {2171912400 7200 0 EET}
    {2187640800 10800 1 EEST}
    {2203362000 7200 0 EET}
    {2219090400 10800 1 EEST}
    {2234811600 7200 0 EET}
    {2250540000 10800 1 EEST}
    {2266866000 7200 0 EET}
    {2281989600 10800 1 EEST}
    {2298315600 7200 0 EET}
    {2313439200 10800 1 EEST}
    {2329765200 7200 0 EET}
    {2345493600 10800 1 EEST}
    {2361214800 7200 0 EET}
    {2376943200 10800 1 EEST}
    {2392664400 7200 0 EET}
    {2408392800 10800 1 EEST}
    {2424114000 7200 0 EET}
    {2439842400 10800 1 EEST}
    {2456168400 7200 0 EET}
    {2471292000 10800 1 EEST}
    {2487618000 7200 0 EET}
    {2503346400 10800 1 EEST}
    {2519067600 7200 0 EET}
    {2534796000 10800 1 EEST}
    {2550517200 7200 0 EET}
    {2566245600 10800 1 EEST}
    {2581966800 7200 0 EET}
    {2597695200 10800 1 EEST}
    {2614021200 7200 0 EET}
    {2629144800 10800 1 EEST}
    {2645470800 7200 0 EET}
    {2660594400 10800 1 EEST}
    {2676920400 7200 0 EET}
    {2692648800 10800 1 EEST}
    {2708370000 7200 0 EET}
    {2724098400 10800 1 EEST}
    {2739819600 7200 0 EET}
    {2755548000 10800 1 EEST}
    {2771269200 7200 0 EET}
    {2786997600 10800 1 EEST}
    {2803323600 7200 0 EET}
    {2818447200 10800 1 EEST}
    {2834773200 7200 0 EET}
    {2850501600 10800 1 EEST}
    {2866222800 7200 0 EET}
    {2881951200 10800 1 EEST}
    {2897672400 7200 0 EET}
    {2913400800 10800 1 EEST}
    {2929122000 7200 0 EET}
    {2944850400 10800 1 EEST}
    {2960571600 7200 0 EET}
    {2976300000 10800 1 EEST}
    {2992626000 7200 0 EET}
    {3007749600 10800 1 EEST}
    {3024075600 7200 0 EET}
    {3039804000 10800 1 EEST}
    {3055525200 7200 0 EET}
    {3071253600 10800 1 EEST}
    {3086974800 7200 0 EET}
    {3102703200 10800 1 EEST}
    {3118424400 7200 0 EET}
    {3134152800 10800 1 EEST}
    {3150478800 7200 0 EET}
    {3165602400 10800 1 EEST}
    {3181928400 7200 0 EET}
    {3197052000 10800 1 EEST}
    {3213378000 7200 0 EET}
    {3229106400 10800 1 EEST}
    {3244827600 7200 0 EET}
    {3260556000 10800 1 EEST}
    {3276277200 7200 0 EET}
    {3292005600 10800 1 EEST}
    {3307726800 7200 0 EET}
    {3323455200 10800 1 EEST}
    {3339781200 7200 0 EET}
    {3354904800 10800 1 EEST}
    {3371230800 7200 0 EET}
    {3386959200 10800 1 EEST}
    {3402680400 7200 0 EET}
    {3418408800 10800 1 EEST}
    {3434130000 7200 0 EET}
    {3449858400 10800 1 EEST}
    {3465579600 7200 0 EET}
    {3481308000 10800 1 EEST}
    {3497634000 7200 0 EET}
    {3512757600 10800 1 EEST}
    {3529083600 7200 0 EET}
    {3544207200 10800 1 EEST}
    {3560533200 7200 0 EET}
    {3576261600 10800 1 EEST}
    {3591982800 7200 0 EET}
    {3607711200 10800 1 EEST}
    {3623432400 7200 0 EET}
    {3639160800 10800 1 EEST}
    {3654882000 7200 0 EET}
    {3670610400 10800 1 EEST}
    {3686936400 7200 0 EET}
    {3702060000 10800 1 EEST}
    {3718386000 7200 0 EET}
    {3734114400 10800 1 EEST}
    {3749835600 7200 0 EET}
    {3765564000 10800 1 EEST}
    {3781285200 7200 0 EET}
    {3797013600 10800 1 EEST}
    {3812734800 7200 0 EET}
    {3828463200 10800 1 EEST}
    {3844184400 7200 0 EET}
    {3859912800 10800 1 EEST}
    {3876238800 7200 0 EET}
    {3891362400 10800 1 EEST}
    {3907688400 7200 0 EET}
    {3923416800 10800 1 EEST}
    {3939138000 7200 0 EET}
    {3954866400 10800 1 EEST}
    {3970587600 7200 0 EET}
    {3986316000 10800 1 EEST}
    {4002037200 7200 0 EET}
    {4017765600 10800 1 EEST}
    {4034091600 7200 0 EET}
    {4049215200 10800 1 EEST}
    {4065541200 7200 0 EET}
    {4080664800 10800 1 EEST}
    {4096990800 7200 0 EET}
}

Changes to library/tzdata/Africa/Casablanca.

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
    {1587261600 0 1 +01}
    {1590890400 3600 0 +01}
    {1618106400 0 1 +01}
    {1621130400 3600 0 +01}
    {1648346400 0 1 +01}
    {1651975200 3600 0 +01}
    {1679191200 0 1 +01}
    {1682820000 3600 0 +01}
    {1710036000 0 1 +01}
    {1713060000 3600 0 +01}
    {1740276000 0 1 +01}
    {1743904800 3600 0 +01}
    {1771120800 0 1 +01}
    {1774144800 3600 0 +01}
    {1801965600 0 1 +01}
    {1804989600 3600 0 +01}
    {1832205600 0 1 +01}
    {1835834400 3600 0 +01}
    {1863050400 0 1 +01}
    {1866074400 3600 0 +01}
    {1893290400 0 1 +01}
    {1896919200 3600 0 +01}
    {1924135200 0 1 +01}
    {1927764000 3600 0 +01}
    {1954980000 0 1 +01}
    {1958004000 3600 0 +01}
    {1985220000 0 1 +01}
    {1988848800 3600 0 +01}
    {2016064800 0 1 +01}
    {2019088800 3600 0 +01}
    {2046304800 0 1 +01}
    {2049933600 3600 0 +01}
    {2077149600 0 1 +01}
    {2080778400 3600 0 +01}
    {2107994400 0 1 +01}
    {2111018400 3600 0 +01}
    {2138234400 0 1 +01}
    {2141863200 3600 0 +01}
    {2169079200 0 1 +01}
    {2172708000 3600 0 +01}
    {2199924000 0 1 +01}
    {2202948000 3600 0 +01}
    {2230164000 0 1 +01}
    {2233792800 3600 0 +01}
    {2261008800 0 1 +01}
    {2264032800 3600 0 +01}
    {2291248800 0 1 +01}
    {2294877600 3600 0 +01}
    {2322093600 0 1 +01}
    {2325722400 3600 0 +01}
    {2352938400 0 1 +01}
    {2355962400 3600 0 +01}
    {2383178400 0 1 +01}
    {2386807200 3600 0 +01}
    {2414023200 0 1 +01}
    {2417652000 3600 0 +01}
    {2444868000 0 1 +01}
    {2447892000 3600 0 +01}
    {2475108000 0 1 +01}
    {2478736800 3600 0 +01}
    {2505952800 0 1 +01}
    {2508976800 3600 0 +01}
    {2536192800 0 1 +01}
    {2539821600 3600 0 +01}
    {2567037600 0 1 +01}
    {2570666400 3600 0 +01}
    {2597882400 0 1 +01}
    {2600906400 3600 0 +01}
    {2628122400 0 1 +01}
    {2631751200 3600 0 +01}
    {2658967200 0 1 +01}
    {2662596000 3600 0 +01}
    {2689812000 0 1 +01}
    {2692836000 3600 0 +01}
    {2720052000 0 1 +01}
    {2723680800 3600 0 +01}
    {2750896800 0 1 +01}
    {2753920800 3600 0 +01}
    {2781136800 0 1 +01}
    {2784765600 3600 0 +01}
    {2811981600 0 1 +01}
    {2815610400 3600 0 +01}
    {2842826400 0 1 +01}
    {2845850400 3600 0 +01}
    {2873066400 0 1 +01}
    {2876695200 3600 0 +01}
    {2903911200 0 1 +01}
    {2907540000 3600 0 +01}
    {2934756000 0 1 +01}
    {2937780000 3600 0 +01}
    {2964996000 0 1 +01}
    {2968624800 3600 0 +01}
    {2995840800 0 1 +01}
    {2998864800 3600 0 +01}
    {3026080800 0 1 +01}
    {3029709600 3600 0 +01}
    {3056925600 0 1 +01}
    {3060554400 3600 0 +01}
    {3087770400 0 1 +01}
    {3090794400 3600 0 +01}
    {3118010400 0 1 +01}
    {3121639200 3600 0 +01}
    {3148855200 0 1 +01}
    {3152484000 3600 0 +01}
    {3179700000 0 1 +01}
    {3182724000 3600 0 +01}
    {3209940000 0 1 +01}
    {3213568800 3600 0 +01}
    {3240784800 0 1 +01}
    {3243808800 3600 0 +01}
    {3271024800 0 1 +01}
    {3274653600 3600 0 +01}
    {3301869600 0 1 +01}
    {3305498400 3600 0 +01}
    {3332714400 0 1 +01}
    {3335738400 3600 0 +01}
    {3362954400 0 1 +01}
    {3366583200 3600 0 +01}
    {3393799200 0 1 +01}
    {3397428000 3600 0 +01}
    {3424644000 0 1 +01}
    {3427668000 3600 0 +01}
    {3454884000 0 1 +01}
    {3458512800 3600 0 +01}
    {3485728800 0 1 +01}
    {3488752800 3600 0 +01}
    {3515968800 0 1 +01}
    {3519597600 3600 0 +01}
    {3546813600 0 1 +01}
    {3550442400 3600 0 +01}
    {3577658400 0 1 +01}
    {3580682400 3600 0 +01}
    {3607898400 0 1 +01}
    {3611527200 3600 0 +01}
    {3638743200 0 1 +01}
    {3642372000 3600 0 +01}
    {3669588000 0 1 +01}
    {3672612000 3600 0 +01}
    {3699828000 0 1 +01}
    {3703456800 3600 0 +01}
}







|















|















|















|















|















|















|















|









|





|





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
    {1587261600 0 1 +01}
    {1590890400 3600 0 +01}
    {1618106400 0 1 +01}
    {1621130400 3600 0 +01}
    {1648346400 0 1 +01}
    {1651975200 3600 0 +01}
    {1679191200 0 1 +01}
    {1682215200 3600 0 +01}
    {1710036000 0 1 +01}
    {1713060000 3600 0 +01}
    {1740276000 0 1 +01}
    {1743904800 3600 0 +01}
    {1771120800 0 1 +01}
    {1774144800 3600 0 +01}
    {1801965600 0 1 +01}
    {1804989600 3600 0 +01}
    {1832205600 0 1 +01}
    {1835834400 3600 0 +01}
    {1863050400 0 1 +01}
    {1866074400 3600 0 +01}
    {1893290400 0 1 +01}
    {1896919200 3600 0 +01}
    {1924135200 0 1 +01}
    {1927159200 3600 0 +01}
    {1954980000 0 1 +01}
    {1958004000 3600 0 +01}
    {1985220000 0 1 +01}
    {1988848800 3600 0 +01}
    {2016064800 0 1 +01}
    {2019088800 3600 0 +01}
    {2046304800 0 1 +01}
    {2049933600 3600 0 +01}
    {2077149600 0 1 +01}
    {2080778400 3600 0 +01}
    {2107994400 0 1 +01}
    {2111018400 3600 0 +01}
    {2138234400 0 1 +01}
    {2141863200 3600 0 +01}
    {2169079200 0 1 +01}
    {2172103200 3600 0 +01}
    {2199924000 0 1 +01}
    {2202948000 3600 0 +01}
    {2230164000 0 1 +01}
    {2233792800 3600 0 +01}
    {2261008800 0 1 +01}
    {2264032800 3600 0 +01}
    {2291248800 0 1 +01}
    {2294877600 3600 0 +01}
    {2322093600 0 1 +01}
    {2325722400 3600 0 +01}
    {2352938400 0 1 +01}
    {2355962400 3600 0 +01}
    {2383178400 0 1 +01}
    {2386807200 3600 0 +01}
    {2414023200 0 1 +01}
    {2417047200 3600 0 +01}
    {2444868000 0 1 +01}
    {2447892000 3600 0 +01}
    {2475108000 0 1 +01}
    {2478736800 3600 0 +01}
    {2505952800 0 1 +01}
    {2508976800 3600 0 +01}
    {2536192800 0 1 +01}
    {2539821600 3600 0 +01}
    {2567037600 0 1 +01}
    {2570666400 3600 0 +01}
    {2597882400 0 1 +01}
    {2600906400 3600 0 +01}
    {2628122400 0 1 +01}
    {2631751200 3600 0 +01}
    {2658967200 0 1 +01}
    {2661991200 3600 0 +01}
    {2689812000 0 1 +01}
    {2692836000 3600 0 +01}
    {2720052000 0 1 +01}
    {2723680800 3600 0 +01}
    {2750896800 0 1 +01}
    {2753920800 3600 0 +01}
    {2781136800 0 1 +01}
    {2784765600 3600 0 +01}
    {2811981600 0 1 +01}
    {2815610400 3600 0 +01}
    {2842826400 0 1 +01}
    {2845850400 3600 0 +01}
    {2873066400 0 1 +01}
    {2876695200 3600 0 +01}
    {2903911200 0 1 +01}
    {2906935200 3600 0 +01}
    {2934756000 0 1 +01}
    {2937780000 3600 0 +01}
    {2964996000 0 1 +01}
    {2968624800 3600 0 +01}
    {2995840800 0 1 +01}
    {2998864800 3600 0 +01}
    {3026080800 0 1 +01}
    {3029709600 3600 0 +01}
    {3056925600 0 1 +01}
    {3060554400 3600 0 +01}
    {3087770400 0 1 +01}
    {3090794400 3600 0 +01}
    {3118010400 0 1 +01}
    {3121639200 3600 0 +01}
    {3148855200 0 1 +01}
    {3151879200 3600 0 +01}
    {3179700000 0 1 +01}
    {3182724000 3600 0 +01}
    {3209940000 0 1 +01}
    {3213568800 3600 0 +01}
    {3240784800 0 1 +01}
    {3243808800 3600 0 +01}
    {3271024800 0 1 +01}
    {3274653600 3600 0 +01}
    {3301869600 0 1 +01}
    {3305498400 3600 0 +01}
    {3332714400 0 1 +01}
    {3335738400 3600 0 +01}
    {3362954400 0 1 +01}
    {3366583200 3600 0 +01}
    {3393799200 0 1 +01}
    {3396823200 3600 0 +01}
    {3424644000 0 1 +01}
    {3427668000 3600 0 +01}
    {3454884000 0 1 +01}
    {3458512800 3600 0 +01}
    {3485728800 0 1 +01}
    {3488752800 3600 0 +01}
    {3515968800 0 1 +01}
    {3519597600 3600 0 +01}
    {3546813600 0 1 +01}
    {3549837600 3600 0 +01}
    {3577658400 0 1 +01}
    {3580682400 3600 0 +01}
    {3607898400 0 1 +01}
    {3611527200 3600 0 +01}
    {3638743200 0 1 +01}
    {3641767200 3600 0 +01}
    {3669588000 0 1 +01}
    {3672612000 3600 0 +01}
    {3699828000 0 1 +01}
    {3703456800 3600 0 +01}
}

Changes to library/tzdata/Africa/El_Aaiun.

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
    {1587261600 0 1 +01}
    {1590890400 3600 0 +01}
    {1618106400 0 1 +01}
    {1621130400 3600 0 +01}
    {1648346400 0 1 +01}
    {1651975200 3600 0 +01}
    {1679191200 0 1 +01}
    {1682820000 3600 0 +01}
    {1710036000 0 1 +01}
    {1713060000 3600 0 +01}
    {1740276000 0 1 +01}
    {1743904800 3600 0 +01}
    {1771120800 0 1 +01}
    {1774144800 3600 0 +01}
    {1801965600 0 1 +01}
    {1804989600 3600 0 +01}
    {1832205600 0 1 +01}
    {1835834400 3600 0 +01}
    {1863050400 0 1 +01}
    {1866074400 3600 0 +01}
    {1893290400 0 1 +01}
    {1896919200 3600 0 +01}
    {1924135200 0 1 +01}
    {1927764000 3600 0 +01}
    {1954980000 0 1 +01}
    {1958004000 3600 0 +01}
    {1985220000 0 1 +01}
    {1988848800 3600 0 +01}
    {2016064800 0 1 +01}
    {2019088800 3600 0 +01}
    {2046304800 0 1 +01}
    {2049933600 3600 0 +01}
    {2077149600 0 1 +01}
    {2080778400 3600 0 +01}
    {2107994400 0 1 +01}
    {2111018400 3600 0 +01}
    {2138234400 0 1 +01}
    {2141863200 3600 0 +01}
    {2169079200 0 1 +01}
    {2172708000 3600 0 +01}
    {2199924000 0 1 +01}
    {2202948000 3600 0 +01}
    {2230164000 0 1 +01}
    {2233792800 3600 0 +01}
    {2261008800 0 1 +01}
    {2264032800 3600 0 +01}
    {2291248800 0 1 +01}
    {2294877600 3600 0 +01}
    {2322093600 0 1 +01}
    {2325722400 3600 0 +01}
    {2352938400 0 1 +01}
    {2355962400 3600 0 +01}
    {2383178400 0 1 +01}
    {2386807200 3600 0 +01}
    {2414023200 0 1 +01}
    {2417652000 3600 0 +01}
    {2444868000 0 1 +01}
    {2447892000 3600 0 +01}
    {2475108000 0 1 +01}
    {2478736800 3600 0 +01}
    {2505952800 0 1 +01}
    {2508976800 3600 0 +01}
    {2536192800 0 1 +01}
    {2539821600 3600 0 +01}
    {2567037600 0 1 +01}
    {2570666400 3600 0 +01}
    {2597882400 0 1 +01}
    {2600906400 3600 0 +01}
    {2628122400 0 1 +01}
    {2631751200 3600 0 +01}
    {2658967200 0 1 +01}
    {2662596000 3600 0 +01}
    {2689812000 0 1 +01}
    {2692836000 3600 0 +01}
    {2720052000 0 1 +01}
    {2723680800 3600 0 +01}
    {2750896800 0 1 +01}
    {2753920800 3600 0 +01}
    {2781136800 0 1 +01}
    {2784765600 3600 0 +01}
    {2811981600 0 1 +01}
    {2815610400 3600 0 +01}
    {2842826400 0 1 +01}
    {2845850400 3600 0 +01}
    {2873066400 0 1 +01}
    {2876695200 3600 0 +01}
    {2903911200 0 1 +01}
    {2907540000 3600 0 +01}
    {2934756000 0 1 +01}
    {2937780000 3600 0 +01}
    {2964996000 0 1 +01}
    {2968624800 3600 0 +01}
    {2995840800 0 1 +01}
    {2998864800 3600 0 +01}
    {3026080800 0 1 +01}
    {3029709600 3600 0 +01}
    {3056925600 0 1 +01}
    {3060554400 3600 0 +01}
    {3087770400 0 1 +01}
    {3090794400 3600 0 +01}
    {3118010400 0 1 +01}
    {3121639200 3600 0 +01}
    {3148855200 0 1 +01}
    {3152484000 3600 0 +01}
    {3179700000 0 1 +01}
    {3182724000 3600 0 +01}
    {3209940000 0 1 +01}
    {3213568800 3600 0 +01}
    {3240784800 0 1 +01}
    {3243808800 3600 0 +01}
    {3271024800 0 1 +01}
    {3274653600 3600 0 +01}
    {3301869600 0 1 +01}
    {3305498400 3600 0 +01}
    {3332714400 0 1 +01}
    {3335738400 3600 0 +01}
    {3362954400 0 1 +01}
    {3366583200 3600 0 +01}
    {3393799200 0 1 +01}
    {3397428000 3600 0 +01}
    {3424644000 0 1 +01}
    {3427668000 3600 0 +01}
    {3454884000 0 1 +01}
    {3458512800 3600 0 +01}
    {3485728800 0 1 +01}
    {3488752800 3600 0 +01}
    {3515968800 0 1 +01}
    {3519597600 3600 0 +01}
    {3546813600 0 1 +01}
    {3550442400 3600 0 +01}
    {3577658400 0 1 +01}
    {3580682400 3600 0 +01}
    {3607898400 0 1 +01}
    {3611527200 3600 0 +01}
    {3638743200 0 1 +01}
    {3642372000 3600 0 +01}
    {3669588000 0 1 +01}
    {3672612000 3600 0 +01}
    {3699828000 0 1 +01}
    {3703456800 3600 0 +01}
}







|















|















|















|















|















|















|















|









|





|





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
    {1587261600 0 1 +01}
    {1590890400 3600 0 +01}
    {1618106400 0 1 +01}
    {1621130400 3600 0 +01}
    {1648346400 0 1 +01}
    {1651975200 3600 0 +01}
    {1679191200 0 1 +01}
    {1682215200 3600 0 +01}
    {1710036000 0 1 +01}
    {1713060000 3600 0 +01}
    {1740276000 0 1 +01}
    {1743904800 3600 0 +01}
    {1771120800 0 1 +01}
    {1774144800 3600 0 +01}
    {1801965600 0 1 +01}
    {1804989600 3600 0 +01}
    {1832205600 0 1 +01}
    {1835834400 3600 0 +01}
    {1863050400 0 1 +01}
    {1866074400 3600 0 +01}
    {1893290400 0 1 +01}
    {1896919200 3600 0 +01}
    {1924135200 0 1 +01}
    {1927159200 3600 0 +01}
    {1954980000 0 1 +01}
    {1958004000 3600 0 +01}
    {1985220000 0 1 +01}
    {1988848800 3600 0 +01}
    {2016064800 0 1 +01}
    {2019088800 3600 0 +01}
    {2046304800 0 1 +01}
    {2049933600 3600 0 +01}
    {2077149600 0 1 +01}
    {2080778400 3600 0 +01}
    {2107994400 0 1 +01}
    {2111018400 3600 0 +01}
    {2138234400 0 1 +01}
    {2141863200 3600 0 +01}
    {2169079200 0 1 +01}
    {2172103200 3600 0 +01}
    {2199924000 0 1 +01}
    {2202948000 3600 0 +01}
    {2230164000 0 1 +01}
    {2233792800 3600 0 +01}
    {2261008800 0 1 +01}
    {2264032800 3600 0 +01}
    {2291248800 0 1 +01}
    {2294877600 3600 0 +01}
    {2322093600 0 1 +01}
    {2325722400 3600 0 +01}
    {2352938400 0 1 +01}
    {2355962400 3600 0 +01}
    {2383178400 0 1 +01}
    {2386807200 3600 0 +01}
    {2414023200 0 1 +01}
    {2417047200 3600 0 +01}
    {2444868000 0 1 +01}
    {2447892000 3600 0 +01}
    {2475108000 0 1 +01}
    {2478736800 3600 0 +01}
    {2505952800 0 1 +01}
    {2508976800 3600 0 +01}
    {2536192800 0 1 +01}
    {2539821600 3600 0 +01}
    {2567037600 0 1 +01}
    {2570666400 3600 0 +01}
    {2597882400 0 1 +01}
    {2600906400 3600 0 +01}
    {2628122400 0 1 +01}
    {2631751200 3600 0 +01}
    {2658967200 0 1 +01}
    {2661991200 3600 0 +01}
    {2689812000 0 1 +01}
    {2692836000 3600 0 +01}
    {2720052000 0 1 +01}
    {2723680800 3600 0 +01}
    {2750896800 0 1 +01}
    {2753920800 3600 0 +01}
    {2781136800 0 1 +01}
    {2784765600 3600 0 +01}
    {2811981600 0 1 +01}
    {2815610400 3600 0 +01}
    {2842826400 0 1 +01}
    {2845850400 3600 0 +01}
    {2873066400 0 1 +01}
    {2876695200 3600 0 +01}
    {2903911200 0 1 +01}
    {2906935200 3600 0 +01}
    {2934756000 0 1 +01}
    {2937780000 3600 0 +01}
    {2964996000 0 1 +01}
    {2968624800 3600 0 +01}
    {2995840800 0 1 +01}
    {2998864800 3600 0 +01}
    {3026080800 0 1 +01}
    {3029709600 3600 0 +01}
    {3056925600 0 1 +01}
    {3060554400 3600 0 +01}
    {3087770400 0 1 +01}
    {3090794400 3600 0 +01}
    {3118010400 0 1 +01}
    {3121639200 3600 0 +01}
    {3148855200 0 1 +01}
    {3151879200 3600 0 +01}
    {3179700000 0 1 +01}
    {3182724000 3600 0 +01}
    {3209940000 0 1 +01}
    {3213568800 3600 0 +01}
    {3240784800 0 1 +01}
    {3243808800 3600 0 +01}
    {3271024800 0 1 +01}
    {3274653600 3600 0 +01}
    {3301869600 0 1 +01}
    {3305498400 3600 0 +01}
    {3332714400 0 1 +01}
    {3335738400 3600 0 +01}
    {3362954400 0 1 +01}
    {3366583200 3600 0 +01}
    {3393799200 0 1 +01}
    {3396823200 3600 0 +01}
    {3424644000 0 1 +01}
    {3427668000 3600 0 +01}
    {3454884000 0 1 +01}
    {3458512800 3600 0 +01}
    {3485728800 0 1 +01}
    {3488752800 3600 0 +01}
    {3515968800 0 1 +01}
    {3519597600 3600 0 +01}
    {3546813600 0 1 +01}
    {3549837600 3600 0 +01}
    {3577658400 0 1 +01}
    {3580682400 3600 0 +01}
    {3607898400 0 1 +01}
    {3611527200 3600 0 +01}
    {3638743200 0 1 +01}
    {3641767200 3600 0 +01}
    {3669588000 0 1 +01}
    {3672612000 3600 0 +01}
    {3699828000 0 1 +01}
    {3703456800 3600 0 +01}
}

Changes to library/tzdata/America/Bogota.

1
2
3
4
5
6
7
8
9
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Bogota) {
    {-9223372036854775808 -17776 0 LMT}
    {-2707671824 -17776 0 BMT}
    {-1739041424 -18000 0 -05}
    {704869200 -14400 1 -05}
    {733896000 -18000 0 -05}
}







|

1
2
3
4
5
6
7
8
9
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Bogota) {
    {-9223372036854775808 -17776 0 LMT}
    {-2707671824 -17776 0 BMT}
    {-1739041424 -18000 0 -05}
    {704869200 -14400 1 -05}
    {729057600 -18000 0 -05}
}

Changes to library/tzdata/America/Cambridge_Bay.

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/Cambridge_Bay) {
    {-9223372036854775808 0 0 -00}
    {-1577923200 -25200 0 MST}
    {-880210800 -21600 1 MWT}
    {-769395600 -21600 1 MPT}
    {-765388800 -25200 0 MST}




    {-147891600 -18000 1 MDDT}








    {-131562000 -25200 0 MST}


    {325674000 -21600 1 MDT}
    {341395200 -25200 0 MST}
    {357123600 -21600 1 MDT}
    {372844800 -25200 0 MST}
    {388573200 -21600 1 MDT}
    {404899200 -25200 0 MST}
    {420022800 -21600 1 MDT}








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







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Cambridge_Bay) {
    {-9223372036854775808 0 0 -00}
    {-1577923200 -25200 0 MST}
    {-880210800 -21600 1 MWT}
    {-769395600 -21600 1 MPT}
    {-765388800 -25200 0 MST}
    {73472400 -21600 1 MDT}
    {89193600 -25200 0 MST}
    {104922000 -21600 1 MDT}
    {120643200 -25200 0 MST}
    {136371600 -21600 1 MDT}
    {152092800 -25200 0 MST}
    {167821200 -21600 1 MDT}
    {183542400 -25200 0 MST}
    {199270800 -21600 1 MDT}
    {215596800 -25200 0 MST}
    {230720400 -21600 1 MDT}
    {247046400 -25200 0 MST}
    {262774800 -21600 1 MDT}
    {278496000 -25200 0 MST}
    {294224400 -21600 1 MDT}
    {309945600 -25200 0 MST}
    {325674000 -21600 1 MDT}
    {341395200 -25200 0 MST}
    {357123600 -21600 1 MDT}
    {372844800 -25200 0 MST}
    {388573200 -21600 1 MDT}
    {404899200 -25200 0 MST}
    {420022800 -21600 1 MDT}

Added library/tzdata/America/Ciudad_Juarez.































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Ciudad_Juarez) {
    {-9223372036854775808 -25556 0 LMT}
    {-1514739600 -25200 0 MST}
    {-1343066400 -21600 0 CST}
    {-1234807200 -25200 0 MST}
    {-1220292000 -21600 1 MDT}
    {-1207159200 -25200 0 MST}
    {-1191344400 -21600 0 CST}
    {820476000 -21600 0 CST}
    {828864000 -18000 1 CDT}
    {846399600 -21600 0 CST}
    {860313600 -18000 1 CDT}
    {877849200 -21600 0 CST}
    {883634400 -21600 0 CST}
    {891766800 -21600 0 MDT}
    {909302400 -25200 0 MST}
    {923216400 -21600 1 MDT}
    {941356800 -25200 0 MST}
    {954666000 -21600 1 MDT}
    {972806400 -25200 0 MST}
    {989139600 -21600 1 MDT}
    {1001836800 -25200 0 MST}
    {1018170000 -21600 1 MDT}
    {1035705600 -25200 0 MST}
    {1049619600 -21600 1 MDT}
    {1067155200 -25200 0 MST}
    {1081069200 -21600 1 MDT}
    {1099209600 -25200 0 MST}
    {1112518800 -21600 1 MDT}
    {1130659200 -25200 0 MST}
    {1143968400 -21600 1 MDT}
    {1162108800 -25200 0 MST}
    {1175418000 -21600 1 MDT}
    {1193558400 -25200 0 MST}
    {1207472400 -21600 1 MDT}
    {1225008000 -25200 0 MST}
    {1238922000 -21600 1 MDT}
    {1256457600 -25200 0 MST}
    {1262329200 -25200 0 MST}
    {1268557200 -21600 1 MDT}
    {1289116800 -25200 0 MST}
    {1300006800 -21600 1 MDT}
    {1320566400 -25200 0 MST}
    {1331456400 -21600 1 MDT}
    {1352016000 -25200 0 MST}
    {1362906000 -21600 1 MDT}
    {1383465600 -25200 0 MST}
    {1394355600 -21600 1 MDT}
    {1414915200 -25200 0 MST}
    {1425805200 -21600 1 MDT}
    {1446364800 -25200 0 MST}
    {1457859600 -21600 1 MDT}
    {1478419200 -25200 0 MST}
    {1489309200 -21600 1 MDT}
    {1509868800 -25200 0 MST}
    {1520758800 -21600 1 MDT}
    {1541318400 -25200 0 MST}
    {1552208400 -21600 1 MDT}
    {1572768000 -25200 0 MST}
    {1583658000 -21600 1 MDT}
    {1604217600 -25200 0 MST}
    {1615712400 -21600 1 MDT}
    {1636272000 -25200 0 MST}
    {1647162000 -21600 1 MDT}
    {1667120400 -21600 0 CST}
    {1669788000 -25200 0 MST}
    {1678611600 -21600 1 MDT}
    {1699171200 -25200 0 MST}
    {1710061200 -21600 1 MDT}
    {1730620800 -25200 0 MST}
    {1741510800 -21600 1 MDT}
    {1762070400 -25200 0 MST}
    {1772960400 -21600 1 MDT}
    {1793520000 -25200 0 MST}
    {1805014800 -21600 1 MDT}
    {1825574400 -25200 0 MST}
    {1836464400 -21600 1 MDT}
    {1857024000 -25200 0 MST}
    {1867914000 -21600 1 MDT}
    {1888473600 -25200 0 MST}
    {1899363600 -21600 1 MDT}
    {1919923200 -25200 0 MST}
    {1930813200 -21600 1 MDT}
    {1951372800 -25200 0 MST}
    {1962867600 -21600 1 MDT}
    {1983427200 -25200 0 MST}
    {1994317200 -21600 1 MDT}
    {2014876800 -25200 0 MST}
    {2025766800 -21600 1 MDT}
    {2046326400 -25200 0 MST}
    {2057216400 -21600 1 MDT}
    {2077776000 -25200 0 MST}
    {2088666000 -21600 1 MDT}
    {2109225600 -25200 0 MST}
    {2120115600 -21600 1 MDT}
    {2140675200 -25200 0 MST}
    {2152170000 -21600 1 MDT}
    {2172729600 -25200 0 MST}
    {2183619600 -21600 1 MDT}
    {2204179200 -25200 0 MST}
    {2215069200 -21600 1 MDT}
    {2235628800 -25200 0 MST}
    {2246518800 -21600 1 MDT}
    {2267078400 -25200 0 MST}
    {2277968400 -21600 1 MDT}
    {2298528000 -25200 0 MST}
    {2309418000 -21600 1 MDT}
    {2329977600 -25200 0 MST}
    {2341472400 -21600 1 MDT}
    {2362032000 -25200 0 MST}
    {2372922000 -21600 1 MDT}
    {2393481600 -25200 0 MST}
    {2404371600 -21600 1 MDT}
    {2424931200 -25200 0 MST}
    {2435821200 -21600 1 MDT}
    {2456380800 -25200 0 MST}
    {2467270800 -21600 1 MDT}
    {2487830400 -25200 0 MST}
    {2499325200 -21600 1 MDT}
    {2519884800 -25200 0 MST}
    {2530774800 -21600 1 MDT}
    {2551334400 -25200 0 MST}
    {2562224400 -21600 1 MDT}
    {2582784000 -25200 0 MST}
    {2593674000 -21600 1 MDT}
    {2614233600 -25200 0 MST}
    {2625123600 -21600 1 MDT}
    {2645683200 -25200 0 MST}
    {2656573200 -21600 1 MDT}
    {2677132800 -25200 0 MST}
    {2688627600 -21600 1 MDT}
    {2709187200 -25200 0 MST}
    {2720077200 -21600 1 MDT}
    {2740636800 -25200 0 MST}
    {2751526800 -21600 1 MDT}
    {2772086400 -25200 0 MST}
    {2782976400 -21600 1 MDT}
    {2803536000 -25200 0 MST}
    {2814426000 -21600 1 MDT}
    {2834985600 -25200 0 MST}
    {2846480400 -21600 1 MDT}
    {2867040000 -25200 0 MST}
    {2877930000 -21600 1 MDT}
    {2898489600 -25200 0 MST}
    {2909379600 -21600 1 MDT}
    {2929939200 -25200 0 MST}
    {2940829200 -21600 1 MDT}
    {2961388800 -25200 0 MST}
    {2972278800 -21600 1 MDT}
    {2992838400 -25200 0 MST}
    {3003728400 -21600 1 MDT}
    {3024288000 -25200 0 MST}
    {3035782800 -21600 1 MDT}
    {3056342400 -25200 0 MST}
    {3067232400 -21600 1 MDT}
    {3087792000 -25200 0 MST}
    {3098682000 -21600 1 MDT}
    {3119241600 -25200 0 MST}
    {3130131600 -21600 1 MDT}
    {3150691200 -25200 0 MST}
    {3161581200 -21600 1 MDT}
    {3182140800 -25200 0 MST}
    {3193030800 -21600 1 MDT}
    {3213590400 -25200 0 MST}
    {3225085200 -21600 1 MDT}
    {3245644800 -25200 0 MST}
    {3256534800 -21600 1 MDT}
    {3277094400 -25200 0 MST}
    {3287984400 -21600 1 MDT}
    {3308544000 -25200 0 MST}
    {3319434000 -21600 1 MDT}
    {3339993600 -25200 0 MST}
    {3350883600 -21600 1 MDT}
    {3371443200 -25200 0 MST}
    {3382938000 -21600 1 MDT}
    {3403497600 -25200 0 MST}
    {3414387600 -21600 1 MDT}
    {3434947200 -25200 0 MST}
    {3445837200 -21600 1 MDT}
    {3466396800 -25200 0 MST}
    {3477286800 -21600 1 MDT}
    {3497846400 -25200 0 MST}
    {3508736400 -21600 1 MDT}
    {3529296000 -25200 0 MST}
    {3540186000 -21600 1 MDT}
    {3560745600 -25200 0 MST}
    {3572240400 -21600 1 MDT}
    {3592800000 -25200 0 MST}
    {3603690000 -21600 1 MDT}
    {3624249600 -25200 0 MST}
    {3635139600 -21600 1 MDT}
    {3655699200 -25200 0 MST}
    {3666589200 -21600 1 MDT}
    {3687148800 -25200 0 MST}
    {3698038800 -21600 1 MDT}
    {3718598400 -25200 0 MST}
    {3730093200 -21600 1 MDT}
    {3750652800 -25200 0 MST}
    {3761542800 -21600 1 MDT}
    {3782102400 -25200 0 MST}
    {3792992400 -21600 1 MDT}
    {3813552000 -25200 0 MST}
    {3824442000 -21600 1 MDT}
    {3845001600 -25200 0 MST}
    {3855891600 -21600 1 MDT}
    {3876451200 -25200 0 MST}
    {3887341200 -21600 1 MDT}
    {3907900800 -25200 0 MST}
    {3919395600 -21600 1 MDT}
    {3939955200 -25200 0 MST}
    {3950845200 -21600 1 MDT}
    {3971404800 -25200 0 MST}
    {3982294800 -21600 1 MDT}
    {4002854400 -25200 0 MST}
    {4013744400 -21600 1 MDT}
    {4034304000 -25200 0 MST}
    {4045194000 -21600 1 MDT}
    {4065753600 -25200 0 MST}
    {4076643600 -21600 1 MDT}
    {4097203200 -25200 0 MST}
}

Changes to library/tzdata/America/Dawson.

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(:America/Dawson) {
    {-9223372036854775808 -33460 0 LMT}
    {-2188996940 -32400 0 YST}
    {-1632056400 -28800 1 YDT}
    {-1615125600 -32400 0 YST}
    {-1596978000 -28800 1 YDT}
    {-1583164800 -32400 0 YST}
    {-880203600 -28800 1 YWT}
    {-769395600 -28800 1 YPT}
    {-765381600 -32400 0 YST}

    {-147884400 -25200 1 YDDT}
    {-131554800 -32400 0 YST}

    {315561600 -28800 0 PST}
    {325677600 -25200 1 PDT}
    {341398800 -28800 0 PST}
    {357127200 -25200 1 PDT}
    {372848400 -28800 0 PST}
    {388576800 -25200 1 PDT}
    {404902800 -28800 0 PST}












>


>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Dawson) {
    {-9223372036854775808 -33460 0 LMT}
    {-2188996940 -32400 0 YST}
    {-1632056400 -28800 1 YDT}
    {-1615125600 -32400 0 YST}
    {-1596978000 -28800 1 YDT}
    {-1583164800 -32400 0 YST}
    {-880203600 -28800 1 YWT}
    {-769395600 -28800 1 YPT}
    {-765381600 -32400 0 YST}
    {-157734000 -32400 0 YST}
    {-147884400 -25200 1 YDDT}
    {-131554800 -32400 0 YST}
    {120646800 -28800 0 PST}
    {315561600 -28800 0 PST}
    {325677600 -25200 1 PDT}
    {341398800 -28800 0 PST}
    {357127200 -25200 1 PDT}
    {372848400 -28800 0 PST}
    {388576800 -25200 1 PDT}
    {404902800 -28800 0 PST}

Changes to library/tzdata/America/Inuvik.

1
2
3
4
5
6




7










8
9
10
11
12
13
14
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Inuvik) {
    {-9223372036854775808 0 0 -00}
    {-536457600 -28800 0 PST}
    {-147888000 -21600 1 PDDT}




    {-131558400 -28800 0 PST}










    {315558000 -25200 0 MST}
    {325674000 -21600 1 MDT}
    {341395200 -25200 0 MST}
    {357123600 -21600 1 MDT}
    {372844800 -25200 0 MST}
    {388573200 -21600 1 MDT}
    {404899200 -25200 0 MST}





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







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Inuvik) {
    {-9223372036854775808 0 0 -00}
    {-536457600 -28800 0 PST}
    {73476000 -25200 1 PDT}
    {89197200 -28800 0 PST}
    {104925600 -25200 1 PDT}
    {120646800 -28800 0 PST}
    {136375200 -25200 1 PDT}
    {152096400 -28800 0 PST}
    {167824800 -25200 1 PDT}
    {183546000 -28800 0 PST}
    {199274400 -25200 1 PDT}
    {215600400 -28800 0 PST}
    {230724000 -25200 1 PDT}
    {247050000 -28800 0 PST}
    {262778400 -25200 1 PDT}
    {278499600 -28800 0 PST}
    {294228000 -21600 0 MDT}
    {309945600 -25200 0 MST}
    {315558000 -25200 0 MST}
    {325674000 -21600 1 MDT}
    {341395200 -25200 0 MST}
    {357123600 -21600 1 MDT}
    {372844800 -25200 0 MST}
    {388573200 -21600 1 MDT}
    {404899200 -25200 0 MST}

Changes to library/tzdata/America/Iqaluit.

1
2
3
4
5
6
7


8








9




10
11
12
13
14
15
16
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Iqaluit) {
    {-9223372036854775808 0 0 -00}
    {-865296000 -14400 0 EWT}
    {-769395600 -14400 1 EPT}
    {-765396000 -18000 0 EST}


    {-147898800 -10800 1 EDDT}








    {-131569200 -18000 0 EST}




    {325666800 -14400 1 EDT}
    {341388000 -18000 0 EST}
    {357116400 -14400 1 EDT}
    {372837600 -18000 0 EST}
    {388566000 -14400 1 EDT}
    {404892000 -18000 0 EST}
    {420015600 -14400 1 EDT}







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







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Iqaluit) {
    {-9223372036854775808 0 0 -00}
    {-865296000 -14400 0 EWT}
    {-769395600 -14400 1 EPT}
    {-765396000 -18000 0 EST}
    {73465200 -14400 1 EDT}
    {89186400 -18000 0 EST}
    {104914800 -14400 1 EDT}
    {120636000 -18000 0 EST}
    {136364400 -14400 1 EDT}
    {152085600 -18000 0 EST}
    {167814000 -14400 1 EDT}
    {183535200 -18000 0 EST}
    {199263600 -14400 1 EDT}
    {215589600 -18000 0 EST}
    {230713200 -14400 1 EDT}
    {247039200 -18000 0 EST}
    {262767600 -14400 1 EDT}
    {278488800 -18000 0 EST}
    {294217200 -14400 1 EDT}
    {309938400 -18000 0 EST}
    {325666800 -14400 1 EDT}
    {341388000 -18000 0 EST}
    {357116400 -14400 1 EDT}
    {372837600 -18000 0 EST}
    {388566000 -14400 1 EDT}
    {404892000 -18000 0 EST}
    {420015600 -14400 1 EDT}

Changes to library/tzdata/America/Nuuk.

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
    {1585443600 -7200 1 -02}
    {1603587600 -10800 0 -03}
    {1616893200 -7200 1 -02}
    {1635642000 -10800 0 -03}
    {1648342800 -7200 1 -02}
    {1667091600 -10800 0 -03}
    {1679792400 -7200 1 -02}
    {1698541200 -10800 0 -03}
    {1711846800 -7200 1 -02}
    {1729990800 -10800 0 -03}
    {1743296400 -7200 1 -02}
    {1761440400 -10800 0 -03}
    {1774746000 -7200 1 -02}
    {1792890000 -10800 0 -03}
    {1806195600 -7200 1 -02}
    {1824944400 -10800 0 -03}
    {1837645200 -7200 1 -02}
    {1856394000 -10800 0 -03}
    {1869094800 -7200 1 -02}
    {1887843600 -10800 0 -03}
    {1901149200 -7200 1 -02}
    {1919293200 -10800 0 -03}
    {1932598800 -7200 1 -02}
    {1950742800 -10800 0 -03}
    {1964048400 -7200 1 -02}
    {1982797200 -10800 0 -03}
    {1995498000 -7200 1 -02}
    {2014246800 -10800 0 -03}
    {2026947600 -7200 1 -02}
    {2045696400 -10800 0 -03}
    {2058397200 -7200 1 -02}
    {2077146000 -10800 0 -03}
    {2090451600 -7200 1 -02}
    {2108595600 -10800 0 -03}
    {2121901200 -7200 1 -02}
    {2140045200 -10800 0 -03}
    {2153350800 -7200 1 -02}
    {2172099600 -10800 0 -03}
    {2184800400 -7200 1 -02}
    {2203549200 -10800 0 -03}
    {2216250000 -7200 1 -02}
    {2234998800 -10800 0 -03}
    {2248304400 -7200 1 -02}
    {2266448400 -10800 0 -03}
    {2279754000 -7200 1 -02}
    {2297898000 -10800 0 -03}
    {2311203600 -7200 1 -02}
    {2329347600 -10800 0 -03}
    {2342653200 -7200 1 -02}
    {2361402000 -10800 0 -03}
    {2374102800 -7200 1 -02}
    {2392851600 -10800 0 -03}
    {2405552400 -7200 1 -02}
    {2424301200 -10800 0 -03}
    {2437606800 -7200 1 -02}
    {2455750800 -10800 0 -03}
    {2469056400 -7200 1 -02}
    {2487200400 -10800 0 -03}
    {2500506000 -7200 1 -02}
    {2519254800 -10800 0 -03}
    {2531955600 -7200 1 -02}
    {2550704400 -10800 0 -03}
    {2563405200 -7200 1 -02}
    {2582154000 -10800 0 -03}
    {2595459600 -7200 1 -02}
    {2613603600 -10800 0 -03}
    {2626909200 -7200 1 -02}
    {2645053200 -10800 0 -03}
    {2658358800 -7200 1 -02}
    {2676502800 -10800 0 -03}
    {2689808400 -7200 1 -02}
    {2708557200 -10800 0 -03}
    {2721258000 -7200 1 -02}
    {2740006800 -10800 0 -03}
    {2752707600 -7200 1 -02}
    {2771456400 -10800 0 -03}
    {2784762000 -7200 1 -02}
    {2802906000 -10800 0 -03}
    {2816211600 -7200 1 -02}
    {2834355600 -10800 0 -03}
    {2847661200 -7200 1 -02}
    {2866410000 -10800 0 -03}
    {2879110800 -7200 1 -02}
    {2897859600 -10800 0 -03}
    {2910560400 -7200 1 -02}
    {2929309200 -10800 0 -03}
    {2942010000 -7200 1 -02}
    {2960758800 -10800 0 -03}
    {2974064400 -7200 1 -02}
    {2992208400 -10800 0 -03}
    {3005514000 -7200 1 -02}
    {3023658000 -10800 0 -03}
    {3036963600 -7200 1 -02}
    {3055712400 -10800 0 -03}
    {3068413200 -7200 1 -02}
    {3087162000 -10800 0 -03}
    {3099862800 -7200 1 -02}
    {3118611600 -10800 0 -03}
    {3131917200 -7200 1 -02}
    {3150061200 -10800 0 -03}
    {3163366800 -7200 1 -02}
    {3181510800 -10800 0 -03}
    {3194816400 -7200 1 -02}
    {3212960400 -10800 0 -03}
    {3226266000 -7200 1 -02}
    {3245014800 -10800 0 -03}
    {3257715600 -7200 1 -02}
    {3276464400 -10800 0 -03}
    {3289165200 -7200 1 -02}
    {3307914000 -10800 0 -03}
    {3321219600 -7200 1 -02}
    {3339363600 -10800 0 -03}
    {3352669200 -7200 1 -02}
    {3370813200 -10800 0 -03}
    {3384118800 -7200 1 -02}
    {3402867600 -10800 0 -03}
    {3415568400 -7200 1 -02}
    {3434317200 -10800 0 -03}
    {3447018000 -7200 1 -02}
    {3465766800 -10800 0 -03}
    {3479072400 -7200 1 -02}
    {3497216400 -10800 0 -03}
    {3510522000 -7200 1 -02}
    {3528666000 -10800 0 -03}
    {3541971600 -7200 1 -02}
    {3560115600 -10800 0 -03}
    {3573421200 -7200 1 -02}
    {3592170000 -10800 0 -03}
    {3604870800 -7200 1 -02}
    {3623619600 -10800 0 -03}
    {3636320400 -7200 1 -02}
    {3655069200 -10800 0 -03}
    {3668374800 -7200 1 -02}
    {3686518800 -10800 0 -03}
    {3699824400 -7200 1 -02}
    {3717968400 -10800 0 -03}
    {3731274000 -7200 1 -02}
    {3750022800 -10800 0 -03}
    {3762723600 -7200 1 -02}
    {3781472400 -10800 0 -03}
    {3794173200 -7200 1 -02}
    {3812922000 -10800 0 -03}
    {3825622800 -7200 1 -02}
    {3844371600 -10800 0 -03}
    {3857677200 -7200 1 -02}
    {3875821200 -10800 0 -03}
    {3889126800 -7200 1 -02}
    {3907270800 -10800 0 -03}
    {3920576400 -7200 1 -02}
    {3939325200 -10800 0 -03}
    {3952026000 -7200 1 -02}
    {3970774800 -10800 0 -03}
    {3983475600 -7200 1 -02}
    {4002224400 -10800 0 -03}
    {4015530000 -7200 1 -02}
    {4033674000 -10800 0 -03}
    {4046979600 -7200 1 -02}
    {4065123600 -10800 0 -03}
    {4078429200 -7200 1 -02}
    {4096573200 -10800 0 -03}
}







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

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
    {1585443600 -7200 1 -02}
    {1603587600 -10800 0 -03}
    {1616893200 -7200 1 -02}
    {1635642000 -10800 0 -03}
    {1648342800 -7200 1 -02}
    {1667091600 -10800 0 -03}
    {1679792400 -7200 1 -02}
    {1698541200 -7200 0 -02}
    {1711846800 -3600 1 -01}
    {1729990800 -7200 0 -02}
    {1743296400 -3600 1 -01}
    {1761440400 -7200 0 -02}
    {1774746000 -3600 1 -01}
    {1792890000 -7200 0 -02}
    {1806195600 -3600 1 -01}
    {1824944400 -7200 0 -02}
    {1837645200 -3600 1 -01}
    {1856394000 -7200 0 -02}
    {1869094800 -3600 1 -01}
    {1887843600 -7200 0 -02}
    {1901149200 -3600 1 -01}
    {1919293200 -7200 0 -02}
    {1932598800 -3600 1 -01}
    {1950742800 -7200 0 -02}
    {1964048400 -3600 1 -01}
    {1982797200 -7200 0 -02}
    {1995498000 -3600 1 -01}
    {2014246800 -7200 0 -02}
    {2026947600 -3600 1 -01}
    {2045696400 -7200 0 -02}
    {2058397200 -3600 1 -01}
    {2077146000 -7200 0 -02}
    {2090451600 -3600 1 -01}
    {2108595600 -7200 0 -02}
    {2121901200 -3600 1 -01}
    {2140045200 -7200 0 -02}
    {2153350800 -3600 1 -01}
    {2172099600 -7200 0 -02}
    {2184800400 -3600 1 -01}
    {2203549200 -7200 0 -02}
    {2216250000 -3600 1 -01}
    {2234998800 -7200 0 -02}
    {2248304400 -3600 1 -01}
    {2266448400 -7200 0 -02}
    {2279754000 -3600 1 -01}
    {2297898000 -7200 0 -02}
    {2311203600 -3600 1 -01}
    {2329347600 -7200 0 -02}
    {2342653200 -3600 1 -01}
    {2361402000 -7200 0 -02}
    {2374102800 -3600 1 -01}
    {2392851600 -7200 0 -02}
    {2405552400 -3600 1 -01}
    {2424301200 -7200 0 -02}
    {2437606800 -3600 1 -01}
    {2455750800 -7200 0 -02}
    {2469056400 -3600 1 -01}
    {2487200400 -7200 0 -02}
    {2500506000 -3600 1 -01}
    {2519254800 -7200 0 -02}
    {2531955600 -3600 1 -01}
    {2550704400 -7200 0 -02}
    {2563405200 -3600 1 -01}
    {2582154000 -7200 0 -02}
    {2595459600 -3600 1 -01}
    {2613603600 -7200 0 -02}
    {2626909200 -3600 1 -01}
    {2645053200 -7200 0 -02}
    {2658358800 -3600 1 -01}
    {2676502800 -7200 0 -02}
    {2689808400 -3600 1 -01}
    {2708557200 -7200 0 -02}
    {2721258000 -3600 1 -01}
    {2740006800 -7200 0 -02}
    {2752707600 -3600 1 -01}
    {2771456400 -7200 0 -02}
    {2784762000 -3600 1 -01}
    {2802906000 -7200 0 -02}
    {2816211600 -3600 1 -01}
    {2834355600 -7200 0 -02}
    {2847661200 -3600 1 -01}
    {2866410000 -7200 0 -02}
    {2879110800 -3600 1 -01}
    {2897859600 -7200 0 -02}
    {2910560400 -3600 1 -01}
    {2929309200 -7200 0 -02}
    {2942010000 -3600 1 -01}
    {2960758800 -7200 0 -02}
    {2974064400 -3600 1 -01}
    {2992208400 -7200 0 -02}
    {3005514000 -3600 1 -01}
    {3023658000 -7200 0 -02}
    {3036963600 -3600 1 -01}
    {3055712400 -7200 0 -02}
    {3068413200 -3600 1 -01}
    {3087162000 -7200 0 -02}
    {3099862800 -3600 1 -01}
    {3118611600 -7200 0 -02}
    {3131917200 -3600 1 -01}
    {3150061200 -7200 0 -02}
    {3163366800 -3600 1 -01}
    {3181510800 -7200 0 -02}
    {3194816400 -3600 1 -01}
    {3212960400 -7200 0 -02}
    {3226266000 -3600 1 -01}
    {3245014800 -7200 0 -02}
    {3257715600 -3600 1 -01}
    {3276464400 -7200 0 -02}
    {3289165200 -3600 1 -01}
    {3307914000 -7200 0 -02}
    {3321219600 -3600 1 -01}
    {3339363600 -7200 0 -02}
    {3352669200 -3600 1 -01}
    {3370813200 -7200 0 -02}
    {3384118800 -3600 1 -01}
    {3402867600 -7200 0 -02}
    {3415568400 -3600 1 -01}
    {3434317200 -7200 0 -02}
    {3447018000 -3600 1 -01}
    {3465766800 -7200 0 -02}
    {3479072400 -3600 1 -01}
    {3497216400 -7200 0 -02}
    {3510522000 -3600 1 -01}
    {3528666000 -7200 0 -02}
    {3541971600 -3600 1 -01}
    {3560115600 -7200 0 -02}
    {3573421200 -3600 1 -01}
    {3592170000 -7200 0 -02}
    {3604870800 -3600 1 -01}
    {3623619600 -7200 0 -02}
    {3636320400 -3600 1 -01}
    {3655069200 -7200 0 -02}
    {3668374800 -3600 1 -01}
    {3686518800 -7200 0 -02}
    {3699824400 -3600 1 -01}
    {3717968400 -7200 0 -02}
    {3731274000 -3600 1 -01}
    {3750022800 -7200 0 -02}
    {3762723600 -3600 1 -01}
    {3781472400 -7200 0 -02}
    {3794173200 -3600 1 -01}
    {3812922000 -7200 0 -02}
    {3825622800 -3600 1 -01}
    {3844371600 -7200 0 -02}
    {3857677200 -3600 1 -01}
    {3875821200 -7200 0 -02}
    {3889126800 -3600 1 -01}
    {3907270800 -7200 0 -02}
    {3920576400 -3600 1 -01}
    {3939325200 -7200 0 -02}
    {3952026000 -3600 1 -01}
    {3970774800 -7200 0 -02}
    {3983475600 -3600 1 -01}
    {4002224400 -7200 0 -02}
    {4015530000 -3600 1 -01}
    {4033674000 -7200 0 -02}
    {4046979600 -3600 1 -01}
    {4065123600 -7200 0 -02}
    {4078429200 -3600 1 -01}
    {4096573200 -7200 0 -02}
}

Changes to library/tzdata/America/Ojinaga.

61
62
63
64
65
66
67



























































































































































68
    {1572768000 -25200 0 MST}
    {1583658000 -21600 1 MDT}
    {1604217600 -25200 0 MST}
    {1615712400 -21600 1 MDT}
    {1636272000 -25200 0 MST}
    {1647162000 -21600 1 MDT}
    {1667120400 -21600 0 CST}



























































































































































}







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

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
    {1572768000 -25200 0 MST}
    {1583658000 -21600 1 MDT}
    {1604217600 -25200 0 MST}
    {1615712400 -21600 1 MDT}
    {1636272000 -25200 0 MST}
    {1647162000 -21600 1 MDT}
    {1667120400 -21600 0 CST}
    {1669788000 -21600 0 CST}
    {1678608000 -18000 1 CDT}
    {1699167600 -21600 0 CST}
    {1710057600 -18000 1 CDT}
    {1730617200 -21600 0 CST}
    {1741507200 -18000 1 CDT}
    {1762066800 -21600 0 CST}
    {1772956800 -18000 1 CDT}
    {1793516400 -21600 0 CST}
    {1805011200 -18000 1 CDT}
    {1825570800 -21600 0 CST}
    {1836460800 -18000 1 CDT}
    {1857020400 -21600 0 CST}
    {1867910400 -18000 1 CDT}
    {1888470000 -21600 0 CST}
    {1899360000 -18000 1 CDT}
    {1919919600 -21600 0 CST}
    {1930809600 -18000 1 CDT}
    {1951369200 -21600 0 CST}
    {1962864000 -18000 1 CDT}
    {1983423600 -21600 0 CST}
    {1994313600 -18000 1 CDT}
    {2014873200 -21600 0 CST}
    {2025763200 -18000 1 CDT}
    {2046322800 -21600 0 CST}
    {2057212800 -18000 1 CDT}
    {2077772400 -21600 0 CST}
    {2088662400 -18000 1 CDT}
    {2109222000 -21600 0 CST}
    {2120112000 -18000 1 CDT}
    {2140671600 -21600 0 CST}
    {2152166400 -18000 1 CDT}
    {2172726000 -21600 0 CST}
    {2183616000 -18000 1 CDT}
    {2204175600 -21600 0 CST}
    {2215065600 -18000 1 CDT}
    {2235625200 -21600 0 CST}
    {2246515200 -18000 1 CDT}
    {2267074800 -21600 0 CST}
    {2277964800 -18000 1 CDT}
    {2298524400 -21600 0 CST}
    {2309414400 -18000 1 CDT}
    {2329974000 -21600 0 CST}
    {2341468800 -18000 1 CDT}
    {2362028400 -21600 0 CST}
    {2372918400 -18000 1 CDT}
    {2393478000 -21600 0 CST}
    {2404368000 -18000 1 CDT}
    {2424927600 -21600 0 CST}
    {2435817600 -18000 1 CDT}
    {2456377200 -21600 0 CST}
    {2467267200 -18000 1 CDT}
    {2487826800 -21600 0 CST}
    {2499321600 -18000 1 CDT}
    {2519881200 -21600 0 CST}
    {2530771200 -18000 1 CDT}
    {2551330800 -21600 0 CST}
    {2562220800 -18000 1 CDT}
    {2582780400 -21600 0 CST}
    {2593670400 -18000 1 CDT}
    {2614230000 -21600 0 CST}
    {2625120000 -18000 1 CDT}
    {2645679600 -21600 0 CST}
    {2656569600 -18000 1 CDT}
    {2677129200 -21600 0 CST}
    {2688624000 -18000 1 CDT}
    {2709183600 -21600 0 CST}
    {2720073600 -18000 1 CDT}
    {2740633200 -21600 0 CST}
    {2751523200 -18000 1 CDT}
    {2772082800 -21600 0 CST}
    {2782972800 -18000 1 CDT}
    {2803532400 -21600 0 CST}
    {2814422400 -18000 1 CDT}
    {2834982000 -21600 0 CST}
    {2846476800 -18000 1 CDT}
    {2867036400 -21600 0 CST}
    {2877926400 -18000 1 CDT}
    {2898486000 -21600 0 CST}
    {2909376000 -18000 1 CDT}
    {2929935600 -21600 0 CST}
    {2940825600 -18000 1 CDT}
    {2961385200 -21600 0 CST}
    {2972275200 -18000 1 CDT}
    {2992834800 -21600 0 CST}
    {3003724800 -18000 1 CDT}
    {3024284400 -21600 0 CST}
    {3035779200 -18000 1 CDT}
    {3056338800 -21600 0 CST}
    {3067228800 -18000 1 CDT}
    {3087788400 -21600 0 CST}
    {3098678400 -18000 1 CDT}
    {3119238000 -21600 0 CST}
    {3130128000 -18000 1 CDT}
    {3150687600 -21600 0 CST}
    {3161577600 -18000 1 CDT}
    {3182137200 -21600 0 CST}
    {3193027200 -18000 1 CDT}
    {3213586800 -21600 0 CST}
    {3225081600 -18000 1 CDT}
    {3245641200 -21600 0 CST}
    {3256531200 -18000 1 CDT}
    {3277090800 -21600 0 CST}
    {3287980800 -18000 1 CDT}
    {3308540400 -21600 0 CST}
    {3319430400 -18000 1 CDT}
    {3339990000 -21600 0 CST}
    {3350880000 -18000 1 CDT}
    {3371439600 -21600 0 CST}
    {3382934400 -18000 1 CDT}
    {3403494000 -21600 0 CST}
    {3414384000 -18000 1 CDT}
    {3434943600 -21600 0 CST}
    {3445833600 -18000 1 CDT}
    {3466393200 -21600 0 CST}
    {3477283200 -18000 1 CDT}
    {3497842800 -21600 0 CST}
    {3508732800 -18000 1 CDT}
    {3529292400 -21600 0 CST}
    {3540182400 -18000 1 CDT}
    {3560742000 -21600 0 CST}
    {3572236800 -18000 1 CDT}
    {3592796400 -21600 0 CST}
    {3603686400 -18000 1 CDT}
    {3624246000 -21600 0 CST}
    {3635136000 -18000 1 CDT}
    {3655695600 -21600 0 CST}
    {3666585600 -18000 1 CDT}
    {3687145200 -21600 0 CST}
    {3698035200 -18000 1 CDT}
    {3718594800 -21600 0 CST}
    {3730089600 -18000 1 CDT}
    {3750649200 -21600 0 CST}
    {3761539200 -18000 1 CDT}
    {3782098800 -21600 0 CST}
    {3792988800 -18000 1 CDT}
    {3813548400 -21600 0 CST}
    {3824438400 -18000 1 CDT}
    {3844998000 -21600 0 CST}
    {3855888000 -18000 1 CDT}
    {3876447600 -21600 0 CST}
    {3887337600 -18000 1 CDT}
    {3907897200 -21600 0 CST}
    {3919392000 -18000 1 CDT}
    {3939951600 -21600 0 CST}
    {3950841600 -18000 1 CDT}
    {3971401200 -21600 0 CST}
    {3982291200 -18000 1 CDT}
    {4002850800 -21600 0 CST}
    {4013740800 -18000 1 CDT}
    {4034300400 -21600 0 CST}
    {4045190400 -18000 1 CDT}
    {4065750000 -21600 0 CST}
    {4076640000 -18000 1 CDT}
    {4097199600 -21600 0 CST}
}

Changes to library/tzdata/America/Pangnirtung.

1


2
3
4
5
6
7
8
9
10
11
12
13
14
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
# created by tools/tclZIC.tcl - do not edit



set TZData(:America/Pangnirtung) {
    {-9223372036854775808 0 0 -00}
    {-1546300800 -14400 0 AST}
    {-880221600 -10800 1 AWT}
    {-769395600 -10800 1 APT}
    {-765399600 -14400 0 AST}
    {-147902400 -7200 1 ADDT}
    {-131572800 -14400 0 AST}
    {325663200 -10800 1 ADT}
    {341384400 -14400 0 AST}
    {357112800 -10800 1 ADT}
    {372834000 -14400 0 AST}
    {388562400 -10800 1 ADT}
    {404888400 -14400 0 AST}
    {420012000 -10800 1 ADT}
    {436338000 -14400 0 AST}
    {452066400 -10800 1 ADT}
    {467787600 -14400 0 AST}
    {483516000 -10800 1 ADT}
    {499237200 -14400 0 AST}
    {514965600 -10800 1 ADT}
    {530686800 -14400 0 AST}
    {544600800 -10800 1 ADT}
    {562136400 -14400 0 AST}
    {576050400 -10800 1 ADT}
    {594190800 -14400 0 AST}
    {607500000 -10800 1 ADT}
    {625640400 -14400 0 AST}
    {638949600 -10800 1 ADT}
    {657090000 -14400 0 AST}
    {671004000 -10800 1 ADT}
    {688539600 -14400 0 AST}
    {702453600 -10800 1 ADT}
    {719989200 -14400 0 AST}
    {733903200 -10800 1 ADT}
    {752043600 -14400 0 AST}
    {765352800 -10800 1 ADT}
    {783493200 -14400 0 AST}
    {796802400 -18000 0 EST}
    {796806000 -14400 1 EDT}
    {814946400 -18000 0 EST}
    {828860400 -14400 1 EDT}
    {846396000 -18000 0 EST}
    {860310000 -14400 1 EDT}
    {877845600 -18000 0 EST}
    {891759600 -14400 1 EDT}
    {909295200 -18000 0 EST}
    {923209200 -14400 1 EDT}
    {941353200 -21600 0 CST}
    {954662400 -18000 1 CDT}
    {972806400 -18000 0 EST}
    {986108400 -14400 1 EDT}
    {1004248800 -18000 0 EST}
    {1018162800 -14400 1 EDT}
    {1035698400 -18000 0 EST}
    {1049612400 -14400 1 EDT}
    {1067148000 -18000 0 EST}
    {1081062000 -14400 1 EDT}
    {1099202400 -18000 0 EST}
    {1112511600 -14400 1 EDT}
    {1130652000 -18000 0 EST}
    {1143961200 -14400 1 EDT}
    {1162101600 -18000 0 EST}
    {1173596400 -14400 1 EDT}
    {1194156000 -18000 0 EST}
    {1205046000 -14400 1 EDT}
    {1225605600 -18000 0 EST}
    {1236495600 -14400 1 EDT}
    {1257055200 -18000 0 EST}
    {1268550000 -14400 1 EDT}
    {1289109600 -18000 0 EST}
    {1299999600 -14400 1 EDT}
    {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}
    {1446357600 -18000 0 EST}
    {1457852400 -14400 1 EDT}
    {1478412000 -18000 0 EST}
    {1489302000 -14400 1 EDT}
    {1509861600 -18000 0 EST}
    {1520751600 -14400 1 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}
    {1636264800 -18000 0 EST}
    {1647154800 -14400 1 EDT}
    {1667714400 -18000 0 EST}
    {1678604400 -14400 1 EDT}
    {1699164000 -18000 0 EST}
    {1710054000 -14400 1 EDT}
    {1730613600 -18000 0 EST}
    {1741503600 -14400 1 EDT}
    {1762063200 -18000 0 EST}
    {1772953200 -14400 1 EDT}
    {1793512800 -18000 0 EST}
    {1805007600 -14400 1 EDT}
    {1825567200 -18000 0 EST}
    {1836457200 -14400 1 EDT}
    {1857016800 -18000 0 EST}
    {1867906800 -14400 1 EDT}
    {1888466400 -18000 0 EST}
    {1899356400 -14400 1 EDT}
    {1919916000 -18000 0 EST}
    {1930806000 -14400 1 EDT}
    {1951365600 -18000 0 EST}
    {1962860400 -14400 1 EDT}
    {1983420000 -18000 0 EST}
    {1994310000 -14400 1 EDT}
    {2014869600 -18000 0 EST}
    {2025759600 -14400 1 EDT}
    {2046319200 -18000 0 EST}
    {2057209200 -14400 1 EDT}
    {2077768800 -18000 0 EST}
    {2088658800 -14400 1 EDT}
    {2109218400 -18000 0 EST}
    {2120108400 -14400 1 EDT}
    {2140668000 -18000 0 EST}
    {2152162800 -14400 1 EDT}
    {2172722400 -18000 0 EST}
    {2183612400 -14400 1 EDT}
    {2204172000 -18000 0 EST}
    {2215062000 -14400 1 EDT}
    {2235621600 -18000 0 EST}
    {2246511600 -14400 1 EDT}
    {2267071200 -18000 0 EST}
    {2277961200 -14400 1 EDT}
    {2298520800 -18000 0 EST}
    {2309410800 -14400 1 EDT}
    {2329970400 -18000 0 EST}
    {2341465200 -14400 1 EDT}
    {2362024800 -18000 0 EST}
    {2372914800 -14400 1 EDT}
    {2393474400 -18000 0 EST}
    {2404364400 -14400 1 EDT}
    {2424924000 -18000 0 EST}
    {2435814000 -14400 1 EDT}
    {2456373600 -18000 0 EST}
    {2467263600 -14400 1 EDT}
    {2487823200 -18000 0 EST}
    {2499318000 -14400 1 EDT}
    {2519877600 -18000 0 EST}
    {2530767600 -14400 1 EDT}
    {2551327200 -18000 0 EST}
    {2562217200 -14400 1 EDT}
    {2582776800 -18000 0 EST}
    {2593666800 -14400 1 EDT}
    {2614226400 -18000 0 EST}
    {2625116400 -14400 1 EDT}
    {2645676000 -18000 0 EST}
    {2656566000 -14400 1 EDT}
    {2677125600 -18000 0 EST}
    {2688620400 -14400 1 EDT}
    {2709180000 -18000 0 EST}
    {2720070000 -14400 1 EDT}
    {2740629600 -18000 0 EST}
    {2751519600 -14400 1 EDT}
    {2772079200 -18000 0 EST}
    {2782969200 -14400 1 EDT}
    {2803528800 -18000 0 EST}
    {2814418800 -14400 1 EDT}
    {2834978400 -18000 0 EST}
    {2846473200 -14400 1 EDT}
    {2867032800 -18000 0 EST}
    {2877922800 -14400 1 EDT}
    {2898482400 -18000 0 EST}
    {2909372400 -14400 1 EDT}
    {2929932000 -18000 0 EST}
    {2940822000 -14400 1 EDT}
    {2961381600 -18000 0 EST}
    {2972271600 -14400 1 EDT}
    {2992831200 -18000 0 EST}
    {3003721200 -14400 1 EDT}
    {3024280800 -18000 0 EST}
    {3035775600 -14400 1 EDT}
    {3056335200 -18000 0 EST}
    {3067225200 -14400 1 EDT}
    {3087784800 -18000 0 EST}
    {3098674800 -14400 1 EDT}
    {3119234400 -18000 0 EST}
    {3130124400 -14400 1 EDT}
    {3150684000 -18000 0 EST}
    {3161574000 -14400 1 EDT}
    {3182133600 -18000 0 EST}
    {3193023600 -14400 1 EDT}
    {3213583200 -18000 0 EST}
    {3225078000 -14400 1 EDT}
    {3245637600 -18000 0 EST}
    {3256527600 -14400 1 EDT}
    {3277087200 -18000 0 EST}
    {3287977200 -14400 1 EDT}
    {3308536800 -18000 0 EST}
    {3319426800 -14400 1 EDT}
    {3339986400 -18000 0 EST}
    {3350876400 -14400 1 EDT}
    {3371436000 -18000 0 EST}
    {3382930800 -14400 1 EDT}
    {3403490400 -18000 0 EST}
    {3414380400 -14400 1 EDT}
    {3434940000 -18000 0 EST}
    {3445830000 -14400 1 EDT}
    {3466389600 -18000 0 EST}
    {3477279600 -14400 1 EDT}
    {3497839200 -18000 0 EST}
    {3508729200 -14400 1 EDT}
    {3529288800 -18000 0 EST}
    {3540178800 -14400 1 EDT}
    {3560738400 -18000 0 EST}
    {3572233200 -14400 1 EDT}
    {3592792800 -18000 0 EST}
    {3603682800 -14400 1 EDT}
    {3624242400 -18000 0 EST}
    {3635132400 -14400 1 EDT}
    {3655692000 -18000 0 EST}
    {3666582000 -14400 1 EDT}
    {3687141600 -18000 0 EST}
    {3698031600 -14400 1 EDT}
    {3718591200 -18000 0 EST}
    {3730086000 -14400 1 EDT}
    {3750645600 -18000 0 EST}
    {3761535600 -14400 1 EDT}
    {3782095200 -18000 0 EST}
    {3792985200 -14400 1 EDT}
    {3813544800 -18000 0 EST}
    {3824434800 -14400 1 EDT}
    {3844994400 -18000 0 EST}
    {3855884400 -14400 1 EDT}
    {3876444000 -18000 0 EST}
    {3887334000 -14400 1 EDT}
    {3907893600 -18000 0 EST}
    {3919388400 -14400 1 EDT}
    {3939948000 -18000 0 EST}
    {3950838000 -14400 1 EDT}
    {3971397600 -18000 0 EST}
    {3982287600 -14400 1 EDT}
    {4002847200 -18000 0 EST}
    {4013737200 -14400 1 EDT}
    {4034296800 -18000 0 EST}
    {4045186800 -14400 1 EDT}
    {4065746400 -18000 0 EST}
    {4076636400 -14400 1 EDT}
    {4097196000 -18000 0 EST}
}

>
>
|
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
1
2
3
4
5

























































































































































































































































# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Iqaluit)]} {
    LoadTimeZoneFile America/Iqaluit
}
set TZData(:America/Pangnirtung) $TZData(:America/Iqaluit)

























































































































































































































































Changes to library/tzdata/America/Rankin_Inlet.

1
2
3
4
5
6


7












8
9
10
11
12
13
14
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Rankin_Inlet) {
    {-9223372036854775808 0 0 -00}
    {-410227200 -21600 0 CST}
    {-147895200 -14400 1 CDDT}


    {-131565600 -21600 0 CST}












    {325670400 -18000 1 CDT}
    {341391600 -21600 0 CST}
    {357120000 -18000 1 CDT}
    {372841200 -21600 0 CST}
    {388569600 -18000 1 CDT}
    {404895600 -21600 0 CST}
    {420019200 -18000 1 CDT}





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







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Rankin_Inlet) {
    {-9223372036854775808 0 0 -00}
    {-410227200 -21600 0 CST}
    {73468800 -18000 1 CDT}
    {89190000 -21600 0 CST}
    {104918400 -18000 1 CDT}
    {120639600 -21600 0 CST}
    {136368000 -18000 1 CDT}
    {152089200 -21600 0 CST}
    {167817600 -18000 1 CDT}
    {183538800 -21600 0 CST}
    {199267200 -18000 1 CDT}
    {215593200 -21600 0 CST}
    {230716800 -18000 1 CDT}
    {247042800 -21600 0 CST}
    {262771200 -18000 1 CDT}
    {278492400 -21600 0 CST}
    {294220800 -18000 1 CDT}
    {309942000 -21600 0 CST}
    {325670400 -18000 1 CDT}
    {341391600 -21600 0 CST}
    {357120000 -18000 1 CDT}
    {372841200 -21600 0 CST}
    {388569600 -18000 1 CDT}
    {404895600 -21600 0 CST}
    {420019200 -18000 1 CDT}

Changes to library/tzdata/America/Resolute.

1
2
3
4
5
6


7












8
9
10
11
12
13
14
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Resolute) {
    {-9223372036854775808 0 0 -00}
    {-704937600 -21600 0 CST}
    {-147895200 -14400 1 CDDT}


    {-131565600 -21600 0 CST}












    {325670400 -18000 1 CDT}
    {341391600 -21600 0 CST}
    {357120000 -18000 1 CDT}
    {372841200 -21600 0 CST}
    {388569600 -18000 1 CDT}
    {404895600 -21600 0 CST}
    {420019200 -18000 1 CDT}





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







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Resolute) {
    {-9223372036854775808 0 0 -00}
    {-704937600 -21600 0 CST}
    {73468800 -18000 1 CDT}
    {89190000 -21600 0 CST}
    {104918400 -18000 1 CDT}
    {120639600 -21600 0 CST}
    {136368000 -18000 1 CDT}
    {152089200 -21600 0 CST}
    {167817600 -18000 1 CDT}
    {183538800 -21600 0 CST}
    {199267200 -18000 1 CDT}
    {215593200 -21600 0 CST}
    {230716800 -18000 1 CDT}
    {247042800 -21600 0 CST}
    {262771200 -18000 1 CDT}
    {278492400 -21600 0 CST}
    {294220800 -18000 1 CDT}
    {309942000 -21600 0 CST}
    {325670400 -18000 1 CDT}
    {341391600 -21600 0 CST}
    {357120000 -18000 1 CDT}
    {372841200 -21600 0 CST}
    {388569600 -18000 1 CDT}
    {404895600 -21600 0 CST}
    {420019200 -18000 1 CDT}

Changes to library/tzdata/America/Whitehorse.

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(:America/Whitehorse) {
    {-9223372036854775808 -32412 0 LMT}
    {-2188997988 -32400 0 YST}
    {-1632056400 -28800 1 YDT}
    {-1615125600 -32400 0 YST}
    {-1596978000 -28800 1 YDT}
    {-1583164800 -32400 0 YST}
    {-880203600 -28800 1 YWT}
    {-769395600 -28800 1 YPT}
    {-765381600 -32400 0 YST}

    {-147884400 -25200 1 YDDT}
    {-131554800 -32400 0 YST}

    {315561600 -28800 0 PST}
    {325677600 -25200 1 PDT}
    {341398800 -28800 0 PST}
    {357127200 -25200 1 PDT}
    {372848400 -28800 0 PST}
    {388576800 -25200 1 PDT}
    {404902800 -28800 0 PST}












>


>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Whitehorse) {
    {-9223372036854775808 -32412 0 LMT}
    {-2188997988 -32400 0 YST}
    {-1632056400 -28800 1 YDT}
    {-1615125600 -32400 0 YST}
    {-1596978000 -28800 1 YDT}
    {-1583164800 -32400 0 YST}
    {-880203600 -28800 1 YWT}
    {-769395600 -28800 1 YPT}
    {-765381600 -32400 0 YST}
    {-157734000 -32400 0 YST}
    {-147884400 -25200 1 YDDT}
    {-131554800 -32400 0 YST}
    {-121273200 -28800 0 PST}
    {315561600 -28800 0 PST}
    {325677600 -25200 1 PDT}
    {341398800 -28800 0 PST}
    {357127200 -25200 1 PDT}
    {372848400 -28800 0 PST}
    {388576800 -25200 1 PDT}
    {404902800 -28800 0 PST}

Changes to library/tzdata/America/Yellowknife.

1


2
3
4
5
6
7
8
9
10
11
12
13
14
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
# created by tools/tclZIC.tcl - do not edit



set TZData(:America/Yellowknife) {
    {-9223372036854775808 0 0 -00}
    {-1104537600 -25200 0 MST}
    {-880210800 -21600 1 MWT}
    {-769395600 -21600 1 MPT}
    {-765388800 -25200 0 MST}
    {-147891600 -18000 1 MDDT}
    {-131562000 -25200 0 MST}
    {315558000 -25200 0 MST}
    {325674000 -21600 1 MDT}
    {341395200 -25200 0 MST}
    {357123600 -21600 1 MDT}
    {372844800 -25200 0 MST}
    {388573200 -21600 1 MDT}
    {404899200 -25200 0 MST}
    {420022800 -21600 1 MDT}
    {436348800 -25200 0 MST}
    {452077200 -21600 1 MDT}
    {467798400 -25200 0 MST}
    {483526800 -21600 1 MDT}
    {499248000 -25200 0 MST}
    {514976400 -21600 1 MDT}
    {530697600 -25200 0 MST}
    {544611600 -21600 1 MDT}
    {562147200 -25200 0 MST}
    {576061200 -21600 1 MDT}
    {594201600 -25200 0 MST}
    {607510800 -21600 1 MDT}
    {625651200 -25200 0 MST}
    {638960400 -21600 1 MDT}
    {657100800 -25200 0 MST}
    {671014800 -21600 1 MDT}
    {688550400 -25200 0 MST}
    {702464400 -21600 1 MDT}
    {720000000 -25200 0 MST}
    {733914000 -21600 1 MDT}
    {752054400 -25200 0 MST}
    {765363600 -21600 1 MDT}
    {783504000 -25200 0 MST}
    {796813200 -21600 1 MDT}
    {814953600 -25200 0 MST}
    {828867600 -21600 1 MDT}
    {846403200 -25200 0 MST}
    {860317200 -21600 1 MDT}
    {877852800 -25200 0 MST}
    {891766800 -21600 1 MDT}
    {909302400 -25200 0 MST}
    {923216400 -21600 1 MDT}
    {941356800 -25200 0 MST}
    {954666000 -21600 1 MDT}
    {972806400 -25200 0 MST}
    {986115600 -21600 1 MDT}
    {1004256000 -25200 0 MST}
    {1018170000 -21600 1 MDT}
    {1035705600 -25200 0 MST}
    {1049619600 -21600 1 MDT}
    {1067155200 -25200 0 MST}
    {1081069200 -21600 1 MDT}
    {1099209600 -25200 0 MST}
    {1112518800 -21600 1 MDT}
    {1130659200 -25200 0 MST}
    {1143968400 -21600 1 MDT}
    {1162108800 -25200 0 MST}
    {1173603600 -21600 1 MDT}
    {1194163200 -25200 0 MST}
    {1205053200 -21600 1 MDT}
    {1225612800 -25200 0 MST}
    {1236502800 -21600 1 MDT}
    {1257062400 -25200 0 MST}
    {1268557200 -21600 1 MDT}
    {1289116800 -25200 0 MST}
    {1300006800 -21600 1 MDT}
    {1320566400 -25200 0 MST}
    {1331456400 -21600 1 MDT}
    {1352016000 -25200 0 MST}
    {1362906000 -21600 1 MDT}
    {1383465600 -25200 0 MST}
    {1394355600 -21600 1 MDT}
    {1414915200 -25200 0 MST}
    {1425805200 -21600 1 MDT}
    {1446364800 -25200 0 MST}
    {1457859600 -21600 1 MDT}
    {1478419200 -25200 0 MST}
    {1489309200 -21600 1 MDT}
    {1509868800 -25200 0 MST}
    {1520758800 -21600 1 MDT}
    {1541318400 -25200 0 MST}
    {1552208400 -21600 1 MDT}
    {1572768000 -25200 0 MST}
    {1583658000 -21600 1 MDT}
    {1604217600 -25200 0 MST}
    {1615712400 -21600 1 MDT}
    {1636272000 -25200 0 MST}
    {1647162000 -21600 1 MDT}
    {1667721600 -25200 0 MST}
    {1678611600 -21600 1 MDT}
    {1699171200 -25200 0 MST}
    {1710061200 -21600 1 MDT}
    {1730620800 -25200 0 MST}
    {1741510800 -21600 1 MDT}
    {1762070400 -25200 0 MST}
    {1772960400 -21600 1 MDT}
    {1793520000 -25200 0 MST}
    {1805014800 -21600 1 MDT}
    {1825574400 -25200 0 MST}
    {1836464400 -21600 1 MDT}
    {1857024000 -25200 0 MST}
    {1867914000 -21600 1 MDT}
    {1888473600 -25200 0 MST}
    {1899363600 -21600 1 MDT}
    {1919923200 -25200 0 MST}
    {1930813200 -21600 1 MDT}
    {1951372800 -25200 0 MST}
    {1962867600 -21600 1 MDT}
    {1983427200 -25200 0 MST}
    {1994317200 -21600 1 MDT}
    {2014876800 -25200 0 MST}
    {2025766800 -21600 1 MDT}
    {2046326400 -25200 0 MST}
    {2057216400 -21600 1 MDT}
    {2077776000 -25200 0 MST}
    {2088666000 -21600 1 MDT}
    {2109225600 -25200 0 MST}
    {2120115600 -21600 1 MDT}
    {2140675200 -25200 0 MST}
    {2152170000 -21600 1 MDT}
    {2172729600 -25200 0 MST}
    {2183619600 -21600 1 MDT}
    {2204179200 -25200 0 MST}
    {2215069200 -21600 1 MDT}
    {2235628800 -25200 0 MST}
    {2246518800 -21600 1 MDT}
    {2267078400 -25200 0 MST}
    {2277968400 -21600 1 MDT}
    {2298528000 -25200 0 MST}
    {2309418000 -21600 1 MDT}
    {2329977600 -25200 0 MST}
    {2341472400 -21600 1 MDT}
    {2362032000 -25200 0 MST}
    {2372922000 -21600 1 MDT}
    {2393481600 -25200 0 MST}
    {2404371600 -21600 1 MDT}
    {2424931200 -25200 0 MST}
    {2435821200 -21600 1 MDT}
    {2456380800 -25200 0 MST}
    {2467270800 -21600 1 MDT}
    {2487830400 -25200 0 MST}
    {2499325200 -21600 1 MDT}
    {2519884800 -25200 0 MST}
    {2530774800 -21600 1 MDT}
    {2551334400 -25200 0 MST}
    {2562224400 -21600 1 MDT}
    {2582784000 -25200 0 MST}
    {2593674000 -21600 1 MDT}
    {2614233600 -25200 0 MST}
    {2625123600 -21600 1 MDT}
    {2645683200 -25200 0 MST}
    {2656573200 -21600 1 MDT}
    {2677132800 -25200 0 MST}
    {2688627600 -21600 1 MDT}
    {2709187200 -25200 0 MST}
    {2720077200 -21600 1 MDT}
    {2740636800 -25200 0 MST}
    {2751526800 -21600 1 MDT}
    {2772086400 -25200 0 MST}
    {2782976400 -21600 1 MDT}
    {2803536000 -25200 0 MST}
    {2814426000 -21600 1 MDT}
    {2834985600 -25200 0 MST}
    {2846480400 -21600 1 MDT}
    {2867040000 -25200 0 MST}
    {2877930000 -21600 1 MDT}
    {2898489600 -25200 0 MST}
    {2909379600 -21600 1 MDT}
    {2929939200 -25200 0 MST}
    {2940829200 -21600 1 MDT}
    {2961388800 -25200 0 MST}
    {2972278800 -21600 1 MDT}
    {2992838400 -25200 0 MST}
    {3003728400 -21600 1 MDT}
    {3024288000 -25200 0 MST}
    {3035782800 -21600 1 MDT}
    {3056342400 -25200 0 MST}
    {3067232400 -21600 1 MDT}
    {3087792000 -25200 0 MST}
    {3098682000 -21600 1 MDT}
    {3119241600 -25200 0 MST}
    {3130131600 -21600 1 MDT}
    {3150691200 -25200 0 MST}
    {3161581200 -21600 1 MDT}
    {3182140800 -25200 0 MST}
    {3193030800 -21600 1 MDT}
    {3213590400 -25200 0 MST}
    {3225085200 -21600 1 MDT}
    {3245644800 -25200 0 MST}
    {3256534800 -21600 1 MDT}
    {3277094400 -25200 0 MST}
    {3287984400 -21600 1 MDT}
    {3308544000 -25200 0 MST}
    {3319434000 -21600 1 MDT}
    {3339993600 -25200 0 MST}
    {3350883600 -21600 1 MDT}
    {3371443200 -25200 0 MST}
    {3382938000 -21600 1 MDT}
    {3403497600 -25200 0 MST}
    {3414387600 -21600 1 MDT}
    {3434947200 -25200 0 MST}
    {3445837200 -21600 1 MDT}
    {3466396800 -25200 0 MST}
    {3477286800 -21600 1 MDT}
    {3497846400 -25200 0 MST}
    {3508736400 -21600 1 MDT}
    {3529296000 -25200 0 MST}
    {3540186000 -21600 1 MDT}
    {3560745600 -25200 0 MST}
    {3572240400 -21600 1 MDT}
    {3592800000 -25200 0 MST}
    {3603690000 -21600 1 MDT}
    {3624249600 -25200 0 MST}
    {3635139600 -21600 1 MDT}
    {3655699200 -25200 0 MST}
    {3666589200 -21600 1 MDT}
    {3687148800 -25200 0 MST}
    {3698038800 -21600 1 MDT}
    {3718598400 -25200 0 MST}
    {3730093200 -21600 1 MDT}
    {3750652800 -25200 0 MST}
    {3761542800 -21600 1 MDT}
    {3782102400 -25200 0 MST}
    {3792992400 -21600 1 MDT}
    {3813552000 -25200 0 MST}
    {3824442000 -21600 1 MDT}
    {3845001600 -25200 0 MST}
    {3855891600 -21600 1 MDT}
    {3876451200 -25200 0 MST}
    {3887341200 -21600 1 MDT}
    {3907900800 -25200 0 MST}
    {3919395600 -21600 1 MDT}
    {3939955200 -25200 0 MST}
    {3950845200 -21600 1 MDT}
    {3971404800 -25200 0 MST}
    {3982294800 -21600 1 MDT}
    {4002854400 -25200 0 MST}
    {4013744400 -21600 1 MDT}
    {4034304000 -25200 0 MST}
    {4045194000 -21600 1 MDT}
    {4065753600 -25200 0 MST}
    {4076643600 -21600 1 MDT}
    {4097203200 -25200 0 MST}
}

>
>
|
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
1
2
3
4
5

























































































































































































































































# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Edmonton)]} {
    LoadTimeZoneFile America/Edmonton
}
set TZData(:America/Yellowknife) $TZData(:America/Edmonton)

























































































































































































































































Changes to library/tzdata/Asia/Gaza.

123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
    {1572037200 7200 0 EET}
    {1585346400 10800 1 EEST}
    {1603490400 7200 0 EET}
    {1616796000 10800 1 EEST}
    {1635458400 7200 0 EET}
    {1648332000 10800 1 EEST}
    {1666998000 7200 0 EET}
    {1679702400 10800 1 EEST}
    {1698447600 7200 0 EET}
    {1711756800 10800 1 EEST}
    {1729897200 7200 0 EET}
    {1743206400 10800 1 EEST}
    {1761346800 7200 0 EET}
    {1774656000 10800 1 EEST}
    {1792796400 7200 0 EET}
    {1806105600 10800 1 EEST}
    {1824850800 7200 0 EET}
    {1837555200 10800 1 EEST}
    {1856300400 7200 0 EET}







|

|

|







123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
    {1572037200 7200 0 EET}
    {1585346400 10800 1 EEST}
    {1603490400 7200 0 EET}
    {1616796000 10800 1 EEST}
    {1635458400 7200 0 EET}
    {1648332000 10800 1 EEST}
    {1666998000 7200 0 EET}
    {1682726400 10800 1 EEST}
    {1698447600 7200 0 EET}
    {1712966400 10800 1 EEST}
    {1729897200 7200 0 EET}
    {1743811200 10800 1 EEST}
    {1761346800 7200 0 EET}
    {1774656000 10800 1 EEST}
    {1792796400 7200 0 EET}
    {1806105600 10800 1 EEST}
    {1824850800 7200 0 EET}
    {1837555200 10800 1 EEST}
    {1856300400 7200 0 EET}
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
    {1995408000 10800 1 EEST}
    {2014153200 7200 0 EET}
    {2026857600 10800 1 EEST}
    {2045602800 7200 0 EET}
    {2058307200 10800 1 EEST}
    {2077052400 7200 0 EET}
    {2090361600 10800 1 EEST}
    {2108502000 7200 0 EET}
    {2121811200 10800 1 EEST}
    {2139951600 7200 0 EET}
    {2153260800 10800 1 EEST}
    {2172006000 7200 0 EET}
    {2184710400 10800 1 EEST}


    {2203455600 7200 0 EET}
    {2216160000 10800 1 EEST}


    {2234905200 7200 0 EET}
    {2248214400 10800 1 EEST}


    {2266354800 7200 0 EET}
    {2279664000 10800 1 EEST}


    {2297804400 7200 0 EET}
    {2311113600 10800 1 EEST}


    {2329254000 7200 0 EET}
    {2342563200 10800 1 EEST}


    {2361308400 7200 0 EET}
    {2374012800 10800 1 EEST}


    {2392758000 7200 0 EET}
    {2405462400 10800 1 EEST}


    {2424207600 7200 0 EET}
    {2437516800 10800 1 EEST}


    {2455657200 7200 0 EET}
    {2468966400 10800 1 EEST}


    {2487106800 7200 0 EET}
    {2500416000 10800 1 EEST}


    {2519161200 7200 0 EET}
    {2531865600 10800 1 EEST}


    {2550610800 7200 0 EET}
    {2563315200 10800 1 EEST}


    {2582060400 7200 0 EET}
    {2595369600 10800 1 EEST}


    {2613510000 7200 0 EET}
    {2626819200 10800 1 EEST}


    {2644959600 7200 0 EET}
    {2658268800 10800 1 EEST}


    {2676409200 7200 0 EET}
    {2689718400 10800 1 EEST}
    {2708463600 7200 0 EET}
    {2721168000 10800 1 EEST}
    {2739913200 7200 0 EET}
    {2752617600 10800 1 EEST}
    {2771362800 7200 0 EET}
    {2784672000 10800 1 EEST}
    {2802812400 7200 0 EET}
    {2816121600 10800 1 EEST}
    {2834262000 7200 0 EET}
    {2847571200 10800 1 EEST}
    {2866316400 7200 0 EET}







|

|

|

>
>


>
>


>
>


>
>


>
>


>
>


>
>


>
>


>
>


>
>


>
>


>
>


>
>


>
>


>
>


>
>

|

|

|







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
    {1995408000 10800 1 EEST}
    {2014153200 7200 0 EET}
    {2026857600 10800 1 EEST}
    {2045602800 7200 0 EET}
    {2058307200 10800 1 EEST}
    {2077052400 7200 0 EET}
    {2090361600 10800 1 EEST}
    {2107897200 7200 0 EET}
    {2121811200 10800 1 EEST}
    {2138742000 7200 0 EET}
    {2153260800 10800 1 EEST}
    {2168982000 7200 0 EET}
    {2184710400 10800 1 EEST}
    {2199826800 7200 0 EET}
    {2202854400 10800 1 EEST}
    {2203455600 7200 0 EET}
    {2216160000 10800 1 EEST}
    {2230066800 7200 0 EET}
    {2233699200 10800 1 EEST}
    {2234905200 7200 0 EET}
    {2248214400 10800 1 EEST}
    {2260911600 7200 0 EET}
    {2263939200 10800 1 EEST}
    {2266354800 7200 0 EET}
    {2279664000 10800 1 EEST}
    {2291756400 7200 0 EET}
    {2294784000 10800 1 EEST}
    {2297804400 7200 0 EET}
    {2311113600 10800 1 EEST}
    {2321996400 7200 0 EET}
    {2325628800 10800 1 EEST}
    {2329254000 7200 0 EET}
    {2342563200 10800 1 EEST}
    {2352841200 7200 0 EET}
    {2355868800 10800 1 EEST}
    {2361308400 7200 0 EET}
    {2374012800 10800 1 EEST}
    {2383686000 7200 0 EET}
    {2386713600 10800 1 EEST}
    {2392758000 7200 0 EET}
    {2405462400 10800 1 EEST}
    {2413926000 7200 0 EET}
    {2417558400 10800 1 EEST}
    {2424207600 7200 0 EET}
    {2437516800 10800 1 EEST}
    {2444770800 7200 0 EET}
    {2447798400 10800 1 EEST}
    {2455657200 7200 0 EET}
    {2468966400 10800 1 EEST}
    {2475010800 7200 0 EET}
    {2478643200 10800 1 EEST}
    {2487106800 7200 0 EET}
    {2500416000 10800 1 EEST}
    {2505855600 7200 0 EET}
    {2508883200 10800 1 EEST}
    {2519161200 7200 0 EET}
    {2531865600 10800 1 EEST}
    {2536700400 7200 0 EET}
    {2539728000 10800 1 EEST}
    {2550610800 7200 0 EET}
    {2563315200 10800 1 EEST}
    {2566940400 7200 0 EET}
    {2570572800 10800 1 EEST}
    {2582060400 7200 0 EET}
    {2595369600 10800 1 EEST}
    {2597785200 7200 0 EET}
    {2600812800 10800 1 EEST}
    {2613510000 7200 0 EET}
    {2626819200 10800 1 EEST}
    {2628025200 7200 0 EET}
    {2631657600 10800 1 EEST}
    {2644959600 7200 0 EET}
    {2658268800 10800 1 EEST}
    {2658870000 7200 0 EET}
    {2662502400 10800 1 EEST}
    {2676409200 7200 0 EET}
    {2692742400 10800 1 EEST}
    {2708463600 7200 0 EET}
    {2723587200 10800 1 EEST}
    {2739913200 7200 0 EET}
    {2753827200 10800 1 EEST}
    {2771362800 7200 0 EET}
    {2784672000 10800 1 EEST}
    {2802812400 7200 0 EET}
    {2816121600 10800 1 EEST}
    {2834262000 7200 0 EET}
    {2847571200 10800 1 EEST}
    {2866316400 7200 0 EET}
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
    {3005424000 10800 1 EEST}
    {3023564400 7200 0 EET}
    {3036873600 10800 1 EEST}
    {3055618800 7200 0 EET}
    {3068323200 10800 1 EEST}
    {3087068400 7200 0 EET}
    {3099772800 10800 1 EEST}
    {3118518000 7200 0 EET}
    {3131827200 10800 1 EEST}
    {3149967600 7200 0 EET}
    {3163276800 10800 1 EEST}
    {3181417200 7200 0 EET}
    {3194726400 10800 1 EEST}
    {3212866800 7200 0 EET}
    {3226176000 10800 1 EEST}



    {3244921200 7200 0 EET}

    {3257625600 10800 1 EEST}
    {3276370800 7200 0 EET}

    {3289075200 10800 1 EEST}
    {3307820400 7200 0 EET}
    {3321129600 10800 1 EEST}
    {3339270000 7200 0 EET}
    {3352579200 10800 1 EEST}


    {3370719600 7200 0 EET}
    {3384028800 10800 1 EEST}


    {3402774000 7200 0 EET}
    {3415478400 10800 1 EEST}


    {3434223600 7200 0 EET}
    {3446928000 10800 1 EEST}


    {3465673200 7200 0 EET}
    {3478982400 10800 1 EEST}


    {3497122800 7200 0 EET}
    {3510432000 10800 1 EEST}


    {3528572400 7200 0 EET}
    {3541881600 10800 1 EEST}


    {3560022000 7200 0 EET}
    {3573331200 10800 1 EEST}


    {3592076400 7200 0 EET}
    {3604780800 10800 1 EEST}


    {3623526000 7200 0 EET}
    {3636230400 10800 1 EEST}


    {3654975600 7200 0 EET}
    {3668284800 10800 1 EEST}


    {3686425200 7200 0 EET}
    {3699734400 10800 1 EEST}
    {3717874800 7200 0 EET}
    {3731184000 10800 1 EEST}
    {3749929200 7200 0 EET}
    {3762633600 10800 1 EEST}
    {3781378800 7200 0 EET}







|

|

|

|

>
>
>
|
>
|
|
>
|
|
|


>
>


>
>


>
>


>
>


>
>


>
>


>
>


>
>


>
>


>
>


>
>







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
    {3005424000 10800 1 EEST}
    {3023564400 7200 0 EET}
    {3036873600 10800 1 EEST}
    {3055618800 7200 0 EET}
    {3068323200 10800 1 EEST}
    {3087068400 7200 0 EET}
    {3099772800 10800 1 EEST}
    {3117913200 7200 0 EET}
    {3131827200 10800 1 EEST}
    {3148758000 7200 0 EET}
    {3163276800 10800 1 EEST}
    {3179602800 7200 0 EET}
    {3194726400 10800 1 EEST}
    {3209842800 7200 0 EET}
    {3226176000 10800 1 EEST}
    {3240687600 7200 0 EET}
    {3243715200 10800 1 EEST}
    {3257622000 10800 1 EEST}
    {3271532400 7200 0 EET}
    {3274560000 10800 1 EEST}
    {3289071600 10800 1 EEST}
    {3301772400 7200 0 EET}
    {3305404800 10800 1 EEST}
    {3321126000 10800 1 EEST}
    {3332617200 7200 0 EET}
    {3335644800 10800 1 EEST}
    {3339270000 7200 0 EET}
    {3352579200 10800 1 EEST}
    {3362857200 7200 0 EET}
    {3366489600 10800 1 EEST}
    {3370719600 7200 0 EET}
    {3384028800 10800 1 EEST}
    {3393702000 7200 0 EET}
    {3397334400 10800 1 EEST}
    {3402774000 7200 0 EET}
    {3415478400 10800 1 EEST}
    {3424546800 7200 0 EET}
    {3427574400 10800 1 EEST}
    {3434223600 7200 0 EET}
    {3446928000 10800 1 EEST}
    {3454786800 7200 0 EET}
    {3458419200 10800 1 EEST}
    {3465673200 7200 0 EET}
    {3478982400 10800 1 EEST}
    {3485631600 7200 0 EET}
    {3488659200 10800 1 EEST}
    {3497122800 7200 0 EET}
    {3510432000 10800 1 EEST}
    {3516476400 7200 0 EET}
    {3519504000 10800 1 EEST}
    {3528572400 7200 0 EET}
    {3541881600 10800 1 EEST}
    {3546716400 7200 0 EET}
    {3550348800 10800 1 EEST}
    {3560022000 7200 0 EET}
    {3573331200 10800 1 EEST}
    {3577561200 7200 0 EET}
    {3580588800 10800 1 EEST}
    {3592076400 7200 0 EET}
    {3604780800 10800 1 EEST}
    {3607801200 7200 0 EET}
    {3611433600 10800 1 EEST}
    {3623526000 7200 0 EET}
    {3636230400 10800 1 EEST}
    {3638646000 7200 0 EET}
    {3642278400 10800 1 EEST}
    {3654975600 7200 0 EET}
    {3668284800 10800 1 EEST}
    {3669490800 7200 0 EET}
    {3672518400 10800 1 EEST}
    {3686425200 7200 0 EET}
    {3699734400 10800 1 EEST}
    {3717874800 7200 0 EET}
    {3731184000 10800 1 EEST}
    {3749929200 7200 0 EET}
    {3762633600 10800 1 EEST}
    {3781378800 7200 0 EET}

Changes to library/tzdata/Asia/Hebron.

122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
    {1572037200 7200 0 EET}
    {1585346400 10800 1 EEST}
    {1603490400 7200 0 EET}
    {1616796000 10800 1 EEST}
    {1635458400 7200 0 EET}
    {1648332000 10800 1 EEST}
    {1666998000 7200 0 EET}
    {1679702400 10800 1 EEST}
    {1698447600 7200 0 EET}
    {1711756800 10800 1 EEST}
    {1729897200 7200 0 EET}
    {1743206400 10800 1 EEST}
    {1761346800 7200 0 EET}
    {1774656000 10800 1 EEST}
    {1792796400 7200 0 EET}
    {1806105600 10800 1 EEST}
    {1824850800 7200 0 EET}
    {1837555200 10800 1 EEST}
    {1856300400 7200 0 EET}







|

|

|







122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
    {1572037200 7200 0 EET}
    {1585346400 10800 1 EEST}
    {1603490400 7200 0 EET}
    {1616796000 10800 1 EEST}
    {1635458400 7200 0 EET}
    {1648332000 10800 1 EEST}
    {1666998000 7200 0 EET}
    {1682726400 10800 1 EEST}
    {1698447600 7200 0 EET}
    {1712966400 10800 1 EEST}
    {1729897200 7200 0 EET}
    {1743811200 10800 1 EEST}
    {1761346800 7200 0 EET}
    {1774656000 10800 1 EEST}
    {1792796400 7200 0 EET}
    {1806105600 10800 1 EEST}
    {1824850800 7200 0 EET}
    {1837555200 10800 1 EEST}
    {1856300400 7200 0 EET}
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
    {1995408000 10800 1 EEST}
    {2014153200 7200 0 EET}
    {2026857600 10800 1 EEST}
    {2045602800 7200 0 EET}
    {2058307200 10800 1 EEST}
    {2077052400 7200 0 EET}
    {2090361600 10800 1 EEST}
    {2108502000 7200 0 EET}
    {2121811200 10800 1 EEST}
    {2139951600 7200 0 EET}
    {2153260800 10800 1 EEST}
    {2172006000 7200 0 EET}
    {2184710400 10800 1 EEST}


    {2203455600 7200 0 EET}
    {2216160000 10800 1 EEST}


    {2234905200 7200 0 EET}
    {2248214400 10800 1 EEST}


    {2266354800 7200 0 EET}
    {2279664000 10800 1 EEST}


    {2297804400 7200 0 EET}
    {2311113600 10800 1 EEST}


    {2329254000 7200 0 EET}
    {2342563200 10800 1 EEST}


    {2361308400 7200 0 EET}
    {2374012800 10800 1 EEST}


    {2392758000 7200 0 EET}
    {2405462400 10800 1 EEST}


    {2424207600 7200 0 EET}
    {2437516800 10800 1 EEST}


    {2455657200 7200 0 EET}
    {2468966400 10800 1 EEST}


    {2487106800 7200 0 EET}
    {2500416000 10800 1 EEST}


    {2519161200 7200 0 EET}
    {2531865600 10800 1 EEST}


    {2550610800 7200 0 EET}
    {2563315200 10800 1 EEST}


    {2582060400 7200 0 EET}
    {2595369600 10800 1 EEST}


    {2613510000 7200 0 EET}
    {2626819200 10800 1 EEST}


    {2644959600 7200 0 EET}
    {2658268800 10800 1 EEST}


    {2676409200 7200 0 EET}
    {2689718400 10800 1 EEST}
    {2708463600 7200 0 EET}
    {2721168000 10800 1 EEST}
    {2739913200 7200 0 EET}
    {2752617600 10800 1 EEST}
    {2771362800 7200 0 EET}
    {2784672000 10800 1 EEST}
    {2802812400 7200 0 EET}
    {2816121600 10800 1 EEST}
    {2834262000 7200 0 EET}
    {2847571200 10800 1 EEST}
    {2866316400 7200 0 EET}







|

|

|

>
>


>
>


>
>


>
>


>
>


>
>


>
>


>
>


>
>


>
>


>
>


>
>


>
>


>
>


>
>


>
>

|

|

|







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
    {1995408000 10800 1 EEST}
    {2014153200 7200 0 EET}
    {2026857600 10800 1 EEST}
    {2045602800 7200 0 EET}
    {2058307200 10800 1 EEST}
    {2077052400 7200 0 EET}
    {2090361600 10800 1 EEST}
    {2107897200 7200 0 EET}
    {2121811200 10800 1 EEST}
    {2138742000 7200 0 EET}
    {2153260800 10800 1 EEST}
    {2168982000 7200 0 EET}
    {2184710400 10800 1 EEST}
    {2199826800 7200 0 EET}
    {2202854400 10800 1 EEST}
    {2203455600 7200 0 EET}
    {2216160000 10800 1 EEST}
    {2230066800 7200 0 EET}
    {2233699200 10800 1 EEST}
    {2234905200 7200 0 EET}
    {2248214400 10800 1 EEST}
    {2260911600 7200 0 EET}
    {2263939200 10800 1 EEST}
    {2266354800 7200 0 EET}
    {2279664000 10800 1 EEST}
    {2291756400 7200 0 EET}
    {2294784000 10800 1 EEST}
    {2297804400 7200 0 EET}
    {2311113600 10800 1 EEST}
    {2321996400 7200 0 EET}
    {2325628800 10800 1 EEST}
    {2329254000 7200 0 EET}
    {2342563200 10800 1 EEST}
    {2352841200 7200 0 EET}
    {2355868800 10800 1 EEST}
    {2361308400 7200 0 EET}
    {2374012800 10800 1 EEST}
    {2383686000 7200 0 EET}
    {2386713600 10800 1 EEST}
    {2392758000 7200 0 EET}
    {2405462400 10800 1 EEST}
    {2413926000 7200 0 EET}
    {2417558400 10800 1 EEST}
    {2424207600 7200 0 EET}
    {2437516800 10800 1 EEST}
    {2444770800 7200 0 EET}
    {2447798400 10800 1 EEST}
    {2455657200 7200 0 EET}
    {2468966400 10800 1 EEST}
    {2475010800 7200 0 EET}
    {2478643200 10800 1 EEST}
    {2487106800 7200 0 EET}
    {2500416000 10800 1 EEST}
    {2505855600 7200 0 EET}
    {2508883200 10800 1 EEST}
    {2519161200 7200 0 EET}
    {2531865600 10800 1 EEST}
    {2536700400 7200 0 EET}
    {2539728000 10800 1 EEST}
    {2550610800 7200 0 EET}
    {2563315200 10800 1 EEST}
    {2566940400 7200 0 EET}
    {2570572800 10800 1 EEST}
    {2582060400 7200 0 EET}
    {2595369600 10800 1 EEST}
    {2597785200 7200 0 EET}
    {2600812800 10800 1 EEST}
    {2613510000 7200 0 EET}
    {2626819200 10800 1 EEST}
    {2628025200 7200 0 EET}
    {2631657600 10800 1 EEST}
    {2644959600 7200 0 EET}
    {2658268800 10800 1 EEST}
    {2658870000 7200 0 EET}
    {2662502400 10800 1 EEST}
    {2676409200 7200 0 EET}
    {2692742400 10800 1 EEST}
    {2708463600 7200 0 EET}
    {2723587200 10800 1 EEST}
    {2739913200 7200 0 EET}
    {2753827200 10800 1 EEST}
    {2771362800 7200 0 EET}
    {2784672000 10800 1 EEST}
    {2802812400 7200 0 EET}
    {2816121600 10800 1 EEST}
    {2834262000 7200 0 EET}
    {2847571200 10800 1 EEST}
    {2866316400 7200 0 EET}
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
    {3005424000 10800 1 EEST}
    {3023564400 7200 0 EET}
    {3036873600 10800 1 EEST}
    {3055618800 7200 0 EET}
    {3068323200 10800 1 EEST}
    {3087068400 7200 0 EET}
    {3099772800 10800 1 EEST}
    {3118518000 7200 0 EET}
    {3131827200 10800 1 EEST}
    {3149967600 7200 0 EET}
    {3163276800 10800 1 EEST}
    {3181417200 7200 0 EET}
    {3194726400 10800 1 EEST}
    {3212866800 7200 0 EET}
    {3226176000 10800 1 EEST}



    {3244921200 7200 0 EET}

    {3257625600 10800 1 EEST}
    {3276370800 7200 0 EET}

    {3289075200 10800 1 EEST}
    {3307820400 7200 0 EET}
    {3321129600 10800 1 EEST}
    {3339270000 7200 0 EET}
    {3352579200 10800 1 EEST}


    {3370719600 7200 0 EET}
    {3384028800 10800 1 EEST}


    {3402774000 7200 0 EET}
    {3415478400 10800 1 EEST}


    {3434223600 7200 0 EET}
    {3446928000 10800 1 EEST}


    {3465673200 7200 0 EET}
    {3478982400 10800 1 EEST}


    {3497122800 7200 0 EET}
    {3510432000 10800 1 EEST}


    {3528572400 7200 0 EET}
    {3541881600 10800 1 EEST}


    {3560022000 7200 0 EET}
    {3573331200 10800 1 EEST}


    {3592076400 7200 0 EET}
    {3604780800 10800 1 EEST}


    {3623526000 7200 0 EET}
    {3636230400 10800 1 EEST}


    {3654975600 7200 0 EET}
    {3668284800 10800 1 EEST}


    {3686425200 7200 0 EET}
    {3699734400 10800 1 EEST}
    {3717874800 7200 0 EET}
    {3731184000 10800 1 EEST}
    {3749929200 7200 0 EET}
    {3762633600 10800 1 EEST}
    {3781378800 7200 0 EET}







|

|

|

|

>
>
>
|
>
|
|
>
|
|
|


>
>


>
>


>
>


>
>


>
>


>
>


>
>


>
>


>
>


>
>


>
>







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
    {3005424000 10800 1 EEST}
    {3023564400 7200 0 EET}
    {3036873600 10800 1 EEST}
    {3055618800 7200 0 EET}
    {3068323200 10800 1 EEST}
    {3087068400 7200 0 EET}
    {3099772800 10800 1 EEST}
    {3117913200 7200 0 EET}
    {3131827200 10800 1 EEST}
    {3148758000 7200 0 EET}
    {3163276800 10800 1 EEST}
    {3179602800 7200 0 EET}
    {3194726400 10800 1 EEST}
    {3209842800 7200 0 EET}
    {3226176000 10800 1 EEST}
    {3240687600 7200 0 EET}
    {3243715200 10800 1 EEST}
    {3257622000 10800 1 EEST}
    {3271532400 7200 0 EET}
    {3274560000 10800 1 EEST}
    {3289071600 10800 1 EEST}
    {3301772400 7200 0 EET}
    {3305404800 10800 1 EEST}
    {3321126000 10800 1 EEST}
    {3332617200 7200 0 EET}
    {3335644800 10800 1 EEST}
    {3339270000 7200 0 EET}
    {3352579200 10800 1 EEST}
    {3362857200 7200 0 EET}
    {3366489600 10800 1 EEST}
    {3370719600 7200 0 EET}
    {3384028800 10800 1 EEST}
    {3393702000 7200 0 EET}
    {3397334400 10800 1 EEST}
    {3402774000 7200 0 EET}
    {3415478400 10800 1 EEST}
    {3424546800 7200 0 EET}
    {3427574400 10800 1 EEST}
    {3434223600 7200 0 EET}
    {3446928000 10800 1 EEST}
    {3454786800 7200 0 EET}
    {3458419200 10800 1 EEST}
    {3465673200 7200 0 EET}
    {3478982400 10800 1 EEST}
    {3485631600 7200 0 EET}
    {3488659200 10800 1 EEST}
    {3497122800 7200 0 EET}
    {3510432000 10800 1 EEST}
    {3516476400 7200 0 EET}
    {3519504000 10800 1 EEST}
    {3528572400 7200 0 EET}
    {3541881600 10800 1 EEST}
    {3546716400 7200 0 EET}
    {3550348800 10800 1 EEST}
    {3560022000 7200 0 EET}
    {3573331200 10800 1 EEST}
    {3577561200 7200 0 EET}
    {3580588800 10800 1 EEST}
    {3592076400 7200 0 EET}
    {3604780800 10800 1 EEST}
    {3607801200 7200 0 EET}
    {3611433600 10800 1 EEST}
    {3623526000 7200 0 EET}
    {3636230400 10800 1 EEST}
    {3638646000 7200 0 EET}
    {3642278400 10800 1 EEST}
    {3654975600 7200 0 EET}
    {3668284800 10800 1 EEST}
    {3669490800 7200 0 EET}
    {3672518400 10800 1 EEST}
    {3686425200 7200 0 EET}
    {3699734400 10800 1 EEST}
    {3717874800 7200 0 EET}
    {3731184000 10800 1 EEST}
    {3749929200 7200 0 EET}
    {3762633600 10800 1 EEST}
    {3781378800 7200 0 EET}

Changes to library/tzdata/Asia/Singapore.

1
2
3
4
5
6
7
8
9
10
11
12
13
# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Singapore) {
    {-9223372036854775808 24925 0 LMT}
    {-2177477725 24925 0 SMT}
    {-2038200925 25200 0 +07}
    {-1167634800 26400 1 +0720}
    {-1073028000 26400 0 +0720}
    {-894180000 27000 0 +0730}
    {-879665400 32400 0 +09}
    {-767005200 27000 0 +0730}
    {378664200 28800 0 +08}
}











|

1
2
3
4
5
6
7
8
9
10
11
12
13
# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Singapore) {
    {-9223372036854775808 24925 0 LMT}
    {-2177477725 24925 0 SMT}
    {-2038200925 25200 0 +07}
    {-1167634800 26400 1 +0720}
    {-1073028000 26400 0 +0720}
    {-894180000 27000 0 +0730}
    {-879665400 32400 0 +09}
    {-767005200 27000 0 +0730}
    {378662400 28800 0 +08}
}

Changes to library/tzdata/Europe/Kirov.

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
    {496792800 14400 0 +04}
    {512517600 18000 1 +05}
    {528242400 14400 0 +04}
    {543967200 18000 1 +05}
    {559692000 14400 0 +04}
    {575416800 18000 1 +05}
    {591141600 14400 0 +04}
    {606866400 10800 0 +04}
    {606870000 14400 1 +04}
    {622594800 10800 0 +03}
    {638319600 14400 1 +04}
    {654649200 10800 0 +03}
    {670374000 14400 0 +04}
    {701820000 10800 0 +04}
    {701823600 14400 1 +04}
    {717548400 10800 0 +03}
    {733273200 14400 1 +04}
    {748998000 10800 0 +03}
    {764722800 14400 1 +04}
    {780447600 10800 0 +03}
    {796172400 14400 1 +04}
    {811897200 10800 0 +03}
    {828226800 14400 1 +04}
    {846370800 10800 0 +03}
    {859676400 14400 1 +04}
    {877820400 10800 0 +03}
    {891126000 14400 1 +04}
    {909270000 10800 0 +03}
    {922575600 14400 1 +04}
    {941324400 10800 0 +03}
    {954025200 14400 1 +04}
    {972774000 10800 0 +03}
    {985474800 14400 1 +04}
    {1004223600 10800 0 +03}
    {1017529200 14400 1 +04}
    {1035673200 10800 0 +03}
    {1048978800 14400 1 +04}
    {1067122800 10800 0 +03}
    {1080428400 14400 1 +04}
    {1099177200 10800 0 +03}
    {1111878000 14400 1 +04}
    {1130626800 10800 0 +03}
    {1143327600 14400 1 +04}
    {1162076400 10800 0 +03}
    {1174777200 14400 1 +04}
    {1193526000 10800 0 +03}
    {1206831600 14400 1 +04}
    {1224975600 10800 0 +03}
    {1238281200 14400 1 +04}
    {1256425200 10800 0 +03}
    {1269730800 14400 1 +04}
    {1288479600 10800 0 +03}
    {1301180400 14400 0 +04}
    {1414274400 10800 0 +03}
}







|
|
|
|
|

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

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
    {496792800 14400 0 +04}
    {512517600 18000 1 +05}
    {528242400 14400 0 +04}
    {543967200 18000 1 +05}
    {559692000 14400 0 +04}
    {575416800 18000 1 +05}
    {591141600 14400 0 +04}
    {606866400 10800 0 MSD}
    {606870000 14400 1 MSD}
    {622594800 10800 0 MSK}
    {638319600 14400 1 MSD}
    {654649200 10800 0 MSK}
    {670374000 14400 0 +04}
    {701820000 10800 0 MSD}
    {701823600 14400 1 MSD}
    {717548400 10800 0 MSK}
    {733273200 14400 1 MSD}
    {748998000 10800 0 MSK}
    {764722800 14400 1 MSD}
    {780447600 10800 0 MSK}
    {796172400 14400 1 MSD}
    {811897200 10800 0 MSK}
    {828226800 14400 1 MSD}
    {846370800 10800 0 MSK}
    {859676400 14400 1 MSD}
    {877820400 10800 0 MSK}
    {891126000 14400 1 MSD}
    {909270000 10800 0 MSK}
    {922575600 14400 1 MSD}
    {941324400 10800 0 MSK}
    {954025200 14400 1 MSD}
    {972774000 10800 0 MSK}
    {985474800 14400 1 MSD}
    {1004223600 10800 0 MSK}
    {1017529200 14400 1 MSD}
    {1035673200 10800 0 MSK}
    {1048978800 14400 1 MSD}
    {1067122800 10800 0 MSK}
    {1080428400 14400 1 MSD}
    {1099177200 10800 0 MSK}
    {1111878000 14400 1 MSD}
    {1130626800 10800 0 MSK}
    {1143327600 14400 1 MSD}
    {1162076400 10800 0 MSK}
    {1174777200 14400 1 MSD}
    {1193526000 10800 0 MSK}
    {1206831600 14400 1 MSD}
    {1224975600 10800 0 MSK}
    {1238281200 14400 1 MSD}
    {1256425200 10800 0 MSK}
    {1269730800 14400 1 MSD}
    {1288479600 10800 0 MSK}
    {1301180400 14400 0 MSK}
    {1414274400 10800 0 MSK}
}

Changes to library/tzdata/Europe/Volgograd.

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
    {465343200 14400 0 +04}
    {481068000 18000 1 +05}
    {496792800 14400 0 +04}
    {512517600 18000 1 +05}
    {528242400 14400 0 +04}
    {543967200 18000 1 +05}
    {559692000 14400 0 +04}
    {575416800 10800 0 +04}
    {575420400 14400 1 +04}
    {591145200 10800 0 +03}
    {606870000 14400 1 +04}
    {622594800 10800 0 +03}
    {638319600 14400 1 +04}
    {654649200 10800 0 +03}
    {670374000 14400 0 +04}
    {701820000 10800 0 +04}
    {701823600 14400 1 +04}
    {717548400 10800 0 +03}
    {733273200 14400 1 +04}
    {748998000 10800 0 +03}
    {764722800 14400 1 +04}
    {780447600 10800 0 +03}
    {796172400 14400 1 +04}
    {811897200 10800 0 +03}
    {828226800 14400 1 +04}
    {846370800 10800 0 +03}
    {859676400 14400 1 +04}
    {877820400 10800 0 +03}
    {891126000 14400 1 +04}
    {909270000 10800 0 +03}
    {922575600 14400 1 +04}
    {941324400 10800 0 +03}
    {954025200 14400 1 +04}
    {972774000 10800 0 +03}
    {985474800 14400 1 +04}
    {1004223600 10800 0 +03}
    {1017529200 14400 1 +04}
    {1035673200 10800 0 +03}
    {1048978800 14400 1 +04}
    {1067122800 10800 0 +03}
    {1080428400 14400 1 +04}
    {1099177200 10800 0 +03}
    {1111878000 14400 1 +04}
    {1130626800 10800 0 +03}
    {1143327600 14400 1 +04}
    {1162076400 10800 0 +03}
    {1174777200 14400 1 +04}
    {1193526000 10800 0 +03}
    {1206831600 14400 1 +04}
    {1224975600 10800 0 +03}
    {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}
}







|
|
|
|
|
|
|

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

|

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
    {465343200 14400 0 +04}
    {481068000 18000 1 +05}
    {496792800 14400 0 +04}
    {512517600 18000 1 +05}
    {528242400 14400 0 +04}
    {543967200 18000 1 +05}
    {559692000 14400 0 +04}
    {575416800 10800 0 MSD}
    {575420400 14400 1 MSD}
    {591145200 10800 0 MSK}
    {606870000 14400 1 MSD}
    {622594800 10800 0 MSK}
    {638319600 14400 1 MSD}
    {654649200 10800 0 MSK}
    {670374000 14400 0 +04}
    {701820000 10800 0 MSD}
    {701823600 14400 1 MSD}
    {717548400 10800 0 MSK}
    {733273200 14400 1 MSD}
    {748998000 10800 0 MSK}
    {764722800 14400 1 MSD}
    {780447600 10800 0 MSK}
    {796172400 14400 1 MSD}
    {811897200 10800 0 MSK}
    {828226800 14400 1 MSD}
    {846370800 10800 0 MSK}
    {859676400 14400 1 MSD}
    {877820400 10800 0 MSK}
    {891126000 14400 1 MSD}
    {909270000 10800 0 MSK}
    {922575600 14400 1 MSD}
    {941324400 10800 0 MSK}
    {954025200 14400 1 MSD}
    {972774000 10800 0 MSK}
    {985474800 14400 1 MSD}
    {1004223600 10800 0 MSK}
    {1017529200 14400 1 MSD}
    {1035673200 10800 0 MSK}
    {1048978800 14400 1 MSD}
    {1067122800 10800 0 MSK}
    {1080428400 14400 1 MSD}
    {1099177200 10800 0 MSK}
    {1111878000 14400 1 MSD}
    {1130626800 10800 0 MSK}
    {1143327600 14400 1 MSD}
    {1162076400 10800 0 MSK}
    {1174777200 14400 1 MSD}
    {1193526000 10800 0 MSK}
    {1206831600 14400 1 MSD}
    {1224975600 10800 0 MSK}
    {1238281200 14400 1 MSD}
    {1256425200 10800 0 MSK}
    {1269730800 14400 1 MSD}
    {1288479600 10800 0 MSK}
    {1301180400 14400 0 MSK}
    {1414274400 10800 0 MSK}
    {1540681200 14400 0 +04}
    {1609020000 10800 0 MSK}
}

Changes to library/word.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
# word.tcl --
#
# This file defines various procedures for computing word boundaries in
# strings. This file is primarily needed so Tk text and entry widgets behave
# properly for different platforms.
#
# Copyright © 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.







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
# word.tcl --
#
# This file defines various procedures for computing word boundaries in
# strings. This file is primarily needed so Tk text and entry widgets behave
# properly for different platforms.
#
# Copyright © 1996 Sun Microsystems, Inc.
# Copyright © 1998 Scriptics 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/changes.txt.

408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
          to other functions like mp_invmod, mp_div, etc...
       -- Sped up mp_exptmod_fast by using new code to find R mod m [e.g. B^n mod m]
       -- minor fixes

Jan 17th, 2003
v0.12  -- re-wrote the majority of the makefile so its more portable and will
          install via "make install" on most *nix platforms
       -- Re-packaged all the source as seperate files.  Means the library a single
          file packagage any more.  Instead of just adding "bn.c" you have to add
          libtommath.a
       -- Renamed "bn.h" to "tommath.h"
       -- Changes to the manual to reflect all of this
       -- Used GNU Indent to clean up the source

Jan 15th, 2003







|







408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
          to other functions like mp_invmod, mp_div, etc...
       -- Sped up mp_exptmod_fast by using new code to find R mod m [e.g. B^n mod m]
       -- minor fixes

Jan 17th, 2003
v0.12  -- re-wrote the majority of the makefile so its more portable and will
          install via "make install" on most *nix platforms
       -- Re-packaged all the source as separate files.  Means the library a single
          file packagage any more.  Instead of just adding "bn.c" you have to add
          libtommath.a
       -- Renamed "bn.h" to "tommath.h"
       -- Changes to the manual to reflect all of this
       -- Used GNU Indent to clean up the source

Jan 15th, 2003

Changes to libtommath/tommath.h.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

#ifndef BN_H_
#define BN_H_

#if !defined(MP_NO_STDINT) && !defined(_STDINT_H) && !defined(_STDINT_H_) \
	&& !defined(__CLANG_STDINT_H) && !defined(_STDINT)
#  include <stdint.h>
#endif
#include <stddef.h>
#include <limits.h>

#ifdef LTM_NO_FILE
#  warning LTM_NO_FILE has been deprecated, use MP_NO_FILE.
#  define MP_NO_FILE
#endif






<
<
|
<







1
2
3
4
5
6


7

8
9
10
11
12
13
14
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

#ifndef BN_H_
#define BN_H_



#include <stdint.h>

#include <stddef.h>
#include <limits.h>

#ifdef LTM_NO_FILE
#  warning LTM_NO_FILE has been deprecated, use MP_NO_FILE.
#  define MP_NO_FILE
#endif

Changes to libtommath/tommath_private.h.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

#ifndef TOMMATH_PRIV_H_
#define TOMMATH_PRIV_H_

#ifdef MP_NO_STDINT
#ifdef HAVE_STDINT_H
#  include <stdint.h>
#else
#  include "../compat/stdint.h"
#endif
#endif
#include "tclTomMath.h"
#include "tommath_class.h"

/*
 * Private symbols
 * ---------------
 *






<
<
|
<
<
<
<







1
2
3
4
5
6


7




8
9
10
11
12
13
14
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

#ifndef TOMMATH_PRIV_H_
#define TOMMATH_PRIV_H_



#include <stdint.h>




#include "tclTomMath.h"
#include "tommath_class.h"

/*
 * Private symbols
 * ---------------
 *

Changes to macosx/GNUmakefile.

1
2
3
4
5
6
7
8
9
10
11
########################################################################################################
#
# Makefile wrapper to build tcl on Mac OS X in a way compatible with the tk/macosx Xcode buildsystem
#	uses the standard unix build system in tcl/unix (which can be used directly instead of this
#	if you are not using the tk/macosx projects).
#
# Copyright (c) 2002-2008 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.
########################################################################################################



|







1
2
3
4
5
6
7
8
9
10
11
########################################################################################################
#
# Makefile wrapper to build tcl on Mac OS X in a way compatible with the tk/macosx Xcode buildsystem
#	uses the standard Unix build system in tcl/unix (which can be used directly instead of this
#	if you are not using the tk/macosx projects).
#
# Copyright (c) 2002-2008 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.
########################################################################################################
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
	--prefix="${PREFIX}" --bindir="${BINDIR}" --libdir="${LIBDIR}" \
	--mandir="${MANDIR}" --enable-framework --enable-dtrace --disable-zipfs \
	${CONFIGURE_ARGS} ${EXTRA_CONFIGURE_ARGS}; else ./config.status; fi

build-${PROJECT}: ${objdir}/Makefile
	${DO_MAKE}
ifeq (${INSTALL_BUILD},)
# symolic link hackery to trick
# 'make install INSTALL_ROOT=${OBJ_DIR}'
# into building Tcl.framework and tclsh in ${SYMROOT}
	@cd "${OBJ_DIR}" && mkdir -p $(dir $(subst ${space},\ ,.${LIBDIR})) $(dir $(subst ${space},\ ,.${BINDIR})) "${SYMROOT}" && \
	rm -f ".${LIBDIR}" ".${BINDIR}" && ln -fs "${SYMROOT}" ".${LIBDIR}" && \
	ln -fs "${SYMROOT}" ".${BINDIR}" && ln -fs "${OBJ_DIR}/tcltest" "${SYMROOT}"
endif








|







146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
	--prefix="${PREFIX}" --bindir="${BINDIR}" --libdir="${LIBDIR}" \
	--mandir="${MANDIR}" --enable-framework --enable-dtrace --disable-zipfs \
	${CONFIGURE_ARGS} ${EXTRA_CONFIGURE_ARGS}; else ./config.status; fi

build-${PROJECT}: ${objdir}/Makefile
	${DO_MAKE}
ifeq (${INSTALL_BUILD},)
# symbolic link hackery to trick
# 'make install INSTALL_ROOT=${OBJ_DIR}'
# into building Tcl.framework and tclsh in ${SYMROOT}
	@cd "${OBJ_DIR}" && mkdir -p $(dir $(subst ${space},\ ,.${LIBDIR})) $(dir $(subst ${space},\ ,.${BINDIR})) "${SYMROOT}" && \
	rm -f ".${LIBDIR}" ".${BINDIR}" && ln -fs "${SYMROOT}" ".${LIBDIR}" && \
	ln -fs "${SYMROOT}" ".${BINDIR}" && ln -fs "${OBJ_DIR}/tcltest" "${SYMROOT}"
endif

Changes to macosx/README.

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
TCL_SRCROOT user build setting, by default this is set to the project-relative
path '../../tcl', if your tcl source directory is named differently, e.g.
'../../tcl9.0', you need to manually change the TCL_SRCROOT setting by editing
your ${USER}.pbxuser file (located inside the Tcl.xcodeproj bundle directory)
with a text editor.

- To build universal binaries outside of the Xcode IDE, set CFLAGS as follows:
	export CFLAGS="-arch x86_64 -arch arm64e"
This requires Mac OS X 10.6 and Xcode 10.2 and will work on any architecture.
Note that configure requires CFLAGS to contain a least one architecture that can
be run on the build machine (i.e. x86_64 on Core2/Xeon).
Universal builds of Tcl TEA extensions are also possible with CFLAGS set as
above, they will be [load]able by universal as well as thin binaries of Tcl.

Detailed Instructions for building with macosx/GNUmakefile
----------------------------------------------------------

- Unpack the Tcl source release archive.

- The following instructions assume the Tcl source tree is named "tcl${ver}",
(where ${ver} is a shell variable containing the Tcl version number e.g. '9.0').
Setup this shell variable as follows:
	ver="9.0"
If you are building from CVS, omit this step (CVS source tree names usually do
not contain a version number).

- Setup environment variables as desired, e.g. for a universal build on 10.5:
	CFLAGS="-arch x86_64 -arch arm64e -mmacosx-version-min=10.5"
	export CFLAGS

- Change to the directory containing the Tcl source tree and build:
	make -C tcl${ver}/macosx

- Install Tcl onto the root volume (admin password required):
	sudo make -C tcl${ver}/macosx install







|















<
<


|







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
TCL_SRCROOT user build setting, by default this is set to the project-relative
path '../../tcl', if your tcl source directory is named differently, e.g.
'../../tcl9.0', you need to manually change the TCL_SRCROOT setting by editing
your ${USER}.pbxuser file (located inside the Tcl.xcodeproj bundle directory)
with a text editor.

- To build universal binaries outside of the Xcode IDE, set CFLAGS as follows:
	export CFLAGS="-arch x86_64 -arch arm64"
This requires Mac OS X 10.6 and Xcode 10.2 and will work on any architecture.
Note that configure requires CFLAGS to contain a least one architecture that can
be run on the build machine (i.e. x86_64 on Core2/Xeon).
Universal builds of Tcl TEA extensions are also possible with CFLAGS set as
above, they will be [load]able by universal as well as thin binaries of Tcl.

Detailed Instructions for building with macosx/GNUmakefile
----------------------------------------------------------

- Unpack the Tcl source release archive.

- The following instructions assume the Tcl source tree is named "tcl${ver}",
(where ${ver} is a shell variable containing the Tcl version number e.g. '9.0').
Setup this shell variable as follows:
	ver="9.0"



- Setup environment variables as desired, e.g. for a universal build on 10.5:
	CFLAGS="-arch x86_64 -arch arm64 -mmacosx-version-min=10.5"
	export CFLAGS

- Change to the directory containing the Tcl source tree and build:
	make -C tcl${ver}/macosx

- Install Tcl onto the root volume (admin password required):
	sudo make -C tcl${ver}/macosx install

Changes to macosx/Tcl.xcodeproj/project.pbxproj.

219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
		F93599D80DF1F98300E04F67 /* self.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = self.n; sourceTree = "<group>"; };
		F946FB8B0FBE3AED00CD6495 /* itcl */ = {isa = PBXFileReference; lastKnownFileType = folder; path = itcl; sourceTree = "<group>"; };
		F95D77E90DFD820D00A8BF6F /* tclIORTrans.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclIORTrans.c; sourceTree = "<group>"; };
		F95FAFF90B34F1130072E431 /* macOSXLoad.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = macOSXLoad.test; sourceTree = "<group>"; };
		F96437C90EF0D4B2003F468E /* tclZlib.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclZlib.c; sourceTree = "<group>"; };
		F96437E60EF0D652003F468E /* libz.dylib */ = {isa = PBXFileReference; lastKnownFileType = "compiled.mach-o.dylib"; name = libz.dylib; path = /usr/lib/libz.dylib; sourceTree = "<absolute>"; };
		F966C07408F2820D005CB29B /* CoreFoundation.framework */ = {isa = PBXFileReference; lastKnownFileType = wrapper.framework; name = CoreFoundation.framework; path = /System/Library/Frameworks/CoreFoundation.framework; sourceTree = "<absolute>"; };
		F96D3DFA08F272A4004A47F5 /* ChangeLog */ = {isa = PBXFileReference; explicitFileType = text; fileEncoding = 4; path = ChangeLog; sourceTree = "<group>"; };
		F96D3DFB08F272A4004A47F5 /* changes */ = {isa = PBXFileReference; explicitFileType = text; fileEncoding = 4; path = changes; sourceTree = "<group>"; };
		F96D3DFD08F272A4004A47F5 /* Access.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Access.3; sourceTree = "<group>"; };
		F96D3DFE08F272A4004A47F5 /* AddErrInfo.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = AddErrInfo.3; sourceTree = "<group>"; };
		F96D3DFF08F272A4004A47F5 /* after.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = after.n; sourceTree = "<group>"; };
		F96D3E0008F272A4004A47F5 /* Alloc.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Alloc.3; sourceTree = "<group>"; };
		F96D3E0108F272A4004A47F5 /* AllowExc.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = AllowExc.3; sourceTree = "<group>"; };
		F96D3E0208F272A4004A47F5 /* append.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = append.n; sourceTree = "<group>"; };







<







219
220
221
222
223
224
225

226
227
228
229
230
231
232
		F93599D80DF1F98300E04F67 /* self.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = self.n; sourceTree = "<group>"; };
		F946FB8B0FBE3AED00CD6495 /* itcl */ = {isa = PBXFileReference; lastKnownFileType = folder; path = itcl; sourceTree = "<group>"; };
		F95D77E90DFD820D00A8BF6F /* tclIORTrans.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclIORTrans.c; sourceTree = "<group>"; };
		F95FAFF90B34F1130072E431 /* macOSXLoad.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = macOSXLoad.test; sourceTree = "<group>"; };
		F96437C90EF0D4B2003F468E /* tclZlib.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclZlib.c; sourceTree = "<group>"; };
		F96437E60EF0D652003F468E /* libz.dylib */ = {isa = PBXFileReference; lastKnownFileType = "compiled.mach-o.dylib"; name = libz.dylib; path = /usr/lib/libz.dylib; sourceTree = "<absolute>"; };
		F966C07408F2820D005CB29B /* CoreFoundation.framework */ = {isa = PBXFileReference; lastKnownFileType = wrapper.framework; name = CoreFoundation.framework; path = /System/Library/Frameworks/CoreFoundation.framework; sourceTree = "<absolute>"; };

		F96D3DFB08F272A4004A47F5 /* changes */ = {isa = PBXFileReference; explicitFileType = text; fileEncoding = 4; path = changes; sourceTree = "<group>"; };
		F96D3DFD08F272A4004A47F5 /* Access.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Access.3; sourceTree = "<group>"; };
		F96D3DFE08F272A4004A47F5 /* AddErrInfo.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = AddErrInfo.3; sourceTree = "<group>"; };
		F96D3DFF08F272A4004A47F5 /* after.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = after.n; sourceTree = "<group>"; };
		F96D3E0008F272A4004A47F5 /* Alloc.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Alloc.3; sourceTree = "<group>"; };
		F96D3E0108F272A4004A47F5 /* AllowExc.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = AllowExc.3; sourceTree = "<group>"; };
		F96D3E0208F272A4004A47F5 /* append.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = append.n; sourceTree = "<group>"; };
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
				F96D425C08F272B2004A47F5 /* libtommath */,
				F96D446E08F272B9004A47F5 /* win */,
				F96D3F3808F272A7004A47F5 /* library */,
				F96D434408F272B5004A47F5 /* tests */,
				F96D3DFC08F272A4004A47F5 /* doc */,
				F96D43D008F272B8004A47F5 /* tools */,
				F9183E690EFC81560030B814 /* pkgs */,
				F96D3DFA08F272A4004A47F5 /* ChangeLog */,
				F96D3DFB08F272A4004A47F5 /* changes */,
				F96D434308F272B5004A47F5 /* README */,
				F96D432B08F272B4004A47F5 /* license.terms */,
			);
			name = "Tcl Sources";
			sourceTree = TCL_SRCROOT;
		};







<







945
946
947
948
949
950
951

952
953
954
955
956
957
958
				F96D425C08F272B2004A47F5 /* libtommath */,
				F96D446E08F272B9004A47F5 /* win */,
				F96D3F3808F272A7004A47F5 /* library */,
				F96D434408F272B5004A47F5 /* tests */,
				F96D3DFC08F272A4004A47F5 /* doc */,
				F96D43D008F272B8004A47F5 /* tools */,
				F9183E690EFC81560030B814 /* pkgs */,

				F96D3DFB08F272A4004A47F5 /* changes */,
				F96D434308F272B5004A47F5 /* README */,
				F96D432B08F272B4004A47F5 /* license.terms */,
			);
			name = "Tcl Sources";
			sourceTree = TCL_SRCROOT;
		};
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
			name = ReleaseUniversal;
		};
		F91BCC51093152310042A6BF /* ReleaseUniversal */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */;
			buildSettings = {
				ARCHS = "$(ARCHS_STANDARD_64_BIT)";
				CFLAGS = "-arch x86_64 -arch arm64e $(CFLAGS)";
				MACOSX_DEPLOYMENT_TARGET = 10.6;
				PREBINDING = NO;
			};
			name = ReleaseUniversal;
		};
		F93084370BB93D2800CD0B9E /* DebugMemCompile */ = {
			isa = XCBuildConfiguration;







|







2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
			name = ReleaseUniversal;
		};
		F91BCC51093152310042A6BF /* ReleaseUniversal */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */;
			buildSettings = {
				ARCHS = "$(ARCHS_STANDARD_64_BIT)";
				CFLAGS = "-arch x86_64 -arch arm64 $(CFLAGS)";
				MACOSX_DEPLOYMENT_TARGET = 10.6;
				PREBINDING = NO;
			};
			name = ReleaseUniversal;
		};
		F93084370BB93D2800CD0B9E /* DebugMemCompile */ = {
			isa = XCBuildConfiguration;
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
			name = "Debug llvm-gcc";
		};
		F9988BB10D81586D00B6B03B /* ReleaseUniversal gcc40 */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */;
			buildSettings = {
				ARCHS = "$(ARCHS_STANDARD_64_BIT)";
				CFLAGS = "-arch x86_64 -arch arm64e $(CFLAGS)";
				GCC_VERSION = 4.0;
				MACOSX_DEPLOYMENT_TARGET = 10.6;
				PREBINDING = NO;
			};
			name = "ReleaseUniversal gcc40";
		};
		F9988BB20D81586D00B6B03B /* ReleaseUniversal gcc40 */ = {







|







2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
			name = "Debug llvm-gcc";
		};
		F9988BB10D81586D00B6B03B /* ReleaseUniversal gcc40 */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */;
			buildSettings = {
				ARCHS = "$(ARCHS_STANDARD_64_BIT)";
				CFLAGS = "-arch x86_64 -arch arm64 $(CFLAGS)";
				GCC_VERSION = 4.0;
				MACOSX_DEPLOYMENT_TARGET = 10.6;
				PREBINDING = NO;
			};
			name = "ReleaseUniversal gcc40";
		};
		F9988BB20D81586D00B6B03B /* ReleaseUniversal gcc40 */ = {
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
			name = "ReleaseUniversal gcc40";
		};
		F9988BB50D81587400B6B03B /* ReleaseUniversal llvm-gcc */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */;
			buildSettings = {
				ARCHS = "$(ARCHS_STANDARD_64_BIT)";
				CFLAGS = "-arch x86_64 -arch arm64e $(CFLAGS)";
				DEBUG_INFORMATION_FORMAT = dwarf;
				GCC = "llvm-gcc";
				GCC_OPTIMIZATION_LEVEL = 4;
				GCC_VERSION = com.apple.compilers.llvmgcc42;
				MACOSX_DEPLOYMENT_TARGET = 10.6;
				PREBINDING = NO;
			};







|







2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
			name = "ReleaseUniversal gcc40";
		};
		F9988BB50D81587400B6B03B /* ReleaseUniversal llvm-gcc */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */;
			buildSettings = {
				ARCHS = "$(ARCHS_STANDARD_64_BIT)";
				CFLAGS = "-arch x86_64 -arch arm64 $(CFLAGS)";
				DEBUG_INFORMATION_FORMAT = dwarf;
				GCC = "llvm-gcc";
				GCC_OPTIMIZATION_LEVEL = 4;
				GCC_VERSION = com.apple.compilers.llvmgcc42;
				MACOSX_DEPLOYMENT_TARGET = 10.6;
				PREBINDING = NO;
			};
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
		F9A9D1F30FC77799002A2BE3 /* ReleaseUniversal clang */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */;
			buildSettings = {
				ARCHS = (
					"$(NATIVE_ARCH_64_BIT)",
				);
				CFLAGS = "-arch x86_64 -arch arm64e $(CFLAGS)";
				DEBUG_INFORMATION_FORMAT = dwarf;
				GCC = clang;
				GCC_OPTIMIZATION_LEVEL = 4;
				GCC_VERSION = com.apple.compilers.llvm.clang.1_0;
				MACOSX_DEPLOYMENT_TARGET = 10.6;
				PREBINDING = NO;
			};







|







2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
		F9A9D1F30FC77799002A2BE3 /* ReleaseUniversal clang */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */;
			buildSettings = {
				ARCHS = (
					"$(NATIVE_ARCH_64_BIT)",
				);
				CFLAGS = "-arch x86_64 -arch arm64 $(CFLAGS)";
				DEBUG_INFORMATION_FORMAT = dwarf;
				GCC = clang;
				GCC_OPTIMIZATION_LEVEL = 4;
				GCC_VERSION = com.apple.compilers.llvm.clang.1_0;
				MACOSX_DEPLOYMENT_TARGET = 10.6;
				PREBINDING = NO;
			};
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
			name = ReleaseUniversal10.5SDK;
		};
		F9EEED990C2FEFD300396116 /* ReleaseUniversal10.5SDK */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */;
			buildSettings = {
				ARCHS = "$(ARCHS_STANDARD_64_BIT)";
				CFLAGS = "-arch x86_64 -arch arm64e $(CFLAGS)";
				CPPFLAGS = "-isysroot $(SDKROOT) $(CPPFLAGS)";
				MACOSX_DEPLOYMENT_TARGET = 10.5;
				PREBINDING = NO;
				SDKROOT = macosx10.5;
			};
			name = ReleaseUniversal10.5SDK;
		};







|







2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
			name = ReleaseUniversal10.5SDK;
		};
		F9EEED990C2FEFD300396116 /* ReleaseUniversal10.5SDK */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */;
			buildSettings = {
				ARCHS = "$(ARCHS_STANDARD_64_BIT)";
				CFLAGS = "-arch x86_64 -arch arm64 $(CFLAGS)";
				CPPFLAGS = "-isysroot $(SDKROOT) $(CPPFLAGS)";
				MACOSX_DEPLOYMENT_TARGET = 10.5;
				PREBINDING = NO;
				SDKROOT = macosx10.5;
			};
			name = ReleaseUniversal10.5SDK;
		};

Changes to macosx/tclMacOSXBundle.c.

166
167
168
169
170
171
172
173
174
175
176
177
178
179
180

int
Tcl_MacOSXOpenVersionedBundleResources(
    TCL_UNUSED(Tcl_Interp *),
    const char *bundleName,
    const char *bundleVersion,
    int hasResourceFile,
    size_t maxPathLen,
    char *libraryPath)
{
#ifdef HAVE_COREFOUNDATION
    CFBundleRef bundleRef, versionedBundleRef = NULL;
    CFStringRef bundleNameRef;
    CFURLRef libURL;








|







166
167
168
169
170
171
172
173
174
175
176
177
178
179
180

int
Tcl_MacOSXOpenVersionedBundleResources(
    TCL_UNUSED(Tcl_Interp *),
    const char *bundleName,
    const char *bundleVersion,
    int hasResourceFile,
    Tcl_Size maxPathLen,
    char *libraryPath)
{
#ifdef HAVE_COREFOUNDATION
    CFBundleRef bundleRef, versionedBundleRef = NULL;
    CFStringRef bundleNameRef;
    CFURLRef libURL;

Changes to macosx/tclMacOSXFCmd.c.

84
85
86
87
88
89
90
91

92
93
94
95
96
97
98
static void		UpdateStringOfOSType(Tcl_Obj *objPtr);

static const Tcl_ObjType tclOSTypeType = {
    "osType",				/* name */
    NULL,				/* freeIntRepProc */
    NULL,				/* dupIntRepProc */
    UpdateStringOfOSType,		/* updateStringProc */
    SetOSTypeFromAny			/* setFromAnyProc */

};

enum {
    kIsInvisible = 0x4000,
};

#define kFinfoIsInvisible	(OSSwapHostToBigConstInt16(kIsInvisible))







|
>







84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
static void		UpdateStringOfOSType(Tcl_Obj *objPtr);

static const Tcl_ObjType tclOSTypeType = {
    "osType",				/* name */
    NULL,				/* freeIntRepProc */
    NULL,				/* dupIntRepProc */
    UpdateStringOfOSType,		/* updateStringProc */
    SetOSTypeFromAny,			/* setFromAnyProc */
    TCL_OBJTYPE_V0
};

enum {
    kIsInvisible = 0x4000,
};

#define kFinfoIsInvisible	(OSSwapHostToBigConstInt16(kIsInvisible))
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
    case MACOSX_RSRCLENGTH_ATTRIBUTE:
	TclNewIntObj(*attributePtrPtr, *rsrcForkSize);
	break;
    }
    return TCL_OK;
#else
    Tcl_SetObjResult(interp, Tcl_NewStringObj(
	    "Mac OS X file attributes not supported", -1));
    Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", NULL);
    return TCL_ERROR;
#endif /* HAVE_GETATTRLIST */
}

/*
 *---------------------------------------------------------------------------







|







199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
    case MACOSX_RSRCLENGTH_ATTRIBUTE:
	TclNewIntObj(*attributePtrPtr, *rsrcForkSize);
	break;
    }
    return TCL_OK;
#else
    Tcl_SetObjResult(interp, Tcl_NewStringObj(
	    "Mac OS X file attributes not supported", TCL_INDEX_NONE));
    Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", NULL);
    return TCL_ERROR;
#endif /* HAVE_GETATTRLIST */
}

/*
 *---------------------------------------------------------------------------
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
	    /*
	     * Only setting rsrclength to 0 to strip a file's resource fork is
	     * supported.
	     */

	    if (newRsrcForkSize != 0) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"setting nonzero rsrclength not supported", -1));
		Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", NULL);
		return TCL_ERROR;
	    }

	    /*
	     * Construct path to resource fork.
	     */







|







331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
	    /*
	     * Only setting rsrclength to 0 to strip a file's resource fork is
	     * supported.
	     */

	    if (newRsrcForkSize != 0) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"setting nonzero rsrclength not supported", TCL_INDEX_NONE));
		Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", NULL);
		return TCL_ERROR;
	    }

	    /*
	     * Construct path to resource fork.
	     */
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
		return TCL_ERROR;
	    }
	}
    }
    return TCL_OK;
#else
    Tcl_SetObjResult(interp, Tcl_NewStringObj(
	    "Mac OS X file attributes not supported", -1));
    Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", NULL);
    return TCL_ERROR;
#endif
}

/*
 *---------------------------------------------------------------------------







|







372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
		return TCL_ERROR;
	    }
	}
    }
    return TCL_OK;
#else
    Tcl_SetObjResult(interp, Tcl_NewStringObj(
	    "Mac OS X file attributes not supported", TCL_INDEX_NONE));
    Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", NULL);
    return TCL_ERROR;
#endif
}

/*
 *---------------------------------------------------------------------------
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
 * TclMacOSXMatchType --
 *
 *	This routine is used by the globbing code to check if a file matches a
 *	given mac type and/or creator code.
 *
 * Results:
 *	The return value is 1, 0 or -1 indicating whether the file matches the
 *	given criteria, does not match them, or an error occurred (in wich
 *	case an error is left in interp).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */







|







488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
 * TclMacOSXMatchType --
 *
 *	This routine is used by the globbing code to check if a file matches a
 *	given mac type and/or creator code.
 *
 * Results:
 *	The return value is 1, 0 or -1 indicating whether the file matches the
 *	given criteria, does not match them, or an error occurred (in which
 *	case an error is left in interp).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
    Tcl_Interp *interp,		/* Tcl interpreter */
    Tcl_Obj *objPtr)		/* Pointer to the object to convert */
{
    const char *string;
    int result = TCL_OK;
    Tcl_DString ds;
    Tcl_Encoding encoding = Tcl_GetEncoding(NULL, "macRoman");
    size_t length;

    string = Tcl_GetStringFromObj(objPtr, &length);
    Tcl_UtfToExternalDStringEx(encoding, string, length, TCL_ENCODING_NOCOMPLAIN, &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);
	}







|


|







636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
    Tcl_Interp *interp,		/* Tcl interpreter */
    Tcl_Obj *objPtr)		/* Pointer to the object to convert */
{
    const char *string;
    int result = TCL_OK;
    Tcl_DString ds;
    Tcl_Encoding encoding = Tcl_GetEncoding(NULL, "macRoman");
    Tcl_Size length;

    string = Tcl_GetStringFromObj(objPtr, &length);
    Tcl_UtfToExternalDStringEx(NULL, encoding, string, length, TCL_ENCODING_PROFILE_TCL8, &ds, NULL);

    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);
	}
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
    src[0] = (char) (osType >> 24);
    src[1] = (char) (osType >> 16);
    src[2] = (char) (osType >>  8);
    src[3] = (char) (osType);
    src[4] = '\0';

    encoding = Tcl_GetEncoding(NULL, "macRoman");
    Tcl_ExternalToUtf(NULL, encoding, src, -1, /* flags */ 0,
	    /* statePtr */ NULL, dst, size, /* srcReadPtr */ NULL,
	    /* dstWrotePtr */ &written, /* dstCharsPtr */ NULL);
    Tcl_FreeEncoding(encoding);

    (void)Tcl_InitStringRep(objPtr, NULL, written);
}








|







706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
    src[0] = (char) (osType >> 24);
    src[1] = (char) (osType >> 16);
    src[2] = (char) (osType >>  8);
    src[3] = (char) (osType);
    src[4] = '\0';

    encoding = Tcl_GetEncoding(NULL, "macRoman");
    Tcl_ExternalToUtf(NULL, encoding, src, TCL_INDEX_NONE, /* flags */ 0,
	    /* statePtr */ NULL, dst, size, /* srcReadPtr */ NULL,
	    /* dstWrotePtr */ &written, /* dstCharsPtr */ NULL);
    Tcl_FreeEncoding(encoding);

    (void)Tcl_InitStringRep(objPtr, NULL, written);
}


Changes to macosx/tclMacOSXNotify.c.

1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
 * 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.
 *
 *----------------------------------------------------------------------
 */







|







1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
 * 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 occurred and 1 if a non-tcl
 *	CFRunLoop source was processed.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Changes to tests-perf/listPerf.tcl.

1
2
3
4
5
6

7
8
9
10
11
12
13
14
#!/usr/bin/tclsh
# ------------------------------------------------------------------------
#
# listPerf.tcl --
#
#  This file provides performance tests for list operations.

#
# ------------------------------------------------------------------------
#
# See the file "license.terms" for information on usage and redistribution
# of this file.
#
# Note: this file does not use the test-performance.tcl framework as we want
# more direct control over timerate options.





|
>
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
#!/usr/bin/tclsh
# ------------------------------------------------------------------------
#
# listPerf.tcl --
#
#  This file provides performance tests for list operations. Run
#     tclsh listPerf.tcl help
#  for options.
# ------------------------------------------------------------------------
#
# See the file "license.terms" for information on usage and redistribution
# of this file.
#
# Note: this file does not use the test-performance.tcl framework as we want
# more direct control over timerate options.
73
74
75
76
77
78
79
80


81
82
83
84
85
86
87
                    set Lengths $val
                }
                -- {
                    # Remaining will be passed back to the caller
                    break
                }
                --* {
                    error "Unknown option $arg"


                }
                default {
                    # Remaining will be passed back to the caller
                    set argv [linsert $argv 0 $arg]
                    break;
                }
            }







|
>
>







74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
                    set Lengths $val
                }
                -- {
                    # Remaining will be passed back to the caller
                    break
                }
                --* {
                    puts stderr "Unknown option $arg"
                    print_usage
                    exit 1
                }
                default {
                    # Remaining will be passed back to the caller
                    set argv [linsert $argv 0 $arg]
                    break;
                }
            }
379
380
381
382
383
384
385


386
387
388
389
390
391
392
        }
        foreach len $Lengths {
            comment Create a list from expansion - single list (special optimal case)
            perf measure [list_describe $len "from a {*}list"] {list {*}$L} [list len $len]
            comment Create a list from two lists - real test of expansion speed
            perf measure [list_describe $len "from a {*}list {*}list"] {list {*}$L {*}$L} [list len [expr {$len/2}]]
        }


    }

    proc lappend_describe {share_mode len num iters} {
        return "lappend L\[$len\] $share_mode $num elems $iters times"
    }
    proc lappend_perf {} {
        variable Lengths







>
>







382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
        }
        foreach len $Lengths {
            comment Create a list from expansion - single list (special optimal case)
            perf measure [list_describe $len "from a {*}list"] {list {*}$L} [list len $len]
            comment Create a list from two lists - real test of expansion speed
            perf measure [list_describe $len "from a {*}list {*}list"] {list {*}$L {*}$L} [list len [expr {$len/2}]]
        }

        perf destroy
    }

    proc lappend_describe {share_mode len num iters} {
        return "lappend L\[$len\] $share_mode $num elems $iters times"
    }
    proc lappend_perf {} {
        variable Lengths
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
        set selections [perf::list::setup $::argv]
        if {[llength $selections] == 0} {
            set commands [info commands ::perf::list::*_perf]
        } else {
            set commands [lmap sel $selections {
                if {$sel eq "help"} {
                    print_usage
                    continue
                }
                set cmd ::perf::list::${sel}_perf
                if {$cmd ni [info commands ::perf::list::*_perf]} {
                    puts stderr "Error: command $sel is not known or supported. Skipping."
                    continue
                }
                set cmd







|







1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
        set selections [perf::list::setup $::argv]
        if {[llength $selections] == 0} {
            set commands [info commands ::perf::list::*_perf]
        } else {
            set commands [lmap sel $selections {
                if {$sel eq "help"} {
                    print_usage
                    exit 0
                }
                set cmd ::perf::list::${sel}_perf
                if {$cmd ni [info commands ::perf::list::*_perf]} {
                    puts stderr "Error: command $sel is not known or supported. Skipping."
                    continue
                }
                set cmd

Changes to tests/abstractlist.test.

1
2
3
4
5
6
7
8
9
10
11





12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
# Exercise AbstractList API via the "lstring" command defined in tclTestABSList.c
#
# Copyright © 2022 Brian Griffin
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}






testConstraint testevalex [llength [info commands testevalex]]

set abstractlisttestvars [info var *]

proc value-isa {var {expected ""}} {
    upvar $var v
    set t [lindex [tcl::unsupported::representation $v] 3]
    if {$expected ne "" && $expected ne $t} {
	set fail " expecting: $expected"
    } else {
	set fail ""
    }
    return "$var is a $t$fail"
}

proc value-cmp {vara varb} {
    upvar $vara a
    upvar $varb b
    set ta [tcl::unsupported::representation $a]
    set tb [tcl::unsupported::representation $b]
    return [string compare $ta $tb]
}
|










>
>
>
>
>





<
<
<
<
<
<
<
<
<
<
<







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











22
23
24
25
26
27
28
# Exercise AbstractList via the "lstring" command defined in tclTestABSList.c
#
# Copyright © 2022 Brian Griffin
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

catch {
    ::tcltest::loadTestedCommands
    package require -exact tcl::test [info patchlevel]
}

testConstraint testevalex [llength [info commands testevalex]]

set abstractlisttestvars [info var *]












proc value-cmp {vara varb} {
    upvar $vara a
    upvar $varb b
    set ta [tcl::unsupported::representation $a]
    set tb [tcl::unsupported::representation $b]
    return [string compare $ta $tb]
}
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
test abstractlist-1.1 {error cases} -body {
    lstring a b c
} -returnCodes 1 \
    -result {wrong # args: should be "lstring string"}

test abstractlist-2.0 {no shimmer llength} {
    set l [lstring $str]
    set l-isa [value-isa l]
    set len [llength $l]
    set l-isa2 [value-isa l]
    list $l ${l-isa} ${len} ${l-isa2}
} {{M y { } n a m e { } i s { } I n i g o { } M o n t o y a . { } Y o u { } k i l l e d { } m y { } f a t h e r . { } P r e p a r e { } t o { } d i e !} {l is a lstring} 63 {l is a lstring}}

test abstractlist-2.1 {no shimmer lindex} {
    set l [lstring $str]
    set l-isa [value-isa l]
    set ele [lindex $l 22]
    set l-isa2 [value-isa l]
    list $l ${l-isa} ${ele} ${l-isa2}
} {{M y { } n a m e { } i s { } I n i g o { } M o n t o y a . { } Y o u { } k i l l e d { } m y { } f a t h e r . { } P r e p a r e { } t o { } d i e !} {l is a lstring} y {l is a lstring}}

test abstractlist-2.2 {no shimmer lreverse} {
    set l [lstring $str]
    set l-isa [value-isa l]
    set r [lreverse $l]
    set r-isa [value-isa r]
    set l-isa2 [value-isa l]
    list $r ${l-isa} ${r-isa} ${l-isa2}
} {{! e i d { } o t { } e r a p e r P { } . r e h t a f { } y m { } d e l l i k { } u o Y { } . a y o t n o M { } o g i n I { } s i { } e m a n { } y M} {l is a lstring} {r is a lstring} {l is a lstring}}

test abstractlist-2.3 {no shimmer lrange} {
    set l [lstring $str]
    set l-isa [value-isa l]
    set il [lsearch -all [lstring $str] { }]
    set l-isa2 [value-isa l]
    lappend il [llength $l]
    set start 0
    set words [lmap i $il {
	set w [join [lrange $l $start $i-1] {} ]
	set start [expr {$i+1}]
	set w
    }]
    set l-isa3 [value-isa l]
    list ${l-isa} $il ${l-isa2} ${l-isa3} $words
} {{l is a lstring} {2 7 10 16 25 29 36 39 47 55 58 63} {l is a lstring} {l is a lstring} {My name is Inigo Montoya. You killed my father. Prepare to die!}}

test abstractlist-2.4 {no shimmer foreach} {
    set l [lstring $str]
    set l-isa [value-isa l]
    set word {}
    set words {}
    foreach c $l {
	if {$c eq { }} {
	    lappend words $word
	    set word {}
	} else {
	    append word $c
	}
    }
    if {$word ne ""} {
	lappend words $word
    }
    set l-isa2 [value-isa l]
    list ${l-isa} ${l-isa2} $words
} {{l is a lstring} {l is a lstring} {My name is Inigo Montoya. You killed my father. Prepare to die!}}

#
# The TBCE implements lreplace as a lrange + lappend operation, so, in this case, $m results is a list, not an lstring.
#
test abstractlist-2.5 {!no shimmer lreplace} {
    set l [lstring $str2]
    set l-isa [value-isa l]
    set m [lreplace $l 18 23 { } f a i l ?]
    set m-isa [value-isa m]
    set l-isa1 [value-isa l]
    list ${l-isa} $m ${m-isa} ${l-isa1}
} {{l is a lstring} {V i z z i n i : { } H E { } D I D N ' T { } f a i l ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} {m is a lstring} {l is a lstring}}

test abstractlist-2.6 {no shimmer ledit} {
    # "ledit m 9 8 S"
    set l [lstring $str2]
    set l-isa [value-isa l]
    set e [ledit l 9 8 S]
    set e-isa [value-isa e]
    list ${l-isa} $e ${e-isa}
} {{l is a lstring} {V i z z i n i : { } S H E { } D I D N ' T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} {e is a lstring}}

test abstractlist-2.7 {no shimmer linsert} {
    # "ledit m 9 8 S"
    set l [lstring $str2]
    set l-isa [value-isa l]
    set i [linsert $l 12 {*}[split "almost " {}]]
    set i-isa [value-isa i]
    set res [list ${l-isa} $i ${i-isa}]
    set p [lpop i 23]
    set p-isa [value-isa p]
    set i-isa2 [value-isa i]
    lappend res $p ${p-isa} $i ${i-isa2}


} {{l is a lstring} {V i z z i n i : { } H E { } a l m o s t { } D I D N ' T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} {i is a lstring} ' {p is a pure} {V i z z i n i : { } H E { } a l m o s t { } D I D N T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} {i is a lstring}}

test abstractlist-2.8 {shimmer lassign} {
    set l [lstring Inconceivable]
    set l-isa [value-isa l]
    set l2 [lassign $l i n c]
    set l-isa2 [value-isa l]
    set l2-isa [value-isa l2]
    list $l ${l-isa} $l2 ${l-isa2} ${l2-isa}
} {{I n c o n c e i v a b l e} {l is a lstring} {o n c e i v a b l e} {l is a lstring} {l2 is a lstring}}

test abstractlist-2.9 {no shimmer lremove} {
    set l [lstring Inconceivable]
    set l-isa [value-isa l]
    set l2 [lremove $l 0 1]
    set l-isa2 [value-isa l]
    set l2-isa [value-isa l2]
    list $l ${l-isa} $l2 ${l-isa2} ${l2-isa}
} {{I n c o n c e i v a b l e} {l is a lstring} {c o n c e i v a b l e} {l is a lstring} {l2 is a lstring}}

test abstractlist-2.10 {shimmer lreverse} {
    set l [lstring Inconceivable]
    set l-isa [value-isa l]
    set l2 [lreverse $l]
    set l-isa2 [value-isa l]
    set l2-isa [value-isa l2]
    list $l ${l-isa} $l2 ${l-isa2} ${l2-isa}
} {{I n c o n c e i v a b l e} {l is a lstring} {e l b a v i e c n o c n I} {l is a lstring} {l2 is a lstring}}

test abstractlist-2.11 {shimmer lset} {
    set l [lstring Inconceivable]
    set l-isa [value-isa l]
    set m [lset l 2 k]
    set m-isa [value-isa m]
    list $l ${l-isa} $m ${m-isa} [value-cmp l m]
} {{I n k o n c e i v a b l e} {l is a lstring} {I n k o n c e i v a b l e} {m is a lstring} 0}

# lrepeat
test abstractlist-2.12 {shimmer lrepeat} {
    set l [lstring Inconceivable]
    set l-isa [value-isa l]
    set m [lrepeat 3 $l]
    set m-isa [value-isa m]
    set n [lindex $m 1]
    list $l ${l-isa} $m ${m-isa} [value-isa n] [value-cmp l n]
} {{I n c o n c e i v a b l e} {l is a lstring} {{I n c o n c e i v a b l e} {I n c o n c e i v a b l e} {I n c o n c e i v a b l e}} {m is a list} {n is a lstring} 0}

test abstractlist-2.13 {no shimmer join llength==1} {
    set l [lstring G]
    set l-isa [value-isa l]
    set j [join $l :]
    set j-isa [value-isa j]
    list ${l-isa} $l ${j-isa} $j
} {{l is a lstring} G {j is a pure} G}

test abstractlist-2.14 {error case lset multiple indicies} -body {
    set l [lstring Inconceivable]
    set l-isa [value-isa l]
    set m [lset l 2 0 1 k]
    set m-isa [value-isa m]
    list $l ${l-isa} $m ${m-isa} [value-cmp l m]
} -returnCodes 1 \
    -result {Multiple indicies not supported by lstring.}

# lsort

test abstractlist-3.0 {no shimmer llength} {
    set l [lstring -not SLICE $str]
    set l-isa [value-isa l]
    set len [llength $l]
    set l-isa2 [value-isa l]
    list $l ${l-isa} ${len} ${l-isa2}
} {{M y { } n a m e { } i s { } I n i g o { } M o n t o y a . { } Y o u { } k i l l e d { } m y { } f a t h e r . { } P r e p a r e { } t o { } d i e !} {l is a lstring} 63 {l is a lstring}}

test abstractlist-3.1 {no shimmer lindex} {
    set l [lstring -not SLICE $str]
    set l-isa [value-isa l]
    set n 22
    set ele [lindex $l $n] ;# exercise INST_LIST_INDEX
    set l-isa2 [value-isa l]
    list $l ${l-isa} ${ele} ${l-isa2}
} {{M y { } n a m e { } i s { } I n i g o { } M o n t o y a . { } Y o u { } k i l l e d { } m y { } f a t h e r . { } P r e p a r e { } t o { } d i e !} {l is a lstring} y {l is a lstring}}

test abstractlist-3.2 {no shimmer lreverse} {
    set l [lstring -not SLICE $str]
    set l-isa [value-isa l]
    set r [lreverse $l]
    set r-isa [value-isa r]
    set l-isa2 [value-isa l]
    list $r ${l-isa} ${r-isa} ${l-isa2}
} {{! e i d { } o t { } e r a p e r P { } . r e h t a f { } y m { } d e l l i k { } u o Y { } . a y o t n o M { } o g i n I { } s i { } e m a n { } y M} {l is a lstring} {r is a lstring} {l is a lstring}}

test abstractlist-3.3 {shimmer lrange} {
    set l [lstring -not SLICE $str]
    set l-isa [value-isa l]
    set il [lsearch -all [lstring -not SLICE $str] { }]
    set l-isa2 [value-isa l]
    lappend il [llength $l]
    set start 0
    set words [lmap i $il {
	set w [join [lrange $l $start $i-1] {} ]
	set start [expr {$i+1}]
	set w
    }]
    set l-isa3 [value-isa l]; # lrange defaults to list behavior
    list ${l-isa} $il ${l-isa2} ${l-isa3} $words
} {{l is a lstring} {2 7 10 16 25 29 36 39 47 55 58 63} {l is a lstring} {l is a list} {My name is Inigo Montoya. You killed my father. Prepare to die!}}

test abstractlist-3.4 {no shimmer foreach} {
    set l [lstring -not SLICE $str]
    set l-isa [value-isa l]
    set word {}
    set words {}
    foreach c $l {
	if {$c eq { }} {
	    lappend words $word
	    set word {}
	} else {
	    append word $c
	}
    }
    if {$word ne ""} {
	lappend words $word
    }
    set l-isa2 [value-isa l]
    list ${l-isa} ${l-isa2} $words
} {{l is a lstring} {l is a lstring} {My name is Inigo Montoya. You killed my father. Prepare to die!}}

#
# The TBCE implements lreplace as a lrange + lappend operation, so, in this case, $m results is a list, not an lstring.
#
test abstractlist-3.5 {!no shimmer lreplace} {
    set l [lstring -not SLICE $str2]
    set l-isa [value-isa l]
    set m [lreplace $l 18 23 { } f a i l ?]
    set m-isa [value-isa m]
    set l-isa1 [value-isa l]
    list ${l-isa} $m ${m-isa} ${l-isa1}
} {{l is a lstring} {V i z z i n i : { } H E { } D I D N ' T { } f a i l ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} {m is a lstring} {l is a lstring}}

test abstractlist-3.6 {no shimmer ledit} {
    # "ledit m 9 8 S"
    set l [lstring -not SLICE $str2]
    set l-isa [value-isa l]
    set e [ledit l 9 8 S]
    set e-isa [value-isa e]
    list ${l-isa} $e ${e-isa}
} {{l is a lstring} {V i z z i n i : { } S H E { } D I D N ' T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} {e is a lstring}}

test abstractlist-3.7 {no shimmer linsert} {
    # "ledit m 9 8 S"
    set res {}
    set l [lstring -not SLICE $str2]
    set l-isa [value-isa l]
    set i [linsert $l 12 {*}[split "almost " {}]]
    set i-isa [value-isa i]
    set res [list ${l-isa} $i ${i-isa}]
    set p [lpop i 23]
    set p-isa [value-isa p]
    set i-isa2 [value-isa i]
    lappend res $p ${p-isa} $i ${i-isa2}
} {{l is a lstring} {V i z z i n i : { } H E { } a l m o s t { } D I D N ' T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} {i is a lstring} ' {p is a pure} {V i z z i n i : { } H E { } a l m o s t { } D I D N T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} {i is a lstring}}

test abstractlist-3.8 {shimmer lassign} {
    set l [lstring -not SLICE Inconceivable]
    set l-isa [value-isa l]
    set l2 [lassign $l i n c] ;# must be using lrange internally
    set l-isa2 [value-isa l]
    set l2-isa [value-isa l2]
    list $l ${l-isa} $l2 ${l-isa2} ${l2-isa}
} {{I n c o n c e i v a b l e} {l is a lstring} {o n c e i v a b l e} {l is a list} {l2 is a list}}

test abstractlist-3.9 {no shimmer lremove} {
    set l [lstring -not SLICE Inconceivable]
    set l-isa [value-isa l]
    set l2 [lremove $l 0 1]
    set l-isa2 [value-isa l]
    set l2-isa [value-isa l2]
    list $l ${l-isa} $l2 ${l-isa2} ${l2-isa}
} {{I n c o n c e i v a b l e} {l is a lstring} {c o n c e i v a b l e} {l is a lstring} {l2 is a lstring}}

test abstractlist-3.10 {shimmer lreverse} {
    set l [lstring -not SLICE Inconceivable]
    set l-isa [value-isa l]
    set l2 [lreverse $l]
    set l-isa2 [value-isa l]
    set l2-isa [value-isa l2]
    list $l ${l-isa} $l2 ${l-isa2} ${l2-isa}
} {{I n c o n c e i v a b l e} {l is a lstring} {e l b a v i e c n o c n I} {l is a lstring} {l2 is a lstring}}

test abstractlist-3.11 {shimmer lset} {
    set l [lstring -not SLICE Inconceivable]
    set l-isa [value-isa l]

    set m [lset l 2 k]
    set m-isa [value-isa m]
    list $l ${l-isa} $m ${m-isa} [value-cmp l m]
} {{I n k o n c e i v a b l e} {l is a lstring} {I n k o n c e i v a b l e} {m is a lstring} 0}

# lrepeat
test abstractlist-3.12 {shimmer lrepeat} {
    set l [lstring -not SLICE Inconceivable]
    set l-isa [value-isa l]
    set m [lrepeat 3 $l]
    set m-isa [value-isa m]
    set n [lindex $m 1]
    list $l ${l-isa} $m ${m-isa} [value-isa n] [value-cmp l n]
} {{I n c o n c e i v a b l e} {l is a lstring} {{I n c o n c e i v a b l e} {I n c o n c e i v a b l e} {I n c o n c e i v a b l e}} {m is a list} {n is a lstring} 0}

# lsort
foreach not {{} REVERSE SLICE SETELEMENT REPLACE GETELEMENTS} {

    testConstraint [format "%sShimmer" [string totitle $not]] [expr {$not eq ""}]
    set options [expr {$not ne "" ? "-not $not" : ""}]

test abstractlist-$not-4.0 {no shimmer llength} {
    set l [lstring {*}$options $str]
    set l-isa [value-isa l]
    set len [llength $l]
    set l-isa2 [value-isa l]
    list $l ${l-isa} ${len} ${l-isa2}
} {{M y { } n a m e { } i s { } I n i g o { } M o n t o y a . { } Y o u { } k i l l e d { } m y { } f a t h e r . { } P r e p a r e { } t o { } d i e !} {l is a lstring} 63 {l is a lstring}}

test abstractlist-$not-4.1 {no shimmer lindex} {
    set l [lstring {*}$options $str]
    set l-isa [value-isa l]
    set ele [lindex $l 22]
    set l-isa2 [value-isa l]
    list $l ${l-isa} ${ele} ${l-isa2}
} {{M y { } n a m e { } i s { } I n i g o { } M o n t o y a . { } Y o u { } k i l l e d { } m y { } f a t h e r . { } P r e p a r e { } t o { } d i e !} {l is a lstring} y {l is a lstring}}

test abstractlist-$not-4.2 {lreverse} ReverseShimmer {
    set l [lstring {*}$options $str]
    set l-isa [value-isa l]
    set r [lreverse $l]
    set r-isa [value-isa r]
    set l-isa2 [value-isa l]
    list $r ${l-isa} ${r-isa} ${l-isa2}
} {{! e i d { } o t { } e r a p e r P { } . r e h t a f { } y m { } d e l l i k { } u o Y { } . a y o t n o M { } o g i n I { } s i { } e m a n { } y M} {l is a lstring} {r is a lstring} {l is a lstring}}

test abstractlist-$not-4.3 {no shimmer lrange} RangeShimmer {
    set l [lstring {*}$options $str]
    set l-isa [value-isa l]
    set il [lsearch -all [lstring {*}$options $str] { }]
    set l-isa2 [value-isa l]
    lappend il [llength $l]
    set start 0
    set words [lmap i $il {
	set w [join [lrange $l $start $i-1] {} ]
	set start [expr {$i+1}]
	set w
    }]
    set l-isa3 [value-isa l]
    list ${l-isa} $il ${l-isa2} ${l-isa3} $words
} {{l is a lstring} {2 7 10 16 25 29 36 39 47 55 58 63} {l is a lstring} {l is a lstring} {My name is Inigo Montoya. You killed my father. Prepare to die!}}

test abstractlist-$not-4.4 {no shimmer foreach} {
    set l [lstring {*}$options $str]
    set l-isa [value-isa l]
    set word {}
    set words {}
    foreach c $l {
	if {$c eq { }} {
	    lappend words $word
	    set word {}
	} else {
	    append word $c
	}
    }
    if {$word ne ""} {
	lappend words $word
    }
    set l-isa2 [value-isa l]
    list ${l-isa} ${l-isa2} $words
} {{l is a lstring} {l is a lstring} {My name is Inigo Montoya. You killed my father. Prepare to die!}}

#
# The TBCE implements lreplace as a lrange + lappend operation, so, in this case, $m results is a list, not an lstring.
#
test abstractlist-$not-4.5 {!no shimmer lreplace} RangeShimmer {
    set l [lstring {*}$options $str2]
    set l-isa [value-isa l]
    set m [lreplace $l 18 23 { } f a i l ?]
    set m-isa [value-isa m]
    set l-isa1 [value-isa l]
    list ${l-isa} $m ${m-isa} ${l-isa1}
} {{l is a lstring} {V i z z i n i : { } H E { } D I D N ' T { } f a i l ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} {m is a list} {l is a lstring}}

test abstractlist-$not-4.6 {no shimmer ledit} {SetelementShimmer ReplaceShimmer} {
    # "ledit m 9 8 S"
    set l [lstring {*}$options $str2]
    set l-isa [value-isa l]
    set e [ledit l 9 8 S]
    set e-isa [value-isa e]
    list ${l-isa} $e ${e-isa}
} {{l is a lstring} {V i z z i n i : { } S H E { } D I D N ' T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} {e is a lstring}}

test abstractlist-$not-4.7 {no shimmer linsert} ReplaceShimmer {
    # "ledit m 9 8 S"
    set l [lstring {*}$options $str2]
    set l-isa [value-isa l]
    set i [linsert $l 12 {*}[split "almost " {}]]
    set i-isa [value-isa i]
    set res [list ${l-isa} $i ${i-isa}]
    set p [lpop i 23]
    set p-isa [value-isa p]
    set i-isa2 [value-isa i]
    lappend res $p ${p-isa} $i ${i-isa2}
} {{l is a lstring} {V i z z i n i : { } H E { } a l m o s t { } D I D N ' T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} {i is a lstring} ' {p is a pure} {V i z z i n i : { } H E { } a l m o s t { } D I D N T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} {i is a list}}

# lassign probably uses lrange internally
test abstractlist-$not-4.8 {shimmer lassign} RangeShimmer {
    set l [lstring {*}$options Inconceivable]
    set l-isa [value-isa l]
    set l2 [lassign $l i n c]
    set l-isa2 [value-isa l]
    set l2-isa [value-isa l2]
    list $l ${l-isa} $l2 ${l-isa2} ${l2-isa}
} {{I n c o n c e i v a b l e} {l is a lstring} {o n c e i v a b l e} {l is a lstring} {l2 is a lstring}}

test abstractlist-$not-4.9 {no shimmer lremove} ReplaceShimmer {
    set l [lstring {*}$options Inconceivable]
    set l-isa [value-isa l]
    set l2 [lremove $l 0 1]
    set l-isa2 [value-isa l]
    set l2-isa [value-isa l2]
    list $l ${l-isa} $l2 ${l-isa2} ${l2-isa}
} {{I n c o n c e i v a b l e} {l is a lstring} {c o n c e i v a b l e} {l is a lstring} {l2 is a lstring}}

test abstractlist-$not-4.10 {shimmer lreverse} ReverseShimmer {
    set l [lstring {*}$options Inconceivable]
    set l-isa [value-isa l]
    set l2 [lreverse $l]
    set l-isa2 [value-isa l]
    set l2-isa [value-isa l2]
    list $l ${l-isa} $l2 ${l-isa2} ${l2-isa}
} {{I n c o n c e i v a b l e} {l is a lstring} {e l b a v i e c n o c n I} {l is a lstring} {l2 is a lstring}}

test abstractlist-$not-4.11 {shimmer lset} SetelementShimmer {
    set l [lstring {*}$options Inconceivable]
    set l-isa [value-isa l]
    set m [lset l 2 k]
    set m-isa [value-isa m]
    list $l ${l-isa} $m ${m-isa} [value-cmp l m]
} {{I n k o n c e i v a b l e} {l is a lstring} {I n k o n c e i v a b l e} {m is a lstring} 0}

test abstractlist-$not-4.11x {lset not compiled} {SetelementShimmer testevalex} {
    set l [lstring {*}$options Inconceivable]
    set l-isa [value-isa l]
    set m [testevalex {lset l 2 k}]
    set m-isa [value-isa m]
    list $l ${l-isa} $m ${m-isa} [value-cmp l m]
} {{I n k o n c e i v a b l e} {l is a lstring} {I n k o n c e i v a b l e} {m is a lstring} 0}

test abstractlist-$not-4.11e {error case lset multiple indicies} \
    -constraints {SetelementShimmer testevalex} -body {
    set l [lstring Inconceivable]
    set l-isa [value-isa l]
    set m [testevalex {lset l 2 0 1 k}]
    set m-isa [value-isa m]
    list $l ${l-isa} $m ${m-isa} [value-cmp l m]
} -returnCodes 1 \
    -result {Multiple indicies not supported by lstring.}

# lrepeat
test abstractlist-$not-4.12 {shimmer lrepeat} {
    set l [lstring {*}$options Inconceivable]
    set l-isa [value-isa l]
    set m [lrepeat 3 $l]
    set m-isa [value-isa m]
    set n [lindex $m 1]
    list $l ${l-isa} $m ${m-isa} [value-isa n] [value-cmp l n]
} {{I n c o n c e i v a b l e} {l is a lstring} {{I n c o n c e i v a b l e} {I n c o n c e i v a b l e} {I n c o n c e i v a b l e}} {m is a list} {n is a lstring} 0}

# Disable constraint
testConstraint [format "%sShimmer" [string totitle $not]] 1

}


































































































# lsort

# cleanup
::tcltest::cleanupTests

proc my_abstl_cleanup {vars} {
    set nowvars [uplevel info vars]







|

|

|



|

|

|



|

|
|

|



|

|







|

|



|













|

|


|



|

|
|

|




|

|

|

|


|

|


|
|

>
>
|



|

|
|

|



|

|
|

|



|

|
|

|



|

|

|




|

|

|
|



|

|

|



|

|








|

|

|



|


|

|



|

|
|

|



|

|







|

|



|













|

|


|



|

|
|

|




|

|

|





|

|


|
|

|



|

|
|

|



|

|
|

|



|

|
|

|



|
>
|
|

|




|

|

|
|









|

|

|



|

|

|



|

|
|

|



|

|







|

|



|













|

|


|



|

|
|

|




|

|

|

|


|

|


|
|

|




|

|
|

|



|

|
|

|



|

|
|

|



|

|

|



|

|

|




|

|







|

|

|
|






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







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
test abstractlist-1.1 {error cases} -body {
    lstring a b c
} -returnCodes 1 \
    -result {wrong # args: should be "lstring string"}

test abstractlist-2.0 {no shimmer llength} {
    set l [lstring $str]
    set l-isa [testobj objtype $l]
    set len [llength $l]
    set l-isa2 [testobj objtype $l]
    list $l ${l-isa} ${len} ${l-isa2}
} {{M y { } n a m e { } i s { } I n i g o { } M o n t o y a . { } Y o u { } k i l l e d { } m y { } f a t h e r . { } P r e p a r e { } t o { } d i e !} lstring 63 lstring}

test abstractlist-2.1 {no shimmer lindex} {
    set l [lstring $str]
    set l-isa [testobj objtype $l]
    set ele [lindex $l 22]
    set l-isa2 [testobj objtype $l]
    list $l ${l-isa} ${ele} ${l-isa2}
} {{M y { } n a m e { } i s { } I n i g o { } M o n t o y a . { } Y o u { } k i l l e d { } m y { } f a t h e r . { } P r e p a r e { } t o { } d i e !} lstring y lstring}

test abstractlist-2.2 {no shimmer lreverse} {
    set l [lstring $str]
    set l-isa [testobj objtype $l]
    set r [lreverse $l]
    set r-isa [testobj objtype $r]
    set l-isa2 [testobj objtype $l]
    list $r ${l-isa} ${r-isa} ${l-isa2}
} {{! e i d { } o t { } e r a p e r P { } . r e h t a f { } y m { } d e l l i k { } u o Y { } . a y o t n o M { } o g i n I { } s i { } e m a n { } y M} lstring lstring lstring}

test abstractlist-2.3 {no shimmer lrange} {
    set l [lstring $str]
    set l-isa [testobj objtype $l]
    set il [lsearch -all [lstring $str] { }]
    set l-isa2 [testobj objtype $l]
    lappend il [llength $l]
    set start 0
    set words [lmap i $il {
	set w [join [lrange $l $start $i-1] {} ]
	set start [expr {$i+1}]
	set w
    }]
    set l-isa3 [testobj objtype $l]
    list ${l-isa} $il ${l-isa2} ${l-isa3} $words
} {lstring {2 7 10 16 25 29 36 39 47 55 58 63} lstring lstring {My name is Inigo Montoya. You killed my father. Prepare to die!}}

test abstractlist-2.4 {no shimmer foreach} {
    set l [lstring $str]
    set l-isa [testobj objtype $l]
    set word {}
    set words {}
    foreach c $l {
	if {$c eq { }} {
	    lappend words $word
	    set word {}
	} else {
	    append word $c
	}
    }
    if {$word ne ""} {
	lappend words $word
    }
    set l-isa2 [testobj objtype $l]
    list ${l-isa} ${l-isa2} $words
} {lstring lstring {My name is Inigo Montoya. You killed my father. Prepare to die!}}

#
# The TBCE implements lreplace as a lrange + lappend operation, so, in this case, $m list, not an lstring.
#
test abstractlist-2.5 {!no shimmer lreplace} {
    set l [lstring $str2]
    set l-isa [testobj objtype $l]
    set m [lreplace $l 18 23 { } f a i l ?]
    set m-isa [testobj objtype $m]
    set l-isa1 [testobj objtype $l]
    list ${l-isa} $m ${m-isa} ${l-isa1}
} {lstring {V i z z i n i : { } H E { } D I D N ' T { } f a i l ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} lstring lstring}

test abstractlist-2.6 {no shimmer ledit} {
    # "ledit m 9 8 S"
    set l [lstring $str2]
    set l-isa [testobj objtype $l]
    set e [ledit l 9 8 S]
    set e-isa [testobj objtype $e]
    list ${l-isa} $e ${e-isa}
} {lstring {V i z z i n i : { } S H E { } D I D N ' T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} lstring}

test abstractlist-2.7 {no shimmer linsert} -body {
    # "ledit m 9 8 S"
    set l [lstring $str2]
    set l-isa [testobj objtype $l]
    set i [linsert $l 12 {*}[split "almost " {}]]
    set i-isa [testobj objtype $i]
    set res [list ${l-isa} $i ${i-isa}]
    set p [lpop i 23]
    set p-isa [testobj objtype $p]
    set i-isa2 [testobj objtype $i]
    lappend res $p ${p-isa} $i ${i-isa2}
} -cleanup {
unset l i l-isa i-isa res p p-isa
} -result {lstring {V i z z i n i : { } H E { } a l m o s t { } D I D N ' T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} lstring ' none {V i z z i n i : { } H E { } a l m o s t { } D I D N T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} lstring}

test abstractlist-2.8 {shimmer lassign} {
    set l [lstring Inconceivable]
    set l-isa [testobj objtype $l]
    set l2 [lassign $l i n c]
    set l-isa2 [testobj objtype $l]
    set l2-isa [testobj objtype $l2]
    list $l ${l-isa} $l2 ${l-isa2} ${l2-isa}
} {{I n c o n c e i v a b l e} lstring {o n c e i v a b l e} lstring lstring}

test abstractlist-2.9 {no shimmer lremove} {
    set l [lstring Inconceivable]
    set l-isa [testobj objtype $l]
    set l2 [lremove $l 0 1]
    set l-isa2 [testobj objtype $l]
    set l2-isa [testobj objtype $l2]
    list $l ${l-isa} $l2 ${l-isa2} ${l2-isa}
} {{I n c o n c e i v a b l e} lstring {c o n c e i v a b l e} lstring lstring}

test abstractlist-2.10 {shimmer lreverse} {
    set l [lstring Inconceivable]
    set l-isa [testobj objtype $l]
    set l2 [lreverse $l]
    set l-isa2 [testobj objtype $l]
    set l2-isa [testobj objtype $l2]
    list $l ${l-isa} $l2 ${l-isa2} ${l2-isa}
} {{I n c o n c e i v a b l e} lstring {e l b a v i e c n o c n I} lstring lstring}

test abstractlist-2.11 {shimmer lset} {
    set l [lstring Inconceivable]
    set l-isa [testobj objtype $l]
    set m [lset l 2 k]
    set m-isa [testobj objtype $m]
    list $l ${l-isa} $m ${m-isa} [value-cmp l m]
} {{I n k o n c e i v a b l e} lstring {I n k o n c e i v a b l e} lstring 0}

# lrepeat
test abstractlist-2.12 {shimmer lrepeat} {
    set l [lstring Inconceivable]
    set l-isa [testobj objtype $l]
    set m [lrepeat 3 $l]
    set m-isa [testobj objtype $m]
    set n [lindex $m 1]
    list $l ${l-isa} $m ${m-isa} [testobj objtype $n] [value-cmp l n]
} {{I n c o n c e i v a b l e} lstring {{I n c o n c e i v a b l e} {I n c o n c e i v a b l e} {I n c o n c e i v a b l e}} list lstring 0}

test abstractlist-2.13 {no shimmer join llength==1} {
    set l [lstring G]
    set l-isa [testobj objtype $l]
    set j [join $l :]
    set j-isa [testobj objtype $j]
    list ${l-isa} $l ${j-isa} $j
} {lstring G none G}

test abstractlist-2.14 {error case lset multiple indicies} -body {
    set l [lstring Inconceivable]
    set l-isa [testobj objtype $l]
    set m [lset l 2 0 1 k]
    set m-isa [testobj objtype $m]
    list $l ${l-isa} $m ${m-isa} [value-cmp l m]
} -returnCodes 1 \
    -result {Multiple indicies not supported by lstring.}

# lsort

test abstractlist-3.0 {no shimmer llength} {
    set l [lstring -not SLICE $str]
    set l-isa [testobj objtype $l]
    set len [llength $l]
    set l-isa2 [testobj objtype $l]
    list $l ${l-isa} ${len} ${l-isa2}
} {{M y { } n a m e { } i s { } I n i g o { } M o n t o y a . { } Y o u { } k i l l e d { } m y { } f a t h e r . { } P r e p a r e { } t o { } d i e !} lstring 63 lstring}

test abstractlist-3.1 {no shimmer lindex} {
    set l [lstring -not SLICE $str]
    set l-isa [testobj objtype $l]
    set n 22
    set ele [lindex $l $n] ;# exercise INST_LIST_INDEX
    set l-isa2 [testobj objtype $l]
    list $l ${l-isa} ${ele} ${l-isa2}
} {{M y { } n a m e { } i s { } I n i g o { } M o n t o y a . { } Y o u { } k i l l e d { } m y { } f a t h e r . { } P r e p a r e { } t o { } d i e !} lstring y lstring}

test abstractlist-3.2 {no shimmer lreverse} {
    set l [lstring -not SLICE $str]
    set l-isa [testobj objtype $l]
    set r [lreverse $l]
    set r-isa [testobj objtype $r]
    set l-isa2 [testobj objtype $l]
    list $r ${l-isa} ${r-isa} ${l-isa2}
} {{! e i d { } o t { } e r a p e r P { } . r e h t a f { } y m { } d e l l i k { } u o Y { } . a y o t n o M { } o g i n I { } s i { } e m a n { } y M} lstring lstring lstring}

test abstractlist-3.3 {shimmer lrange} {
    set l [lstring -not SLICE $str]
    set l-isa [testobj objtype $l]
    set il [lsearch -all [lstring -not SLICE $str] { }]
    set l-isa2 [testobj objtype $l]
    lappend il [llength $l]
    set start 0
    set words [lmap i $il {
	set w [join [lrange $l $start $i-1] {} ]
	set start [expr {$i+1}]
	set w
    }]
    set l-isa3 [testobj objtype $l]; # lrange defaults to list behavior
    list ${l-isa} $il ${l-isa2} ${l-isa3} $words
} {lstring {2 7 10 16 25 29 36 39 47 55 58 63} lstring list {My name is Inigo Montoya. You killed my father. Prepare to die!}}

test abstractlist-3.4 {no shimmer foreach} {
    set l [lstring -not SLICE $str]
    set l-isa [testobj objtype $l]
    set word {}
    set words {}
    foreach c $l {
	if {$c eq { }} {
	    lappend words $word
	    set word {}
	} else {
	    append word $c
	}
    }
    if {$word ne ""} {
	lappend words $word
    }
    set l-isa2 [testobj objtype $l]
    list ${l-isa} ${l-isa2} $words
} {lstring lstring {My name is Inigo Montoya. You killed my father. Prepare to die!}}

#
# The TBCE implements lreplace as a lrange + lappend operation, so, in this case, $m list, not an lstring.
#
test abstractlist-3.5 {!no shimmer lreplace} {
    set l [lstring -not SLICE $str2]
    set l-isa [testobj objtype $l]
    set m [lreplace $l 18 23 { } f a i l ?]
    set m-isa [testobj objtype $m]
    set l-isa1 [testobj objtype $l]
    list ${l-isa} $m ${m-isa} ${l-isa1}
} {lstring {V i z z i n i : { } H E { } D I D N ' T { } f a i l ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} lstring lstring}

test abstractlist-3.6 {no shimmer ledit} {
    # "ledit m 9 8 S"
    set l [lstring -not SLICE $str2]
    set l-isa [testobj objtype $l]
    set e [ledit l 9 8 S]
    set e-isa [testobj objtype $e]
    list ${l-isa} $e ${e-isa}
} {lstring {V i z z i n i : { } S H E { } D I D N ' T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} lstring}

test abstractlist-3.7 {no shimmer linsert} {
    # "ledit m 9 8 S"
    set res {}
    set l [lstring -not SLICE $str2]
    set l-isa [testobj objtype $l]
    set i [linsert $l 12 {*}[split "almost " {}]]
    set i-isa [testobj objtype $i]
    set res [list ${l-isa} $i ${i-isa}]
    set p [lpop i 23]
    set p-isa [testobj objtype $p]
    set i-isa2 [testobj objtype $i]
    lappend res $p ${p-isa} $i ${i-isa2}
} {lstring {V i z z i n i : { } H E { } a l m o s t { } D I D N ' T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} lstring ' none {V i z z i n i : { } H E { } a l m o s t { } D I D N T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} lstring}

test abstractlist-3.8 {shimmer lassign} {
    set l [lstring -not SLICE Inconceivable]
    set l-isa [testobj objtype $l]
    set l2 [lassign $l i n c] ;# must be using lrange internally
    set l-isa2 [testobj objtype $l]
    set l2-isa [testobj objtype $l2]
    list $l ${l-isa} $l2 ${l-isa2} ${l2-isa}
} {{I n c o n c e i v a b l e} lstring {o n c e i v a b l e} list list}

test abstractlist-3.9 {no shimmer lremove} {
    set l [lstring -not SLICE Inconceivable]
    set l-isa [testobj objtype $l]
    set l2 [lremove $l 0 1]
    set l-isa2 [testobj objtype $l]
    set l2-isa [testobj objtype $l2]
    list $l ${l-isa} $l2 ${l-isa2} ${l2-isa}
} {{I n c o n c e i v a b l e} lstring {c o n c e i v a b l e} lstring lstring}

test abstractlist-3.10 {shimmer lreverse} {
    set l [lstring -not SLICE Inconceivable]
    set l-isa [testobj objtype $l]
    set l2 [lreverse $l]
    set l-isa2 [testobj objtype $l]
    set l2-isa [testobj objtype $l2]
    list $l ${l-isa} $l2 ${l-isa2} ${l2-isa}
} {{I n c o n c e i v a b l e} lstring {e l b a v i e c n o c n I} lstring lstring}

test abstractlist-3.11 {shimmer lset} {
    set l [lstring -not SLICE Inconceivable]
    set l-isa [testobj objtype $l]
    set four 4
    set m [lset l $four-2 k]
    set m-isa [testobj objtype $m]
    list $l ${l-isa} $m ${m-isa} [value-cmp l m]
} {{I n k o n c e i v a b l e} lstring {I n k o n c e i v a b l e} lstring 0}

# lrepeat
test abstractlist-3.12 {shimmer lrepeat} {
    set l [lstring -not SLICE Inconceivable]
    set l-isa [testobj objtype $l]
    set m [lrepeat 3 $l]
    set m-isa [testobj objtype $m]
    set n [lindex $m 1]
    list $l ${l-isa} $m ${m-isa} [testobj objtype $n] [value-cmp l n]
} {{I n c o n c e i v a b l e} lstring {{I n c o n c e i v a b l e} {I n c o n c e i v a b l e} {I n c o n c e i v a b l e}} list lstring 0}

# lsort
foreach not {{} REVERSE SLICE SETELEMENT REPLACE GETELEMENTS} {

    testConstraint [format "%sShimmer" [string totitle $not]] [expr {$not eq ""}]
    set options [expr {$not ne "" ? "-not $not" : ""}]

test abstractlist-$not-4.0 {no shimmer llength} {
    set l [lstring {*}$options $str]
    set l-isa [testobj objtype $l]
    set len [llength $l]
    set l-isa2 [testobj objtype $l]
    list $l ${l-isa} ${len} ${l-isa2}
} {{M y { } n a m e { } i s { } I n i g o { } M o n t o y a . { } Y o u { } k i l l e d { } m y { } f a t h e r . { } P r e p a r e { } t o { } d i e !} lstring 63 lstring}

test abstractlist-$not-4.1 {no shimmer lindex} {
    set l [lstring {*}$options $str]
    set l-isa [testobj objtype $l]
    set ele [lindex $l 22]
    set l-isa2 [testobj objtype $l]
    list $l ${l-isa} ${ele} ${l-isa2}
} {{M y { } n a m e { } i s { } I n i g o { } M o n t o y a . { } Y o u { } k i l l e d { } m y { } f a t h e r . { } P r e p a r e { } t o { } d i e !} lstring y lstring}

test abstractlist-$not-4.2 {lreverse} ReverseShimmer {
    set l [lstring {*}$options $str]
    set l-isa [testobj objtype $l]
    set r [lreverse $l]
    set r-isa [testobj objtype $r]
    set l-isa2 [testobj objtype $l]
    list $r ${l-isa} ${r-isa} ${l-isa2}
} {{! e i d { } o t { } e r a p e r P { } . r e h t a f { } y m { } d e l l i k { } u o Y { } . a y o t n o M { } o g i n I { } s i { } e m a n { } y M} lstring lstring lstring}

test abstractlist-$not-4.3 {no shimmer lrange} RangeShimmer {
    set l [lstring {*}$options $str]
    set l-isa [testobj objtype $l]
    set il [lsearch -all [lstring {*}$options $str] { }]
    set l-isa2 [testobj objtype $l]
    lappend il [llength $l]
    set start 0
    set words [lmap i $il {
	set w [join [lrange $l $start $i-1] {} ]
	set start [expr {$i+1}]
	set w
    }]
    set l-isa3 [testobj objtype $l]
    list ${l-isa} $il ${l-isa2} ${l-isa3} $words
} {lstring {2 7 10 16 25 29 36 39 47 55 58 63} lstring lstring {My name is Inigo Montoya. You killed my father. Prepare to die!}}

test abstractlist-$not-4.4 {no shimmer foreach} {
    set l [lstring {*}$options $str]
    set l-isa [testobj objtype $l]
    set word {}
    set words {}
    foreach c $l {
	if {$c eq { }} {
	    lappend words $word
	    set word {}
	} else {
	    append word $c
	}
    }
    if {$word ne ""} {
	lappend words $word
    }
    set l-isa2 [testobj objtype $l]
    list ${l-isa} ${l-isa2} $words
} {lstring lstring {My name is Inigo Montoya. You killed my father. Prepare to die!}}

#
# The TBCE implements lreplace as a lrange + lappend operation, so, in this case, $m list, not an lstring.
#
test abstractlist-$not-4.5 {!no shimmer lreplace} RangeShimmer {
    set l [lstring {*}$options $str2]
    set l-isa [testobj objtype $l]
    set m [lreplace $l 18 23 { } f a i l ?]
    set m-isa [testobj objtype $m]
    set l-isa1 [testobj objtype $l]
    list ${l-isa} $m ${m-isa} ${l-isa1}
} {lstring {V i z z i n i : { } H E { } D I D N ' T { } f a i l ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} list lstring}

test abstractlist-$not-4.6 {no shimmer ledit} {SetelementShimmer ReplaceShimmer} {
    # "ledit m 9 8 S"
    set l [lstring {*}$options $str2]
    set l-isa [testobj objtype $l]
    set e [ledit l 9 8 S]
    set e-isa [testobj objtype $e]
    list ${l-isa} $e ${e-isa}
} {lstring {V i z z i n i : { } S H E { } D I D N ' T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} lstring}

test abstractlist-$not-4.7 {no shimmer linsert} {ReplaceShimmer GetelementsShimmer}  {
    # "ledit m 9 8 S"
    set l [lstring {*}$options $str2]
    set l-isa [testobj objtype $l]
    set i [linsert $l 12 {*}[split "almost " {}]]
    set i-isa [testobj objtype $i]
    set res [list ${l-isa} $i ${i-isa}]
    set p [lpop i 23]
    set p-isa [testobj objtype $p]
    set i-isa2 [testobj objtype $i]
    lappend res $p ${p-isa} $i ${i-isa2}
} {lstring {V i z z i n i : { } H E { } a l m o s t { } D I D N ' T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} lstring ' none {V i z z i n i : { } H E { } a l m o s t { } D I D N T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} lstring}

# lassign probably uses lrange internally
test abstractlist-$not-4.8 {shimmer lassign} RangeShimmer {
    set l [lstring {*}$options Inconceivable]
    set l-isa [testobj objtype $l]
    set l2 [lassign $l i n c]
    set l-isa2 [testobj objtype $l]
    set l2-isa [testobj objtype $l2]
    list $l ${l-isa} $l2 ${l-isa2} ${l2-isa}
} {{I n c o n c e i v a b l e} lstring {o n c e i v a b l e} lstring lstring}

test abstractlist-$not-4.9 {no shimmer lremove} ReplaceShimmer {
    set l [lstring {*}$options Inconceivable]
    set l-isa [testobj objtype $l]
    set l2 [lremove $l 0 1]
    set l-isa2 [testobj objtype $l]
    set l2-isa [testobj objtype $l2]
    list $l ${l-isa} $l2 ${l-isa2} ${l2-isa}
} {{I n c o n c e i v a b l e} lstring {c o n c e i v a b l e} lstring lstring}

test abstractlist-$not-4.10 {shimmer lreverse} ReverseShimmer {
    set l [lstring {*}$options Inconceivable]
    set l-isa [testobj objtype $l]
    set l2 [lreverse $l]
    set l-isa2 [testobj objtype $l]
    set l2-isa [testobj objtype $l2]
    list $l ${l-isa} $l2 ${l-isa2} ${l2-isa}
} {{I n c o n c e i v a b l e} lstring {e l b a v i e c n o c n I} lstring lstring}

test abstractlist-$not-4.11 {shimmer lset} SetelementShimmer {
    set l [lstring {*}$options Inconceivable]
    set l-isa [testobj objtype $l]
    set m [lset l 2 k]
    set m-isa [testobj objtype $m]
    list $l ${l-isa} $m ${m-isa} [value-cmp l m]
} {{I n k o n c e i v a b l e} lstring {I n k o n c e i v a b l e} lstring 0}

test abstractlist-$not-4.11x {lset not compiled} {SetelementShimmer testevalex} {
    set l [lstring {*}$options Inconceivable]
    set l-isa [testobj objtype $l]
    set m [testevalex {lset l 2 k}]
    set m-isa [testobj objtype $m]
    list $l ${l-isa} $m ${m-isa} [value-cmp l m]
} {{I n k o n c e i v a b l e} lstring {I n k o n c e i v a b l e} lstring 0}

test abstractlist-$not-4.11e {error case lset multiple indicies} \
    -constraints {SetelementShimmer testevalex} -body {
    set l [lstring Inconceivable]
    set l-isa [testobj objtype $l]
    set m [testevalex {lset l 2 0 1 k}]
    set m-isa [testobj objtype $m]
    list $l ${l-isa} $m ${m-isa} [value-cmp l m]
} -returnCodes 1 \
    -result {Multiple indicies not supported by lstring.}

# lrepeat
test abstractlist-$not-4.12 {shimmer lrepeat} {
    set l [lstring {*}$options Inconceivable]
    set l-isa [testobj objtype $l]
    set m [lrepeat 3 $l]
    set m-isa [testobj objtype $m]
    set n [lindex $m 1]
    list $l ${l-isa} $m ${m-isa} [testobj objtype $n] [value-cmp l n]
} {{I n c o n c e i v a b l e} lstring {{I n c o n c e i v a b l e} {I n c o n c e i v a b l e} {I n c o n c e i v a b l e}} list lstring 0}

# Disable constraint
testConstraint [format "%sShimmer" [string totitle $not]] 1

}

#
# Test fix for bug in TEBC for STR CONCAT, and LIST INDEX
# instructions.
# This example abstract list (lgen) causes a rescursive call in TEBC,
# stack management was not included for these instructions in TEBC.
#
test abstractlist-lgen-bug {bug in str concat and list operations} -setup {
    set lgenfile [makeFile {
	# Test TIP 192 - Lazy Lists

	set res {}
	set cntr 0

	# Fatal error here when [source]'d -- It is a refcounting problem...
	lappend res Index*2:[lgen 1 expr 2* ]:--
	set x [lseq 17]
	set y [lgen 17 apply {{index} {expr {$index * 6}}}] ;# expr * 6
	foreach i $x n $y {
	    lappend res "$i -> $n"
	}
	proc my_expr {offset index} {
	    expr {$index + $offset}
	}
	lappend res my_expr(3):[my_expr 3 0]

	lappend res [set ss [lgen 15 my_expr 7]]
	lappend res s2:[list "Index+7:" $ss ":--"]

	lappend res  foo:[list "Index-8:" [lgen 15 my_expr -8] ":--"]

	set 9 [lgen 15 my_expr 7]
	lappend res 9len=[llength $9]
	lappend res 9(3)=[lindex $9 3]
	lappend res bar:[list "Index+7:" $9 ":--"]

	lappend res Index+7:$9:--

	lappend res Index+7:[lgen 15 my_expr 7]:--

	proc fib {phi n} {
	    set d [expr {round(pow($phi, $n) / sqrt(5.0))}]
	    return $d
	}
	set phi [expr {(1 + sqrt(5.0)) / 2.0}]

	lappend res fib:[lmap n [lseq 5] {fib $phi $n}]

	set x [lgen 20 fib $phi]
	lappend res "First 20 fibbinacci:[lgen 20 fib $phi]"
	lappend res "First 20 fibbinacci from x :$x"
	unset x
	lappend res Good-Bye!
	set res
    } source.file]
} -body {
    set tcl_traceExec 0
    set tcl_traceCompile 0
    set f $lgenfile
    #set script [format "puts ====-%s-====\nsource %s\nputs ====-done-====\n" $f $f]
    set script [format "source %s" $f]
    #puts stderr "eval $script"
    eval $script
} -cleanup {
    removeFile source.file
    unset res
} -result {Index*2:0:-- {0 -> 0} {1 -> 6} {2 -> 12} {3 -> 18} {4 -> 24} {5 -> 30} {6 -> 36} {7 -> 42} {8 -> 48} {9 -> 54} {10 -> 60} {11 -> 66} {12 -> 72} {13 -> 78} {14 -> 84} {15 -> 90} {16 -> 96} my_expr(3):3 {7 8 9 10 11 12 13 14 15 16 17 18 19 20 21} {s2:Index+7: {7 8 9 10 11 12 13 14 15 16 17 18 19 20 21} :--} {foo:Index-8: {-8 -7 -6 -5 -4 -3 -2 -1 0 1 2 3 4 5 6} :--} 9len=15 9(3)=10 {bar:Index+7: {7 8 9 10 11 12 13 14 15 16 17 18 19 20 21} :--} {Index+7:7 8 9 10 11 12 13 14 15 16 17 18 19 20 21:--} {Index+7:7 8 9 10 11 12 13 14 15 16 17 18 19 20 21:--} {fib:0 1 1 2 3} {First 20 fibbinacci:0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181} {First 20 fibbinacci from x :0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181} Good-Bye!}

test abstractlist-lgen-bug2 {bug in foreach} -body {

    set x [lseq 17]
    set y [lgen 17 expr 6*]

    lappend res x-[lrange [tcl::unsupported::representation $x] 0 3]
    lappend res y-[lrange [tcl::unsupported::representation $y] 0 3]
    foreach i $x n $y {
	lappend res "$i -> $n"
    }
    lappend res x-[lrange [tcl::unsupported::representation $x] 0 3]
    lappend res y-[lrange [tcl::unsupported::representation $y] 0 3]

} -cleanup {
    unset res
} -result {{x-value is a arithseries} {y-value is a lgenseries} {0 -> 0} {1 -> 6} {2 -> 12} {3 -> 18} {4 -> 24} {5 -> 30} {6 -> 36} {7 -> 42} {8 -> 48} {9 -> 54} {10 -> 60} {11 -> 66} {12 -> 72} {13 -> 78} {14 -> 84} {15 -> 90} {16 -> 96} {x-value is a arithseries} {y-value is a lgenseries}}

# scalar values
test abstractlist-int {TclLengthOne: anti-shimmer of boolean, int, double, bignum} {
    set res {}
    foreach i [list [expr {1+0}] [expr {true}] [expr {3.141592}] [expr {round(double(0x7fffffffffffffff))}]] {
	lappend res [testobj objtype $i]
	lappend res [llength $i]
	lappend res [testobj objtype $i]
    }
#set w [expr {3.141592}]
#lappend res [testobj objtype $w] [llength $w] [testobj objtype $w]
    set res
} {int 1 int boolean 1 boolean double 1 double bignum 1 bignum}

# lsort

# cleanup
::tcltest::cleanupTests

proc my_abstl_cleanup {vars} {
    set nowvars [uplevel info vars]

Changes to tests/append.test.

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
    lappend x(0) 44
} -result {can't set "x(0)": variable isn't array}

test append-7.1 {lappend-created var and error in trace on that var} -setup {
    catch {rename foo ""}
    unset -nocomplain x
} -body {
    trace variable x w foo
    proc foo {} {global x; unset x}
    catch {lappend x 1}
    proc foo {args} {global x; unset x}
    info exists x
    set x
    lappend x 1
    list [info exists x] [catch {set x} msg] $msg
} -result {0 1 {can't read "x": no such variable}}
test append-7.2 {lappend var triggers read trace} -setup {
    unset -nocomplain myvar
    unset -nocomplain ::result
} -body {
    trace variable myvar r foo
    proc foo {args} {append ::result $args}
    lappend myvar a
    return $::result
} -result {myvar {} r}
test append-7.3 {lappend var triggers read trace, array var} -setup {
    unset -nocomplain myvar
    unset -nocomplain ::result
} -body {
    # The behavior of read triggers on lappend changed in 8.0 to not trigger
    # them, and was changed back in 8.4.
    trace variable myvar r foo
    proc foo {args} {append ::result $args}
    lappend myvar(b) a
    return $::result
} -result {myvar b r}
test append-7.4 {lappend var triggers read trace, array var exists} -setup {
    unset -nocomplain myvar
    unset -nocomplain ::result
} -body {
    set myvar(0) 1
    trace variable myvar r foo
    proc foo {args} {append ::result $args}
    lappend myvar(b) a
    return $::result
} -result {myvar b r}
test append-7.5 {append var does not trigger read trace} -setup {
    unset -nocomplain myvar
    unset -nocomplain ::result
} -body {
    trace variable myvar r foo
    proc foo {args} {append ::result $args}
    append myvar a
    info exists ::result
} -result {0}

# THERE ARE NO append-8.* TESTS








|












|



|






|



|





|



|




|







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
    lappend x(0) 44
} -result {can't set "x(0)": variable isn't array}

test append-7.1 {lappend-created var and error in trace on that var} -setup {
    catch {rename foo ""}
    unset -nocomplain x
} -body {
    trace add variable x write foo
    proc foo {} {global x; unset x}
    catch {lappend x 1}
    proc foo {args} {global x; unset x}
    info exists x
    set x
    lappend x 1
    list [info exists x] [catch {set x} msg] $msg
} -result {0 1 {can't read "x": no such variable}}
test append-7.2 {lappend var triggers read trace} -setup {
    unset -nocomplain myvar
    unset -nocomplain ::result
} -body {
    trace add variable myvar read foo
    proc foo {args} {append ::result $args}
    lappend myvar a
    return $::result
} -result {myvar {} read}
test append-7.3 {lappend var triggers read trace, array var} -setup {
    unset -nocomplain myvar
    unset -nocomplain ::result
} -body {
    # The behavior of read triggers on lappend changed in 8.0 to not trigger
    # them, and was changed back in 8.4.
    trace add variable myvar read foo
    proc foo {args} {append ::result $args}
    lappend myvar(b) a
    return $::result
} -result {myvar b read}
test append-7.4 {lappend var triggers read trace, array var exists} -setup {
    unset -nocomplain myvar
    unset -nocomplain ::result
} -body {
    set myvar(0) 1
    trace add variable myvar read foo
    proc foo {args} {append ::result $args}
    lappend myvar(b) a
    return $::result
} -result {myvar b read}
test append-7.5 {append var does not trigger read trace} -setup {
    unset -nocomplain myvar
    unset -nocomplain ::result
} -body {
    trace add variable myvar read foo
    proc foo {args} {append ::result $args}
    append myvar a
    info exists ::result
} -result {0}

# THERE ARE NO append-8.* TESTS

Changes to tests/appendComp.test.

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

test appendComp-7.1 {lappendComp-created var and error in trace on that var} -setup {
    catch {rename foo ""}
    unset -nocomplain x
} -body {
    proc bar {} {
	global x
	trace variable x w foo
	proc foo {} {global x; unset x}
	catch {lappend x 1}
	proc foo {args} {global x; unset x}
	info exists x
	set x
	lappend x 1
	list [info exists x] [catch {set x} msg] $msg
    }
    bar
} -result {0 1 {can't read "x": no such variable}}
test appendComp-7.2 {lappend var triggers read trace, index var} -setup {
    unset -nocomplain ::result
} -body {
    proc bar {} {
	trace variable myvar r foo
	proc foo {args} {append ::result $args}
	lappend myvar a
	return $::result
    }
    bar
} -result {myvar {} r} -constraints {bug-3057639}
test appendComp-7.3 {lappend var triggers read trace, stack var} -setup {
    unset -nocomplain ::result
    unset -nocomplain ::myvar
} -body {
    proc bar {} {
	trace variable ::myvar r foo
	proc foo {args} {append ::result $args}
	lappend ::myvar a
	return $::result
    }
    bar
} -result {::myvar {} r} -constraints {bug-3057639}
test appendComp-7.4 {lappend var triggers read trace, array var} -setup {
    unset -nocomplain ::result
} -body {
    # The behavior of read triggers on lappend changed in 8.0 to not trigger
    # them. Maybe not correct, but been there a while.
    proc bar {} {
	trace variable myvar r foo
	proc foo {args} {append ::result $args}
	lappend myvar(b) a
	return $::result
    }
    bar
} -result {myvar b r} -constraints {bug-3057639}
test appendComp-7.5 {lappend var triggers read trace, array var} -setup {
    unset -nocomplain ::result
} -body {
    # The behavior of read triggers on lappend changed in 8.0 to not trigger
    # them. Maybe not correct, but been there a while.
    proc bar {} {
	trace variable myvar r foo
	proc foo {args} {append ::result $args}
	lappend myvar(b) a b
	return $::result
    }
    bar
} -result {myvar b r}
test appendComp-7.6 {lappend var triggers read trace, array var exists} -setup {
    unset -nocomplain ::result
} -body {
    proc bar {} {
	set myvar(0) 1
	trace variable myvar r foo
	proc foo {args} {append ::result $args}
	lappend myvar(b) a
	return $::result
    }
    bar
} -result {myvar b r} -constraints {bug-3057639}
test appendComp-7.7 {lappend var triggers read trace, array stack var} -setup {
    unset -nocomplain ::myvar
    unset -nocomplain ::result
} -body {
    proc bar {} {
	trace variable ::myvar r foo
	proc foo {args} {append ::result $args}
	lappend ::myvar(b) a
	return $::result
    }
    bar
} -result {::myvar b r} -constraints {bug-3057639}
test appendComp-7.8 {lappend var triggers read trace, array stack var} -setup {
    unset -nocomplain ::myvar
    unset -nocomplain ::result
} -body {
    proc bar {} {
	trace variable ::myvar r foo
	proc foo {args} {append ::result $args}
	lappend ::myvar(b) a b
	return $::result
    }
    bar
} -result {::myvar b r}
test appendComp-7.9 {append var does not trigger read trace} -setup {
    unset -nocomplain ::result
} -body {
    proc bar {} {
	trace variable myvar r foo
	proc foo {args} {append ::result $args}
	append myvar a
	info exists ::result
    }
    bar
} -result {0}








|














|





|





|












|





|






|





|





|





|





|





|





|





|




|







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

test appendComp-7.1 {lappendComp-created var and error in trace on that var} -setup {
    catch {rename foo ""}
    unset -nocomplain x
} -body {
    proc bar {} {
	global x
	trace add variable x write foo
	proc foo {} {global x; unset x}
	catch {lappend x 1}
	proc foo {args} {global x; unset x}
	info exists x
	set x
	lappend x 1
	list [info exists x] [catch {set x} msg] $msg
    }
    bar
} -result {0 1 {can't read "x": no such variable}}
test appendComp-7.2 {lappend var triggers read trace, index var} -setup {
    unset -nocomplain ::result
} -body {
    proc bar {} {
	trace add variable myvar read foo
	proc foo {args} {append ::result $args}
	lappend myvar a
	return $::result
    }
    bar
} -result {myvar {} read} -constraints {bug-3057639}
test appendComp-7.3 {lappend var triggers read trace, stack var} -setup {
    unset -nocomplain ::result
    unset -nocomplain ::myvar
} -body {
    proc bar {} {
	trace add variable ::myvar read foo
	proc foo {args} {append ::result $args}
	lappend ::myvar a
	return $::result
    }
    bar
} -result {::myvar {} r} -constraints {bug-3057639}
test appendComp-7.4 {lappend var triggers read trace, array var} -setup {
    unset -nocomplain ::result
} -body {
    # The behavior of read triggers on lappend changed in 8.0 to not trigger
    # them. Maybe not correct, but been there a while.
    proc bar {} {
	trace add variable myvar read foo
	proc foo {args} {append ::result $args}
	lappend myvar(b) a
	return $::result
    }
    bar
} -result {myvar b read} -constraints {bug-3057639}
test appendComp-7.5 {lappend var triggers read trace, array var} -setup {
    unset -nocomplain ::result
} -body {
    # The behavior of read triggers on lappend changed in 8.0 to not trigger
    # them. Maybe not correct, but been there a while.
    proc bar {} {
	trace add variable myvar read foo
	proc foo {args} {append ::result $args}
	lappend myvar(b) a b
	return $::result
    }
    bar
} -result {myvar b read}
test appendComp-7.6 {lappend var triggers read trace, array var exists} -setup {
    unset -nocomplain ::result
} -body {
    proc bar {} {
	set myvar(0) 1
	trace add variable myvar read foo
	proc foo {args} {append ::result $args}
	lappend myvar(b) a
	return $::result
    }
    bar
} -result {myvar b read} -constraints {bug-3057639}
test appendComp-7.7 {lappend var triggers read trace, array stack var} -setup {
    unset -nocomplain ::myvar
    unset -nocomplain ::result
} -body {
    proc bar {} {
	trace add variable ::myvar read foo
	proc foo {args} {append ::result $args}
	lappend ::myvar(b) a
	return $::result
    }
    bar
} -result {::myvar b read} -constraints {bug-3057639}
test appendComp-7.8 {lappend var triggers read trace, array stack var} -setup {
    unset -nocomplain ::myvar
    unset -nocomplain ::result
} -body {
    proc bar {} {
	trace add variable ::myvar read foo
	proc foo {args} {append ::result $args}
	lappend ::myvar(b) a b
	return $::result
    }
    bar
} -result {::myvar b read}
test appendComp-7.9 {append var does not trigger read trace} -setup {
    unset -nocomplain ::result
} -body {
    proc bar {} {
	trace add variable myvar read foo
	proc foo {args} {append ::result $args}
	append myvar a
	info exists ::result
    }
    bar
} -result {0}

380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
# Note also the tests above now constrained by bug-3057639, these changed
# behaviour with the triggering of read traces in bc mode gone.

# Going back to the tests below. The direct-eval tests are ok before and after
# patch (no read traces run for lappend, append). The compiled tests are
# failing for lappend (9.0/1) before the patch, showing how it invokes read
# traces in the compiled path. The append tests are good (9.2/3). After the
# patch the failues are gone.

test appendComp-9.0 {bug 3057639, lappend compiled, read trace on non-existing array variable element} -setup {
    unset -nocomplain myvar
    array set myvar {}
} -body {
    proc nonull {var key val} {
	upvar 1 $var lvar







|







380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
# Note also the tests above now constrained by bug-3057639, these changed
# behaviour with the triggering of read traces in bc mode gone.

# Going back to the tests below. The direct-eval tests are ok before and after
# patch (no read traces run for lappend, append). The compiled tests are
# failing for lappend (9.0/1) before the patch, showing how it invokes read
# traces in the compiled path. The append tests are good (9.2/3). After the
# patch the failures are gone.

test appendComp-9.0 {bug 3057639, lappend compiled, read trace on non-existing array variable element} -setup {
    unset -nocomplain myvar
    array set myvar {}
} -body {
    proc nonull {var key val} {
	upvar 1 $var lvar

Changes to tests/basic.test.

344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
    list [testcmdtoken name $x] \
         [rename test_ns_basic::test_ns_basic2::p q] \
         [testcmdtoken name $x]
} {{p ::test_ns_basic::test_ns_basic2::p} {} {q ::q}}
test basic-20.3 {Tcl_GetCommandInfo, #-quoting} testcmdtoken {
    catch {rename \# ""}
    set x [testcmdtoken create \#]
    testcmdtoken name $x
} {{#} ::#}

test basic-21.1 {Tcl_GetCommandName} {emptyTest} {
} {}

test basic-22.1 {Tcl_GetCommandFullName} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}







|







344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
    list [testcmdtoken name $x] \
         [rename test_ns_basic::test_ns_basic2::p q] \
         [testcmdtoken name $x]
} {{p ::test_ns_basic::test_ns_basic2::p} {} {q ::q}}
test basic-20.3 {Tcl_GetCommandInfo, #-quoting} testcmdtoken {
    catch {rename \# ""}
    set x [testcmdtoken create \#]
    return [testcmdtoken name $x]
} {{#} ::#}

test basic-21.1 {Tcl_GetCommandName} {emptyTest} {
} {}

test basic-22.1 {Tcl_GetCommandFullName} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}

Added tests/bigdata.test.































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
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
# Test cases for large sized data
#
# Copyright © 2023 Ashok P. Nadkarni
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# These are very rudimentary tests for large size arguments to commands.
# They do not exercise all possible code paths such as shared/unshared Tcl_Objs,
# literal/variable arguments etc.
# They do however test compiled and uncompiled execution.

if {"::tcltest" ni [namespace children]} {
    package require tcltest

    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]
source [file join [file dirname [info script]] tcltests.tcl]

#
# bigtest and bigtestRO (RO->read only) generate compiled and uncompiled
# versions of the given test script. The difference between the two is
# that bigtest generates separate test instances for the two cases while
# bigtestRO generates a single test case covering both. The latter can
# only be used when operands are not modified and when combining tests
# does not consume too much additional memory.

# Wrapper to generate compiled and uncompiled cases for a test. If $args does
# not contain a -body key, $comment is treated as the test body
proc bigtest {id comment result args} {
    if {[dict exists $args -body]} {
        set body [dict get $args -body]
        dict unset args -body
    } else {
        set body $comment
    }
    dict lappend args -constraints bigdata

    uplevel 1 [list test $id.uncompiled "$comment (uncompiled)" \
                   -body [list testevalex $body] \
                   -result $result \
                   {*}$args]

    uplevel 1 [list test $id.compiled-script "$comment (compiled script)" \
                   -body [list try $body] \
                   -result $result \
                   {*}$args]

    return

    # TODO - is this proc compilation required separately from the compile-script above?
    dict append args -setup \n[list proc testxproc {} $body]
    dict append args -cleanup "\nrename testxproc {}"
    uplevel 1 [list test $id.compiled-proc "$comment (compiled proc)" \
                   -body {testxproc} \
                   -result $result \
                   {*}$args]
}

# Like bigtest except that both compiled and uncompiled are combined into one
# test using the same inout argument. This saves time but for obvious reasons
# should only be used when the input argument is not modified.
proc bigtestRO {id comment result args} {
    if {[dict exists $args -body]} {
        set body [dict get $args -body]
        dict unset args -body
    } else {
        set body $comment
    }
    dict lappend args -constraints bigdata

    set wrapper ""
    set body "{$body}"
    append wrapper "set uncompiled_result \[testevalex $body]" \n
    append wrapper "set compiled_result \[try $body]" \n
    append wrapper {list $uncompiled_result $compiled_result}
    uplevel 1 [list test $id.uncompiled,compiled {$comment} \
                   -body $wrapper \
                   -result [list $result $result] \
                   {*}$args]
    return
}

interp alias {} bigClean {} unset -nocomplain s s1 s2 bin bin1 bin2 l l1 l2

interp alias {} bigString {} testbigdata string
interp alias {} bigBinary {} testbigdata bytearray
interp alias {} bigList {} testbigdata list
proc bigPatLen {} {
    proc bigPatLen {} "return [string length [testbigdata string]]"
    bigPatLen
}

# Returns list of expected elements at the indices specified
proc bigStringIndices {indices} {
    set pat [testbigdata string]
    set patlen [string length $pat]
    lmap idx $indices {
        string index $pat [expr {$idx%$patlen}]
    }
}

# Returns the largest multiple of the pattern length that is less than $limit
proc bigPatlenMultiple {limit} {
    set patlen [bigPatLen]
    return [expr {($limit/$patlen)*$patlen}]
}

set ::bigLengths(intmax) 0x7fffffff
set ::bigLengths(uintmax) 0xffffffff
# Some tests are more convenient if operands are multiple of pattern length
if {[testConstraint bigdata]} {
set ::bigLengths(patlenmultiple) [bigPatlenMultiple $::bigLengths(intmax)]
set ::bigLengths(upatlenmultiple) [bigPatlenMultiple $::bigLengths(uintmax)]
}

#
# script limits
bigtestRO script-length-bigdata-1 {Test script length limit} b -body {
    try [string cat [string repeat " " 0x7ffffff7] "set a b"]
}
# TODO - different behaviour between compiled and uncompiled
test script-length-bigdata-2.compiled {Test script length limit} -body {
    try [string cat [string repeat " " 0x7ffffff8] "set a b"]
} -constraints {
    bigdata
} -result {Script length 2147483647 exceeds max permitted length 2147483646.} -returnCodes error
test script-length-bigdata-2.uncompiled {Test script length limit} -body {
    testevalex [string cat [string repeat " " 0x7ffffff8] "set a b"]
} -constraints {
    bigdata
 } -result b
test script-bytecode-length-bigdata-1 {Test bytecode length limit} -body {
    # Note we need to exceed bytecode limit without exceeding script char limit
    set s [string repeat {{*}$x;} [expr 0x7fffffff/6]]
    catch $s r e
} -cleanup {
    bigClean
} -constraints panic-in-EnterCmdStartData

#
# string cat
bigtest string-cat-bigdata-1 "string cat large small result > INT_MAX" 1 -body {
    string equal \
        [string cat [bigString $::bigLengths(patlenmultiple)] [bigString]] \
        [bigString [expr {[bigPatLen]+$::bigLengths(patlenmultiple)}]]
}
bigtest string-cat-bigdata-2 "string cat small large result > INT_MAX" 1 -body {
    string equal \
        [string cat [bigString] [bigString $::bigLengths(patlenmultiple)]] \
        [bigString [expr {[bigPatLen]+$::bigLengths(patlenmultiple)}]]
}
bigtest string-cat-bigdata-3 "string cat result > UINT_MAX" 1 -body {
    set s [bigString $::bigLengths(patlenmultiple)]
    string equal \
        [string cat $s [bigString] $s] \
        [bigString [expr {[bigPatLen]+2*$::bigLengths(patlenmultiple)}]]
}

#
# string compare/equal
bigtestRO string-equal/compare-bigdata-1 "string compare/equal equal strings" {0 1} -body {
    list [string compare $s1 $s2] [string equal $s1 $s2]
} -setup {
    set s1 [bigString 0x100000000]
    set s2 [bigString 0x100000000]; # Separate so Tcl_Obj is not the same
} -cleanup {
    bigClean
}
bigtestRO string-equal/compare-bigdata-2 "string compare/equal -length unequal strings" {-1 0 0 1} -body {
    # Also tests lengths do not wrap
    set result {}
    lappend result [string compare $s1 $s2]
    lappend result [string equal $s1 $s2]
    # Check lengths > UINT_MAX
    # Also that lengths do not truncate to sizeof(int)
    lappend result [string compare -length 0x100000000 $s1 $s2]
    lappend result [string equal -length 0x100000000 $s1 $s2]
} -setup {
    set s1 [bigString 0x100000001]
    set s2 [bigString 0x100000001 0x100000000]; # Differs in last char
} -cleanup {
    bigClean
}

#
# string first
bigtestRO string-first-bigdata-1 "string first > INT_MAX" {2147483648 -1 2147483650 1} -body {
    list \
        [string first X $s] \
        [string first Y $s] \
        [string first 0 $s 0x80000000] \
        [string first 1 $s end-0x80000010]
} -setup {
    set s [bigString 0x8000000a 0x80000000]
} -cleanup {
    bigClean
}

bigtestRO string-first-bigdata-2 "string first > UINT_MAX" {4294967296 -1 4294967300 1} -body {
    list \
        [string first X $s] \
        [string first Y $s] \
        [string first 0 $s 0x100000000] \
        [string first 1 $s end-0x100000010]
} -setup {
    set s [bigString 0x10000000a 0x100000000]
} -cleanup {
    bigClean
}

bigtestRO string-first-bigdata-3 "string first - long needle" 10 -body {
    string first $needle $s
} -setup {
    set s [bigString 0x10000000a 0]
    set needle [bigString 0x100000000]
} -cleanup {
   bigClean needle
}

#
# string index
bigtestRO string-index-bigdata-1 "string index" {6 7 5 {} 5 4 {} 9 {}} -body {
    list \
        [string index $s 0x100000000] \
        [string index $s 0x100000000+1] \
        [string index $s 0x100000000-1] \
        [string index $s 0x10000000a] \
        [string index $s end] \
        [string index $s end-1] \
        [string index $s end+1] \
        [string index $s end-0x100000000] \
        [string index $s end-0x10000000a]
} -setup {
    set s [bigString 0x10000000a]
} -cleanup {
    bigClean
}

#
# string insert
bigtestRO string-insert-bigdata-1 "string insert" 1 -body {
    # Note insert at multiple of 10 to enable comparison against generated string
    string equal [string insert [bigString 4294967312] 4294967310 "0123456789"] [bigString 4294967322]
}
bigtestRO string-insert-bigdata-2 "string insert" 1 -body {
    string equal [string insert [bigString 4294967312] 10 "0123456789"] [bigString 4294967322]
}

#
# string is
bigtestRO string-is-bigdata-1 "string is" {1 0 0 4294967296} -body {
    # TODO - add the other "is" classes
    unset -nocomplain failat result
    lappend result [string is alnum -failindex failat $s] [info exists failat]
    lappend result [string is digit -failindex failat $s] $failat
} -setup {
    set s [bigString 0x10000000a 0x100000000]
} -cleanup {
    bigClean failat
}

#
# string last
bigtestRO string-last-bigdata-1 "string last > INT_MAX" {2 -1 2147483640 11} -body {
    set s [bigString 0x80000010 2]
    list \
        [string last X $s] \
        [string last Y $s] \
        [string last 0 $s 0x80000000] \
        [string last 1 $s end-0x80000000]
} -setup {
    set s [bigString 0x80000010 2]
} -cleanup {
    bigClean
}
bigtestRO string-last-bigdata-2 "string last > UINT_MAX" {4294967300 -1 4294967290 1} -body {
    list \
        [string last 0 $s] \
        [string last Y $s] \
        [string last 0 $s 0x100000000] \
        [string last 1 $s end-0x100000010]
} -setup {
    set s [bigString 0x10000000a 2]
} -cleanup {
    bigClean
}
bigtestRO string-last-bigdata-3 "string last - long needle" 0 -body {
    string last $needle $s
} -setup {
    set s [bigString 0x10000000a 0x10000000a]
    set needle [bigString 0x100000000]
} -cleanup {
    bigClean needle
}

#
# string length
bigtestRO string-length-bigdata-1 {string length $s} 4294967296 -setup {
    set s [bigString 0x100000000]
} -cleanup {
    bigClean
}

#
# string map
bigtestRO string-map-bigdata-1 {string map} {5 0 0 5} -body {
    # Unset explicitly before setting to save memory as bigtestRO runs the
    # script below twice.
    unset -nocomplain s2
    set s2 [string map {0 5 5 0} $s]
    list \
        [string index $s2 0] \
        [string index $s2 5] \
        [string index $s2 end] \
        [string index $s2 end-5]
} -setup {
    set s [bigString 0x100000000]
} -cleanup {
    bigClean
} -constraints bug-takesTooLong

#
# string match
bigtestRO string-match-bigdata-1 {string match} {1 0 1} -body {
    list \
        [string match 0*5 $s] \
        [string match 0*4 $s] \
        [string match $s $s]
} -setup {
    set s [bigString 0x100000000]
} -cleanup {
    bigClean
}

#
# string range
bigtestRO string-range-bigdata-1 "string range" {6 7 5 {} 5 4 {} 9 {}} -body {
    list \
        [string range $s 0x100000000 0x100000000] \
        [string range $s 0x100000000+1 0x100000000+1] \
        [string range $s 0x100000000-1 0x100000000-1] \
        [string range $s 0x10000000a 0x10000000a] \
        [string range $s end end] \
        [string range $s end-1 end-1] \
        [string range $s end+1 end+1] \
        [string range $s end-0x100000000 end-0x100000000] \
        [string range $s end-0x10000000a end-0x10000000a]
} -setup {
    set s [bigString 0x10000000a]
} -cleanup {
    bigClean
}
bigtestRO string-range-bigdata-2 "bug ad9361fd20 case 1" aXaaaa -body {
    string range [string insert [string repeat a 0x80000000] end-0x7fffffff X] 0 5
}
bigtestRO string-range-bigdata-3 "bug ad9361fd20 case 2" 2 -body {
    string length [string range $s end-0x7fffffff end-0x7ffffffe]
} -setup {
    set s [string repeat a 0xffffffff]
} -cleanup {
    bigClean
}
# TODO - add tests for large result range

#
# string repeat - use bigtest, not bigtestRO !!
bigtest string-repeat-bigdata-1 "string repeat single char length > UINT_MAX" 4294967296 -body {
    string length [string repeat x 0x100000000]
}
bigtest string-repeat-bigdata-2 "string repeat multiple char" {4294967296 0123456789abcdef 0123456789abcdef} -body {
    set s [string repeat 0123456789abcdef [expr 0x100000000/16]]
    list \
        [string length $s] \
        [string range $s 0 15] \
        [string range $s end-15 end]
} -cleanup {
    bigClean
}

#
# string replace
bigtestRO string-replace-bigdata-1 "string replace" {789012345 012345678 XYZ789012345 012345678XYZ} -body {
    # Unset explicitly before setting to save memory as bigtestRO runs the
    # script below twice.
    unset -nocomplain result
    lappend result [string replace $s 0 0x100000000]
    lappend result [string replace $s end-0x100000000 end]
    lappend result [string replace $s 0 0x100000000 XYZ]
    lappend result [string replace $s end-0x100000000 end XYZ]
} -setup {
    set s [bigString 0x10000000a]
} -cleanup {
    bigClean
}
# TODO -
# - replacements string is large
# - replace in the middle - string length grows, shrinks
# - last < first

#
# string reverse
bigtestRO string-reverse-bigdata-1 "string reverse" {5432109876 9876543210} -body {
    # Unset explicitly before setting to save memory as bigtestRO runs the
    # script below twice.
    unset -nocomplain s2 result
    set s2 [string reverse $s]
    list [string range $s2 0 9] [string range $s2 end-9 end]
} -setup {
    set s [bigString 0x10000000a]
} -cleanup {
    bigClean
}

#
# string tolower
bigtestRO string-tolower-bigdata-1 "string tolower" 1 -body {
    string equal [string tolower $s] [string repeat abcd $repts]
} -setup {
    set repts [expr 0x100000010/4]
    set s [string repeat ABCD $repts]
} -cleanup {
    bigClean repts
}
bigtestRO string-tolower-bigdata-2 "string tolower first last" {4294967312 ABCDabcdABCD 4294967312 ABCDabcdABCD 4294967312 ABCDabcdABCD} -body {
    # Unset explicitly before setting to save memory as bigtestRO runs the
    # script below twice.
    unset -nocomplain s2 result
    set s2 [string tolower $s 4 7]
    lappend result [string length $s2] [string range $s2 0 11]

    unset s2; #Explicit free to reduce total memory
    set s2 [string tolower $s 0x100000008 0x10000000b]
    lappend result [string length $s2] [string range $s2 0x100000004 end]

    unset s2; #Explicit free to reduce total memory
    set s2 [string tolower $s end-7 end-4]
    lappend result [string length $s2] [string range $s2 0x100000004 end]
} -setup {
    set repts [expr 0x100000010/4]
    set s [string repeat ABCD $repts]
} -cleanup {
    bigClean repts
}

#
# string totitle
bigtestRO string-totitle-bigdata-1 "string totitle first last" {4294967312 aBcDAbcdaBcD 4294967312 aBcDAbcdaBcD 4294967312 aBcDAbcdaBcD} -body {
    # Unset explicitly before setting to save memory as bigtestRO runs the
    # script below twice.
    unset -nocomplain s2 result
    set s2 [string totitle $s 4 7]
    lappend result [string length $s2] [string range $s2 0 11]
    unset s2; #Explicit free to reduce total memory
    set s2 [string totitle $s 0x100000008 0x10000000b]
    lappend result [string length $s2] [string range $s2 0x100000004 0x10000000f]
    unset s2; #Explicit free to reduce total memory
    set s2 [string totitle $s end-7 end-4]
    lappend result [string length $s2] [string range $s2 0x100000004 0x10000000f]
} -setup {
    set repts [expr 0x100000010/4]
    set s [string repeat aBcD $repts]
} -cleanup {
    bigClean repts
}

#
# string toupper
bigtestRO string-toupper-bigdata-1 "string toupper" 1 -body {
    string equal [string toupper $s] [string repeat ABCD $repts]
} -setup {
    set repts [expr 0x100000010/4]
    set s [string repeat abcd $repts]
} -cleanup {
    bigClean repts
}
bigtestRO string-toupper-bigdata-2 "string toupper first last" {4294967312 abcdABCDabcd 4294967312 abcdABCDabcd 4294967312 abcdABCDabcd} -body {
    # Unset explicitly before setting to save memory as bigtestRO runs the
    # script below twice.
    unset -nocomplain s2 result
    set s2 [string toupper $s 4 7]
    lappend result [string length $s2] [string range $s2 0 11]
    unset s2; #Explicit free to reduce total memory
    set s2 [string toupper $s 0x100000008 0x10000000b]
    lappend result [string length $s2] [string range $s2 0x100000004 0x10000000f]
    unset s2; #Explicit free to reduce total memory
    set s2 [string toupper $s end-7 end-4]
    lappend result [string length $s2] [string range $s2 0x100000004 0x10000000f]
} -setup {
    set repts [expr 0x100000010/4]
    set s [string repeat abcd $repts]
} -cleanup {
    bigClean repts
}

#
# string trim
bigtestRO string-trim-bigdata-1 "string trim" {abcdyxxy yxxyabcd} -body {
    # Unset explicitly before setting to save memory as bigtestRO runs the
    # script below twice.
    unset -nocomplain s2
    set s2 [string trim $s xy]
    list [string range $s2 0 7] [string range $s2 end-7 end]
} -setup {
    set repts [expr 0x100000010/8]
    set s [string repeat xyabcdyx $repts]
} -cleanup {
    bigClean
}

#
# string trimleft
bigtestRO string-trimleft-bigdata-1 "string trimleft" {abcdyxxy xyabcdyx} -body {
    # Unset explicitly before setting to save memory as bigtestRO runs the
    # script below twice.
    unset -nocomplain s2
    set s2 [string trimleft $s xy]
    list [string range $s2 0 7] [string range $s2 end-7 end]
} -setup {
    set repts [expr 0x100000010/8]
    set s [string repeat xyabcdyx $repts]
} -cleanup {
    bigClean
}

#
# string trimright
bigtestRO string-trimright-bigdata-1 "string trimright" {xyabcdyx yxxyabcd} -body {
    # Unset explicitly before setting to save memory as bigtestRO runs the
    # script below twice.
    unset -nocomplain s2
    set s2 [string trimright $s xy]
    list [string range $s2 0 7] [string range $s2 end-7 end]
} -setup {
    set repts [expr 0x100000010/8]
    set s [string repeat xyabcdyx $repts]
} -cleanup {
    bigClean
}

#
# append
bigtestRO append-bigdata-1 "append large to small" 1 -body {
    set s 0123456789
    append s [bigString 0x100000000]
    string equal $s [bigString 0x10000000a]
} -cleanup {
    bigClean
}
bigtest append-bigdata-2 "append small to cross UINT_MAX boundary" 1 -body {
    append s 0123456789
    string equal $s [bigString 4294967300]
} -setup {
    set s [bigString 4294967290]
} -cleanup {
    bigClean
}
bigtest append-bigdata-3 "append small to cross UINT_MAX boundary" 1 -body {
    set s2 ""
    append s2 $s $s $s $s
    string equal $s2 [bigString 4294967320]
} -setup {
    # Make length multiple of 4 AND 10 since the bigString pattern length is 10
    set len [expr 4294967320/4]
    set s [bigString $len]
} -cleanup {
    bigClean
}

#
# format
bigtestRO format-bigdata-1 "format %s" 1 -body {
    # Unset explicitly before setting to save memory as bigtestRO runs the
    # script below twice.
    unset -nocomplain s2
    set s2 [format %s $s]
    string equal $s $s2
} -setup {
    set s [bigString 0x100000000]
} -cleanup {
    bigClean
}
bigtest format-bigdata-2 "format bigstring%s" 1 -body {
    set s [format $s X]
    string equal $s [bigString 0x100000001 0x100000000]
} -setup {
    set s [bigString 0x100000000]
    append s %s
} -cleanup {
    bigClean
}
bigtest format-bigdata-3 "format big width" {4294967300 {    } {   a}} -body {
    set s [format %4294967300s a]
    list [string length $s] [string range $s 0 3] [string range $s end-3 end]
} -cleanup {
    bigClean
}
bigtest format-bigdata-4 "format big negative width" {4294967300 {a   } {    }} -body {
    set s [format %-4294967300s a]
    list [string length $s] [string range $s 0 3] [string range $s end-3 end]
} -cleanup {
    bigClean
}
bigtest format-bigdata-5 "format big * width" {4294967300 {    } {   a}} -body {
    set s [format %*s 4294967300 a]
    list [string length $s] [string range $s 0 3] [string range $s end-3 end]
} -cleanup {
    bigClean
}
bigtest format-bigdata-6 "format big negative * width" {4294967300 {a   } {    }} -body {
    set s [format %*s -4294967300 a]
    list [string length $s] [string range $s 0 3] [string range $s end-3 end]
} -cleanup {
    bigClean
}
bigtestRO format-bigdata-7 "format big precision" {4294967300 0123 6789} -body {
    # Unset explicitly before setting to save memory as bigtestRO runs the
    # script below twice.
    unset -nocomplain s2
    set s2 [format %.4294967300s $s]
    list [string length $s2] [string range $s2 0 3] [string range $s2 end-3 end]
} -setup {
    set s [testbigdata string 4294967310]
} -cleanup {
    bigClean
}
bigtestRO format-bigdata-8 "format big * precision" {4294967300 0123 6789} -body {
    # Unset explicitly before setting to save memory as bigtestRO runs the
    # script below twice.
    unset -nocomplain s2
    set s2 [format %.*s 4294967300 $s]
    list [string length $s2] [string range $s2 0 3] [string range $s2 end-3 end]
} -setup {
    set s [testbigdata string 4294967310]
} -cleanup {
    bigClean
}

#
# scan
bigtestRO scan-bigdata-1 "scan %s" {1 1 2 X 1 2 4294967300 01234X} -body {
    # Unset explicitly before setting to save memory as bigtestRO runs the
    # script below twice.
    unset -nocomplain result digits x
    lappend result [string equal [scan $s %s] $s]
    lappend result [string equal [scan $s {%[0-9X]}] $s]
    lappend result [scan $s {%[0-9]%s} digits x] $x
    lappend result [string equal $digits [bigString 0x100000009]]
    lappend result [scan $s %4294967300s%s x y]
    lappend result [string length $x] $y
} -setup {
    set s [bigString 0x10000000a 0x100000009]
} -cleanup {
    bigClean digits
}

#
# regexp
bigtestRO regexp-bigdata-1 "regexp" 1 -body {
    # Unset explicitly before setting to save memory as bigtestRO runs the
    # script below twice.
    unset -nocomplain result digits
    lappend result [regexp {[[:digit:]]*X} $s]
} -setup {
    set s [bigString 0x100000000 0x100000000]
} -cleanup {
    bigClean digits
}
bigtestRO regexp-bigdata-2 "regexp with capture" 1 -body {
    # Unset explicitly before setting to save memory as bigtestRO runs the
    # script below twice.
    unset -nocomplain result digits match
    lappend result [regexp {([[:digit:]])*X} $s match digits] [string equal $match $s]
    puts B
    unset match; # Free up memory
    lappend result [string equal $digits [bigString 0x100000009]]
} -setup {
    set s [bigString 0x10000000a 0x100000009]
} -cleanup {
    bigClean digits match
} -constraints bug-takesTooLong

#
# regsub
bigtestRO regsub-bigdata-1 "regsub" X -body {
    regsub -all \\d $s {}
} -setup {
    set s [bigString 0x100000001 0x100000000]
} -cleanup {
    bigClean
} -constraints bug-takesTooLong
bigtestRO regsub-bigdata-2 "regsub" 1 -body {
    string equal [regsub -all \\d $s x] [string cat [string repeat x 0x100000000] X]
} -setup {
    set s [bigString 0x100000001 0x100000000]
} -cleanup {
    bigClean
} -constraints bug-takesTooLong

#
# subst
bigtestRO subst-bigdata-1 "subst" {1 1} -body {
    unset -nocomplain result
    lappend result [string equal [subst $s] $s]
    lappend result [string equal [subst {$s}] $s]
} -setup {
    set s [bigString 0x10000000a]
} -cleanup {
    bigClean
}

#
# binary format
bigtestRO binary-format-bigdata-1 "binary format aN" [list 4294967296  X\0\0\0 \0\0\0\0] -body {
    # Unset explicitly before setting to save memory as bigtestRO runs the
    # script below twice.
    unset -nocomplain bin
    set bin [binary format a4294967296 X]
    list [string length $bin] [string range $bin 0 3] [string range $bin end-3 end]
} -cleanup {
    bigClean
}
# TODO - do string compare and add other format specifiers

bigtestRO binary-format-bigdata-2 "binary format a*" 1 -body {
    # Unset explicitly before setting to save memory as bigtestRO runs the
    # script below twice.
    unset -nocomplain bin2
    set bin2 [binary format a* $bin]
    string equal $bin $bin2
} -setup {
    set bin [bigBinary 4294967296]
} -cleanup {
    bigClean
}

#
# binary scan
bigtestRO binary-scan-bigdata-1 "binary scan aN" {4294967296 0123 2345} -body {
    # Unset explicitly before setting to save memory as bigtestRO runs the
    # script below twice.
    unset -nocomplain bin2
    binary scan $bin a4294967296 bin2
    list [string length $bin2] [string range $bin2 0 3] [string range $bin2 end-3 end]
} -setup {
    set bin [bigBinary 4294967296]
} -cleanup {
    bigClean
}
# TODO - do string compare and add other format specifiers once above bug is fixed

bigtestRO binary-scan-bigdata-2 "binary scan a*" 1 -body {
    # Unset explicitly before setting to save memory as bigtestRO runs the
    # script below twice.
    unset -nocomplain bin2
    binary scan $bin a* bin2
    string equal $bin $bin2
} -setup {
    set bin [bigBinary 4294967296]
} -cleanup {
    bigClean
}
# TODO - do string compare and add other format specifiers once above bug is fixed

#
# binary encode / decode base64
bigtestRO binary-encode/decode-base64-bigdata-1 "binary encode/decode base64" 1 -body {
    # Unset explicitly before setting to save memory as bigtestRO runs the
    # script below twice.
    string equal $bin [binary decode base64 [binary encode base64 $bin]]
} -setup {
    set bin [bigBinary 4294967296]
} -cleanup {
    bigClean
}

#
# binary encode / decode hex
bigtestRO binary-encode/decode-hex-bigdata-1 "binary encode/decode hex" 1 -body {
    # Unset explicitly before setting to save memory as bigtestRO runs the
    # script below twice.
    string equal $bin [binary decode hex [binary encode hex $bin]]
} -setup {
    set bin [bigBinary 4294967296]
} -cleanup {
    bigClean
}

#
# binary encode / decode uuencode
bigtestRO binary-encode/decode-uuencode-bigdata-1 "binary encode/decode uuencode" 1 -body {
    string equal $bin [binary decode uuencode [binary encode uuencode $bin]]
} -setup {
    set bin [bigBinary 4294967296]
} -cleanup {
    bigClean
}

################################################################
# List commands

#
# foreach
bigtestRO foreach-bigdata-1 "foreach" 1 -body {
    # Unset explicitly before setting as bigtestRO runs the script twice.
    unset -nocomplain l2
    foreach x $l {
        lappend l2 $x
    }
    testlutil equal $l $l2
} -setup {
    set l [bigList 0x100000000]
} -cleanup {
    bigClean
}

#
# lappend
bigtest lappend-bigdata-1 "lappend" {4294967300 4294967300 {1 2 3 4 5 a b c d}} -body {
    # Do NOT initialize l in a -setup block. That requires more memory and fails.
    # Do not have enough memory for a full compare.
    # Just check end
    set l [bigList 0x100000000]
    list [llength [lappend l a b c d]] [llength $l] [lrange $l end-8 end]
} -cleanup {
    bigClean
}

#
# lassign
bigtestRO lassign-bigdata-1 "lassign" {0 1 2 3 4 5 6 7 8 {9 0 1 2 3 4 5 6 7 8} {6 7 8 9 0 1 2 3 4 5}} -body {
    # Unset explicitly before setting to save memory as bigtestRO runs the
    # script below twice.
    unset -nocomplain l2
    set l2 [lassign $l a b c d e f g h i]
    list $a $b $c $d $e $f $g $h $i [lrange $l2 0 9] [lrange $l2 end-9 end]
} -setup {
    set l [bigList 0x10000000a]
} -cleanup {
    bigClean
}

#
# ledit
bigtest ledit-bigdata-1 "ledit - small result" {{0 X Y Z 8} {0 X Y Z 8}} -body {
    list [ledit l 1 0x100000001 X Y Z] $l
} -setup {
    set l [bigList 0x100000003]
} -cleanup {
    bigClean
}

bigtest ledit-bigdata-2 "ledit - large result" {4294967304 4294967304 {a b c d e f g 7}} -body {
    # Do NOT initialize l in a -setup block. That requires more memory and fails.
    set l [bigList 0x100000002]
    list [llength [ledit l 0x100000000 0x100000000 a b c d e f g]] [llength $l] [lrange $l 0x100000000 end]
} -cleanup {
    bigClean
}

bigtest ledit-bigdata-3 "ledit - small -> large result" {2147483650 2147483650 {a b 0 1 2 3 4 5} {0 1 e f g h i j}} -body {
    set l2 {a b c d e f g h i j}
    list [llength [ledit l2 2 3 {*}$l]] [llength $l2] [lrange $l2 0 7] [lrange $l2 end-7 end]
} -setup {
    # Note total number of arguments has to be less than INT_MAX
    set l [bigList 2147483642]
} -cleanup {
    bigClean
} -constraints memory-allocation-panic

#
# lindex
bigtestRO lindex-bigdata-1 "lindex" {6 7 5 {} 5 4 {} 9 {}} -body {
    list \
        [lindex $l 0x100000000] \
        [lindex $l 0x100000000+1] \
        [lindex $l 0x100000000-1] \
        [lindex $l 0x10000000a] \
        [lindex $l end] \
        [lindex $l end-1] \
        [lindex $l end+1] \
        [lindex $l end-0x100000000] \
        [lindex $l end-0x10000000a]
} -setup {
    set l [bigList 0x10000000a]
} -cleanup {
    bigClean
}
# TODO nested index

#
# linsert
# Cannot use bigtestRO here because 16GB memory not enough to have two 4G sized lists
# Have to throw away source list every time. Also means we cannot compare entire lists
# and instead just compare the affected range
bigtest linsert-bigdata-1 "linsert" {4294967330 1} -body {
    # Note insert at multiple of 10 to enable comparison against generated string
    set ins [split abcdefghij ""]
    set pat [split 0123456789 ""]
    set insidx 2000000000
    set l [linsert [bigList 4294967320] $insidx {*}$ins]
    list \
        [llength $l] \
        [testlutil equal [lrange $l $insidx-10 $insidx+19] [concat $pat $ins $pat]]
} -cleanup {
    bigClean
}

#
# list and {*}
# TODO - compiled and uncompiled behave differently so tested separately
test list-bigdata-1.compiled {list {*}}  -body {
    set l [bigList 0x100000000]
    set l2 [list {*}$l]
    unset l
    list [llength $l2] [lindex $l2 0] [lindex $l2 end]
} -cleanup {
    bigClean
} -constraints {
    bigdata
} -result {4294967296 0 5}
test list-bigdata-1.uncompiled {list {*}}  -body {
    set l [bigList 0x7fffffff]
    testevalex {set l2 [list {*}$l]}
} -cleanup {
    bigClean
} -constraints {
    bigdata
} -result {Number of words in command exceeds limit 2147483647.} -returnCodes error

#
# llength
bigtestRO llength-bigdata-1 {llength} 4294967296 -body {
    llength $l
} -setup {
    set l [bigList 0x100000000]
} -cleanup {
    bigClean
}

#
# lmap
bigtestRO lmap-bigdata-1 "lmap" 4294967296 -body {
    set n 0
    if {0} {
        # TODO - This is the right test but runs out of memory
        testlutil equal $l [lmap e $l {set e}]
    } else {
        lmap e $l {incr n; continue}
    }
    set n
} -setup {
    set l [bigList 0x100000000]
} -cleanup {
    bigClean
    puts ""
}

#
# lrange
bigtestRO lrange-bigdata-1 "lrange" {6 {6 7} 7 5 {} 5 4 {} 9 {8 9} {}} -body {
    list \
        [lrange $l 0x100000000 0x100000000] \
        [lrange $l 0x100000000 0x100000001] \
        [lrange $l 0x100000000+1 0x100000000+1] \
        [lrange $l 0x100000000-1 0x100000000-1] \
        [lrange $l 0x10000000a 0x10000000a] \
        [lrange $l end end] \
        [lrange $l end-1 end-1] \
        [lrange $l end+1 end+1] \
        [lrange $l end-0x100000000 end-0x100000000] \
        [lrange $l end-0x100000001 end-0x100000000] \
        [lrange $l end-0x10000000a end-0x10000000a]
} -setup {
    set l [bigList 0x10000000a]
} -cleanup {
    bigClean
}
# TODO - add tests for large result range

#
# lrepeat - use bigtest, not bigtestRO !!
bigtest lrepeat-bigdata-1 "lrepeat single element length > UINT_MAX" 4294967296 -body {
    # Just to test long lengths are accepted as arguments
    llength [lrepeat 0x100000000 x]
}

bigtest lrepeat-bigdata-2 "string repeat multiple char" {4294967400 {0 1 2 3 4 5 6 7}} -body {
    set len [expr 4294967400/8]
    set l [lrepeat $len 0 1 2 3 4 5 6 7]
    list [llength $l] [lrange $l end-7 end]
} -cleanup {
    bigClean
}

#
# lreplace
bigtestRO lreplace-bigdata-1 "lreplace - small result" [list \
                                             [split 789012345 ""] \
                                             [split 012345678 ""] \
                                             [split XYZ789012345 ""] \
                                             [split 012345678XYZ ""] \
                                            ] -body {
    # Unset explicitly before setting to save memory as bigtestRO runs the
    # script below twice.
    unset -nocomplain result
    lappend result [lreplace $l 0 0x100000000]
    lappend result [lreplace $l end-0x100000000 end]
    lappend result [lreplace $l 0 0x100000000 X Y Z]
    lappend result [lreplace $l end-0x100000000 end X Y Z]
} -setup {
    set l [bigList 0x10000000a]
} -cleanup {
    bigClean
}

bigtest lreplace-bigdata-2 "lreplace - large result" {4294967301 {a b c d e 0 1 2 3 4 5 6}} -body {
    # Unset explicitly before setting to save memory as bigtestRO runs the
    # script below twice.
    unset -nocomplain l2
    set l2 [lreplace [bigList 4294967296] 4294967290 0 a b c d e]
    lrange $l2 4294967290 end
} -setup {
    #set l [bigList 4294967296]
} -cleanup {
    bigClean
} -constraints bug-outofmemorypanic

#
# lsearch
bigtestRO lsearch-bigdata-1 "lsearch" {4294967300 4294967310 -1}  -body {
    list \
        [lsearch -exact $l X] \
        [lsearch -exact -start 4294967291 $l 0] \
        [lsearch -exact $l Y]
} -setup {
    set l [bigList 0x100000010 4294967300]
} -cleanup {
    bigClean
}
# TODO - stride, inline, all

#
# lseq
bigtest lseq-bigdata-1 "lseq" {4294967297 4294967296} -body {
    list [llength $l] [lindex $l 0x100000000]
} -setup {
    set l [lseq 0x100000001]
} -cleanup {
    bigClean
}
bigtest lseq-bigdata-2 "lseq" {9223372036854775807 9223372036854775799} -body {
    list [llength $l] [lindex $l 9223372036854775800]
} -setup {
    set l [lseq 0x7fffffffffffffff]; llength $l
} -cleanup {
    bigClean
} -constraints bug-fa00fbbbab

#
# lset
bigtest lset-bigdata-1 "lset" {4294967297 4294967297 {1 2 3 4 5 X}} -body {
    # Do NOT initialize l in a -setup block. That requires more memory and fails.
    set l [bigList 0x100000001]
    list [llength [lset l 0x100000000 X]] [llength $l] [lrange $l end-5 end]
} -cleanup {
    bigClean
}

#
# lsort
bigtestRO lsort-bigdata-1 "lsort" [list 4294967296 [lrepeat 10 0] [lrepeat 10 9]] -body {
    # Unset explicitly before setting to save memory as bigtestRO runs the
    # script below twice.
    unset -nocomplain l2
    set l2 [lsort $l]
    list [llength $l2] [lrange $l2 0 9] [lrange $l2 end-9 end]
} -setup {
    set l [bigList 0x100000000]
} -cleanup {
    bigClean
} -constraints notenoughmemoryexception

#
# join
bigtestRO join-bigdata-1 "join" [list 0123456789 6789012345] -body {
    set s [join $l ""]
    list [string range $s 0 9] [string range $s end-9 end]
} -setup {
    set l [bigList 0x100000000]
} -cleanup {
    bigClean
}

bigtest split-bigdata-1 "split" {4294967296 {0 1 2 3 4} {1 2 3 4 5}} -body {
    # Fill list compare needs too much memory
    set l [split $s ""]
    list [llength $l] [lrange 0 4] [lrange end-4 end]
} -setup {
    set s [bigString 0x100000000]
} -cleanup {
    bigClean
} -constraints bug-takesTooLong

bigtestRO concat-bigdata-1 "concat" {4294967296 {0 1 2 3 4} {6 7 0 1 2} {3 4 5 6 7}} -body {
    unset -nocomplain l2
    set l2 [concat $l $l]
    list [llength $l2] [lrange $l2 0 4] [lrange $l2 0x80000000-2 0x80000000+2] [lrange $l2 end-4 end]
} -setup {
    set l [bigList 0x80000000]
}

test puts-bigdata-1 "puts" -setup {
    set fpath [makeFile {} bug-0306a5563.data]
} -constraints {
    bigdata
} -body {
    set fd [open $fpath w]
    puts -nonewline $fd [testbigdata string 0x80000001]
    close $fd
    set fd [open $fpath]
    seek $fd 0x7FFFFFFA
    set written [read $fd]
    close $fd
    set written
} -result {2345678}

test puts-bigdata-2 "puts" -setup {
    set fpath [tcltest::makeFile {} bug-0306a5563.data]
} -constraints {
    bigdata
} -body {
    set fd [open $fpath w]
    set s [testbigdata string 0x7FFFFFFE]
    # The character to append in the next line is —, EM DASH,
    # code point 0x2014 (decimal 8212, UTF-8 #xE2 #x80 #x94)
    append s \u2014
    puts -nonewline $fd $s
    close $fd
    set fd [open $fpath]
    seek $fd 0x7FFFFFFA
    set written [read $fd]
    close $fd
    set written
} -result {2345—}

#
# TODO
# lremove
# lreverse
# encoding convertfrom
# encoding convertto
# dict *



# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# fill-column: 78
# End:

Changes to tests/binary.test.

11
12
13
14
15
16
17


18
19
20
21
22

23
24
25
26
27
28
29
# 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} {







>
>





>







11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
# 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
source [file join [file dirname [info script]] tcltests.tcl]

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]]
testConstraint pointerIs64bit [expr {$tcl_platform(pointerSize) >= 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} {
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
} \x3F\xCC\xCC\xCD
test binary-53.19 {Tcl_BinaryObjCmd: format} {} {
    set a {1.6 3.4}
    binary format r1 $a
} \xCD\xCC\xCC\x3F
test binary-53.20 {Tcl_BinaryObjCmd: float Inf} {} {
    binary format R Inf
} \x7f\x80\x00\x00
test binary-53.21 {Tcl_BinaryObjCmd: float Inf} {} {
    binary format r Inf
} \x00\x00\x80\x7f
test binary-53.22 {Binary float Inf round trip} -body {
    binary scan [binary format R Inf] R inf
    binary scan [binary format R -Inf] R inf_
    list $inf $inf_
} -result {Inf -Inf}
test binary-53.23 {Binary float round to FLT_MAX} -body {
    binary scan [binary format H* 7f7fffff] R fltmax







|


|







2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
} \x3F\xCC\xCC\xCD
test binary-53.19 {Tcl_BinaryObjCmd: format} {} {
    set a {1.6 3.4}
    binary format r1 $a
} \xCD\xCC\xCC\x3F
test binary-53.20 {Tcl_BinaryObjCmd: float Inf} {} {
    binary format R Inf
} \x7F\x80\x00\x00
test binary-53.21 {Tcl_BinaryObjCmd: float Inf} {} {
    binary format r Inf
} \x00\x00\x80\x7F
test binary-53.22 {Binary float Inf round trip} -body {
    binary scan [binary format R Inf] R inf
    binary scan [binary format R -Inf] R inf_
    list $inf $inf_
} -result {Inf -Inf}
test binary-53.23 {Binary float round to FLT_MAX} -body {
    binary scan [binary format H* 7f7fffff] R fltmax
3035
3036
3037
3038
3039
3040
3041



3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
} -result "expected byte sequence but character 4 was '乎' (U+004E4E)"
test binary-80.3 {Tcl_GetBytesFromObj} -constraints testbytestring -returnCodes 1 -body {
    testbytestring [testbytestring "\xC0\x80\xA0\xA0\xA0\xE4\xB9\x8E"]
} -result "expected byte sequence but character 4 was '乎' (U+004E4E)"
test binary-80.4 {Tcl_GetBytesFromObj} -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:







>
>
>










3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
} -result "expected byte sequence but character 4 was '乎' (U+004E4E)"
test binary-80.3 {Tcl_GetBytesFromObj} -constraints testbytestring -returnCodes 1 -body {
    testbytestring [testbytestring "\xC0\x80\xA0\xA0\xA0\xE4\xB9\x8E"]
} -result "expected byte sequence but character 4 was '乎' (U+004E4E)"
test binary-80.4 {Tcl_GetBytesFromObj} -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)"
test binary-80.5 {Tcl_GetBytesFromObj} -constraints testbytestring -constraints {pointerIs64bit deprecated} -body {
    testbytestring [string repeat A [expr 2**31]]
} -returnCodes 1 -result "byte sequence length exceeds INT_MAX"

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

14
15
16
17
18
19
20
# This file contains a collection of tests for the Tcl built-in 'chan'
# command. Sourcing this file into Tcl runs the tests and generates
# output for errors. No output means no errors were found.
#
# Copyright © 2005 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}


package require tcltests

#
# Note: The tests for the chan methods "create" and "postevent"
# currently reside in the file "ioCmd.test".
#













>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
# This file contains a collection of tests for the Tcl built-in 'chan'
# command. Sourcing this file into Tcl runs the tests and generates
# output for errors. No output means no errors were found.
#
# Copyright © 2005 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}
source [file join [file dirname [info script]] tcltests.tcl]

package require tcltests

#
# Note: The tests for the chan methods "create" and "postevent"
# currently reside in the file "ioCmd.test".
#

Changes to tests/chanio.test.

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

    catch {
	::tcltest::loadTestedCommands
	package require -exact tcl::test [info patchlevel]
	set ::tcltestlib [info loaded {} Tcltest]
    }
    package require tcltests

    testConstraint testbytestring   [llength [info commands testbytestring]]
    testConstraint testchannel      [llength [info commands testchannel]]
    testConstraint testfevent       [llength [info commands testfevent]]
    testConstraint testchannelevent [llength [info commands testchannelevent]]
    testConstraint testmainthread   [llength [info commands testmainthread]]
    testConstraint testservicemode  [llength [info commands testservicemode]]
    testConstraint notWinCI       [expr {
	$::tcl_platform(platform) ne "windows" || ![info exists ::env(CI)]}]
    testConstraint notOSX [expr {$::tcl_platform(os) ne "Darwin"}]


    testConstraint specialfiles  [expr {[file exists /dev/zero] || [file exists NUL]}]

    # You need a *very* special environment to do some tests.  In particular,
    # many file systems do not support large-files...
    testConstraint largefileSupport [expr {$::tcl_platform(os) ne "Darwin"}]

    # some tests can only be run is umask is 2 if "umask" cannot be run, the







|










>
>







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

    catch {
	::tcltest::loadTestedCommands
	package require -exact tcl::test [info patchlevel]
	set ::tcltestlib [info loaded {} Tcltest]
    }
    source [file join [file dirname [info script]] tcltests.tcl]

    testConstraint testbytestring   [llength [info commands testbytestring]]
    testConstraint testchannel      [llength [info commands testchannel]]
    testConstraint testfevent       [llength [info commands testfevent]]
    testConstraint testchannelevent [llength [info commands testchannelevent]]
    testConstraint testmainthread   [llength [info commands testmainthread]]
    testConstraint testservicemode  [llength [info commands testservicemode]]
    testConstraint notWinCI       [expr {
	$::tcl_platform(platform) ne "windows" || ![info exists ::env(CI)]}]
    testConstraint notOSX [expr {$::tcl_platform(os) ne "Darwin"}]
    # File permissions broken on wsl without some "exotic" wsl configuration
    testConstraint notWsl [expr {[llength [array names ::env *WSL*]] == 0}]
    testConstraint specialfiles  [expr {[file exists /dev/zero] || [file exists NUL]}]

    # You need a *very* special environment to do some tests.  In particular,
    # many file systems do not support large-files...
    testConstraint largefileSupport [expr {$::tcl_platform(os) ne "Darwin"}]

    # some tests can only be run is umask is 2 if "umask" cannot be run, the
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
test chan-io-1.5 {Tcl_WriteChars: CheckChannelErrors} {emptyTest} {
    # no test, need to cause an async error.
} {}
set path(test1) [makeFile {} test1]
test chan-io-1.6 {Tcl_WriteChars: WriteBytes} {
    set f [open $path(test1) w]
    chan configure $f -encoding binary
    chan puts -nonewline $f "a\x00"
    chan close $f
    contents $path(test1)
} "aM\x00"
test chan-io-1.7 {Tcl_WriteChars: WriteChars} {
    set f [open $path(test1) w]
    chan configure $f -encoding shiftjis
    chan puts -nonewline $f "a乍\x00"
    chan close $f
    contents $path(test1)
} "a\x93\xE1\x00"







|


|







114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
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\x4D\x00"
    chan close $f
    contents $path(test1)
} aM\x00
test chan-io-1.7 {Tcl_WriteChars: WriteChars} {
    set f [open $path(test1) w]
    chan configure $f -encoding shiftjis
    chan puts -nonewline $f "a乍\x00"
    chan close $f
    contents $path(test1)
} "a\x93\xE1\x00"
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
    contents $path(test1)
} -cleanup {
    chan close $f
} -result "\r\n12"
test chan-io-3.4 {WriteChars: loop over stage buffer} -body {
    # stage buffer maps to more than can be queued at once.
    set f [open $path(test1) w]
    chan configure $f -encoding jis0208 -buffersize 16
    chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
    set x [list [contents $path(test1)]]
    chan close $f
    lappend x [contents $path(test1)]
} -cleanup {
    catch {chan close $f}
} -result [list "!)!)!)!)!)!)!)!)" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
test chan-io-3.5 {WriteChars: saved != 0} -body {
    # Bytes produced by UtfToExternal from end of last channel buffer had to
    # be moved to beginning of next channel buffer to preserve requested
    # buffersize.
    set f [open $path(test1) w]
    chan configure $f -encoding jis0208 -buffersize 17
    chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
    set x [list [contents $path(test1)]]
    chan close $f
    lappend x [contents $path(test1)]
} -cleanup {
    catch {chan close $f}
} -result [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
test chan-io-3.6 {WriteChars: (stageRead + dstWrote == 0)} -body {
    # One incomplete UTF-8 character at end of staging buffer. Backup in src
    # to the beginning of that UTF-8 character and try again.
    #
    # Translate the first 16 bytes, produce 14 bytes of output, 2 left over
    # (first two bytes of A in UTF-8). Given those two bytes try
    # translating them again, find that no bytes are read produced, and break
    # to outer loop where those two bytes will have the remaining 4 bytes (the
    # last byte of A plus the all of B) appended.
    set f [open $path(test1) w]
    chan configure $f -encoding shiftjis -buffersize 16
    chan puts -nonewline $f "12345678901234AB"
    set x [list [contents $path(test1)]]
    chan close $f
    lappend x [contents $path(test1)]
} -cleanup {
    catch {chan close $f}
} -result [list "12345678901234\x82\x60" "12345678901234\x82\x60\x82\x61"]
test chan-io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} -body {
    # 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
    # at the end of the partial character to preserve the requested blocksize
    # on flush. The truncated bytes are moved to the beginning of the next
    # channel buffer.
    set f [open $path(test1) w]
    chan configure $f -encoding jis0208 -buffersize 17
    chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
    set x [list [contents $path(test1)]]
    chan close $f
    lappend x [contents $path(test1)]
} -cleanup {
    catch {chan close $f}
} -result [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]







|












|


















|













|







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
    contents $path(test1)
} -cleanup {
    chan close $f
} -result "\r\n12"
test chan-io-3.4 {WriteChars: loop over stage buffer} -body {
    # stage buffer maps to more than can be queued at once.
    set f [open $path(test1) w]
    chan configure $f -encoding jis0208 -buffersize 16 -profile tcl8
    chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
    set x [list [contents $path(test1)]]
    chan close $f
    lappend x [contents $path(test1)]
} -cleanup {
    catch {chan close $f}
} -result [list "!)!)!)!)!)!)!)!)" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
test chan-io-3.5 {WriteChars: saved != 0} -body {
    # Bytes produced by UtfToExternal from end of last channel buffer had to
    # be moved to beginning of next channel buffer to preserve requested
    # buffersize.
    set f [open $path(test1) w]
    chan configure $f -encoding jis0208 -buffersize 17 -profile tcl8
    chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
    set x [list [contents $path(test1)]]
    chan close $f
    lappend x [contents $path(test1)]
} -cleanup {
    catch {chan close $f}
} -result [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
test chan-io-3.6 {WriteChars: (stageRead + dstWrote == 0)} -body {
    # One incomplete UTF-8 character at end of staging buffer. Backup in src
    # to the beginning of that UTF-8 character and try again.
    #
    # Translate the first 16 bytes, produce 14 bytes of output, 2 left over
    # (first two bytes of A in UTF-8). Given those two bytes try
    # translating them again, find that no bytes are read produced, and break
    # to outer loop where those two bytes will have the remaining 4 bytes (the
    # last byte of A plus the all of B) appended.
    set f [open $path(test1) w]
    chan configure $f -encoding shiftjis -buffersize 16
    chan puts -nonewline $f 12345678901234AB
    set x [list [contents $path(test1)]]
    chan close $f
    lappend x [contents $path(test1)]
} -cleanup {
    catch {chan close $f}
} -result [list "12345678901234\x82\x60" "12345678901234\x82\x60\x82\x61"]
test chan-io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} -body {
    # 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
    # at the end of the partial character to preserve the requested blocksize
    # on flush. The truncated bytes are moved to the beginning of the next
    # channel buffer.
    set f [open $path(test1) w]
    chan configure $f -encoding jis0208 -buffersize 17 -profile tcl8
    chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
    set x [list [contents $path(test1)]]
    chan close $f
    lappend x [contents $path(test1)]
} -cleanup {
    catch {chan close $f}
} -result [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
    list [chan tell $f] [chan gets $f line] [chan tell $f] [chan gets $f line] $line
} -cleanup {
    chan close $f
} -result {0 3 5 4 defg}
test chan-io-6.4 {Tcl_GetsObj: encoding == NULL} -body {
    set f [open $path(test1) w]
    chan configure $f -translation binary
    chan puts $f "\x81\u1234\x00"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation binary
    list [chan gets $f line] $line
} -cleanup {
    chan close $f
} -result [list 3 "\x81\x34\x00"]







|







430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
    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\x34\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"]
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
    set x ""
} -constraints {testchannel} -body {
    set f [open $path(test1) w]
    chan configure $f -encoding binary
    chan puts -nonewline $f "1234567890123\x82\x4F\x82\x50\x82"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -encoding shiftjis
    lappend x [chan gets $f line] $line
    lappend x [chan tell $f] [testchannel inputbuffered $f] [chan eof $f]
    lappend x [chan gets $f line] $line
} -cleanup {
    chan close $f
} -result [list 15 "123456789012301" 18 0 1 -1 ""]
test chan-io-7.4 {FilterInputBytes: recover from split up character} -setup {
    variable x ""
} -constraints {stdio fileevent} -body {
    set f [openpipe w+ $path(cat)]
    chan configure $f -encoding binary -buffering none
    chan puts -nonewline $f "1234567890123\x82\x4F\x82\x50\x82"
    chan configure $f -encoding shiftjis -blocking 0







|





|







1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
    set x ""
} -constraints {testchannel} -body {
    set f [open $path(test1) w]
    chan configure $f -encoding binary
    chan puts -nonewline $f "1234567890123\x82\x4F\x82\x50\x82"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -encoding shiftjis -profile tcl8
    lappend x [chan gets $f line] $line
    lappend x [chan tell $f] [testchannel inputbuffered $f] [chan eof $f]
    lappend x [chan gets $f line] $line
} -cleanup {
    chan close $f
} -result [list 16 "123456789012301\x82" 18 0 1 -1 ""]
test chan-io-7.4 {FilterInputBytes: recover from split up character} -setup {
    variable x ""
} -constraints {stdio fileevent} -body {
    set f [openpipe w+ $path(cat)]
    chan configure $f -encoding binary -buffering none
    chan puts -nonewline $f "1234567890123\x82\x4F\x82\x50\x82"
    chan configure $f -encoding shiftjis -blocking 0
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
} -constraints {stdio testchannel fileevent} -body {
    # Make sure bytes are removed from buffer.
    set f [openpipe w+ $path(cat)]
    chan configure $f -translation {auto binary} -buffering none
    chan puts -nonewline $f "abcdefghijklmno\r"
    # here
    lappend x [chan gets $f line] $line [testchannel queuedcr $f]
    chan puts -nonewline $f "\x1A"
    lappend x [chan gets $f line] $line
} -cleanup {
    chan close $f
} -result {15 abcdefghijklmno 1 -1 {}}

test chan-io-9.1 {CommonGetsCleanup} emptyTest {
} {}







|







1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
} -constraints {stdio testchannel fileevent} -body {
    # Make sure bytes are removed from buffer.
    set f [openpipe w+ $path(cat)]
    chan configure $f -translation {auto binary} -buffering none
    chan puts -nonewline $f "abcdefghijklmno\r"
    # here
    lappend x [chan gets $f line] $line [testchannel queuedcr $f]
    chan puts -nonewline $f \x1A
    lappend x [chan gets $f line] $line
} -cleanup {
    chan close $f
} -result {15 abcdefghijklmno 1 -1 {}}

test chan-io-9.1 {CommonGetsCleanup} emptyTest {
} {}
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
    chan configure $f -encoding shiftjis -blocking 0
    chan event $f read [namespace code {
	lappend x [chan read $f] [testchannel inputbuffered $f]
    }]
    chan configure $f -encoding shiftjis
    vwait [namespace which -variable x]
    chan configure $f -encoding binary -blocking 1
    chan puts -nonewline $f "\x7B"
    after 500			;# Give the cat process time to catch up
    chan configure $f -encoding shiftjis -blocking 0
    vwait [namespace which -variable x]
    return $x
} -cleanup {
    chan close $f
} -result [list "123456789012345" 1 "本" 0]
test chan-io-12.5 {ReadChars: chan events on partial characters} -setup {
    variable x {}
} -constraints {stdio fileevent} -body {
    set path(test1) [makeFile {
	chan configure stdout -encoding binary -buffering none
	chan gets stdin; chan puts -nonewline "\xE7"
	chan gets stdin; chan puts -nonewline "\x89"
	chan gets stdin; chan puts -nonewline "\xA6"
    } test1]
    set f [openpipe r+ $path(test1)]
    chan event $f readable [namespace code {
	lappend x [chan read $f]
	if {[chan eof $f]} {
	    lappend x eof
	}







|






|





|
|
|







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
    chan configure $f -encoding shiftjis -blocking 0
    chan event $f read [namespace code {
	lappend x [chan read $f] [testchannel inputbuffered $f]
    }]
    chan configure $f -encoding shiftjis
    vwait [namespace which -variable x]
    chan configure $f -encoding binary -blocking 1
    chan puts -nonewline $f \x7B
    after 500			;# Give the cat process time to catch up
    chan configure $f -encoding shiftjis -blocking 0
    vwait [namespace which -variable x]
    return $x
} -cleanup {
    chan close $f
} -result [list "123456789012345" 1  0]
test chan-io-12.5 {ReadChars: chan events on partial characters} -setup {
    variable x {}
} -constraints {stdio fileevent} -body {
    set path(test1) [makeFile {
	chan configure stdout -encoding binary -buffering none
	chan gets stdin; chan puts -nonewline \xE7
	chan gets stdin; chan puts -nonewline \x89
	chan gets stdin; chan puts -nonewline \xA6
    } test1]
    set f [openpipe r+ $path(test1)]
    chan event $f readable [namespace code {
	lappend x [chan read $f]
	if {[chan eof $f]} {
	    lappend x eof
	}
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579
3580
    chan configure $f -translation binary
    chan configure $f -translation
} -cleanup {
    chan close $f
} -result lf
#
# Test chan-io-9.14 has been removed because "auto" output translation mode is
# not supoprted.
#
test chan-io-31.14 {Tcl_Write mixed, Tcl_Gets auto} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf







|







3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579
3580
3581
3582
    chan configure $f -translation binary
    chan configure $f -translation
} -cleanup {
    chan close $f
} -result lf
#
# Test chan-io-9.14 has been removed because "auto" output translation mode is
# not supported.
#
test chan-io-31.14 {Tcl_Write mixed, Tcl_Gets auto} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
4976
4977
4978
4979
4980
4981
4982
4983
4984
4985
4986
4987
4988
4989
4990
    lappend l [chan configure $f -buffersize]
} -cleanup {
    chan close $f
} -result {4096 10000 1 1 1 100000 1048576}
test chan-io-38.3 {Tcl_SetChannelBufferSize, changing buffersize between reads} {
    # This test crashes the interp if Bug #427196 is not fixed
    set chan [open [info script] r]
    chan configure $chan -buffersize 10
    set var [chan read $chan 2]
    chan configure $chan -buffersize 32
    append var [chan read $chan]
    chan close $chan
} {}

# Test Tcl_SetChannelOption, Tcl_GetChannelOption







|







4978
4979
4980
4981
4982
4983
4984
4985
4986
4987
4988
4989
4990
4991
4992
    lappend l [chan configure $f -buffersize]
} -cleanup {
    chan close $f
} -result {4096 10000 1 1 1 100000 1048576}
test chan-io-38.3 {Tcl_SetChannelBufferSize, changing buffersize between reads} {
    # This test crashes the interp if Bug #427196 is not fixed
    set chan [open [info script] r]
    chan configure $chan -buffersize 10 -encoding utf-8
    set var [chan read $chan 2]
    chan configure $chan -buffersize 32
    append var [chan read $chan]
    chan close $chan
} {}

# Test Tcl_SetChannelOption, Tcl_GetChannelOption
5207
5208
5209
5210
5211
5212
5213
5214
5215
5216
5217
5218
5219
5220
5221
    chan close $f
} -result {unknown encoding "foobar"}
test chan-io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} -setup {
    variable x {}
} -constraints {stdio fileevent} -body {
    set f [openpipe r+ $path(cat)]
    chan configure $f -encoding binary
    chan puts -nonewline $f "\xE7"
    chan flush $f
    chan configure $f -encoding utf-8 -blocking 0
    chan event $f readable [namespace code { lappend x [chan read $f] }]
    vwait [namespace which -variable x]
    after 300 [namespace code { lappend x timeout }]
    vwait [namespace which -variable x]
    chan configure $f -encoding utf-8







|







5209
5210
5211
5212
5213
5214
5215
5216
5217
5218
5219
5220
5221
5222
5223
    chan close $f
} -result {unknown encoding "foobar"}
test chan-io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} -setup {
    variable x {}
} -constraints {stdio fileevent} -body {
    set f [openpipe r+ $path(cat)]
    chan configure $f -encoding binary
    chan puts -nonewline $f \xE7
    chan flush $f
    chan configure $f -encoding utf-8 -blocking 0
    chan event $f readable [namespace code { lappend x [chan read $f] }]
    vwait [namespace which -variable x]
    after 300 [namespace code { lappend x timeout }]
    vwait [namespace which -variable x]
    chan configure $f -encoding utf-8
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
    chan configure $f1 -eofchar {O {}}
    lappend l [chan configure $f1 -eofchar]
    chan configure $f1 -eofchar D
    lappend l [chan configure $f1 -eofchar]
} -cleanup {
    chan close $f1
} -result {{} O D}
test chan-io-39.22a {Tcl_SetChannelOption, invariance} -setup {
    file delete $path(test1)
    set l [list]
} -constraints deprecated -body {
    set f1 [open $path(test1) w+]
    chan configure $f1 -eofchar {O {}}
    lappend l [chan configure $f1 -eofchar]
    chan configure $f1 -eofchar D
    lappend l [chan configure $f1 -eofchar]
    lappend l [list [catch {chan configure $f1 -eofchar {1 2 3}} msg] $msg]
} -cleanup {
    chan close $f1
} -result {O D {1 {bad value for -eofchar: must be non-NUL ASCII character}}}

test chan-io-39.23 {Tcl_GetChannelOption, server socket is not readable or\
        writeable, it should still have valid -eofchar and -translation options} -setup {

    set l [list]
} -body {
    set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
    lappend l [chan configure $sock -eofchar] \
	[chan configure $sock -translation]
} -cleanup {
    chan close $sock







|


|









>
|
|
>







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
    chan configure $f1 -eofchar {O {}}
    lappend l [chan configure $f1 -eofchar]
    chan configure $f1 -eofchar D
    lappend l [chan configure $f1 -eofchar]
} -cleanup {
    chan close $f1
} -result {{} O D}
test chan-io-39.22a {Tcl_SetChannelOption, invariance} -constraints deprecated -setup {
    file delete $path(test1)
    set l [list]
} -body {
    set f1 [open $path(test1) w+]
    chan configure $f1 -eofchar {O {}}
    lappend l [chan configure $f1 -eofchar]
    chan configure $f1 -eofchar D
    lappend l [chan configure $f1 -eofchar]
    lappend l [list [catch {chan configure $f1 -eofchar {1 2 3}} msg] $msg]
} -cleanup {
    chan close $f1
} -result {O D {1 {bad value for -eofchar: must be non-NUL ASCII character}}}
test chan-io-39.23 {
	Tcl_GetChannelOption, server socket is not readable or writable, but should
	still have valid -eofchar and -translation options.
} -setup {
    set l [list]
} -body {
    set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
    lappend l [chan configure $sock -eofchar] \
	[chan configure $sock -translation]
} -cleanup {
    chan close $sock
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
    set f [open $path(test3) r]
    lappend x [chan gets $f]
} -cleanup {
    chan close $f
} -result {zzy abzzy}
test chan-io-40.2 {POSIX open access modes: CREAT} -setup {
    file delete $path(test3)
} -constraints {unix} -body {
    set f [open $path(test3) {WRONLY CREAT} 0o600]
    file stat $path(test3) stats
    set x [format 0o%03o [expr {$stats(mode) & 0o777}]]
    chan puts $f "line 1"
    chan close $f
    set f [open $path(test3) r]
    lappend x [chan gets $f]
} -cleanup {
    chan close $f
} -result {0o600 {line 1}}
test chan-io-40.3 {POSIX open access modes: CREAT} -setup {
    file delete $path(test3)
} -constraints {unix umask} -body {
    # This test only works if your umask is 2, like ouster's.
    chan close [open $path(test3) {WRONLY CREAT}]
    file stat $path(test3) stats
    format 0o%03o [expr {$stats(mode) & 0o777}]
} -result [format 0o%03o [expr {0o666 & ~ $umaskValue}]]
test chan-io-40.4 {POSIX open access modes: CREAT} -setup {
    file delete $path(test3)







|












|







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
    set f [open $path(test3) r]
    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 notWsl} -body {
    set f [open $path(test3) {WRONLY CREAT} 0o600]
    file stat $path(test3) stats
    set x [format 0o%03o [expr {$stats(mode) & 0o777}]]
    chan puts $f "line 1"
    chan close $f
    set f [open $path(test3) r]
    lappend x [chan gets $f]
} -cleanup {
    chan close $f
} -result {0o600 {line 1}}
test chan-io-40.3 {POSIX open access modes: CREAT} -setup {
    file delete $path(test3)
} -constraints {unix umask notWsl} -body {
    # This test only works if your umask is 2, like ouster's.
    chan close [open $path(test3) {WRONLY CREAT}]
    file stat $path(test3) stats
    format 0o%03o [expr {$stats(mode) & 0o777}]
} -result [format 0o%03o [expr {0o666 & ~ $umaskValue}]]
test chan-io-40.4 {POSIX open access modes: CREAT} -setup {
    file delete $path(test3)
6696
6697
6698
6699
6700
6701
6702
6703
6704
6705
6706
6707
6708
6709
6710
6711
    chan close $f3
} -match glob -result {channel "*" is busy}
test chan-io-52.3 {TclCopyChannel} -constraints {fcopy} -setup {
    file delete $path(test1)
} -body {
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    chan configure $f1 -translation lf -blocking 0
    chan configure $f2 -translation cr -blocking 0
    set s0 [chan copy $f1 $f2]
    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)} {







|
|







6700
6701
6702
6703
6704
6705
6706
6707
6708
6709
6710
6711
6712
6713
6714
6715
    chan close $f3
} -match glob -result {channel "*" is busy}
test chan-io-52.3 {TclCopyChannel} -constraints {fcopy} -setup {
    file delete $path(test1)
} -body {
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    chan configure $f1 -translation lf -encoding iso8859-1 -blocking 0
    chan configure $f2 -translation cr -encoding iso8859-1 -blocking 0
    set s0 [chan copy $f1 $f2]
    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)} {
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
    lappend result [file size $path(test1)]
} -result {0 0 40}
test chan-io-52.5 {TclCopyChannel, all} -constraints {fcopy} -setup {
    file delete $path(test1)
} -body {
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    chan configure $f1 -translation lf -blocking 0
    chan configure $f2 -translation lf -blocking 0
    chan copy $f1 $f2 -size -1 ;# -1 means 'copy all', same as if no -size specified.
    set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
    chan close $f1
    chan close $f2
    if {[file size $thisScript] == [file size $path(test1)]} {
        lappend result ok
    }
    return $result
} -result {0 0 ok}
test chan-io-52.5a {TclCopyChannel, all, other negative value} -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
    chan copy $f1 $f2 -size -2 ;# < 0 behaves like -1, copy all
    set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
    chan close $f1
    chan close $f2
    if {[file size $thisScript] == [file size $path(test1)]} {
        lappend result ok
    }
    return $result
} -result {0 0 ok}
test chan-io-52.5b {TclCopyChannel, all, wrap to negative value} -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
    chan copy $f1 $f2 -size 3221176172 ;# Wrapped to < 0, behaves like -1, copy all
    set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
    chan close $f1
    chan close $f2
    if {[file size $thisScript] ==  [file size $path(test1)]} {
        lappend result ok
    }
    return $result
} -result {0 0 ok}
test chan-io-52.6 {TclCopyChannel} -setup {
    file delete $path(test1)
} -constraints {fcopy} -body {
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    chan configure $f1 -translation lf -blocking 0
    chan configure $f2 -translation lf -blocking 0
    set s0 [chan copy $f1 $f2 -size [expr {[file size $thisScript] + 5}]]
    set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
    chan close $f1
    chan close $f2
    set s1 [file size $thisScript]
    set s2 [file size $path(test1)]
    if {($s1 == $s2) && ($s0 == $s1)} {
        lappend result ok
    }
    return $result
} -result {0 0 ok}
test chan-io-52.7 {TclCopyChannel} -constraints {fcopy} -setup {
    file delete $path(test1)
} -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
    chan copy $f1 $f2
    set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
    if {[file size $thisScript] == [file size $path(test1)]} {
        lappend result ok
    }
    return $result
} -cleanup {







|
|














|
|














|
|














|
|
















|
|







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
    lappend result [file size $path(test1)]
} -result {0 0 40}
test chan-io-52.5 {TclCopyChannel, all} -constraints {fcopy} -setup {
    file delete $path(test1)
} -body {
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    chan configure $f1 -translation lf -encoding iso8859-1 -blocking 0
    chan configure $f2 -translation lf -encoding iso8859-1 -blocking 0
    chan copy $f1 $f2 -size -1 ;# -1 means 'copy all', same as if no -size specified.
    set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
    chan close $f1
    chan close $f2
    if {[file size $thisScript] == [file size $path(test1)]} {
        lappend result ok
    }
    return $result
} -result {0 0 ok}
test chan-io-52.5a {TclCopyChannel, all, other negative value} -setup {
    file delete $path(test1)
} -constraints {fcopy} -body {
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    chan configure $f1 -translation lf -encoding iso8859-1 -blocking 0
    chan configure $f2 -translation lf -encoding iso8859-1 -blocking 0
    chan copy $f1 $f2 -size -2 ;# < 0 behaves like -1, copy all
    set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
    chan close $f1
    chan close $f2
    if {[file size $thisScript] == [file size $path(test1)]} {
        lappend result ok
    }
    return $result
} -result {0 0 ok}
test chan-io-52.5b {TclCopyChannel, all, wrap to negative value} -setup {
    file delete $path(test1)
} -constraints {fcopy} -body {
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    chan configure $f1 -translation lf -encoding iso8859-1 -blocking 0
    chan configure $f2 -translation lf -encoding iso8859-1 -blocking 0
    chan copy $f1 $f2 -size 3221176172 ;# Wrapped to < 0, behaves like -1, copy all
    set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
    chan close $f1
    chan close $f2
    if {[file size $thisScript] ==  [file size $path(test1)]} {
        lappend result ok
    }
    return $result
} -result {0 0 ok}
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 -encoding iso8859-1 -blocking 0
    chan configure $f2 -translation lf -encoding iso8859-1 -blocking 0
    set s0 [chan copy $f1 $f2 -size [expr {[file size $thisScript] + 5}]]
    set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
    chan close $f1
    chan close $f2
    set s1 [file size $thisScript]
    set s2 [file size $path(test1)]
    if {($s1 == $s2) && ($s0 == $s1)} {
        lappend result ok
    }
    return $result
} -result {0 0 ok}
test chan-io-52.7 {TclCopyChannel} -constraints {fcopy} -setup {
    file delete $path(test1)
} -body {
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    chan configure $f1 -translation lf -encoding iso8859-1 -blocking 0
    chan configure $f2 -translation lf -encoding iso8859-1 -blocking 0
    chan copy $f1 $f2
    set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
    if {[file size $thisScript] == [file size $path(test1)]} {
        lappend result ok
    }
    return $result
} -cleanup {
6839
6840
6841
6842
6843
6844
6845
6846
6847
6848
6849
6850
6851
6852
6853
# Empty files, to register them with the test facility
set path(kyrillic.txt)   [makeFile {} kyrillic.txt]
set path(utf8-fcopy.txt) [makeFile {} utf8-fcopy.txt]
set path(utf8-rp.txt)    [makeFile {} utf8-rp.txt]
# Create kyrillic file, use lf translation to avoid os eol issues
set out [open $path(kyrillic.txt) w]
chan configure $out -encoding koi8-r -translation lf
chan puts       $out "АА"
chan close      $out
test chan-io-52.9 {TclCopyChannel & encodings} {fcopy} {
    # Copy kyrillic to UTF-8, using chan copy.
    set in  [open $path(kyrillic.txt) r]
    set out [open $path(utf8-fcopy.txt) w]
    chan configure $in  -encoding koi8-r -translation lf
    chan configure $out -encoding utf-8 -translation lf







|







6843
6844
6845
6846
6847
6848
6849
6850
6851
6852
6853
6854
6855
6856
6857
# Empty files, to register them with the test facility
set path(kyrillic.txt)   [makeFile {} kyrillic.txt]
set path(utf8-fcopy.txt) [makeFile {} utf8-fcopy.txt]
set path(utf8-rp.txt)    [makeFile {} utf8-rp.txt]
# Create kyrillic file, use lf translation to avoid os eol issues
set out [open $path(kyrillic.txt) w]
chan configure $out -encoding koi8-r -translation lf
chan puts       $out АА
chan close      $out
test chan-io-52.9 {TclCopyChannel & encodings} {fcopy} {
    # Copy kyrillic to UTF-8, using chan copy.
    set in  [open $path(kyrillic.txt) r]
    set out [open $path(utf8-fcopy.txt) w]
    chan configure $in  -encoding koi8-r -translation lf
    chan configure $out -encoding utf-8 -translation lf
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
    chan puts -nonewline $out [chan read $in]
    chan close $in
    chan close $out
    list [file size $path(kyrillic.txt)] \
	    [file size $path(utf8-fcopy.txt)] \
	    [file size $path(utf8-rp.txt)]
} {3 5 5}
test chan-io-52.10 {TclCopyChannel & encodings} {fcopy} {
    # encoding to binary (=> implies that the internal utf-8 is written)
    set in  [open $path(kyrillic.txt) r]
    set out [open $path(utf8-fcopy.txt) w]
    chan configure $in  -encoding koi8-r -translation lf
    # -translation binary is also -encoding binary
    chan configure $out -translation binary
    chan copy $in $out
    chan close $in
    chan close $out
    file size $path(utf8-fcopy.txt)
} 5

test chan-io-52.11 {TclCopyChannel & encodings} -setup {
    set f [open $path(utf8-fcopy.txt) w]
    fconfigure $f -encoding utf-8 -translation lf
    puts $f "АА"
    close $f
} -constraints {fcopy} -body {
    # binary to encoding => the input has to be in utf-8 to make sense to the
    # encoder
    set in  [open $path(utf8-fcopy.txt) r]
    set out [open $path(kyrillic.txt) w]
    # -translation binary is also -encoding binary
    chan configure $in  -translation binary
    chan configure $out -encoding koi8-r -translation lf
    chan copy $in $out



    chan close $in


    chan close $out
    file size $path(kyrillic.txt)

} -result 3



test chan-io-53.1 {CopyData} -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 cr -blocking 0
    chan copy $f1 $f2 -size 0
    set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
    chan close $f1
    chan close $f2
    lappend result [file size $path(test1)]
} -result {0 0 0}
test chan-io-53.2 {CopyData} -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 cr -blocking 0
    chan copy $f1 $f2 -command [namespace code {set s0}]
    set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
    variable s0
    vwait [namespace which -variable s0]
    chan close $f1
    chan close $f2
    set s1 [file size $thisScript]







|
<









|
>



|


<
<




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



















|
|







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
    chan puts -nonewline $out [chan read $in]
    chan close $in
    chan close $out
    list [file size $path(kyrillic.txt)] \
	    [file size $path(utf8-fcopy.txt)] \
	    [file size $path(utf8-rp.txt)]
} {3 5 5}
test chan-io-52.10 {TclCopyChannel & encodings} -constraints {fcopy} -body {

    set in  [open $path(kyrillic.txt) r]
    set out [open $path(utf8-fcopy.txt) w]
    chan configure $in  -encoding koi8-r -translation lf
    # -translation binary is also -encoding binary
    chan configure $out -translation binary
    chan copy $in $out
    chan close $in
    chan close $out
    file size $path(utf8-fcopy.txt)
} -returnCodes 1 -match glob -result {error writing "*":\
	invalid or incomplete multibyte or wide character}
test chan-io-52.11 {TclCopyChannel & encodings} -setup {
    set f [open $path(utf8-fcopy.txt) w]
    fconfigure $f -encoding utf-8 -translation lf
    puts $f АА
    close $f
} -constraints {fcopy} -body {


    set in  [open $path(utf8-fcopy.txt) r]
    set out [open $path(kyrillic.txt) w]
    # -translation binary is also -encoding binary
    chan configure $in  -translation binary
    chan configure $out -encoding koi8-r -translation lf -profile strict
    catch {chan copy $in $out} cres copts
    return $cres
} -cleanup {
    if {$in in [chan names]} {
	close $in
    }
    if {$out in [chan names]} {
	close $out

    }
    catch {unset cres}
} -match glob -result  {error writing "*": invalid or incomplete\
	multibyte or wide character}

test chan-io-53.1 {CopyData} -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 cr -blocking 0
    chan copy $f1 $f2 -size 0
    set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
    chan close $f1
    chan close $f2
    lappend result [file size $path(test1)]
} -result {0 0 0}
test chan-io-53.2 {CopyData} -setup {
    file delete $path(test1)
} -constraints {fcopy} -body {
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    chan configure $f1 -translation lf -encoding iso8859-1 -blocking 0
    chan configure $f2 -translation cr -encoding iso8859-1 -blocking 0
    chan copy $f1 $f2 -command [namespace code {set s0}]
    set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
    variable s0
    vwait [namespace which -variable s0]
    chan close $f1
    chan close $f2
    set s1 [file size $thisScript]
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
		chan copy $b $a -command [list geof $b]
		chan puts stderr 2COPY
	    }
	    chan puts stderr ...
	}
	chan puts stderr SRV
	set l {}
	set srv [socket -server new 9999]

	chan puts stderr WAITING
	chan event stdin readable bye
	chan puts OK
	vwait forever
    }
    # wait for OK from server.
    chan gets $pipe
    # Now the two clients.
    proc done {sock} {
	if {[chan eof $sock]} { chan close $sock ; return }
	lappend ::forever [chan gets $sock]
	return
    }
    set a [socket 127.0.0.1 9999]
    set b [socket 127.0.0.1 9999]
    chan configure $a -translation binary -buffering none
    chan configure $b -translation binary -buffering none
    chan event  $a readable [namespace code "done $a"]
    chan event  $b readable [namespace code "done $b"]
} -constraints {stdio fcopy} -body {
    # Now pass data through the server in both directions.
    set ::forever {}







|
>


|



|






|
|







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
		chan copy $b $a -command [list geof $b]
		chan puts stderr 2COPY
	    }
	    chan puts stderr ...
	}
	chan puts stderr SRV
	set l {}
	set srv [socket -server new -myaddr 127.0.0.1 0]
        set port [lindex [chan configure $srv -sockname] 2]
	chan puts stderr WAITING
	chan event stdin readable bye
	puts "OK $port"
	vwait forever
    }
    # wait for OK from server.
    lassign [chan gets $pipe] ok port
    # Now the two clients.
    proc done {sock} {
	if {[chan eof $sock]} { chan close $sock ; return }
	lappend ::forever [chan gets $sock]
	return
    }
    set a [socket 127.0.0.1 $port]
    set b [socket 127.0.0.1 $port]
    chan configure $a -translation binary -buffering none
    chan configure $b -translation binary -buffering none
    chan event  $a readable [namespace code "done $a"]
    chan event  $b readable [namespace code "done $b"]
} -constraints {stdio fcopy} -body {
    # Now pass data through the server in both directions.
    set ::forever {}
7574
7575
7576
7577
7578
7579
7580
7581
7582
7583
7584
7585
7586
7587
7588
    chan event $pipe readable [namespace code [list readit $pipe]]
    variable x ""
    set result ""
    vwait [namespace which -variable x]
    # cut of the remainder of the error stack, especially the filename
    set result [lreplace $result 3 3 [lindex [split [lindex $result 3] \n] 0]]
    list $x $result
} {1 {gets {} catch {error writing "stdout": illegal byte sequence}}}

test chan-io-61.1 {Reset eof state after changing the eof char} -setup {
    set datafile [makeFile {} eofchar]
    set f [open $datafile w]
    chan configure $f -translation binary
    chan puts -nonewline $f [string repeat "Ho hum\n" 11]
    chan puts $f =







|







7584
7585
7586
7587
7588
7589
7590
7591
7592
7593
7594
7595
7596
7597
7598
    chan event $pipe readable [namespace code [list readit $pipe]]
    variable x ""
    set result ""
    vwait [namespace which -variable x]
    # cut of the remainder of the error stack, especially the filename
    set result [lreplace $result 3 3 [lindex [split [lindex $result 3] \n] 0]]
    list $x $result
} {1 {gets {} catch {error writing "stdout": invalid or incomplete multibyte or wide character}}}

test chan-io-61.1 {Reset eof state after changing the eof char} -setup {
    set datafile [makeFile {} eofchar]
    set f [open $datafile w]
    chan configure $f -translation binary
    chan puts -nonewline $f [string repeat "Ho hum\n" 11]
    chan puts $f =
7602
7603
7604
7605
7606
7607
7608
7609
7610
7611
7612
7613
7614
7615
7616
    #chan seek $f 0 current
    #lappend res [chan read $f; chan tell $f]
} -cleanup {
    chan close $f
    removeFile eofchar
} -result {77 = 23431}

# Test the cutting and splicing of channels, this is incidentially the
# attach/detach facility of package Thread, but __without any safeguards__. It
# can also be used to emulate transfer of channels between threads, and is
# used for that here.

test chan-io-70.0 {Cutting & Splicing channels} -setup {
    set f [makeFile {... dummy ...} cutsplice]
    set res {}







|







7612
7613
7614
7615
7616
7617
7618
7619
7620
7621
7622
7623
7624
7625
7626
    #chan seek $f 0 current
    #lappend res [chan read $f; chan tell $f]
} -cleanup {
    chan close $f
    removeFile eofchar
} -result {77 = 23431}

# Test the cutting and splicing of channels, this is incidentally the
# attach/detach facility of package Thread, but __without any safeguards__. It
# can also be used to emulate transfer of channels between threads, and is
# used for that here.

test chan-io-70.0 {Cutting & Splicing channels} -setup {
    set f [makeFile {... dummy ...} cutsplice]
    set res {}

Changes to tests/clock.test.

36039
36040
36041
36042
36043
36044
36045
36046
36047
36048
36049
36050
36051
36052
36053
	    unset oldTZ
	} else {
	    unset env(TZ)
	}
    } \
    -result {-0500}

# 43.1 was a bad test - mktime returning -1 is an error according to posix.

test clock-44.1 {regression test - time zone name containing hyphen } \
    -setup {
	if { [info exists env(TZ)] } {
	    set oldTZ $env(TZ)
	}
	set env(TZ) US/East-Indiana







|







36039
36040
36041
36042
36043
36044
36045
36046
36047
36048
36049
36050
36051
36052
36053
	    unset oldTZ
	} else {
	    unset env(TZ)
	}
    } \
    -result {-0500}

# 43.1 was a bad test - mktime returning -1 is an error according to Posix.

test clock-44.1 {regression test - time zone name containing hyphen } \
    -setup {
	if { [info exists env(TZ)] } {
	    set oldTZ $env(TZ)
	}
	set env(TZ) US/East-Indiana
36763
36764
36765
36766
36767
36768
36769








36770
36771
36772
36773
36774
36775
36776
    }
    -result {Sun Jan 08 22:30:06 WAST 2012}
}

test clock-57.1 {clock scan - abbreviated options} {
    clock scan 1970-01-01 -f %Y-%m-%d -g true
} 0









test clock-58.1 {clock l10n - Japanese localisation} {*}{
    -setup {
	proc backslashify { string } {

	    set retval {}
	    foreach char [split $string {}] {







>
>
>
>
>
>
>
>







36763
36764
36765
36766
36767
36768
36769
36770
36771
36772
36773
36774
36775
36776
36777
36778
36779
36780
36781
36782
36783
36784
    }
    -result {Sun Jan 08 22:30:06 WAST 2012}
}

test clock-57.1 {clock scan - abbreviated options} {
    clock scan 1970-01-01 -f %Y-%m-%d -g true
} 0

test clock-57.2 {clock scan - not -gmt and -timezone in the same call} {
    catch {clock scan 1970-01-01 -format %Y-%m-%d -gmt true -timezone :Europe/Berlin}
} 1

test clock-57.3 {clock scan - not -g and -timezone in the same call} {
    catch {clock scan 1970-01-01 -format %Y-%m-%d -g true -timezone :Europe/Berlin}
} 1

test clock-58.1 {clock l10n - Japanese localisation} {*}{
    -setup {
	proc backslashify { string } {

	    set retval {}
	    foreach char [split $string {}] {
36975
36976
36977
36978
36979
36980
36981









36982
36983
36984
36985
36986
36987
36988
    -body {
	clock add 0 1 year -foo bar
    }
    -match glob
    -returnCodes error
    -result {bad option "-foo"*}
}










test clock-66.1 {clock scan, no date, never-before-seen timezone} {*}{
    -setup {
	::tcl::clock::ClearCaches
    }
    -body {
	clock scan 1200 \







>
>
>
>
>
>
>
>
>







36983
36984
36985
36986
36987
36988
36989
36990
36991
36992
36993
36994
36995
36996
36997
36998
36999
37000
37001
37002
37003
37004
37005
    -body {
	clock add 0 1 year -foo bar
    }
    -match glob
    -returnCodes error
    -result {bad option "-foo"*}
}

test clock-65.2 {clock add with both -timezone and -gmt} {*}{
    -body {
	clock add 0 1 year -timezone :CET -gmt true
    }
    -match glob
    -returnCodes error
    -result {cannot use -gmt and -timezone in same call}
}

test clock-66.1 {clock scan, no date, never-before-seen timezone} {*}{
    -setup {
	::tcl::clock::ClearCaches
    }
    -body {
	clock scan 1200 \

Changes to tests/cmdAH.test.

24
25
26
27
28
29
30


31
32
33
34
35
36
37
testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint linkDirectory [expr {
    ![testConstraint win] ||
    ($::tcl_platform(osVersion) >= 5.0
     && [lindex [file system [temporaryDirectory]] 1] eq "NTFS")
}]
testConstraint notWine [expr {![info exists ::env(CI_USING_WINE)]}]



global env
set cmdAHwd [pwd]
catch {set platform [testgetplatform]}

proc waitForEvenSecondForFAT {} {
    # Windows 9x uses filesystems (the FAT* family of FSes) without enough







>
>







24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint linkDirectory [expr {
    ![testConstraint win] ||
    ($::tcl_platform(osVersion) >= 5.0
     && [lindex [file system [temporaryDirectory]] 1] eq "NTFS")
}]
testConstraint notWine [expr {![info exists ::env(CI_USING_WINE)]}]
# File permissions broken on wsl without some "exotic" wsl configuration
testConstraint notWsl [expr {[llength [array names ::env *WSL*]] == 0}]

global env
set cmdAHwd [pwd]
catch {set platform [testgetplatform]}

proc waitForEvenSecondForFAT {} {
    # Windows 9x uses filesystems (the FAT* family of FSes) without enough
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
test cmdAH-3.1 {Tcl_ContinueObjCmd, errors} -returnCodes error -body {
    continue foo
} -result {wrong # args: should be "continue"}
test cmdAH-3.2 {Tcl_ContinueObjCmd, success} {
    list [catch {continue} msg] $msg
} {4 {}}























































































































test cmdAH-4.1 {Tcl_EncodingObjCmd} -returnCodes error -body {
    encoding
} -result {wrong # args: should be "encoding subcommand ?arg ...?"}
test cmdAH-4.2 {Tcl_EncodingObjCmd} -returnCodes error -body {
    encoding foo
} -result {unknown or ambiguous subcommand "foo": must be convertfrom, convertto, dirs, names, or system}
test cmdAH-4.3 {Tcl_EncodingObjCmd} -returnCodes error -body {
    encoding convertto
} -result {wrong # args: should be "encoding convertto ?-nocomplain? ?-strict? ?-failindex var? ?encoding? data"}
test cmdAH-4.4 {Tcl_EncodingObjCmd} -returnCodes error -body {
    encoding convertto foo bar
} -result {unknown encoding "foo"}
test cmdAH-4.5 {Tcl_EncodingObjCmd} -setup {
    set system [encoding system]
} -body {

    encoding system jis0208
    encoding convertto 乎
} -cleanup {
    encoding system $system
} -result 8C
test cmdAH-4.6 {Tcl_EncodingObjCmd} -setup {
    set system [encoding system]
} -body {
    encoding system iso8859-1
    encoding convertto jis0208 乎
} -cleanup {
    encoding system $system
} -result 8C
test cmdAH-4.7 {Tcl_EncodingObjCmd} -returnCodes error -body {
    encoding convertfrom
} -result {wrong # args: should be "encoding convertfrom ?-nocomplain? ?-strict? ?-failindex var? ?encoding? data"}
test cmdAH-4.8 {Tcl_EncodingObjCmd} -returnCodes error -body {
    encoding convertfrom foo bar
} -result {unknown encoding "foo"}
test cmdAH-4.9 {Tcl_EncodingObjCmd} -setup {
    set system [encoding system]
} -body {
    encoding system jis0208
    encoding convertfrom 8C
} -cleanup {
    encoding system $system
} -result 乎
test cmdAH-4.10 {Tcl_EncodingObjCmd} -setup {
    set system [encoding system]
} -body {
    encoding system iso8859-1
    encoding convertfrom jis0208 8C
} -cleanup {
    encoding system $system
} -result 乎
test cmdAH-4.11 {Tcl_EncodingObjCmd} -returnCodes error -body {
    encoding names foo
} -result {wrong # args: should be "encoding names"}
test cmdAH-4.12 {Tcl_EncodingObjCmd} -returnCodes error -body {
    encoding system foo bar
} -result {wrong # args: should be "encoding system ?encoding?"}
test cmdAH-4.13 {Tcl_EncodingObjCmd} -setup {
    set system [encoding system]
} -body {
    encoding system iso8859-1
    encoding system
} -cleanup {
    encoding system $system
} -result iso8859-1



test cmdAH-4.14.1 {Syntax error, -nocomplain and -failindex, no encoding} -body {


    encoding convertfrom -nocomplain -failindex 2 ABC
} -returnCodes 1 -result {wrong # args: should be "encoding convertfrom ?-nocomplain? ?-strict? ?-failindex var? ?encoding? data"}
test cmdAH-4.14.2 {Syntax error, -nocomplain and -failindex, no encoding} -body {
    encoding convertto -nocomplain -failindex 2 ABC

} -returnCodes 1 -result {wrong # args: should be "encoding convertto ?-nocomplain? ?-strict? ?-failindex var? ?encoding? data"}

test cmdAH-4.15.1 {Syntax error, -failindex and -nocomplain, no encoding} -body {





    encoding convertfrom -failindex 2 -nocomplain ABC




} -returnCodes 1 -result {unknown encoding "-nocomplain"}

test cmdAH-4.15.2 {Syntax error, -failindex and -nocomplain, no encoding} -body {


    encoding convertto -failindex 2 -nocomplain ABC


} -returnCodes 1 -result {unknown encoding "-nocomplain"}



test cmdAH-4.16.1 {Syntax error, -nocomplain and -failindex, encoding} -body {









    encoding convertfrom -nocomplain -failindex 2 utf-8 ABC
} -returnCodes 1 -result {wrong # args: should be "encoding convertfrom ?-nocomplain? ?-strict? ?-failindex var? ?encoding? data"}
test cmdAH-4.16.2 {Syntax error, -nocomplain and -failindex, encoding} -body {
    encoding convertto -nocomplain -failindex 2 utf-8 ABC
} -returnCodes 1 -result {wrong # args: should be "encoding convertto ?-nocomplain? ?-strict? ?-failindex var? ?encoding? data"}


test cmdAH-4.17.1 {Syntax error, -failindex and -nocomplain, encoding} -body {
    encoding convertfrom -failindex 2 -nocomplain utf-8 ABC





} -returnCodes 1 -result {wrong # args: should be "encoding convertfrom ?-nocomplain? ?-strict? ?-failindex var? ?encoding? data"}
test cmdAH-4.17.2 {Syntax error, -failindex and -nocomplain, encoding} -body {
    encoding convertto -failindex 2 -nocomplain utf-8 ABC




} -returnCodes 1 -result {wrong # args: should be "encoding convertto ?-nocomplain? ?-strict? ?-failindex var? ?encoding? data"}







test cmdAH-4.18.1 {Syntax error, -failindex with no var, no encoding} -body {


    encoding convertfrom -failindex ABC
} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertfrom ?-nocomplain? ?-strict? ?-failindex var? ?encoding? data"}




test cmdAH-4.18.2 {Syntax error, -failindex with no var, no encoding (byte compiled)} -setup {




    proc encoding_test {} {


        encoding convertfrom -failindex ABC
    }
} -body {
    # Compile and execute
    encoding_test
} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertfrom ?-nocomplain? ?-strict? ?-failindex var? ?encoding? data"} -cleanup {
    rename encoding_test ""

}



test cmdAH-4.18.3 {Syntax error, -failindex with no var, no encoding} -body {
    encoding convertto -failindex ABC
} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertto ?-nocomplain? ?-strict? ?-failindex var? ?encoding? data"}
test cmdAH-4.18.4 {Syntax error, -failindex with no var, no encoding (byte compiled)} -setup {





    proc encoding_test {} {
        encoding convertto -failindex ABC





    }

} -body {
    # Compile and execute







    encoding_test
} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertto ?-nocomplain? ?-strict? ?-failindex var? ?encoding? data"} -cleanup {
    rename encoding_test ""



}
test cmdAH-4.19.1 {convertrom -failindex with correct data} -body {

    encoding convertfrom -failindex test ABC

    set test


} -returnCodes 0 -result -1

test cmdAH-4.19.2 {convertrom -failindex with correct data (byt compiled)} -setup {






    proc encoding_test {} {
	encoding convertfrom -failindex test ABC
	set test

    }







} -body {







    # Compile and execute

    encoding_test
} -returnCodes 0 -result -1 -cleanup {
    rename encoding_test ""




}


test cmdAH-4.19.3 {convertrom -failindex with correct data} -body {




    encoding convertto -failindex test ABC
    set test


} -returnCodes 0 -result -1


test cmdAH-4.19.4 {convertrom -failindex with correct data (byt compiled)} -setup {
    proc encoding_test {} {

	encoding convertto -failindex test ABC
	set test




    }
} -body {

    # Compile and execute






    encoding_test
} -returnCodes 0 -result -1 -cleanup {
    rename encoding_test ""





}

test cmdAH-4.20.1 {convertrom -failindex with incomplete utf8} -body {
    set x [encoding convertfrom -failindex i utf-8 A\xc3]


    binary scan $x H* y
    list $y $i
} -returnCodes 0 -result {41c3 -1}
test cmdAH-4.20.2 {convertrom -failindex with incomplete utf8 (byte compiled)} -setup {
    proc encoding_test {} {
	set x [encoding convertfrom -failindex i utf-8 A\xc3]






	binary scan $x H* y

	list $y $i


    }





} -body {





    # Compile and execute
    encoding_test

} -returnCodes 0 -result {41c3 -1} -cleanup {






    rename encoding_test ""




}
test cmdAH-4.21.1 {convertto -failindex with wrong character} -body {
    set x [encoding convertto -failindex i iso8859-1 A\u0141]


    binary scan $x H* y

    list $y $i
} -returnCodes 0 -result {41 1}



test cmdAH-4.21.2 {convertto -failindex with wrong character (byte compiled)} -setup {





    proc encoding_test {} {
    set x [encoding convertto -failindex i iso8859-1 A\u0141]


	binary scan $x H* y

	list $y $i




    }

} -body {
    # Compile and execute
    encoding_test
} -returnCodes 0 -result {41 1} -cleanup {


    rename encoding_test ""
}
test cmdAH-4.22 {convertfrom -strict} -body {
    encoding convertfrom -strict utf-8 A\x00B








} -result A\x00B

















test cmdAH-4.23 {convertfrom -strict} -body {


    encoding convertfrom -strict utf-8 A\xC0\x80B
} -returnCodes error -result {unexpected byte sequence starting at index 1: '\xC0'}



test cmdAH-4.24 {convertto -strict} -body {

    encoding convertto -strict utf-8 A\x00B

} -result A\x00B




test cmdAH-4.25 {convertfrom -strict} -constraints knownBug -body {
    encoding convertfrom -strict utf-8 A\x80B

} -returnCodes error -result {unexpected byte sequence starting at index 1: '\x80'}

test cmdAH-4.26 {convertto -strict} -constraints {testbytestring knownBug} -body {
    encoding convertto -strict utf-8 A[testbytestring \x80]B
} -returnCodes error -result {unexpected byte sequence starting at index 1: '\x80'}


test cmdAH-5.1 {Tcl_FileObjCmd} -returnCodes error -body {
    file
} -result {wrong # args: should be "file subcommand ?arg ...?"}
test cmdAH-5.2 {Tcl_FileObjCmd} -returnCodes error -body {
    file x
} -result {unknown or ambiguous subcommand "x": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, home, isdirectory, isfile, join, link, lstat, mkdir, mtime, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempdir, tempfile, tildeexpand, type, volumes, or writable}







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


|

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








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

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

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

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

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

>
>
|
>
|
>
|

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







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
test cmdAH-3.1 {Tcl_ContinueObjCmd, errors} -returnCodes error -body {
    continue foo
} -result {wrong # args: should be "continue"}
test cmdAH-3.2 {Tcl_ContinueObjCmd, success} {
    list [catch {continue} msg] $msg
} {4 {}}

###
# encoding command

set "numargErrors(encoding system)" {^wrong # args: should be "(encoding |::tcl::encoding::)system \?encoding\?"$}
set "numargErrors(encoding convertfrom)" {wrong # args: should be "(encoding |::tcl::encoding::)convertfrom \?-profile profile\? \?-failindex var\? encoding data" or "(encoding |::tcl::encoding::)convertfrom data"}
set "numargErrors(encoding convertto)" {wrong # args: should be "(encoding |::tcl::encoding::)convertto \?-profile profile\? \?-failindex var\? encoding data" or "(encoding |::tcl::encoding::)convertto data"}
set "numargErrors(encoding names)" {wrong # args: should be "encoding names"}
set "numargErrors(encoding profiles)" {wrong # args: should be "encoding profiles"}

source [file join [file dirname [info script]] encodingVectors.tcl]


# Maps utf-{16,32}{le,be} to utf-16, utf-32 and
# others to "". Used to test utf-16, utf-32 based
# on system endianness
proc endianUtf {enc} {
    if {$::tcl_platform(byteOrder) eq "littleEndian"} {
        set endian le
    } else {
        set endian be
    }
    if {$enc eq "utf-16$endian" || $enc eq "utf-32$endian"} {
        return [string range $enc 0 5]
    }
    return ""
}

#
# Check errors for invalid number of arguments
proc badnumargs {id cmd cmdargs} {
    variable numargErrors
    test $id.a "Syntax error: $cmd $cmdargs" \
        -body [list {*}$cmd {*}$cmdargs] \
        -result $numargErrors($cmd) \
        -match regexp \
        -returnCodes error
    test $id.b "Syntax error: $cmd (byte compiled)" \
        -setup [list proc compiled_proc {} [list {*}$cmd {*}$cmdargs]] \
        -body {compiled_proc} \
        -cleanup {rename compiled_proc {}} \
        -result $numargErrors($cmd) \
        -match regexp \
        -returnCodes error
}

# Wraps tests resulting in unknown encoding errors
proc unknownencodingtest {id cmd} {
    set result "unknown encoding \"[lindex $cmd end-1]\""
    test $id.a "Unknown encoding error: $cmd" \
        -body [list encoding {*}$cmd] \
        -result $result \
        -returnCodes error
    test $id.b "Syntax error: $cmd (byte compiled)" \
        -setup [list proc encoding_test {} [list encoding {*}$cmd]] \
        -body {encoding_test} \
        -cleanup {rename encoding_test {}} \
        -result $result \
        -returnCodes error
}

# Wraps tests for conversion, successful or not.
# Really more general than just for encoding conversion.
proc testconvert {id body result args} {
    test $id.a $body \
        -body $body \
        -result $result \
        {*}$args
    dict append args -setup \n[list proc compiled_script {} $body]
    dict append args -cleanup "\nrename compiled_script {}"
    test $id.b "$body (byte compiled)" \
        -body {compiled_script} \
        -result $result \
        {*}$args
}

# Wrapper to verify encoding convert{to,from} ?-profile?
# Generates tests for compiled and uncompiled implementation.
# Also generates utf-{16,32} tests if passed encoding is utf-{16,32}{le,be}
# The enc and profile are appended to id to generate the test id
proc testprofile {id converter enc profile data result args} {
    testconvert $id.$enc.$profile [list encoding $converter -profile $profile $enc $data] $result {*}$args
    if {[set enc2 [endianUtf $enc]] ne ""} {
        # If utf{16,32}-{le,be}, also do utf{16,32}
        testconvert $id.$enc2.$profile [list encoding $converter -profile $profile $enc2 $data] $result {*}$args
    }

    # If this is the default profile, generate a test without specifying profile
    if {$profile eq $::encDefaultProfile} {
        testconvert $id.$enc.default [list encoding $converter $enc $data] $result {*}$args
        if {[set enc2 [endianUtf $enc]] ne ""} {
            # If utf{16,32}-{le,be}, also do utf{16,32}
            testconvert $id.$enc2.default [list encoding $converter $enc2 $data] $result {*}$args
        }
    }
}


# Wrapper to verify encoding convert{to,from} -failindex ?-profile?
# Generates tests for compiled and uncompiled implementation.
# Also generates utf-{16,32} tests if passed encoding is utf-{16,32}{le,be}
# The enc and profile are appended to id to generate the test id
proc testfailindex {id converter enc data result failidx {profile default}} {
    testconvert $id.$enc.$profile "list \[encoding $converter -profile $profile -failindex idx $enc [list $data]\] \[set idx\]" [list $result $failidx]
    if {[set enc2 [endianUtf $enc]] ne ""} {
        # If utf{16,32}-{le,be}, also do utf{16,32}
        testconvert $id.$enc2.$profile "list \[encoding $converter -profile $profile -failindex idx $enc2 [list $data]\] \[set idx]" [list $result $failidx]
    }

    # If this is the default profile, generate a test without specifying profile
    if {$profile eq $::encDefaultProfile} {
        testconvert $id.$enc.default "list \[encoding $converter -failindex idx $enc [list $data]\] \[set idx]" [list $result $failidx]
        if {[set enc2 [endianUtf $enc]] ne ""} {
            # If utf{16,32}-{le,be}, also do utf{16,32}
            testconvert $id.$enc2.default "list \[encoding $converter -failindex idx $enc2 [list $data]\] \[set idx]" [list $result $failidx]
        }
    }
}

test cmdAH-4.1.1 {encoding} -returnCodes error -body {
    encoding
} -result {wrong # args: should be "encoding subcommand ?arg ...?"}
test cmdAH-4.1.2 {Tcl_EncodingObjCmd} -returnCodes error -body {
    encoding foo
} -result {unknown or ambiguous subcommand "foo": must be convertfrom, convertto, dirs, names, profiles, or system}









#
# encoding system 4.2.*


badnumargs cmdAH-4.2.1 {encoding system} {ascii ascii}

test cmdAH-4.2.2 {Tcl_EncodingObjCmd} -setup {




































    set system [encoding system]
} -body {
    encoding system iso8859-1
    encoding system
} -cleanup {
    encoding system $system
} -result iso8859-1

#
# encoding convertfrom 4.3.*

# Odd number of args is always invalid since last two args
# are ENCODING DATA and all options take a value
badnumargs cmdAH-4.3.1 {encoding convertfrom} {}
badnumargs cmdAH-4.3.2 {encoding convertfrom} {-failindex VAR ABC}
badnumargs cmdAH-4.3.3 {encoding convertfrom} {-profile VAR ABC}
badnumargs cmdAH-4.3.4 {encoding convertfrom} {-failindex VAR -profile strict ABC}
badnumargs cmdAH-4.3.5 {encoding convertfrom} {-profile strict -failindex VAR ABC}

# Test that last two args always treated as ENCODING DATA
unknownencodingtest cmdAH-4.3.6 {convertfrom -failindex ABC}
unknownencodingtest cmdAH-4.3.7 {convertfrom -profile ABC}
unknownencodingtest cmdAH-4.3.8 {convertfrom nosuchencoding ABC}
unknownencodingtest cmdAH-4.3.9 {convertfrom -failindex VAR -profile ABC}
unknownencodingtest cmdAH-4.3.10 {convertfrom -profile strict -failindex ABC}
testconvert cmdAH-4.3.11 {
    encoding convertfrom jis0208 \x38\x43
} 乎 -setup {
    set system [encoding system]
    encoding system iso8859-1
} -cleanup {
    encoding system $system
}

# Verify single arg defaults to system encoding
testconvert cmdAH-4.3.12 {
    encoding convertfrom \x38\x43
} 乎 -setup {
    set system [encoding system]
    encoding system jis0208
} -cleanup {
    encoding system $system
}

# convertfrom ?-profile? : valid byte sequences
foreach {enc str hex ctrl comment} $encValidStrings {
    if {"knownBug" in $ctrl} continue
    set bytes [binary decode hex $hex]
    set prefix A
    set suffix B
    set prefix_bytes [encoding convertto $enc A]
    set suffix_bytes [encoding convertto $enc B]
    foreach profile $encProfiles {
        testprofile cmdAH-4.3.13.$hex.solo convertfrom $enc $profile $bytes $str
        testprofile cmdAH-4.3.13.$hex.lead convertfrom $enc $profile $bytes$suffix_bytes $str$suffix
        testprofile cmdAH-4.3.13.$hex.tail convertfrom $enc $profile $prefix_bytes$bytes $prefix$str

        testprofile cmdAH-4.3.13.$hex.middle convertfrom $enc $profile $prefix_bytes$bytes$suffix_bytes $prefix$str$suffix
    }
}

# convertfrom ?-profile? : invalid byte sequences
foreach {enc hex profile str failidx ctrl comment} $encInvalidBytes {
    if {"knownBug" in $ctrl} continue
    set bytes [binary format H* $hex]
    set prefix A
    set suffix B
    set prefix_bytes [encoding convertto $enc $prefix]

    set suffix_bytes [encoding convertto $enc $suffix]
    set prefixLen [string length $prefix_bytes]
    set result [list $str]
    # TODO - if the bad byte is unprintable, tcltest errors out when printing a mismatch
    # so glob it out in error message pattern for now.
    set errorWithoutPrefix [list "unexpected byte sequence starting at index $failidx: *" -returnCodes error -match glob]
    set errorWithPrefix [list "unexpected byte sequence starting at index [expr {$failidx+$prefixLen}]: *" -returnCodes error -match glob]
    if {$ctrl eq {} || "solo" in $ctrl} {
        if {$failidx == -1} {
            set result [list $str]
        } else {
            set result $errorWithoutPrefix
        }
        testprofile cmdAH-4.3.13.$hex.solo convertfrom $enc $profile $bytes {*}$result
    }
    if {$ctrl eq {} || "lead" in $ctrl} {
        if {$failidx == -1} {

            set result [list $str$suffix]
        } else {
            set result $errorWithoutPrefix
        }
        testprofile cmdAH-4.3.13.$hex.lead convertfrom $enc $profile $bytes$suffix_bytes {*}$result
    }
    if {$ctrl eq {} || "tail" in $ctrl} {
        if {$failidx == -1} {
            set result [list $prefix$str]
        } else {
            set result $errorWithPrefix
        }
        testprofile cmdAH-4.3.13.$hex.tail convertfrom $enc $profile $prefix_bytes$bytes {*}$result
    }
    if {$ctrl eq {} || "middle" in $ctrl} {
        if {$failidx == -1} {
            set result [list $prefix$str$suffix]

        } else {
            set result $errorWithPrefix
        }
        testprofile cmdAH-4.3.13.$hex.middle convertfrom $enc $profile $prefix_bytes$bytes$suffix_bytes {*}$result
    }
}

# convertfrom -failindex ?-profile? - valid data


foreach {enc str hex ctrl comment} $encValidStrings {
    if {"knownBug" in $ctrl} continue
    set bytes [binary decode hex $hex]
    set prefix A
    set suffix B
    set prefix_bytes [encoding convertto $enc $prefix]
    set suffix_bytes [encoding convertto $enc $suffix]
    foreach profile $encProfiles {
        testfailindex cmdAH-4.3.14.$hex.solo convertfrom $enc $bytes $str -1 $profile
        testfailindex cmdAH-4.3.14.$hex.lead convertfrom $enc $bytes$suffix_bytes $str$suffix -1 $profile
        testfailindex cmdAH-4.3.14.$hex.tail convertfrom $enc $prefix_bytes$bytes $prefix$str -1 $profile
        testfailindex cmdAH-4.3.14.$hex.middle convertfrom $enc $prefix_bytes$bytes$suffix_bytes $prefix$str$suffix -1 $profile
    }
}


# convertfrom -failindex ?-profile? - invalid data
foreach {enc hex profile str failidx ctrl comment} $encInvalidBytes {
    if {"knownBug" in $ctrl} continue
    # There are multiple test cases based on location of invalid bytes
    set bytes [binary decode hex $hex]
    set prefix A
    set suffix B
    set prefix_bytes [encoding convertto $enc $prefix]

    set suffix_bytes [encoding convertto $enc $suffix]
    set prefixLen [string length $prefix_bytes]
    if {$ctrl eq {} || "solo" in $ctrl} {
        testfailindex cmdAH-4.3.14.$hex.solo convertfrom $enc $bytes $str $failidx $profile
    }

    if {$ctrl eq {} || "lead" in $ctrl} {
        if {$failidx == -1} {
            # If success expected
            set result $str$suffix
        } else {
            # Failure expected
            set result ""
        }
        testfailindex cmdAH-4.3.14.$hex.lead convertfrom $enc $bytes$suffix_bytes $result $failidx $profile
    }
    if {$ctrl eq {} || "tail" in $ctrl} {
        set expected_failidx $failidx
        if {$failidx == -1} {
            # If success expected
            set result $prefix$str
        } else {
            # Failure expected
            set result $prefix
            incr expected_failidx $prefixLen
        }
        testfailindex cmdAH-4.3.14.$hex.tail convertfrom $enc $prefix_bytes$bytes $result $expected_failidx $profile
    }
    if {$ctrl eq {} || "middle" in $ctrl} {
        set expected_failidx $failidx
        if {$failidx == -1} {
            # If success expected
            set result $prefix$str$suffix
        } else {
            # Failure expected
            set result $prefix
            incr expected_failidx $prefixLen
        }
        testfailindex cmdAH-4.3.14.$hex.middle convertfrom $enc $prefix_bytes$bytes$suffix_bytes $result $expected_failidx $profile
    }
}

#
# encoding convertto 4.4.*

badnumargs cmdAH-4.4.1 {encoding convertto} {}
badnumargs cmdAH-4.4.2 {encoding convertto} {-failindex VAR ABC}
badnumargs cmdAH-4.4.3 {encoding convertto} {-profile VAR ABC}
badnumargs cmdAH-4.4.4 {encoding convertto} {-failindex VAR -profile strict ABC}
badnumargs cmdAH-4.4.5 {encoding convertto} {-profile strict -failindex VAR ABC}

# Test that last two args always treated as ENCODING DATA
unknownencodingtest cmdAH-4.4.6 {convertto -failindex ABC}
unknownencodingtest cmdAH-4.4.7 {convertto -profile ABC}
unknownencodingtest cmdAH-4.4.8 {convertto nosuchencoding ABC}
unknownencodingtest cmdAH-4.4.9 {convertto -failindex VAR -profile ABC}
unknownencodingtest cmdAH-4.4.10 {convertto -profile strict -failindex ABC}
testconvert cmdAH-4.4.11 {
    encoding convertto jis0208 
} \x38\x43 -setup {
    set system [encoding system]
    encoding system iso8859-1
} -cleanup {
    encoding system $system
}

# Verify single arg defaults to system encoding
testconvert cmdAH-4.4.12 {
    encoding convertto 
} \x38\x43 -setup {
    set system [encoding system]
    encoding system jis0208
} -cleanup {
    encoding system $system
}

# convertto ?-profile? : valid byte sequences

foreach {enc str hex ctrl comment} $encValidStrings {
    if {"knownBug" in $ctrl} continue
    set bytes [binary decode hex $hex]
    set printable [tcltest::Asciify $str]
    set prefix A
    set suffix B
    set prefix_bytes [encoding convertto $enc A]

    set suffix_bytes [encoding convertto $enc B]
    foreach profile $encProfiles {
        testprofile cmdAH-4.4.13.$printable.solo convertto $enc $profile $str $bytes
        testprofile cmdAH-4.4.13.$printable.lead convertto $enc $profile $str$suffix $bytes$suffix_bytes
        testprofile cmdAH-4.4.13.$printable.tail convertto $enc $profile $prefix$str $prefix_bytes$bytes
        testprofile cmdAH-4.4.13.$printable.middle convertto $enc $profile $prefix$str$suffix $prefix_bytes$bytes$suffix_bytes
    }
}

# convertto ?-profile? : invalid byte sequences
foreach {enc str profile hex failidx ctrl comment} $encUnencodableStrings {
    if {"knownBug" in $ctrl} continue
    set bytes [binary decode hex $hex]
    set printable [tcltest::Asciify $str]
    set prefix A
    set suffix B
    set prefix_bytes [encoding convertto $enc $prefix]
    set suffix_bytes [encoding convertto $enc $suffix]
    set prefixLen [string length $prefix_bytes]
    set result [list $bytes]
    # TODO - if the bad byte is unprintable, tcltest errors out when printing a mismatch
    # so glob it out in error message pattern for now.
    set errorWithoutPrefix [list "unexpected character at index $failidx: *" -returnCodes error -match glob]
    set errorWithPrefix [list "unexpected character at index [expr {$failidx+$prefixLen}]: *" -returnCodes error -match glob]
    if {$ctrl eq {} || "solo" in $ctrl} {
        if {$failidx == -1} {
            set result [list $bytes]
        } else {
            set result $errorWithoutPrefix
        }
        testprofile cmdAH-4.4.13.$printable.solo convertto $enc $profile $str {*}$result
    }
    if {$ctrl eq {} || "lead" in $ctrl} {
        if {$failidx == -1} {
            set result [list $bytes$suffix_bytes]
        } else {
            set result $errorWithoutPrefix
        }
        testprofile cmdAH-4.4.13.$printable.lead convertto $enc $profile $str$suffix {*}$result
    }
    if {$ctrl eq {} || "tail" in $ctrl} {
        if {$failidx == -1} {
            set result [list $prefix_bytes$bytes]
        } else {
            set result $errorWithPrefix
        }
        testprofile cmdAH-4.4.13.$printable.tail convertto $enc $profile $prefix$str {*}$result
    }
    if {$ctrl eq {} || "middle" in $ctrl} {
        if {$failidx == -1} {
            set result [list $prefix_bytes$bytes$suffix_bytes]
        } else {
            set result $errorWithPrefix
        }
        testprofile cmdAH-4.4.13.$printable.middle convertto $enc $profile $prefix$str$suffix {*}$result
    }
}

# convertto -failindex ?-profile? - valid data
foreach {enc str hex ctrl comment} $encValidStrings {
    if {"knownBug" in $ctrl} continue
    set bytes [binary decode hex $hex]
    set printable [tcltest::Asciify $str]
    set prefix A
    set suffix B
    set prefix_bytes [encoding convertto $enc A]
    set suffix_bytes [encoding convertto $enc B]
    foreach profile $encProfiles {
        testfailindex cmdAH-4.4.14.$enc.$printable.solo convertto $enc $str $bytes -1 $profile
        testfailindex cmdAH-4.4.14.$enc.$printable.lead convertto $enc $str$suffix $bytes$suffix_bytes -1 $profile
        testfailindex cmdAH-4.4.14.$enc.$printable.tail convertto $enc $prefix$str $prefix_bytes$bytes -1 $profile
        testfailindex cmdAH-4.4.14.$enc.$printable.middle convertto $enc $prefix$str$suffix $prefix_bytes$bytes$suffix_bytes -1 $profile
    }
}

# convertto -failindex ?-profile? - invalid data
foreach {enc str profile hex failidx ctrl comment} $encUnencodableStrings {
    if {"knownBug" in $ctrl} continue
    set bytes [binary decode hex $hex]
    set printable [tcltest::Asciify $str]
    set prefix A
    set suffix B
    set prefixLen [string length [encoding convertto $enc $prefix]]
    if {$ctrl eq {} || "solo" in $ctrl} {
        testfailindex cmdAH-4.4.14.$printable.solo convertto $enc $str $bytes $failidx $profile
    }
    if {$ctrl eq {} || "lead" in $ctrl} {
        if {$failidx == -1} {

            # If success expected
            set result $bytes$suffix
        } else {
            # Failure expected
            set result ""
        }
        testfailindex cmdAH-4.4.14.$printable.lead convertto $enc $str$suffix $result $failidx $profile

    }
    if {$ctrl eq {} || "tail" in $ctrl} {
        set expected_failidx $failidx
        if {$failidx == -1} {
            # If success expected
            set result $prefix$bytes
        } else {
            # Failure expected
            set result $prefix
            incr expected_failidx $prefixLen
        }
        testfailindex cmdAH-4.4.14.$printable.tail convertto $enc $prefix$str $result $expected_failidx $profile
    }
    if {$ctrl eq {} || "middle" in $ctrl} {
        set expected_failidx $failidx
        if {$failidx == -1} {
            # If success expected
            set result $prefix$bytes$suffix
        } else {
            # Failure expected
            set result $prefix
            incr expected_failidx $prefixLen
        }
        testfailindex cmdAH-4.4.14.$printable.middle convertto $enc $prefix$str$suffix $result $expected_failidx $profile
    }
}

test cmdAH-4.4.xx {convertto -profile strict} -constraints {testbytestring knownBug} -body {
    # TODO - what does testbytestring even test? Invalid UTF8 in the Tcl_Obj bytes field
    encoding convertto -profile strict utf-8 A[testbytestring \x80]B
} -returnCodes error -result {unexpected byte sequence starting at index 1: '\x80'}

#
# encoding names 4.5.*
badnumargs cmdAH-4.5.1 {encoding names} {foo}
test cmdAH-4.5.2 {encoding names should include at least utf-8 and iso8859-1 and at least one more} -body {
    set names [encoding names]
    list [expr {"utf-8" in $names}] [expr {"iso8859-1" in $names}] [expr {[llength $names] > 2}]
} -result {1 1 1}

#
# encoding profiles 4.6.*
badnumargs cmdAH-4.6.1 {encoding profiles} {foo}
test cmdAH-4.6.2 {encoding profiles} -body {
    lsort [encoding profiles]
} -result {replace strict tcl8}

#



# file command

test cmdAH-5.1 {Tcl_FileObjCmd} -returnCodes error -body {
    file
} -result {wrong # args: should be "file subcommand ?arg ...?"}
test cmdAH-5.2 {Tcl_FileObjCmd} -returnCodes error -body {
    file x
} -result {unknown or ambiguous subcommand "x": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, home, isdirectory, isfile, join, link, lstat, mkdir, mtime, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempdir, tempfile, tildeexpand, type, volumes, or writable}
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
test cmdAH-16.2 {Tcl_FileObjCmd: readable} {
    -constraints testchmod
    -setup  	 {testchmod 0o444 $gorpfile}
    -body   	 {file readable $gorpfile}
    -result 	 1
}
test cmdAH-16.3 {Tcl_FileObjCmd: readable} {
    -constraints {unix notRoot testchmod}
    -setup  	 {testchmod 0o333 $gorpfile}
    -body   	 {file readable $gorpfile}
    -result 	 0
}

# writable
test cmdAH-17.1 {Tcl_FileObjCmd: writable} {







|







1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
test cmdAH-16.2 {Tcl_FileObjCmd: readable} {
    -constraints testchmod
    -setup  	 {testchmod 0o444 $gorpfile}
    -body   	 {file readable $gorpfile}
    -result 	 1
}
test cmdAH-16.3 {Tcl_FileObjCmd: readable} {
    -constraints {unix notRoot testchmod notWsl}
    -setup  	 {testchmod 0o333 $gorpfile}
    -body   	 {file readable $gorpfile}
    -result 	 0
}

# writable
test cmdAH-17.1 {Tcl_FileObjCmd: writable} {
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
removeFile $gorpfile
removeDirectory $dirfile
set dirfile [makeDirectory dir.file]
set gorpfile [makeFile abcde gorp.file]
test cmdAH-18.1 {Tcl_FileObjCmd: executable} -returnCodes error -body {
    file executable a b
} -result {wrong # args: should be "file executable name"}
test cmdAH-18.2 {Tcl_FileObjCmd: executable} {notRoot} {
    file executable $gorpfile
} 0
test cmdAH-18.3 {Tcl_FileObjCmd: executable} {unix testchmod} {
    # Only on unix will setting the execute bit on a regular file cause that
    # file to be executable.
    testchmod 0o775 $gorpfile
    file exe $gorpfile







|







1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
removeFile $gorpfile
removeDirectory $dirfile
set dirfile [makeDirectory dir.file]
set gorpfile [makeFile abcde gorp.file]
test cmdAH-18.1 {Tcl_FileObjCmd: executable} -returnCodes error -body {
    file executable a b
} -result {wrong # args: should be "file executable name"}
test cmdAH-18.2 {Tcl_FileObjCmd: executable} {notRoot notWsl} {
    file executable $gorpfile
} 0
test cmdAH-18.3 {Tcl_FileObjCmd: executable} {unix testchmod} {
    # Only on unix will setting the execute bit on a regular file cause that
    # file to be executable.
    testchmod 0o775 $gorpfile
    file exe $gorpfile
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
} -result "could not get modification time for file \"con\"" -returnCodes error
test cmdAH-24.14.1 {
    Tcl_FileObjCmd: mtime (built-in Windows names with dir path and extension)
} -constraints {win} -body {
    file mtime [file join [temporaryDirectory] CON.txt]
} -match regexp -result {could not (?:get modification time|read)} -returnCodes error

# 3155760000 is 64-bit unix time, Wed Jan 01 00:00:00 GMT 2070:
test cmdAH-24.20.1 {Tcl_FileObjCmd: atime 64-bit time_t, bug [4718b41c56]} -setup {
    set filename [makeFile "" foo.text]
} -body {
    list [file atime $filename 3155760000] [file atime $filename]
} -cleanup {
    removeFile $filename
} -result {3155760000 3155760000}







|







1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
} -result "could not get modification time for file \"con\"" -returnCodes error
test cmdAH-24.14.1 {
    Tcl_FileObjCmd: mtime (built-in Windows names with dir path and extension)
} -constraints {win} -body {
    file mtime [file join [temporaryDirectory] CON.txt]
} -match regexp -result {could not (?:get modification time|read)} -returnCodes error

# 3155760000 is 64-bit Unix time, Wed Jan 01 00:00:00 GMT 2070:
test cmdAH-24.20.1 {Tcl_FileObjCmd: atime 64-bit time_t, bug [4718b41c56]} -setup {
    set filename [makeFile "" foo.text]
} -body {
    list [file atime $filename 3155760000] [file atime $filename]
} -cleanup {
    removeFile $filename
} -result {3155760000 3155760000}
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
} -result {atime ctime dev gid ino mode mtime nlink size type uid}
test cmdAH-28.4 {Tcl_FileObjCmd: stat} -setup {
    unset -nocomplain stat
} -body {
    file stat $gorpfile stat
    list $stat(nlink) $stat(size) $stat(type)
} -result {1 12 file}
test cmdAH-28.5 {Tcl_FileObjCmd: stat} -constraints {unix} -setup {
    unset -nocomplain stat
} -body {
    file stat $gorpfile stat
    format 0o%03o [expr {$stat(mode) & 0o777}]
} -result 0o765
test cmdAH-28.6 {Tcl_FileObjCmd: stat} {
    list [catch {file stat _bogus_ stat} msg] [string tolower $msg] $errorCode







|







1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
} -result {atime ctime dev gid ino mode mtime nlink size type uid}
test cmdAH-28.4 {Tcl_FileObjCmd: stat} -setup {
    unset -nocomplain stat
} -body {
    file stat $gorpfile stat
    list $stat(nlink) $stat(size) $stat(type)
} -result {1 12 file}
test cmdAH-28.5 {Tcl_FileObjCmd: stat} -constraints {unix notWsl} -setup {
    unset -nocomplain stat
} -body {
    file stat $gorpfile stat
    format 0o%03o [expr {$stat(mode) & 0o777}]
} -result 0o765
test cmdAH-28.6 {Tcl_FileObjCmd: stat} {
    list [catch {file stat _bogus_ stat} msg] [string tolower $msg] $errorCode
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
test cmdAH-32.5 {file tempfile - templates} -constraints unix -body {
    set template [file join $dirfile foo]
    close [file tempfile name $template]
    expr {[string match $template* $name] ? "ok" : "$template produced $name"}
} -cleanup {
    catch {file delete $name}
} -result ok
# Not portable; not all unix systems have mkstemps()
test cmdAH-32.6 {file tempfile - templates} -body {
    set template [file join $dirfile foo]
    close [file tempfile name $template.bar]
    expr {[string match $template*.bar $name] ? "ok" :
	  "$template.bar produced $name"}
} -constraints {unix nonPortable} -cleanup {
    catch {file delete $name}







|







2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
test cmdAH-32.5 {file tempfile - templates} -constraints unix -body {
    set template [file join $dirfile foo]
    close [file tempfile name $template]
    expr {[string match $template* $name] ? "ok" : "$template produced $name"}
} -cleanup {
    catch {file delete $name}
} -result ok
# Not portable; not all Unix systems have mkstemps()
test cmdAH-32.6 {file tempfile - templates} -body {
    set template [file join $dirfile foo]
    close [file tempfile name $template.bar]
    expr {[string match $template*.bar $name] ? "ok" :
	  "$template.bar produced $name"}
} -constraints {unix nonPortable} -cleanup {
    catch {file delete $name}

Changes to tests/cmdIL.test.

164
165
166
167
168
169
170



171
172
173
174
175
176
177
} [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







>
>
>







164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
} [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}
test cmdIL-1.43 {lsort -stride errors} -returnCodes error -body {
    lsort -stride 4294967296 bar
} -result {list size must be a multiple of the stride length}

# 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

Changes to tests/cmdMZ.test.

51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
} -match glob -result {?*}
test cmdMZ-1.4 {Tcl_PwdObjCmd: failure} -setup {
    set cwd [pwd]
    set foodir [file join [temporaryDirectory] foo]
    file delete -force $foodir
    file mkdir $foodir
    cd $foodir
} -constraints {unix nonPortable} -body {
    # This test fails on various unix platforms (eg Linux) where permissions
    # caching causes this to fail. The caching is strictly incorrect, but we
    # have no control over that.
    file attr . -permissions 0
    pwd
} -returnCodes error -cleanup {
    cd $cwd
    file delete -force $foodir







|
|







51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
} -match glob -result {?*}
test cmdMZ-1.4 {Tcl_PwdObjCmd: failure} -setup {
    set cwd [pwd]
    set foodir [file join [temporaryDirectory] foo]
    file delete -force $foodir
    file mkdir $foodir
    cd $foodir
} -constraints {Unix nonPortable} -body {
    # This test fails on various Unix platforms (eg Linux) where permissions
    # caching causes this to fail. The caching is strictly incorrect, but we
    # have no control over that.
    file attr . -permissions 0
    pwd
} -returnCodes error -cleanup {
    cd $cwd
    file delete -force $foodir

Changes to tests/compExpr-old.test.

74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
	default {
	    return 0
	}
    }
}
testConstraint ieeeFloatingPoint [testIEEE]

testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}]

# procedures used below

proc put_hello_char {c} {
    global a
    append a [format %c $c]
    return $c
}







<
<
<







74
75
76
77
78
79
80



81
82
83
84
85
86
87
	default {
	    return 0
	}
    }
}
testConstraint ieeeFloatingPoint [testIEEE]




# procedures used below

proc put_hello_char {c} {
    global a
    append a [format %c $c]
    return $c
}

Changes to tests/compile.test.

516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
    ti eval {foreach cmd {eval "if 1" try catch} {
	set c [gencode 500 $cmd]
	lappend errors [catch $c e] $e
    }}
    #puts $errors
    # all of nested calls exceed the limit, so must end with "too many nested compilations"
    # (or evaluations, depending on compile method/instruction and "mixed" compile within
    # evaliation), so no one succeeds, the result must be empty:
    ti eval {set result}
} -result {}
#
# clean up:
if {[interp exists ti]} {
    interp delete ti
}







|







516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
    ti eval {foreach cmd {eval "if 1" try catch} {
	set c [gencode 500 $cmd]
	lappend errors [catch $c e] $e
    }}
    #puts $errors
    # all of nested calls exceed the limit, so must end with "too many nested compilations"
    # (or evaluations, depending on compile method/instruction and "mixed" compile within
    # evaluation), so no one succeeds, the result must be empty:
    ti eval {set result}
} -result {}
#
# clean up:
if {[interp exists ti]} {
    interp delete ti
}

Changes to tests/dict.test.

9
10
11
12
13
14
15





16
17
18
19
20
21
22
23
24
25
26
27
28
29

30
31
32
33
34
35
36
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}






# Used for constraining memory leak tests
testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {
    proc memtest script {
	set end [lindex [split [memory info] \n] 3 3]
	for {set i 0} {$i < 5} {incr i} {
	    uplevel 1 $script
	    set tmp $end
	    set end [lindex [split [memory info] \n] 3 3]
	}
	expr {$end - $tmp}
    }
}


test dict-1.1 {dict command basic syntax} -returnCodes error -body {
    dict
} -result {wrong # args: should be "dict subcommand ?arg ...?"}
test dict-1.2 {dict command basic syntax} -returnCodes error -body {
    dict ?
} -match glob -result {unknown or ambiguous subcommand "?": must be *}







>
>
>
>
>














>







9
10
11
12
13
14
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
# See the file "license.terms" for information on usage and redistribution 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 {
    ::tcltest::loadTestedCommands
    package require -exact tcl::test [info patchlevel]
}

# Used for constraining memory leak tests
testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {
    proc memtest script {
	set end [lindex [split [memory info] \n] 3 3]
	for {set i 0} {$i < 5} {incr i} {
	    uplevel 1 $script
	    set tmp $end
	    set end [lindex [split [memory info] \n] 3 3]
	}
	expr {$end - $tmp}
    }
}


test dict-1.1 {dict command basic syntax} -returnCodes error -body {
    dict
} -result {wrong # args: should be "dict subcommand ?arg ...?"}
test dict-1.2 {dict command basic syntax} -returnCodes error -body {
    dict ?
} -match glob -result {unknown or ambiguous subcommand "?": must be *}
134
135
136
137
138
139
140
141




142




143
144
145
146
147
148
149
} -result {missing value to go with key}
test dict-3.15 {compiled dict get error cleanliness - Bug 2431847} -body {
    apply {{} {
	dict set a(z) b c
	dict get $a(z) d
    }}
} -returnCodes error -result {key "d" not known in dictionary}
test dict-3.16 {dict/list shimmering - Bug 3004007} {set l [list p 1 p 2 q 3];dict get $l q;set l} {p 1 p 2 q 3}




test dict-3.17 {dict/list shimmering - Bug 3004007} {set l [list p 1 p 2 q 3];dict get $l q;llength $l} 6





test dict-4.1 {dict replace command} {
    dict replace {a b c d}
} {a b c d}
test dict-4.2 {dict replace command} {
    dict replace {a b c d} e f
} {a b c d e f}







|
>
>
>
>
|
>
>
>
>







140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
} -result {missing value to go with key}
test dict-3.15 {compiled dict get error cleanliness - Bug 2431847} -body {
    apply {{} {
	dict set a(z) b c
	dict get $a(z) d
    }}
} -returnCodes error -result {key "d" not known in dictionary}
test dict-3.16 {dict/list shimmering - Bug 3004007} {
    set l [list p 1 p 2 q 3]
    dict get $l q
    list $l [testobj objtype $l]
} {{p 1 p 2 q 3} dict}
test dict-3.17 {dict/list shimmering - Bug 3004007} {
    set l [list p 1 p 2 q 3]
    dict get $l q
    list [llength $l] [testobj objtype $l]
} {6 dict}

test dict-4.1 {dict replace command} {
    dict replace {a b c d}
} {a b c d}
test dict-4.2 {dict replace command} {
    dict replace {a b c d} e f
} {a b c d e f}
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
    }}
} ok,a,b
test dict-14.14 {dict for command: handle representation loss} -body {
    set dictVar {a b c d e f g h}
    set keys {}
    set values {}
    dict for {k v} $dictVar {
	if {[llength $dictVar]} {
	    lappend keys $k
	    lappend values $v
	}
    }
    list [lsort $keys] [lsort $values]
} -cleanup {
    unset dictVar keys values k v
} -result {{a c e g} {b d f h}}
test dict-14.15 {dict for command: keys are unique and iterated over once only} -setup {
    unset -nocomplain accum
    array set accum {}
} -body {
    set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
    dict for {k v} $dictVar {
	append accum($k) $v,







|




|


|







672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
    }}
} ok,a,b
test dict-14.14 {dict for command: handle representation loss} -body {
    set dictVar {a b c d e f g h}
    set keys {}
    set values {}
    dict for {k v} $dictVar {
	if {[string length $dictVar]} {
	    lappend keys $k
	    lappend values $v
	}
    }
    list [lsort $keys] [lsort $values] [testobj objtype $dictVar]
} -cleanup {
    unset dictVar keys values k v
} -result {{a c e g} {b d f h} string}
test dict-14.15 {dict for command: keys are unique and iterated over once only} -setup {
    unset -nocomplain accum
    array set accum {}
} -body {
    set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
    dict for {k v} $dictVar {
	append accum($k) $v,
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
        dict get $successors x
    }}
} [dict create c d a b]
test dict-19.2 {dict: testing for leaks} -constraints memory -body {
    # This test is made to stress object reference management
    memtest {
	apply {{} {
	    # A shared invalid dictinary
	    set apa {a {}b c d}
	    set bepa $apa
	    catch {dict replace $apa e f}
	    catch {dict remove  $apa c d}
	    catch {dict incr    apa  a 5}
	    catch {dict lappend apa  a 5}
	    catch {dict append  apa  a 5}







|







1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
        dict get $successors x
    }}
} [dict create c d a b]
test dict-19.2 {dict: testing for leaks} -constraints memory -body {
    # This test is made to stress object reference management
    memtest {
	apply {{} {
	    # A shared invalid dictionary
	    set apa {a {}b c d}
	    set bepa $apa
	    catch {dict replace $apa e f}
	    catch {dict remove  $apa c d}
	    catch {dict incr    apa  a 5}
	    catch {dict lappend apa  a 5}
	    catch {dict append  apa  a 5}
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
} ok,a,b
test dict-24.14 {dict map command: handle representation loss} -setup {
    set keys {}
    set values {}
} -body {
    set dictVar {a b c d e f g h}
    list [dict size [dict map {k v} $dictVar {
	if {[llength $dictVar]} {
	    lappend keys $k
	    lappend values $v
	    return -level 0 $k
	}
    }]] [lsort $keys] [lsort $values]
} -cleanup {
    unset dictVar keys values k v
} -result {4 {a c e g} {b d f h}}
test dict-24.14a {dict map command: handle representation loss} -body {
    apply {{} {
	set dictVar {a b c d e f g h}
	list [dict size [dict map {k v} $dictVar {
	    if {[llength $dictVar]} {
		lappend keys $k
		lappend values $v
		return -level 0 $k
	    }
	}]] [lsort $keys] [lsort $values]
    }}
} -result {4 {a c e g} {b d f h}}
test dict-24.15 {dict map command: keys are unique and iterated over once only} -setup {
    unset -nocomplain accum
    array set accum {}
} -body {
    set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
    dict map {k v} $dictVar {
	append accum($k) $v,







|




|


|




|




|

|







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
} ok,a,b
test dict-24.14 {dict map command: handle representation loss} -setup {
    set keys {}
    set values {}
} -body {
    set dictVar {a b c d e f g h}
    list [dict size [dict map {k v} $dictVar {
	if {[string length $dictVar]} {
	    lappend keys $k
	    lappend values $v
	    return -level 0 $k
	}
    }]] [lsort $keys] [lsort $values] [testobj objtype $dictVar]
} -cleanup {
    unset dictVar keys values k v
} -result {4 {a c e g} {b d f h} string}
test dict-24.14a {dict map command: handle representation loss} -body {
    apply {{} {
	set dictVar {a b c d e f g h}
	list [dict size [dict map {k v} $dictVar {
	    if {[string length $dictVar]} {
		lappend keys $k
		lappend values $v
		return -level 0 $k
	    }
	}]] [lsort $keys] [lsort $values] [testobj objtype $dictVar]
    }}
} -result {4 {a c e g} {b d f h} string}
test dict-24.15 {dict map command: keys are unique and iterated over once only} -setup {
    unset -nocomplain accum
    array set accum {}
} -body {
    set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
    dict map {k v} $dictVar {
	append accum($k) $v,

Changes to tests/dstring.test.

207
208
209
210
211
212
213
































214
215
216
217
218
219
220
    # decision about whether #-quoting can be disabled.
    testdstring append "x  " -1
    testdstring element #
    testdstring get
} -cleanup {
    testdstring free
} -result {x  #}

































test dstring-3.1 {nested sublists} -constraints testdstring -setup {
    testdstring free
} -body {
    testdstring start
    testdstring element foo
    testdstring element bar







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







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
    # decision about whether #-quoting can be disabled.
    testdstring append "x  " -1
    testdstring element #
    testdstring get
} -cleanup {
    testdstring free
} -result {x  #}
test dstring-2.16 {appending list elements - bug [46dda6fc29] segfault} -constraints testdstring -setup {
    testdstring free
} -body {
    testdstring element "\\\n"; # Will setfault
    testdstring get
} -cleanup {
    testdstring free
} -result \\\\\\n
test dstring-2.17 {appending list elements - bug [46dda6fc29] segfault} -constraints testdstring -setup {
    testdstring free
} -body {
    testdstring element "\\\{"; # Will setfault
    testdstring get
} -cleanup {
    testdstring free
} -result [list [list \{]]
test dstring-2.18 {appending list elements - bug [46dda6fc29] segfault} -constraints testdstring -setup {
    testdstring free
} -body {
    testdstring element "\\\}"; # Will setfault
    testdstring get
} -cleanup {
    testdstring free
} -result [list [list \}]]
test dstring-2.19 {appending list elements - bug [46dda6fc29] segfault} -constraints testdstring -setup {
    testdstring free
} -body {
    testdstring element "\\\\"; # Will setfault
    testdstring get
} -cleanup {
    testdstring free
} -result [list [list \\]]

test dstring-3.1 {nested sublists} -constraints testdstring -setup {
    testdstring free
} -body {
    testdstring start
    testdstring element foo
    testdstring element bar
382
383
384
385
386
387
388


















389
390
391
392
393
394
395
} -body {
    testdstring append "xyzzy" -1
    testdstring trunc 0
    list [testdstring get] [testdstring length]
} -cleanup {
    testdstring free
} -result {{} 0}



















test dstring-5.1 {copying to result} -constraints testdstring -setup {
    testdstring free
} -body {
    testdstring append xyz -1
    testdstring result
} -cleanup {







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







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
} -body {
    testdstring append "xyzzy" -1
    testdstring trunc 0
    list [testdstring get] [testdstring length]
} -cleanup {
    testdstring free
} -result {{} 0}
test dstring-4.3 {truncation} -constraints testdstring -setup {
    testdstring free
} -body {
    testdstring append "xwvut" -1
    # Pass a negative length to Tcl_DStringSetLength();
    # if not caught, causing '\0' to be written out-of-bounds,
    # try corrupting dsPtr->length which begins
    # 2*sizeof(Tcl_Size) bytes before dsPtr->staticSpace[],
    # so that the result is -256 (on little endian systems)
    # rather than e.g. -8 or -16.
    # (sizeof(Tcl_Size) does not seem to be available via Tcl,
    # so assume sizeof(Tcl_Size) == sizeof(void*) for Tcl 9.)
    testdstring trunc [expr {-2*([package vsatisfies $tcl_version 9.0-]
	? $tcl_platform(pointerSize) : 4)}]
    list [testdstring get] [testdstring length]
} -cleanup {
    testdstring free
} -result {{} 0}

test dstring-5.1 {copying to result} -constraints testdstring -setup {
    testdstring free
} -body {
    testdstring append xyz -1
    testdstring result
} -cleanup {
469
470
471
472
473
474
475







































476
477
478
479
480
481
482
483
484
485
486
487
    set result {}
    lappend result [testdstring gresult special]
    testdstring append z 1
    lappend result [testdstring get]
} -cleanup {
    testdstring free
} -result {{} {This is a specially-allocated stringz}}








































# cleanup
if {[testConstraint testdstring]} {
    testdstring free
}
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# fill-column: 78
# End:







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












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
    set result {}
    lappend result [testdstring gresult special]
    testdstring append z 1
    lappend result [testdstring get]
} -cleanup {
    testdstring free
} -result {{} {This is a specially-allocated stringz}}

test dstring-7.1 {copying to Tcl_Obj} -constraints testdstring -setup {
    testdstring free
} -body {
    testdstring append xyz -1
    list [testdstring toobj] [testdstring length]
} -cleanup {
    testdstring free
} -result {xyz 0}
test dstring-7.2 {copying to a Tcl_Obj} -constraints testdstring -setup {
    testdstring free
    unset -nocomplain a
} -body {
    foreach l {a b c d e f g h i j k l m n o p} {
	testdstring append $l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l\n -1
    }
    set a [testdstring toobj]
    testdstring append abc -1
    list $a [testdstring get]
} -cleanup {
    testdstring free
} -result {{aaaaaaaaaaaaaaaaaaaaa
bbbbbbbbbbbbbbbbbbbbb
ccccccccccccccccccccc
ddddddddddddddddddddd
eeeeeeeeeeeeeeeeeeeee
fffffffffffffffffffff
ggggggggggggggggggggg
hhhhhhhhhhhhhhhhhhhhh
iiiiiiiiiiiiiiiiiiiii
jjjjjjjjjjjjjjjjjjjjj
kkkkkkkkkkkkkkkkkkkkk
lllllllllllllllllllll
mmmmmmmmmmmmmmmmmmmmm
nnnnnnnnnnnnnnnnnnnnn
ooooooooooooooooooooo
ppppppppppppppppppppp
} abc}


# cleanup
if {[testConstraint testdstring]} {
    testdstring free
}
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# fill-column: 78
# End:

Changes to tests/encoding.test.

39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint teststringbytes [llength [info commands teststringbytes]]
testConstraint exec [llength [info commands exec]]
testConstraint testgetencpath [llength [info commands testgetencpath]]
testConstraint fullutf [expr {[format %c 0x010000] ne "\uFFFD"}]
testConstraint utf32 [expr {[testConstraint fullutf]
		&& [string length [format %c 0x10000]] == 1}]

# TclInitEncodingSubsystem is tested by the rest of this file
# TclFinalizeEncodingSubsystem is not currently tested

test encoding-1.1 {Tcl_GetEncoding: system encoding} -setup {
    set old [encoding system]
} -constraints {testencoding} -body {
    testencoding create foo [namespace origin toutf] [namespace origin fromutf]







|







39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint teststringbytes [llength [info commands teststringbytes]]
testConstraint exec [llength [info commands exec]]
testConstraint testgetencpath [llength [info commands testgetencpath]]
testConstraint fullutf [expr {[format %c 0x010000] ne "\uFFFD"}]
testConstraint utf32 [expr {[testConstraint fullutf]
		&& [string length [format %c 0x10000]] == 1}]

# TclInitEncodingSubsystem is tested by the rest of this file
# TclFinalizeEncodingSubsystem is not currently tested

test encoding-1.1 {Tcl_GetEncoding: system encoding} -setup {
    set old [encoding system]
} -constraints {testencoding} -body {
    testencoding create foo [namespace origin toutf] [namespace origin fromutf]
102
103
104
105
106
107
108








109
110
111
112
113
114
115
    set old [fconfigure stdout -encoding]
} -body {
    fconfigure stdout -encoding jis0208
    fconfigure stdout -encoding
} -cleanup {
    fconfigure stdout -encoding $old
} -result {jis0208}









test encoding-4.1 {Tcl_GetEncodingNames} -constraints {testencoding} -setup {
    cd [makeDirectory tmp]
    makeDirectory [file join tmp encoding]
    set path [encoding dirs]
    encoding dirs {}
    catch {unset encodings}







>
>
>
>
>
>
>
>







102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
    set old [fconfigure stdout -encoding]
} -body {
    fconfigure stdout -encoding jis0208
    fconfigure stdout -encoding
} -cleanup {
    fconfigure stdout -encoding $old
} -result {jis0208}
test encoding-3.3 {fconfigure -profile} -setup {
    set old [fconfigure stdout -profile]
} -body {
    fconfigure stdout -profile replace
    fconfigure stdout -profile
} -cleanup {
    fconfigure stdout -profile $old
} -result replace

test encoding-4.1 {Tcl_GetEncodingNames} -constraints {testencoding} -setup {
    cd [makeDirectory tmp]
    makeDirectory [file join tmp encoding]
    set path [encoding dirs]
    encoding dirs {}
    catch {unset encodings}
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
    encoding convertto foo abcd
    testencoding delete foo
    return $x
} {{toutf a} {fromutf b}}

test encoding-7.1 {Tcl_ExternalToUtfDString: small buffer} {
    encoding convertfrom jis0208 8c8c8c8c
} "吾吾吾吾"
test encoding-7.2 {Tcl_UtfToExternalDString: big buffer} {
    set a 8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C
    append a $a
    append a $a
    append a $a
    append a $a
    set x [encoding convertfrom jis0208 $a]







|







176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
    encoding convertto foo abcd
    testencoding delete foo
    return $x
} {{toutf a} {fromutf b}}

test encoding-7.1 {Tcl_ExternalToUtfDString: small buffer} {
    encoding convertfrom jis0208 8c8c8c8c
} 吾吾吾吾
test encoding-7.2 {Tcl_UtfToExternalDString: big buffer} {
    set a 8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C
    append a $a
    append a $a
    append a $a
    append a $a
    set x [encoding convertfrom jis0208 $a]
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
    close $f
    set f [open [file join [temporaryDirectory] dummy] r]
    fconfigure $f -translation binary -encoding shiftjis
    set x [read $f]
    close $f
    file delete [file join [temporaryDirectory] dummy]
    return $x
} "ab乎g"

test encoding-9.1 {Tcl_UtfToExternalDString: small buffer} {
    encoding convertto jis0208 "吾吾吾吾"
} {8c8c8c8c}
test encoding-9.2 {Tcl_UtfToExternalDString: big buffer} {
    set a 乎乎乎乎乎乎乎乎
    append a $a
    append a $a
    append a $a
    append a $a
    append a $a
    append a $a
    set x [encoding convertto jis0208 $a]
    list [string length $x] [string range $x 0 1]
} "1024 8C"

test encoding-10.1 {Tcl_UtfToExternal} {
    set f [open [file join [temporaryDirectory] dummy] w]
    fconfigure $f -translation binary -encoding shiftjis
    puts -nonewline $f "ab乎g"
    close $f
    set f [open [file join [temporaryDirectory] dummy] r]
    fconfigure $f -translation binary -encoding iso8859-1
    set x [read $f]
    close $f
    file delete [file join [temporaryDirectory] dummy]
    return $x
} "ab\x8C\xC1g"

proc viewable {str} {
    set res ""
    foreach c [split $str {}] {
	if {[string is print $c] && [string is ascii $c]} {
	    append res $c
	} else {
	    append res "\\u[format %4.4X [scan $c %c]]"
	}
    }
    return "$str ($res)"
}

test encoding-11.1 {LoadEncodingFile: unknown encoding} {testencoding} {
    set system [encoding system]
    set path [encoding dirs]
    encoding system iso8859-1
    encoding dirs {}
    llength jis0208	;# Shimmer any cached Tcl_Encoding in shared literal
    set x [list [catch {encoding convertto jis0208 乎} msg] $msg]
    encoding dirs $path
    encoding system $system
    lappend x [encoding convertto jis0208 乎]
} {1 {unknown encoding "jis0208"} 8C}
test encoding-11.2 {LoadEncodingFile: single-byte} {
    encoding convertfrom jis0201 \xA1
} "。"
test encoding-11.3 {LoadEncodingFile: double-byte} {
    encoding convertfrom jis0208 8C
} 乎
test encoding-11.4 {LoadEncodingFile: multi-byte} {
    encoding convertfrom shiftjis \x8C\xC1
} 乎
test encoding-11.5 {LoadEncodingFile: escape file} {
    viewable [encoding convertto iso2022 乎]
} [viewable "\x1B\$B8C\x1B(B"]
test encoding-11.5.1 {LoadEncodingFile: escape file} {
    viewable [encoding convertto iso2022-jp 乎]
} [viewable "\x1B\$B8C\x1B(B"]
test encoding-11.6 {LoadEncodingFile: invalid file} -constraints {testencoding} -setup {
    set system [encoding system]
    set path [encoding dirs]
    encoding system iso8859-1
} -body {
    cd [temporaryDirectory]
    encoding dirs [file join tmp encoding]







|



















|









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













|







|
|

|
|







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
    close $f
    set f [open [file join [temporaryDirectory] dummy] r]
    fconfigure $f -translation binary -encoding shiftjis
    set x [read $f]
    close $f
    file delete [file join [temporaryDirectory] dummy]
    return $x
} ab乎g

test encoding-9.1 {Tcl_UtfToExternalDString: small buffer} {
    encoding convertto jis0208 "吾吾吾吾"
} {8c8c8c8c}
test encoding-9.2 {Tcl_UtfToExternalDString: big buffer} {
    set a 乎乎乎乎乎乎乎乎
    append a $a
    append a $a
    append a $a
    append a $a
    append a $a
    append a $a
    set x [encoding convertto jis0208 $a]
    list [string length $x] [string range $x 0 1]
} "1024 8C"

test encoding-10.1 {Tcl_UtfToExternal} {
    set f [open [file join [temporaryDirectory] dummy] w]
    fconfigure $f -translation binary -encoding shiftjis
    puts -nonewline $f ab乎g
    close $f
    set f [open [file join [temporaryDirectory] dummy] r]
    fconfigure $f -translation binary -encoding iso8859-1
    set x [read $f]
    close $f
    file delete [file join [temporaryDirectory] dummy]
    return $x
} "ab\x8C\xC1g"













test encoding-11.1 {LoadEncodingFile: unknown encoding} {testencoding} {
    set system [encoding system]
    set path [encoding dirs]
    encoding system iso8859-1
    encoding dirs {}
    llength jis0208	;# Shimmer any cached Tcl_Encoding in shared literal
    set x [list [catch {encoding convertto jis0208 乎} msg] $msg]
    encoding dirs $path
    encoding system $system
    lappend x [encoding convertto jis0208 乎]
} {1 {unknown encoding "jis0208"} 8C}
test encoding-11.2 {LoadEncodingFile: single-byte} {
    encoding convertfrom jis0201 \xA1
} 
test encoding-11.3 {LoadEncodingFile: double-byte} {
    encoding convertfrom jis0208 8C
} 乎
test encoding-11.4 {LoadEncodingFile: multi-byte} {
    encoding convertfrom shiftjis \x8C\xC1
} 乎
test encoding-11.5 {LoadEncodingFile: escape file} {
    encoding convertto iso2022 乎
} \x1B\$B8C\x1B(B
test encoding-11.5.1 {LoadEncodingFile: escape file} {
    encoding convertto iso2022-jp 乎
} \x1B\$B8C\x1B(B
test encoding-11.6 {LoadEncodingFile: invalid file} -constraints {testencoding} -setup {
    set system [encoding system]
    set path [encoding dirs]
    encoding system iso8859-1
} -body {
    cd [temporaryDirectory]
    encoding dirs [file join tmp encoding]
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
    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)}
test encoding-11.10 {encoding: extended Unicode UTF-32} {
    viewable [encoding convertto utf-32le 😹]
} "9\xF6\x01\x00 (9\\u00F6\\u0001\\u0000)"
test encoding-11.11 {encoding: extended Unicode UTF-32} {
    viewable [encoding convertto utf-32be 😹]
} "\x00\x01\xF69 (\\u0000\\u0001\\u00F69)"
# OpenEncodingFile is fully tested by the rest of the tests in this file.

test encoding-12.1 {LoadTableEncoding: normal encoding} {
    set x [encoding convertto iso8859-3 Ġ]
    append x [encoding convertto -nocomplain iso8859-3 Õ]
    append x [encoding convertfrom iso8859-3 Õ]
} "Õ?Ġ"
test encoding-12.2 {LoadTableEncoding: single-byte encoding} {
    set x [encoding convertto iso8859-3 abĠg]
    append x [encoding convertfrom iso8859-3 abÕg]
} "abÕgabĠg"
test encoding-12.3 {LoadTableEncoding: multi-byte encoding} {







|
|

|
|

|
|

|
|




|







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
    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} {
    encoding convertto utf-16le 😹
} =Ø9Þ
test encoding-11.9 {encoding: extended Unicode UTF-16} {
    encoding convertto utf-16be 😹
} Ø=Þ9
test encoding-11.10 {encoding: extended Unicode UTF-32} {
    encoding convertto utf-32le 😹
} 9\xF6\x01\x00
test encoding-11.11 {encoding: extended Unicode UTF-32} {
    encoding convertto utf-32be 😹
} \x00\x01\xF69
# OpenEncodingFile is fully tested by the rest of the tests in this file.

test encoding-12.1 {LoadTableEncoding: normal encoding} {
    set x [encoding convertto iso8859-3 Ġ]
    append x [encoding convertto -profile tcl8 iso8859-3 Õ]
    append x [encoding convertfrom iso8859-3 Õ]
} "Õ?Ġ"
test encoding-12.2 {LoadTableEncoding: single-byte encoding} {
    set x [encoding convertto iso8859-3 abĠg]
    append x [encoding convertfrom iso8859-3 abÕg]
} "abÕgabĠg"
test encoding-12.3 {LoadTableEncoding: multi-byte encoding} {
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
test encoding-12.5 {LoadTableEncoding: symbol encoding} {
    set x [encoding convertto symbol γ]
    append x [encoding convertto symbol g]
    append x [encoding convertfrom symbol g]
} "ggγ"

test encoding-13.1 {LoadEscapeTable} {
    viewable [set x [encoding convertto iso2022 ab乎棙g]]
} [viewable "ab\x1B\$B8C\x1B\$\(DD%\x1B(Bg"]

test encoding-15.1 {UtfToUtfProc} {
    encoding convertto utf-8 £
} "\xC2\xA3"
test encoding-15.2 {UtfToUtfProc null character output} testbytestring {
    binary scan [testbytestring [encoding convertto utf-8 \x00]] H* z
    set z
} 00
test encoding-15.3 {UtfToUtfProc null character input} teststringbytes {
    set y [encoding convertfrom utf-8 [encoding convertto utf-8 \x00]]
    binary scan [teststringbytes $y] H* z
    set z
} c080
test encoding-15.4 {UtfToUtfProc emoji character input} -body {
    set x \xED\xA0\xBD\xED\xB8\x82
    set y [encoding convertfrom -nocomplain utf-8 \xED\xA0\xBD\xED\xB8\x82]
    list [string length $x] $y
} -result "6 \uD83D\uDE02"
test encoding-15.5 {UtfToUtfProc emoji character input} {
    set x \xF0\x9F\x98\x82
    set y [encoding convertfrom utf-8 \xF0\x9F\x98\x82]
    list [string length $x] $y
} "4 😂"
test encoding-15.6 {UtfToUtfProc emoji character output} utf32 {
    set x \uDE02\uD83D\uDE02\uD83D
    set y [encoding convertto -nocomplain utf-8 \uDE02\uD83D\uDE02\uD83D]
    binary scan $y H* z
    list [string length $y] $z
} {12 efbfbdefbfbdefbfbdefbfbd}
test encoding-15.7 {UtfToUtfProc emoji character output} utf32 {
    set x \uDE02\uD83D\uD83D
    set y [encoding convertto -nocomplain utf-8 \uDE02\uD83D\uD83D]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {3 9 efbfbdefbfbdefbfbd}
test encoding-15.8 {UtfToUtfProc emoji character output} utf32 {
    set x \uDE02\uD83Dé
    set y [encoding convertto -nocomplain utf-8 \uDE02\uD83Dé]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {3 8 efbfbdefbfbdc3a9}
test encoding-15.9 {UtfToUtfProc emoji character output} utf32 {
    set x \uDE02\uD83DX
    set y [encoding convertto -nocomplain utf-8 \uDE02\uD83DX]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {3 7 efbfbdefbfbd58}
test encoding-15.10 {UtfToUtfProc high surrogate character output} utf32 {
    set x \uDE02é
    set y [encoding convertto -nocomplain utf-8 \uDE02é]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {2 5 efbfbdc3a9}
test encoding-15.11 {UtfToUtfProc low surrogate character output} utf32 {
    set x \uDA02é
    set y [encoding convertto -nocomplain utf-8 \uDA02é]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {2 5 efbfbdc3a9}
test encoding-15.12 {UtfToUtfProc high surrogate character output} utf32 {
    set x \uDE02Y
    set y [encoding convertto -nocomplain utf-8 \uDE02Y]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {2 4 efbfbd59}
test encoding-15.13 {UtfToUtfProc low surrogate character output} utf32 {
    set x \uDA02Y
    set y [encoding convertto -nocomplain utf-8 \uDA02Y]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {2 4 efbfbd59}
test encoding-15.14 {UtfToUtfProc high surrogate character output} utf32 {
    set x \uDE02
    set y [encoding convertto -nocomplain utf-8 \uDE02]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {1 3 efbfbd}
test encoding-15.15 {UtfToUtfProc low surrogate character output} utf32 {
    set x \uDA02
    set y [encoding convertto -nocomplain utf-8 \uDA02]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {1 3 efbfbd}
test encoding-15.16 {UtfToUtfProc: Invalid 4-byte UTF-8, see [ed29806ba]} {
    set x \xF0\xA0\xA1\xC2
    set y [encoding convertfrom -nocomplain utf-8 \xF0\xA0\xA1\xC2]
    list [string length $x] $y
} "4 \xF0\xA0\xA1\xC2"
test encoding-15.17 {UtfToUtfProc emoji character output} {
    set x 😂
    set y [encoding convertto utf-8 😂]
    binary scan $y H* z
    list [string length $y] $z







|
|















|









|


|
|

|


|
|

|


|
|

|


|
|

|


|
|

|


|
|

|


|
|

|


|
|

|


|
|

|


|


|







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
test encoding-12.5 {LoadTableEncoding: symbol encoding} {
    set x [encoding convertto symbol γ]
    append x [encoding convertto symbol g]
    append x [encoding convertfrom symbol g]
} "ggγ"

test encoding-13.1 {LoadEscapeTable} {
    encoding convertto iso2022 ab乎棙g
} ab\x1B\$B8C\x1B\$\(DD%\x1B(Bg

test encoding-15.1 {UtfToUtfProc} {
    encoding convertto utf-8 £
} "\xC2\xA3"
test encoding-15.2 {UtfToUtfProc null character output} testbytestring {
    binary scan [testbytestring [encoding convertto utf-8 \x00]] H* z
    set z
} 00
test encoding-15.3 {UtfToUtfProc null character input} teststringbytes {
    set y [encoding convertfrom utf-8 [encoding convertto utf-8 \x00]]
    binary scan [teststringbytes $y] H* z
    set z
} c080
test encoding-15.4 {UtfToUtfProc emoji character input} -body {
    set x \xED\xA0\xBD\xED\xB8\x82
    set y [encoding convertfrom -profile tcl8 utf-8 \xED\xA0\xBD\xED\xB8\x82]
    list [string length $x] $y
} -result "6 \uD83D\uDE02"
test encoding-15.5 {UtfToUtfProc emoji character input} {
    set x \xF0\x9F\x98\x82
    set y [encoding convertfrom utf-8 \xF0\x9F\x98\x82]
    list [string length $x] $y
} "4 😂"
test encoding-15.6 {UtfToUtfProc emoji character output} utf32 {
    set x \uDE02\uD83D\uDE02\uD83D
    set y [encoding convertto -profile tcl8 utf-8 \uDE02\uD83D\uDE02\uD83D]
    binary scan $y H* z
    list [string length $y] $z
} {12 edb882eda0bdedb882eda0bd}
test encoding-15.7 {UtfToUtfProc emoji character output} {
    set x \uDE02\uD83D\uD83D
    set y [encoding convertto -profile tcl8 utf-8 \uDE02\uD83D\uD83D]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {3 9 edb882eda0bdeda0bd}
test encoding-15.8 {UtfToUtfProc emoji character output} {
    set x \uDE02\uD83Dé
    set y [encoding convertto -profile tcl8 utf-8 \uDE02\uD83Dé]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {3 8 edb882eda0bdc3a9}
test encoding-15.9 {UtfToUtfProc emoji character output} {
    set x \uDE02\uD83DX
    set y [encoding convertto -profile tcl8 utf-8 \uDE02\uD83DX]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {3 7 edb882eda0bd58}
test encoding-15.10 {UtfToUtfProc high surrogate character output} {
    set x \uDE02é
    set y [encoding convertto -profile tcl8 utf-8 \uDE02é]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {2 5 edb882c3a9}
test encoding-15.11 {UtfToUtfProc low surrogate character output} {
    set x \uDA02é
    set y [encoding convertto -profile tcl8 utf-8 \uDA02é]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {2 5 eda882c3a9}
test encoding-15.12 {UtfToUtfProc high surrogate character output} {
    set x \uDE02Y
    set y [encoding convertto -profile tcl8 utf-8 \uDE02Y]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {2 4 edb88259}
test encoding-15.13 {UtfToUtfProc low surrogate character output} {
    set x \uDA02Y
    set y [encoding convertto -profile tcl8 utf-8 \uDA02Y]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {2 4 eda88259}
test encoding-15.14 {UtfToUtfProc high surrogate character output} {
    set x \uDE02
    set y [encoding convertto -profile tcl8 utf-8 \uDE02]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {1 3 edb882}
test encoding-15.15 {UtfToUtfProc low surrogate character output} {
    set x \uDA02
    set y [encoding convertto -profile tcl8 utf-8 \uDA02]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {1 3 eda882}
test encoding-15.16 {UtfToUtfProc: Invalid 4-byte UTF-8, see [ed29806ba]} {
    set x \xF0\xA0\xA1\xC2
    set y [encoding convertfrom -profile tcl8 utf-8 \xF0\xA0\xA1\xC2]
    list [string length $x] $y
} "4 \xF0\xA0\xA1\xC2"
test encoding-15.17 {UtfToUtfProc emoji character output} {
    set x 😂
    set y [encoding convertto utf-8 😂]
    binary scan $y H* z
    list [string length $y] $z
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
    list [string length $y] $z
} {2 c480}
test encoding-15.24 {UtfToUtfProc CESU-8 bug [048dd20b4171c8da]} {
    set y [encoding convertto cesu-8 \u3FF]
    binary scan $y H* z
    list [string length $y] $z
} {2 cfbf}

























test encoding-16.1 {Utf16ToUtfProc} -body {
    set val [encoding convertfrom utf-16 NN]
    list $val [format %x [scan $val %c]]
} -result "乎 4e4e"
test encoding-16.2 {Utf16ToUtfProc} -body {
    set val [encoding convertfrom utf-16 "\xD8\xD8\xDC\xDC"]
    list $val [format %x [scan $val %c]]
} -result "\U460DC 460dc"
test encoding-16.3 {Utf16ToUtfProc} -body {
    set val [encoding convertfrom utf-16 "\xDC\xDC"]
    list $val [format %x [scan $val %c]]
} -result "\uDCDC dcdc"
test encoding-16.4 {Ucs2ToUtfProc} -body {
    set val [encoding convertfrom ucs-2 NN]
    list $val [format %x [scan $val %c]]
} -result "乎 4e4e"
test encoding-16.5 {Ucs2ToUtfProc} -body {
    set val [encoding convertfrom ucs-2 "\xD8\xD8\xDC\xDC"]
    list $val [format %x [scan $val %c]]
} -result "\U460DC 460dc"
test encoding-16.6 {Utf32ToUtfProc} -body {
    set val [encoding convertfrom utf-32le NN\0\0]
    list $val [format %x [scan $val %c]]
} -result "乎 4e4e"
test encoding-16.7 {Utf32ToUtfProc} -body {
    set val [encoding convertfrom utf-32be \0\0NN]
    list $val [format %x [scan $val %c]]
} -result "乎 4e4e"




















































































test encoding-17.1 {UtfToUtf16Proc} -body {
    encoding convertto utf-16 "\U460DC"
} -result "\xD8\xD8\xDC\xDC"
test encoding-17.2 {UtfToUcs2Proc} -body {
    encoding convertfrom utf-16 [encoding convertto ucs-2 "\U460DC"]
} -result "\uFFFD"
test encoding-17.3 {UtfToUtf16Proc} -body {
    encoding convertto -nocomplain utf-16be "\uDCDC"
} -result "\xFF\xFD"
test encoding-17.4 {UtfToUtf16Proc} -body {
    encoding convertto -nocomplain utf-16le "\uD8D8"
} -result "\xFD\xFF"
test encoding-17.5 {UtfToUtf16Proc} -body {
    encoding convertto utf-32le "\U460DC"
} -result "\xDC\x60\x04\x00"
test encoding-17.6 {UtfToUtf16Proc} -body {
    encoding convertto utf-32be "\U460DC"
} -result "\x00\x04\x60\xDC"



















test encoding-18.1 {TableToUtfProc} {

} {}
















test encoding-19.1 {TableFromUtfProc} {

} {}
















test encoding-20.1 {TableFreefProc} {
} {}

test encoding-21.1 {EscapeToUtfProc} {
} {}








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










|











|



|


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

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




|
|

|
|

|
|
|


|


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

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

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







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
    list [string length $y] $z
} {2 c480}
test encoding-15.24 {UtfToUtfProc CESU-8 bug [048dd20b4171c8da]} {
    set y [encoding convertto cesu-8 \u3FF]
    binary scan $y H* z
    list [string length $y] $z
} {2 cfbf}
test encoding-15.25 {UtfToUtfProc CESU-8} {
    encoding convertfrom cesu-8 \x00
} \x00
test {encoding-15.26 cesu-8 tclnull strict} {UtfToUtfProc CESU-8} {
    encoding convertfrom -profile tcl8 cesu-8 \xC0\x80
} \x00
test {encoding-15.26 cesu-8 tclnull tcl8} {UtfToUtfProc CESU-8} {
    encoding convertfrom -profile tcl8 cesu-8 \xC0\x80
} \x00
test encoding-15.27 {UtfToUtfProc -profile strict CESU-8} {
    encoding convertfrom -profile strict cesu-8 \x00
} \x00
test encoding-15.28 {UtfToUtfProc -profile strict CESU-8} -body {
    encoding convertfrom -profile strict cesu-8 \xC0\x80
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC0'}
test encoding-15.29 {UtfToUtfProc CESU-8} {
    encoding convertto cesu-8 \x00
} \x00
test encoding-15.30 {UtfToUtfProc -profile strict CESU-8} {
    encoding convertto -profile strict cesu-8 \x00
} \x00
test encoding-15.31 {UtfToUtfProc -profile strict CESU-8 (bytes F0-F4 are invalid)} -body {
    encoding convertfrom -profile strict cesu-8 \xF1\x86\x83\x9C
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xF1'}

test encoding-16.1 {Utf16ToUtfProc} -body {
    set val [encoding convertfrom utf-16 NN]
    list $val [format %x [scan $val %c]]
} -result "乎 4e4e"
test encoding-16.2 {Utf16ToUtfProc} -body {
    set val [encoding convertfrom utf-16 "\xD8\xD8\xDC\xDC"]
    list $val [format %x [scan $val %c]]
} -result "\U460DC 460dc"
test encoding-16.3 {Utf16ToUtfProc} -body {
    set val [encoding convertfrom -profile tcl8 utf-16 "\xDC\xDC"]
    list $val [format %x [scan $val %c]]
} -result "\uDCDC dcdc"
test encoding-16.4 {Ucs2ToUtfProc} -body {
    set val [encoding convertfrom ucs-2 NN]
    list $val [format %x [scan $val %c]]
} -result "乎 4e4e"
test encoding-16.5 {Ucs2ToUtfProc} -body {
    set val [encoding convertfrom ucs-2 "\xD8\xD8\xDC\xDC"]
    list $val [format %x [scan $val %c]]
} -result "\U460DC 460dc"
test encoding-16.6 {Utf32ToUtfProc} -body {
    set val [encoding convertfrom -profile strict utf-32le NN\0\0]
    list $val [format %x [scan $val %c]]
} -result "乎 4e4e"
test encoding-16.7 {Utf32ToUtfProc} -body {
    set val [encoding convertfrom -profile strict utf-32be \0\0NN]
    list $val [format %x [scan $val %c]]
} -result "乎 4e4e"
test encoding-16.8 {Utf32ToUtfProc} -body {
    set val [encoding convertfrom -profile tcl8 utf-32 \x41\x00\x00\x41]
    list $val [format %x [scan $val %c]]
} -result "\uFFFD fffd"
test encoding-16.9 {Utf32ToUtfProc} -constraints utf32 -body {
    encoding convertfrom -profile tcl8 utf-32le \x00\xD8\x00\x00
} -result \uD800
test encoding-16.10 {Utf32ToUtfProc} -body {
    encoding convertfrom -profile tcl8 utf-32le \x00\xDC\x00\x00
} -result \uDC00
test encoding-16.11 {Utf32ToUtfProc} -body {
    encoding convertfrom -profile tcl8 utf-32le \x00\xD8\x00\x00\x00\xDC\x00\x00
} -result \uD800\uDC00
test encoding-16.12 {Utf32ToUtfProc} -constraints utf32 -body {
    encoding convertfrom -profile tcl8 utf-32le \x00\xDC\x00\x00\x00\xD8\x00\x00
} -result \uDC00\uD800
test encoding-16.13 {Utf16ToUtfProc} -body {
    encoding convertfrom -profile tcl8 utf-16le \x00\xD8
} -result \uD800
test encoding-16.14 {Utf16ToUtfProc} -body {
    encoding convertfrom -profile tcl8 utf-16le \x00\xDC
} -result \uDC00
test encoding-16.15 {Utf16ToUtfProc} -body {
    encoding convertfrom utf-16le \x00\xD8\x00\xDC
} -result \U010000
test encoding-16.16 {Utf16ToUtfProc} -body {
    encoding convertfrom -profile tcl8 utf-16le \x00\xDC\x00\xD8
} -result \uDC00\uD800
test encoding-16.17 {Utf32ToUtfProc} -body {
    list [encoding convertfrom -profile strict -failindex  idx utf-32le \x41\x00\x00\x00\x00\xD8\x00\x00\x42\x00\x00\x00] [set idx]
} -result {A 4}

test encoding-16.18 {
    Utf16ToUtfProc, Tcl_UniCharToUtf, surrogate pairs in utf-16
} -body {
    apply [list {} {
	for {set i 0xD800} {$i < 0xDBFF} {incr i} {
	    for {set j 0xDC00} {$j < 0xDFFF} {incr j} {
		set string [binary format S2 [list $i $j]]
		set status [catch {
		    set decoded [encoding convertfrom utf-16be $string]
		    set encoded [encoding convertto utf-16be $decoded]
		}]
		if {$status || ( $encoded ne $string )} {
		    return [list [format %x $i] [format %x $j]]
		}
	    }
	}
	return done
    } [namespace current]]
} -result done
test {encoding-16.19 strict} {Utf16ToUtfProc, bug [d19fe0a5b]} -body {
    encoding convertfrom -profile strict utf-16 "\x41\x41\x41"
} -returnCodes 1 -result {unexpected byte sequence starting at index 2: '\x41'}
test {encoding-16.19 tcl8} {Utf16ToUtfProc, bug [d19fe0a5b]} -body {
    encoding convertfrom -profile tcl8 utf-16 "\x41\x41\x41"
} -result \u4141\uFFFD
test encoding-16.20 {utf16ToUtfProc, bug [d19fe0a5b]} \
    -constraints deprecated -body {
    encoding convertfrom utf-16 "\xD8\xD8"
} -result \uD8D8
test encoding-16.21.tcl8 {Utf32ToUtfProc, bug [d19fe0a5b]} -body {
    encoding convertfrom -profile tcl8 utf-32 "\x00\x00\x00\x00\x41\x41"
} -result \x00\uFFFD
test encoding-16.21.strict {Utf32ToUtfProc, bug [d19fe0a5b]} -body {
    encoding convertfrom -profile strict utf-32 "\x00\x00\x00\x00\x41\x41"
} -returnCodes 1 -result {unexpected byte sequence starting at index 4: '\x41'}

test encoding-16.22 {Utf16ToUtfProc, strict, bug [db7a085bd9]} -body {
    encoding convertfrom -profile strict utf-16le \x00\xD8
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\x00'}
test encoding-16.23 {Utf16ToUtfProc, strict, bug [db7a085bd9]} -body {
    encoding convertfrom -profile strict utf-16le \x00\xDC
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\x00'}
test encoding-16.24 {Utf32ToUtfProc} -body {
    encoding convertfrom utf-32 "\xFF\xFF\xFF\xFF"
} -result \uFFFD
test {encoding-16.25 strict} {Utf32ToUtfProc} -body {
    encoding convertfrom -profile strict utf-32 "\x01\x00\x00\x01"
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\x01'}
test {encoding-16.25 tcl8} {Utf32ToUtfProc} -body {
    encoding convertfrom -profile tcl8 utf-32 "\x01\x00\x00\x01"
} -result \uFFFD

test encoding-17.1 {UtfToUtf16Proc} -body {
    encoding convertto utf-16 "\U460DC"
} -result "\xD8\xD8\xDC\xDC"
test encoding-17.2 {UtfToUcs2Proc} -body {
    encoding convertfrom utf-16 \xD8\xD8\xDC\xDC
} -result "\U460DC"
test encoding-17.3 {UtfToUtf16Proc} -body {
    encoding convertto -profile tcl8 utf-16be "\uDCDC"
} -result "\xDC\xDC"
test encoding-17.4 {UtfToUtf16Proc} -body {
    encoding convertto -profile tcl8 utf-16le "\uD8D8"
} -result "\xD8\xD8"
test encoding-17.5 {UtfToUtf32Proc} -body {
    encoding convertto utf-32le "\U460DC"
} -result "\xDC\x60\x04\x00"
test encoding-17.6 {UtfToUtf32Proc} -body {
    encoding convertto utf-32be "\U460DC"
} -result "\x00\x04\x60\xDC"
test encoding-17.7 {UtfToUtf16Proc} -body {
    encoding convertto -profile strict utf-16be "\uDCDC"
} -returnCodes error -result {unexpected character at index 0: 'U+00DCDC'}
test encoding-17.8 {UtfToUtf16Proc} -body {
    encoding convertto -profile strict utf-16le "\uD8D8"
} -returnCodes error -result {unexpected character at index 0: 'U+00D8D8'}
test encoding-17.9 {Utf32ToUtfProc} -body {
    encoding convertfrom -profile strict utf-32 "\xFF\xFF\xFF\xFF"
} -returnCodes error -result {unexpected byte sequence starting at index 0: '\xFF'}
test encoding-17.10 {Utf32ToUtfProc} -body {
    encoding convertfrom -profile tcl8 utf-32 "\xFF\xFF\xFF\xFF"
} -result \uFFFD
test encoding-17.11 {Utf32ToUtfProc} -body {
    encoding convertfrom -profile strict utf-32le "\x00\xD8\x00\x00"
} -returnCodes error -result {unexpected byte sequence starting at index 0: '\x00'}
test encoding-17.12 {Utf32ToUtfProc} -body {
    encoding convertfrom -profile strict utf-32le "\x00\xDC\x00\x00"
} -returnCodes error -result {unexpected byte sequence starting at index 0: '\x00'}

test encoding-18.1 {TableToUtfProc on invalid input} -body {
	list [catch {encoding convertto -profile tcl8 jis0208 \\} res] $res
} -result {0 !)}
test encoding-18.2 {TableToUtfProc on invalid input with -profile strict} -body {
	list [catch {encoding convertto -profile strict jis0208 \\} res] $res
} -result {1 {unexpected character at index 0: 'U+00005C'}}
test encoding-18.3 {TableToUtfProc on invalid input with -profile strict -failindex} -body {
	list [catch {encoding convertto -profile strict -failindex pos jis0208 \\} res] $res $pos
} -result {0 {} 0}
test encoding-18.4 {TableToUtfProc on invalid input with -failindex -profile strict} -body {
	list [catch {encoding convertto -failindex pos -profile strict jis0208 \\} res] $res $pos
} -result {0 {} 0}
test encoding-18.5 {TableToUtfProc on invalid input with -failindex} -body {
	list [catch {encoding convertto -profile tcl8 -failindex pos jis0208 \\} res] $res $pos
} -result {0 !) -1}
test encoding-18.6 {TableToUtfProc on invalid input with -profile tcl8} -body {
	list [catch {encoding convertto -profile tcl8 jis0208 \\} res] $res
} -result {0 !)}

test encoding-19.1 {TableFromUtfProc} -body {
    encoding convertfrom -profile tcl8 ascii AÁ
} -result AÁ
test encoding-19.2 {TableFromUtfProc} -body {
    encoding convertfrom -profile tcl8 ascii AÁ
} -result AÁ
test encoding-19.3 {TableFromUtfProc} -body {
    encoding convertfrom -profile strict ascii AÁ
} -returnCodes 1 -result {unexpected byte sequence starting at index 1: '\xC1'}
test encoding-19.4 {TableFromUtfProc} -body {
    list [encoding convertfrom -profile tcl8 -failindex idx ascii AÁ] [set idx]
} -result [list A\xC1 -1]
test encoding-19.5 {TableFromUtfProc} -body {
    list [encoding convertfrom -failindex idx -profile strict ascii A\xC1] [set idx]
} -result {A 1}
test encoding-19.6 {TableFromUtfProc} -body {
    list [encoding convertfrom -failindex idx -profile strict ascii AÁB] [set idx]
} -result {A 1}

test encoding-20.1 {TableFreefProc} {
} {}

test encoding-21.1 {EscapeToUtfProc} {
} {}

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
	set f [open [file join [file dirname [info script]] iso2022.txt]]
	fconfigure $f -encoding iso2022-jp
	gets $f
    }
} {}
test encoding-24.2 {EscapeFreeProc on open channels} {exec} {
    # Bug #524674 output
    viewable [runInSubprocess {
	encoding system cp1252;	# Bug #2891556 crash revelator
	fconfigure stdout -encoding iso2022-jp
	puts ab乎棙g
	set env(TCL_FINALIZE_ON_EXIT) 1
	exit
    }]

} "ab\x1B\$B8C\x1B\$(DD%\x1B(Bg (ab\\u001B\$B8C\\u001B\$(DD%\\u001B(Bg)"
test encoding-24.3 {EscapeFreeProc on open channels} {stdio} {
    # Bug #219314 - if we don't free escape encodings correctly on channel
    # closure, we go boom
    set file [makeFile {
	encoding system iso2022-jp
	set a "乎乞也"; # 3 Japanese Kanji letters
	puts $a
    } iso2022.tcl]
    set f [open "|[list [interpreter] $file]"]
    fconfigure $f -encoding iso2022-jp
    set count [gets $f line]
    close $f
    removeFile iso2022.tcl
    list $count [viewable $line]
} [list 3 "乎乞也 (\\u4E4E\\u4E5E\\u4E5F)"]




test encoding-24.4 {Parse valid or invalid utf-8} {
    string length [encoding convertfrom utf-8 "\xC0\x80"]
} 1
test encoding-24.5 {Parse valid or invalid utf-8} {
    string length [encoding convertfrom -nocomplain utf-8 "\xC0\x81"]
} 2
test encoding-24.6 {Parse valid or invalid utf-8} {
    string length [encoding convertfrom -nocomplain utf-8 "\xC1\xBF"]
} 2
test encoding-24.7 {Parse valid or invalid utf-8} {
    string length [encoding convertfrom utf-8 "\xC2\x80"]
} 1
test encoding-24.8 {Parse valid or invalid utf-8} {
    string length [encoding convertfrom -nocomplain utf-8 "\xE0\x80\x80"]
} 3
test encoding-24.9 {Parse valid or invalid utf-8} {
    string length [encoding convertfrom -nocomplain utf-8 "\xE0\x9F\xBF"]
} 3
test encoding-24.10 {Parse valid or invalid utf-8} {
    string length [encoding convertfrom utf-8 "\xE0\xA0\x80"]
} 1
test encoding-24.11 {Parse valid or invalid utf-8} {
    string length [encoding convertfrom -nocomplain utf-8 "\xEF\xBF\xBF"]
} 1
test encoding-24.12 {Parse valid or invalid utf-8} -body {
    encoding convertfrom utf-8 "\xC0\x81"
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC0'}
test encoding-24.13 {Parse valid or invalid utf-8} -body {
    encoding convertfrom utf-8 "\xC1\xBF"
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC1'}
test encoding-24.14 {Parse valid or invalid utf-8} {
    string length [encoding convertfrom utf-8 "\xC2\x80"]
} 1



test encoding-24.15 {Parse valid or invalid utf-8} -body {
    encoding convertfrom utf-8 "Z\xE0\x80"
} -result Z\xE0\x80
test encoding-24.16 {Parse valid or invalid utf-8} -constraints testbytestring -body {
    encoding convertto utf-8 [testbytestring "Z\u4343\x80"]
} -returnCodes 1 -result {expected byte sequence but character 1 was '䍃€' (U+004343)}
test encoding-24.17 {Parse valid or invalid utf-8} -constraints testbytestring -body {
    encoding convertto utf-8 [testbytestring "Z\xE0\x80"]
} -result "Z\xC3\xA0\xE2\x82\xAC"
test encoding-24.18 {Parse valid or invalid utf-8} -constraints testbytestring -body {
    encoding convertto utf-8 [testbytestring "Z\xE0\x80xxxxxx"]
} -result "Z\xC3\xA0\xE2\x82\xACxxxxxx"
test encoding-24.19 {Parse valid or invalid utf-8} -body {
    encoding convertto utf-8 "ZX\uD800"



} -returnCodes 1 -match glob -result "unexpected character at index 2: 'U+00D800'"
test encoding-24.20 {Parse with -nocomplain but without providing encoding} {
    string length [encoding convertfrom -nocomplain "\x20"]
} 1

test encoding-24.21 {Parse with -nocomplain but without providing encoding} {
    string length [encoding convertto -nocomplain "\x20"]
} 1

test encoding-24.22 {Syntax error, two encodings} -body {
    encoding convertfrom iso8859-1 utf-8 "ZX\uD800"
} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertfrom ?-nocomplain? ?-strict? ?-failindex var? ?encoding? data"}
test encoding-24.23 {Syntax error, two encodings} -body {
    encoding convertto iso8859-1 utf-8 "ZX\uD800"



} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertto ?-nocomplain? ?-strict? ?-failindex var? ?encoding? data"}



































































file delete [file join [temporaryDirectory] iso2022.txt]

#
# Begin jajp encoding round-trip conformity tests
#
proc foreach-jisx0208 {varName command} {







|





<
>
|













|
|

>
>
>
|
|
|

|


|





|


|





|

|
|

|
|

|
|

>
>
>
|
|
|









|
|
>
>
>

|
|
<
>
|
|
<
>


|


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







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
	set f [open [file join [file dirname [info script]] iso2022.txt]]
	fconfigure $f -encoding iso2022-jp
	gets $f
    }
} {}
test encoding-24.2 {EscapeFreeProc on open channels} {exec} {
    # Bug #524674 output
    runInSubprocess {
	encoding system cp1252;	# Bug #2891556 crash revelator
	fconfigure stdout -encoding iso2022-jp
	puts ab乎棙g
	set env(TCL_FINALIZE_ON_EXIT) 1
	exit

    }
} "ab\x1B\$B8C\x1B\$(DD%\x1B(Bg"
test encoding-24.3 {EscapeFreeProc on open channels} {stdio} {
    # Bug #219314 - if we don't free escape encodings correctly on channel
    # closure, we go boom
    set file [makeFile {
	encoding system iso2022-jp
	set a "乎乞也"; # 3 Japanese Kanji letters
	puts $a
    } iso2022.tcl]
    set f [open "|[list [interpreter] $file]"]
    fconfigure $f -encoding iso2022-jp
    set count [gets $f line]
    close $f
    removeFile iso2022.tcl
    list $count $line
} [list 3 乎乞也]

test {encoding-24.4 utf-8 invalid strict} {Parse invalid utf-8, strict} -body {
    encoding convertfrom -profile strict utf-8 "\xC0\x80"
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC0'}
test {encoding-24.4 utf-8 invalid tcl8} {UtfToUtfProc utf-8} {
    encoding convertfrom -profile tcl8 utf-8 \xC0\x80
} \x00
test encoding-24.5 {Parse valid or invalid utf-8} {
    string length [encoding convertfrom -profile tcl8 utf-8 "\xC0\x81"]
} 2
test encoding-24.6 {Parse valid or invalid utf-8} {
    string length [encoding convertfrom -profile tcl8 utf-8 "\xC1\xBF"]
} 2
test encoding-24.7 {Parse valid or invalid utf-8} {
    string length [encoding convertfrom utf-8 "\xC2\x80"]
} 1
test encoding-24.8 {Parse valid or invalid utf-8} {
    string length [encoding convertfrom -profile tcl8 utf-8 "\xE0\x80\x80"]
} 3
test encoding-24.9 {Parse valid or invalid utf-8} {
    string length [encoding convertfrom -profile tcl8 utf-8 "\xE0\x9F\xBF"]
} 3
test encoding-24.10 {Parse valid or invalid utf-8} {
    string length [encoding convertfrom utf-8 "\xE0\xA0\x80"]
} 1
test encoding-24.11 {Parse valid or invalid utf-8} {
    string length [encoding convertfrom -profile tcl8 utf-8 "\xEF\xBF\xBF"]
} 1
test encoding-24.12 {Parse invalid utf-8} -body {
    encoding convertfrom -profile strict utf-8 "\xC0\x81"
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC0'}
test encoding-24.13 {Parse invalid utf-8} -body {
    encoding convertfrom -profile strict utf-8 "\xC1\xBF"
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC1'}
test encoding-24.14 {Parse valid utf-8} {
    expr {[encoding convertfrom utf-8 "\xC2\x80"] eq "\u80"}
} 1
test encoding-24.15.strict {Parse invalid utf-8, -profile strict} -body {
    encoding convertfrom -profile strict utf-8 "Z\xE0\x80"
} -returnCodes 1 -result "unexpected byte sequence starting at index 1: '\\xE0'"
test encoding-24.15.tcl8 {Parse invalid utf-8, -profile tcl8} -body {
    encoding convertfrom -profile tcl8 utf-8 "Z\xE0\x80"
} -result Z\xE0\u20AC
test encoding-24.16 {Parse valid or invalid utf-8} -constraints testbytestring -body {
    encoding convertto utf-8 [testbytestring "Z\u4343\x80"]
} -returnCodes 1 -result {expected byte sequence but character 1 was '䍃€' (U+004343)}
test encoding-24.17 {Parse valid or invalid utf-8} -constraints testbytestring -body {
    encoding convertto utf-8 [testbytestring "Z\xE0\x80"]
} -result "Z\xC3\xA0\xE2\x82\xAC"
test encoding-24.18 {Parse valid or invalid utf-8} -constraints testbytestring -body {
    encoding convertto utf-8 [testbytestring "Z\xE0\x80xxxxxx"]
} -result "Z\xC3\xA0\xE2\x82\xACxxxxxx"
test encoding-24.19.1 {Parse valid or invalid utf-8} -body {
    encoding convertto -profile tcl8 utf-8 "ZX\uD800"
} -result ZX\xED\xA0\x80
test encoding-24.19.2 {Parse valid or invalid utf-8} -body {
    encoding convertto -profile strict utf-8 "ZX\uD800"
} -returnCodes 1 -match glob -result "unexpected character at index 2: 'U+00D800'"
test encoding-24.20 {Parse with -profile tcl8 but without providing encoding} -body {
    encoding convertfrom -profile tcl8 "\x20"

} -result {wrong # args: should be "::tcl::encoding::convertfrom ?-profile profile? ?-failindex var? encoding data" or "::tcl::encoding::convertfrom data"} -returnCodes error
test encoding-24.21 {Parse with -profile tcl8 but without providing encoding} -body {
    string length [encoding convertto -profile tcl8 "\x20"]

} -result {wrong # args: should be "::tcl::encoding::convertto ?-profile profile? ?-failindex var? encoding data" or "::tcl::encoding::convertto data"} -returnCodes error
test encoding-24.22 {Syntax error, two encodings} -body {
    encoding convertfrom iso8859-1 utf-8 "ZX\uD800"
} -result {bad option "iso8859-1": must be -profile or -failindex} -returnCodes error
test encoding-24.23 {Syntax error, two encodings} -body {
    encoding convertto iso8859-1 utf-8 "ZX\uD800"
} -result {bad option "iso8859-1": must be -profile or -failindex} -returnCodes error
test encoding-24.24 {Parse invalid utf-8 with -profile strict} -body {
    encoding convertfrom -profile strict utf-8 "\xC0\x80\x00\x00"
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC0'}
test encoding-24.25 {Parse invalid utf-8 with -profile strict} -body {
    encoding convertfrom -profile strict utf-8 "\x40\x80\x00\x00"
} -returnCodes 1 -result {unexpected byte sequence starting at index 1: '\x80'}
test encoding-24.26 {Parse valid utf-8 with -profile strict} -body {
    encoding convertfrom -profile strict utf-8 "\xF1\x80\x80\x80"
} -result \U40000
test encoding-24.27 {Parse invalid utf-8 with -profile strict} -body {
    encoding convertfrom -profile strict utf-8 "\xF0\x80\x80\x80"
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xF0'}
test encoding-24.28 {Parse invalid utf-8 with -profile strict} -body {
    encoding convertfrom -profile strict utf-8 "\xFF\x00\x00"
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xFF'}
test encoding-24.29 {Parse invalid utf-8} -body {
    encoding convertfrom utf-8 \xEF\xBF\xBF
} -result \uFFFF
test encoding-24.30 {Parse noncharacter with -profile strict} -body {
    encoding convertfrom -profile strict utf-8 \xEF\xBF\xBF
} -result \uFFFF
test encoding-24.31 {Parse invalid utf-8 with -profile tcl8} -body {
    encoding convertfrom -profile tcl8 utf-8 \xEF\xBF\xBF
} -result \uFFFF
test encoding-24.32 {Try to generate invalid utf-8} -body {
    encoding convertto utf-8 \uFFFF
} -result \xEF\xBF\xBF
test encoding-24.33 {Try to generate invalid utf-8} -body {
    encoding convertto -profile strict utf-8 \uFFFF
} -result \xEF\xBF\xBF
test encoding-24.34 {Try to generate invalid utf-8 with -profile tcl8} -body {
    encoding convertto -profile tcl8 utf-8 \uFFFF
} -result \xEF\xBF\xBF
test encoding-24.35 {Parse invalid utf-8} -constraints utf32 -body {
    encoding convertfrom -profile tcl8 utf-8 \xED\xA0\x80
} -result \uD800
test encoding-24.36 {Parse invalid utf-8 with -profile strict} -body {
    encoding convertfrom -profile strict utf-8 \xED\xA0\x80
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xED'}
test encoding-24.37 {Parse invalid utf-8 with -profile tcl8} -body {
    encoding convertfrom -profile tcl8 utf-8 \xED\xA0\x80
} -result \uD800
test encoding-24.38.1 {Try to generate invalid utf-8} -body {
    encoding convertto -profile tcl8 utf-8 \uD800
} -result \xED\xA0\x80
test encoding-24.38.2 {Try to generate invalid utf-8} -body {
    encoding convertto -profile strict utf-8 \uD800
} -returnCodes 1 -result {unexpected character at index 0: 'U+00D800'}
test encoding-24.39 {Try to generate invalid utf-8 with -profile strict} -body {
    encoding convertto -profile strict utf-8 \uD800
} -returnCodes 1 -result {unexpected character at index 0: 'U+00D800'}
test encoding-24.40 {Try to generate invalid utf-8 with -profile tcl8} -body {
    encoding convertto -profile tcl8 utf-8 \uD800
} -result \xED\xA0\x80
test encoding-24.41 {Parse invalid utf-8 with -profile strict} -body {
    encoding convertfrom -profile strict utf-8 \xED\xA0\x80\xED\xB0\x80
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xED'}
test encoding-24.42 {Parse invalid utf-8, fallback to cp1252 [885c86a9a0]} -body {
    encoding convertfrom -profile tcl8 utf-8 \xF0\x80\x80\x80
} -result \xF0\u20AC\u20AC\u20AC
test encoding-24.43 {Parse invalid utf-8, fallback to cp1252 [885c86a9a0]} -body {
    encoding convertfrom -profile tcl8 utf-8 \x80
} -result \u20AC
test encoding-24.44 {Try to generate invalid ucs-2 with -profile strict} -body {
    encoding convertto -profile strict ucs-2 \uD800
} -returnCodes 1 -result {unexpected character at index 0: 'U+00D800'}
test encoding-24.45 {Try to generate invalid ucs-2 with -profile strict} -body {
    encoding convertto -profile strict ucs-2 \U10000
} -returnCodes 1 -result {unexpected character at index 0: 'U+010000'}

file delete [file join [temporaryDirectory] iso2022.txt]

#
# Begin jajp encoding round-trip conformity tests
#
proc foreach-jisx0208 {varName command} {
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

test encoding-28.0 {all encodings load} -body {
	set string hello
	foreach name [encoding names] {
		if {$name ne "unicode"} {
		    incr count
		}
		encoding convertto -nocomplain $name $string

		# discard the cached internal representation of Tcl_Encoding
		# Unfortunately, without this, encoding 2-1 fails.
		llength $name
	}
	return $count
} -result 91

runtests







































}

test encoding-29.0 {get encoding nul terminator lengths} -constraints {
    testencoding
} -body {
    list \
        [testencoding nullength ascii] \
        [testencoding nullength utf-16] \
        [testencoding nullength utf-32] \
        [testencoding nullength gb12345] \
        [testencoding nullength ksc5601]
} -result {1 2 4 2 2}



























































# cleanup
namespace delete ::tcl::test::encoding
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:







|










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












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









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

test encoding-28.0 {all encodings load} -body {
	set string hello
	foreach name [encoding names] {
		if {$name ne "unicode"} {
		    incr count
		}
		encoding convertto -profile tcl8 $name $string

		# discard the cached internal representation of Tcl_Encoding
		# Unfortunately, without this, encoding 2-1 fails.
		llength $name
	}
	return $count
} -result 91

runtests

test encoding-bug-183a1adcc0-1 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints {
    testencoding
} -body {
    # Note - buffers are initialized to \xFF
    list [catch {testencoding Tcl_UtfToExternal utf-16 A {start end} {} 1} result] $result
} -result [list 0 [list nospace {} \xFF]]

test encoding-bug-183a1adcc0-2 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints {
    testencoding
} -body {
    # Note - buffers are initialized to \xFF
    list [catch {testencoding Tcl_UtfToExternal utf-16 A {start end} {} 0} result] $result
} -result [list 0 [list nospace {} {}]]

test encoding-bug-183a1adcc0-3 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints {
    testencoding
} -body {
    # Note - buffers are initialized to \xFF
    list [catch {testencoding Tcl_UtfToExternal utf-16 A {start end} {} 2} result] $result
} -result [list 0 [list nospace {} \x00\x00]]

test encoding-bug-183a1adcc0-4 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints {
    testencoding
} -body {
    # Note - buffers are initialized to \xFF
    list [catch {testencoding Tcl_UtfToExternal utf-16 A {start end} {} 3} result] $result
} -result [list 0 [list nospace {} \x00\x00\xFF]]

test encoding-bug-183a1adcc0-5 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints {
    testencoding ucs2 knownBug
} -body {
    # The knownBug constraint is because test depends on TCL_UTF_MAX and
    # also UtfToUtf16 assumes space required in destination buffer is
    # sizeof(Tcl_UniChar) which is incorrect when TCL_UTF_MAX==4
    # Note - buffers are initialized to \xFF
    list [catch {testencoding Tcl_UtfToExternal utf-16 A {start end} {} 4} result] $result
} -result [list 0 [list ok {} [expr {$::tcl_platform(byteOrder) eq "littleEndian" ? "\x41\x00" : "\x00\x41"}]\x00\x00]]

}

test encoding-29.0 {get encoding nul terminator lengths} -constraints {
    testencoding
} -body {
    list \
        [testencoding nullength ascii] \
        [testencoding nullength utf-16] \
        [testencoding nullength utf-32] \
        [testencoding nullength gb12345] \
        [testencoding nullength ksc5601]
} -result {1 2 4 2 2}

test encoding-30.0 {encoding convertto large strings UINT_MAX} -constraints {
    perf
} -body {
    # Test to ensure not misinterpreted as -1
    list [string length [set s [string repeat A 0xFFFFFFFF]]] [string equal $s [encoding convertto ascii $s]]
} -result {4294967295 1}

test encoding-30.1 {encoding convertto large strings > 4GB} -constraints {
    perf
} -body {
    list [string length [set s [string repeat A 0x100000000]]] [string equal $s [encoding convertto ascii $s]]
} -result {4294967296 1}

test encoding-30.2 {encoding convertfrom large strings UINT_MAX} -constraints {
    perf
} -body {
    # Test to ensure not misinterpreted as -1
    list [string length [set s [string repeat A 0xFFFFFFFF]]] [string equal $s [encoding convertfrom ascii $s]]
} -result {4294967295 1}

test encoding-30.3 {encoding convertfrom large strings > 4GB} -constraints {
    perf
} -body {
    list [string length [set s [string repeat A 0x100000000]]] [string equal $s [encoding convertfrom ascii $s]]
} -result {4294967296 1}

test encoding-bug-6a3e2cb0f0-1 {Bug [6a3e2cb0f0] - invalid bytes in escape encodings} -body {
    encoding convertfrom -profile tcl8 iso2022-jp x\x1B\x7Aaby
} -result x\uFFFDy
test encoding-bug-6a3e2cb0f0-2 {Bug [6a3e2cb0f0] - invalid bytes in escape encodings} -body {
    encoding convertfrom -profile strict iso2022-jp x\x1B\x7Aaby
} -returnCodes error -result {unexpected byte sequence starting at index 1: '\x1B'}
test encoding-bug-6a3e2cb0f0-3 {Bug [6a3e2cb0f0] - invalid bytes in escape encodings} -body {
    encoding convertfrom -profile replace iso2022-jp x\x1B\x7Aaby
} -result x\uFFFDy

test encoding-bug-66ffafd309-1-tcl8 {Bug [66ffafd309] - truncated DBCS} -body {
    encoding convertfrom -profile tcl8 gb12345 x
} -result x
test encoding-bug-66ffafd309-1-strict {Bug [66ffafd309] - truncated DBCS} -body {
    encoding convertfrom -profile strict gb12345 x
} -result {unexpected byte sequence starting at index 0: '\x78'} -returnCodes error
test encoding-bug-66ffafd309-1-replace {Bug [66ffafd309] - truncated DBCS} -body {
    encoding convertfrom -profile replace gb12345 x
} -result \uFFFD
test encoding-bug-66ffafd309-2-tcl8 {Bug [66ffafd309] - invalid DBCS} -body {
    # Not truncated but invalid
    encoding convertfrom -profile tcl8 jis0208 \x78\x79
} -result \x78\x79
test encoding-bug-66ffafd309-2-strict {Bug [66ffafd309] - invalid DBCS} -body {
    # Not truncated but invalid
    encoding convertfrom -profile strict jis0208 \x78\x79
} -result {unexpected byte sequence starting at index 1: '\x79'} -returnCodes error
test encoding-bug-66ffafd309-2-replace {Bug [66ffafd309] - invalid DBCS} -body {
    # Not truncated but invalid
    encoding convertfrom -profile replace jis0208 \x78\x79
} -result \uFFFD\uFFFD

# cleanup
namespace delete ::tcl::test::encoding
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Added tests/encodingVectors.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
# This file contains test vectors for verifying various encodings. They are
# stored in a common file so that they can be sourced into the various test
# modules that are dependent on encodings. This file contains statically defined
# test vectors. In addition, it sources the ICU-generated test vectors from
# icuUcmTests.tcl.
#
# Note that sourcing the file will reinitialize any existing encoding test
# vectors.
#

# List of defined encoding profiles
set encProfiles {tcl8 strict replace}
set encDefaultProfile tcl8; # Should reflect the default from implementation

# encValidStrings - Table of valid strings.
#
# Each row is <ENCODING STR BYTES CTRL COMMENT>
# The pair <ENCODING,STR> should be unique for generated test ids to be unique.
# STR is a string that can be encoded in the encoding ENCODING resulting
# in the byte sequence BYTES. The CTRL field is a list that controls test
# generation. It may contain zero or more of `solo`, `lead`, `tail` and
# `middle` indicating that the generated tests should include the string
# by itself, as the lead of a longer string, as the tail of a longer string
# and in the middle of a longer string. If CTRL is empty, it is treated as
# containing all four of the above. The CTRL field may also contain the
# words knownBug or knownW3C which will cause the test generation for that
# vector to be skipped.
#
# utf-16, utf-32 missing because they are automatically
# generated based on le/be versions.
set encValidStrings {}; # Reset the table

lappend encValidStrings {*}{
    ascii    \u0000 00 {} {Lowest ASCII}
    ascii    \u007F 7F {} {Highest ASCII}
    ascii    \u007D 7D {} {Brace - just to verify test scripts are escaped correctly}
    ascii    \u007B 7B {} {Terminating brace - just to verify test scripts are escaped correctly}

    utf-8    \u0000 00 {} {Unicode Table 3.7 Row 1}
    utf-8    \u007F 7F {} {Unicode Table 3.7 Row 1}
    utf-8    \u0080 C280 {} {Unicode Table 3.7 Row 2}
    utf-8    \u07FF DFBF {} {Unicode Table 3.7 Row 2}
    utf-8    \u0800 E0A080 {} {Unicode Table 3.7 Row 3}
    utf-8    \u0FFF E0BFBF {} {Unicode Table 3.7 Row 3}
    utf-8    \u1000 E18080 {} {Unicode Table 3.7 Row 4}
    utf-8    \uCFFF ECBFBF {} {Unicode Table 3.7 Row 4}
    utf-8    \uD000 ED8080 {} {Unicode Table 3.7 Row 5}
    utf-8    \uD7FF ED9FBF {} {Unicode Table 3.7 Row 5}
    utf-8    \uE000 EE8080 {} {Unicode Table 3.7 Row 6}
    utf-8    \uFFFF EFBFBF {} {Unicode Table 3.7 Row 6}
    utf-8    \U10000 F0908080 {} {Unicode Table 3.7 Row 7}
    utf-8    \U3FFFF F0BFBFBF {} {Unicode Table 3.7 Row 7}
    utf-8    \U40000 F1808080 {} {Unicode Table 3.7 Row 8}
    utf-8    \UFFFFF F3BFBFBF {} {Unicode Table 3.7 Row 8}
    utf-8    \U100000 F4808080 {} {Unicode Table 3.7 Row 9}
    utf-8    \U10FFFF F48FBFBF {} {Unicode Table 3.7 Row 9}
    utf-8    A\u03A9\u8A9E\U00010384 41CEA9E8AA9EF0908E84 {} {Unicode 2.5}

    utf-16le \u0000 0000 {} {Lowest code unit}
    utf-16le \uD7FF FFD7 {} {Below high surrogate range}
    utf-16le \uE000 00E0 {} {Above low surrogate range}
    utf-16le \uFFFF FFFF {} {Highest code unit}
    utf-16le \U010000 00D800DC {} {First surrogate pair}
    utf-16le \U10FFFF FFDBFFDF {} {First surrogate pair}
    utf-16le A\u03A9\u8A9E\U00010384 4100A9039E8A00D884DF {} {Unicode 2.5}

    utf-16be \u0000 0000 {} {Lowest code unit}
    utf-16be \uD7FF D7FF {} {Below high surrogate range}
    utf-16be \uE000 E000 {} {Above low surrogate range}
    utf-16be \uFFFF FFFF {} {Highest code unit}
    utf-16be \U010000 D800DC00 {} {First surrogate pair}
    utf-16be \U10FFFF DBFFDFFF {} {First surrogate pair}
    utf-16be A\u03A9\u8A9E\U00010384 004103A98A9ED800DF84 {} {Unicode 2.5}

    utf-32le \u0000 00000000 {} {Lowest code unit}
    utf-32le \uFFFF FFFF0000 {} {Highest BMP}
    utf-32le \U010000 00000100 {} {First supplementary}
    utf-32le \U10FFFF ffff1000 {} {Last supplementary}
    utf-32le A\u03A9\u8A9E\U00010384 41000000A90300009E8A000084030100 {} {Unicode 2.5}

    utf-32be \u0000 00000000 {} {Lowest code unit}
    utf-32be \uFFFF 0000FFFF {} {Highest BMP}
    utf-32be \U010000 00010000 {} {First supplementary}
    utf-32be \U10FFFF 0010FFFF {} {Last supplementary}
    utf-32be A\u03A9\u8A9E\U00010384 00000041000003A900008A9E00010384 {} {Unicode 2.5}
}

# encInvalidBytes - Table of invalid byte sequences
# These are byte sequences that should appear for an encoding. Each row is
# of the form
#    <ENCODING BYTES PROFILE EXPECTEDRESULT EXPECTEDFAILINDEX CTRL COMMENT>
# The triple <ENCODING,BYTES,PROFILE> should be unique for test ids to be
# unique. BYTES is a byte sequence that is invalid. EXPECTEDRESULT is the
# expected string when the bytes are decoded using the PROFILE profile.
# FAILINDEX gives the expected index of the invalid byte under that profile. The
# CTRL field is a list that controls test generation. It may contain zero or
# more of `solo`, `lead`, `tail` and `middle` indicating that the generated the
# tail of a longer and in the middle of a longer string. If empty, it is treated
# as containing all four of the above. The CTRL field may also contain the words
# knownBug or knownW3C which will cause the test generation for that vector to
# be skipped.
#
# utf-32 missing because they are automatically generated based on le/be
# versions.
set encInvalidBytes {}; # Reset the table

# ascii - Any byte above 127 is invalid and is mapped
# to the same numeric code point except for the range
# 80-9F which is treated as cp1252.
# This tests the TableToUtfProc code path.
lappend encInvalidBytes {*}{
    ascii 80 tcl8    \u20AC -1 {knownBug} {map to cp1252}
    ascii 80 replace \uFFFD -1 {} {Smallest invalid byte}
    ascii 80 strict  {}      0 {} {Smallest invalid byte}
    ascii 81 tcl8    \u0081 -1 {knownBug} {map to cp1252}
    ascii 82 tcl8    \u201A -1 {knownBug} {map to cp1252}
    ascii 83 tcl8    \u0192 -1 {knownBug} {map to cp1252}
    ascii 84 tcl8    \u201E -1 {knownBug} {map to cp1252}
    ascii 85 tcl8    \u2026 -1 {knownBug} {map to cp1252}
    ascii 86 tcl8    \u2020 -1 {knownBug} {map to cp1252}
    ascii 87 tcl8    \u2021 -1 {knownBug} {map to cp1252}
    ascii 88 tcl8    \u0276 -1 {knownBug} {map to cp1252}
    ascii 89 tcl8    \u2030 -1 {knownBug} {map to cp1252}
    ascii 8A tcl8    \u0160 -1 {knownBug} {map to cp1252}
    ascii 8B tcl8    \u2039 -1 {knownBug} {map to cp1252}
    ascii 8C tcl8    \u0152 -1 {knownBug} {map to cp1252}
    ascii 8D tcl8    \u008D -1 {knownBug} {map to cp1252}
    ascii 8E tcl8    \u017D -1 {knownBug} {map to cp1252}
    ascii 8F tcl8    \u008F -1 {knownBug} {map to cp1252}
    ascii 90 tcl8    \u0090 -1 {knownBug} {map to cp1252}
    ascii 91 tcl8    \u2018 -1 {knownBug} {map to cp1252}
    ascii 92 tcl8    \u2019 -1 {knownBug} {map to cp1252}
    ascii 93 tcl8    \u201C -1 {knownBug} {map to cp1252}
    ascii 94 tcl8    \u201D -1 {knownBug} {map to cp1252}
    ascii 95 tcl8    \u2022 -1 {knownBug} {map to cp1252}
    ascii 96 tcl8    \u2013 -1 {knownBug} {map to cp1252}
    ascii 97 tcl8    \u2014 -1 {knownBug} {map to cp1252}
    ascii 98 tcl8    \u02DC -1 {knownBug} {map to cp1252}
    ascii 99 tcl8    \u2122 -1 {knownBug} {map to cp1252}
    ascii 9A tcl8    \u0161 -1 {knownBug} {map to cp1252}
    ascii 9B tcl8    \u203A -1 {knownBug} {map to cp1252}
    ascii 9C tcl8    \u0153 -1 {knownBug} {map to cp1252}
    ascii 9D tcl8    \u009D -1 {knownBug} {map to cp1252}
    ascii 9E tcl8    \u017E -1 {knownBug} {map to cp1252}
    ascii 9F tcl8    \u0178 -1 {knownBug} {map to cp1252}

    ascii FF tcl8    \u00FF -1 {} {Largest invalid byte}
    ascii FF replace \uFFFD -1 {} {Largest invalid byte}
    ascii FF strict  {}      0 {} {Largest invalid byte}
}

# utf-8 - valid sequences based on Table 3.7 in the Unicode
# standard.
#
# Code Points        First   Second  Third   Fourth Byte
# U+0000..U+007F     00..7F
# U+0080..U+07FF     C2..DF  80..BF
# U+0800..U+0FFF     E0      A0..BF  80..BF
# U+1000..U+CFFF     E1..EC  80..BF  80..BF
# U+D000..U+D7FF     ED      80..9F  80..BF
# U+E000..U+FFFF     EE..EF  80..BF  80..BF
# U+10000..U+3FFFF   F0      90..BF  80..BF  80..BF
# U+40000..U+FFFFF   F1..F3  80..BF  80..BF  80..BF
# U+100000..U+10FFFF F4      80..8F  80..BF  80..BF
#
# Tests below are based on the "gaps" in the above table. Note ascii test
# values are repeated because internally a different code path is used
# (UtfToUtfProc).
# Note C0, C1, F5:FF are invalid bytes ANYWHERE. Exception is C080
lappend encInvalidBytes {*}{
    utf-8 80 tcl8    \u20AC -1 {} {map to cp1252}
    utf-8 80 replace \uFFFD -1 {} {Smallest invalid byte}
    utf-8 80 strict  {}      0 {} {Smallest invalid byte}
    utf-8 81 tcl8    \u0081 -1 {} {map to cp1252}
    utf-8 82 tcl8    \u201A -1 {} {map to cp1252}
    utf-8 83 tcl8    \u0192 -1 {} {map to cp1252}
    utf-8 84 tcl8    \u201E -1 {} {map to cp1252}
    utf-8 85 tcl8    \u2026 -1 {} {map to cp1252}
    utf-8 86 tcl8    \u2020 -1 {} {map to cp1252}
    utf-8 87 tcl8    \u2021 -1 {} {map to cp1252}
    utf-8 88 tcl8    \u02C6 -1 {} {map to cp1252}
    utf-8 89 tcl8    \u2030 -1 {} {map to cp1252}
    utf-8 8A tcl8    \u0160 -1 {} {map to cp1252}
    utf-8 8B tcl8    \u2039 -1 {} {map to cp1252}
    utf-8 8C tcl8    \u0152 -1 {} {map to cp1252}
    utf-8 8D tcl8    \u008D -1 {} {map to cp1252}
    utf-8 8E tcl8    \u017D -1 {} {map to cp1252}
    utf-8 8F tcl8    \u008F -1 {} {map to cp1252}
    utf-8 90 tcl8    \u0090 -1 {} {map to cp1252}
    utf-8 91 tcl8    \u2018 -1 {} {map to cp1252}
    utf-8 92 tcl8    \u2019 -1 {} {map to cp1252}
    utf-8 93 tcl8    \u201C -1 {} {map to cp1252}
    utf-8 94 tcl8    \u201D -1 {} {map to cp1252}
    utf-8 95 tcl8    \u2022 -1 {} {map to cp1252}
    utf-8 96 tcl8    \u2013 -1 {} {map to cp1252}
    utf-8 97 tcl8    \u2014 -1 {} {map to cp1252}
    utf-8 98 tcl8    \u02DC -1 {} {map to cp1252}
    utf-8 99 tcl8    \u2122 -1 {} {map to cp1252}
    utf-8 9A tcl8    \u0161 -1 {} {map to cp1252}
    utf-8 9B tcl8    \u203A -1 {} {map to cp1252}
    utf-8 9C tcl8    \u0153 -1 {} {map to cp1252}
    utf-8 9D tcl8    \u009D -1 {} {map to cp1252}
    utf-8 9E tcl8    \u017E -1 {} {map to cp1252}
    utf-8 9F tcl8    \u0178 -1 {} {map to cp1252}

    utf-8 C0 tcl8    \u00C0 -1 {} {C0 is invalid anywhere}
    utf-8 C0 strict  {}      0 {} {C0 is invalid anywhere}
    utf-8 C0 replace \uFFFD -1 {} {C0 is invalid anywhere}
    utf-8 C080 tcl8    \u0000 -1 {} {C080 -> U+0 in Tcl's internal modified UTF8}
    utf-8 C080 strict  {}      0 {} {C080 -> invalid}
    utf-8 C080 replace \uFFFD -1 {} {C080 -> single replacement char}
    utf-8 C0A2 tcl8    \u00C0\u00A2 -1 {} {websec.github.io - A}
    utf-8 C0A2 replace \uFFFD\uFFFD -1 {} {websec.github.io - A}
    utf-8 C0A2 strict  {}            0 {} {websec.github.io - A}
    utf-8 C0A7 tcl8    \u00C0\u00A7 -1 {} {websec.github.io - double quote}
    utf-8 C0A7 replace \uFFFD\uFFFD -1 {} {websec.github.io - double quote}
    utf-8 C0A7 strict  {}            0 {} {websec.github.io - double quote}
    utf-8 C0AE tcl8    \u00C0\u00AE -1 {} {websec.github.io - full stop}
    utf-8 C0AE replace \uFFFD\uFFFD -1 {} {websec.github.io - full stop}
    utf-8 C0AE strict  {}            0 {} {websec.github.io - full stop}
    utf-8 C0AF tcl8    \u00C0\u00AF -1 {} {websec.github.io - solidus}
    utf-8 C0AF replace \uFFFD\uFFFD -1 {} {websec.github.io - solidus}
    utf-8 C0AF strict  {}            0 {} {websec.github.io - solidus}

    utf-8 C1 tcl8    \u00C1 -1 {} {C1 is invalid everywhere}
    utf-8 C1 replace \uFFFD -1 {} {C1 is invalid everywhere}
    utf-8 C1 strict  {}      0 {} {C1 is invalid everywhere}
    utf-8 C181 tcl8    \u00C1\u0081 -1 {} {websec.github.io - base test (A)}
    utf-8 C181 replace \uFFFD\uFFFD -1 {} {websec.github.io - base test (A)}
    utf-8 C181 strict  {}            0 {} {websec.github.io - base test (A)}
    utf-8 C19C tcl8    \u00C1\u0153 -1 {} {websec.github.io - reverse solidus}
    utf-8 C19C replace \uFFFD\uFFFD -1 {} {websec.github.io - reverse solidus}
    utf-8 C19C strict  {}            0 {} {websec.github.io - reverse solidus}

    utf-8 C2 tcl8      \u00C2     -1 {} {Missing trail byte}
    utf-8 C2 replace   \uFFFD     -1 {} {Missing trail byte}
    utf-8 C2 strict    {}          0 {} {Missing trail byte}
    utf-8 C27F tcl8    \u00C2\x7F -1 {} {Trail byte must be 80:BF}
    utf-8 C27F replace \uFFFD\x7F -1 {} {Trail byte must be 80:BF}
    utf-8 C27F strict  {}          0 {} {Trail byte must be 80:BF}
    utf-8 DF tcl8      \u00DF     -1 {} {Missing trail byte}
    utf-8 DF replace   \uFFFD     -1 {} {Missing trail byte}
    utf-8 DF strict    {}          0 {} {Missing trail byte}
    utf-8 DF7F tcl8    \u00DF\x7F -1 {} {Trail byte must be 80:BF}
    utf-8 DF7F replace \uFFFD\x7F -1 {} {Trail byte must be 80:BF}
    utf-8 DF7F strict  {}          0 {} {Trail byte must be 80:BF}
    utf-8 DFE0A080 tcl8    \u00DF\u0800 -1 {} {Invalid trail byte is start of valid sequence}
    utf-8 DFE0A080 replace \uFFFD\u0800 -1 {} {Invalid trail byte is start of valid sequence}
    utf-8 DFE0A080 strict  {}            0 {} {Invalid trail byte is start of valid sequence}

    utf-8 E0 tcl8      \u00E0     -1 {} {Missing trail byte}
    utf-8 E0 replace   \uFFFD     -1 {} {Missing trail byte}
    utf-8 E0 strict    {}          0 {} {Missing trail byte}
    utf-8 E080 tcl8      \u00E0\u20AC   -1 {} {First trail byte must be A0:BF}
    utf-8 E080 replace   \uFFFD\uFFFD   -1 {} {First trail byte must be A0:BF}
    utf-8 E080 strict    {}              0 {} {First trail byte must be A0:BF}
    utf-8 E0819C tcl8    \u00E0\u0081\u0153 -1 {} {websec.github.io - reverse solidus}
    utf-8 E0819C replace \uFFFD\uFFFD\uFFFD -1 {} {websec.github.io - reverse solidus}
    utf-8 E0819C strict  {}                  0 {} {websec.github.io - reverse solidus}
    utf-8 E09F tcl8      \u00E0\u0178   -1 {} {First trail byte must be A0:BF}
    utf-8 E09F replace   \uFFFD\uFFFD   -1 {} {First trail byte must be A0:BF}
    utf-8 E09F strict    {}              0 {} {First trail byte must be A0:BF}
    utf-8 E0A0 tcl8      \u00E0\u00A0   -1 {} {Missing second trail byte}
    utf-8 E0A0 replace   \uFFFD         -1 {knownW3C} {Missing second trail byte}
    utf-8 E0A0 strict    {}              0 {} {Missing second trail byte}
    utf-8 E0BF tcl8      \u00E0\u00BF   -1 {} {Missing second trail byte}
    utf-8 E0BF replace   \uFFFD         -1 {knownW3C} {Missing second trail byte}
    utf-8 E0BF strict    {}              0 {} {Missing second trail byte}
    utf-8 E0A07F tcl8    \u00E0\u00A0\x7F   -1 {}     {Second trail byte must be 80:BF}
    utf-8 E0A07F replace \uFFFD\u7F         -1 {knownW3C} {Second trail byte must be 80:BF}
    utf-8 E0A07F strict  {}                  0 {}         {Second trail byte must be 80:BF}
    utf-8 E0BF7F tcl8    \u00E0\u00BF\x7F   -1 {}         {Second trail byte must be 80:BF}
    utf-8 E0BF7F replace \uFFFD\u7F         -1 {knownW3C} {Second trail byte must be 80:BF}
    utf-8 E0BF7F strict  {}                  0 {}         {Second trail byte must be 80:BF}

    utf-8 E1 tcl8      \u00E1     -1 {} {Missing trail byte}
    utf-8 E1 replace   \uFFFD     -1 {} {Missing trail byte}
    utf-8 E1 strict    {}          0 {} {Missing trail byte}
    utf-8 E17F tcl8    \u00E1\x7F -1 {} {Trail byte must be 80:BF}
    utf-8 E17F replace \uFFFD\x7F -1 {} {Trail byte must be 80:BF}
    utf-8 E17F strict  {}          0 {} {Trail byte must be 80:BF}
    utf-8 E181 tcl8      \u00E1\u0081   -1 {} {Missing second trail byte}
    utf-8 E181 replace   \uFFFD         -1 {knownW3C} {Missing second trail byte}
    utf-8 E181 strict    {}              0 {} {Missing second trail byte}
    utf-8 E1BF tcl8      \u00E1\u00BF   -1 {} {Missing second trail byte}
    utf-8 E1BF replace   \uFFFD         -1 {knownW3C} {Missing second trail byte}
    utf-8 E1BF strict    {}              0 {} {Missing second trail byte}
    utf-8 E1807F tcl8    \u00E1\u20AC\x7F   -1 {} {Second trail byte must be 80:BF}
    utf-8 E1807F replace \uFFFD\u7F         -1 {knownW3C} {Second trail byte must be 80:BF}
    utf-8 E1807F strict  {}                  0 {}         {Second trail byte must be 80:BF}
    utf-8 E1BF7F tcl8    \u00E1\u00BF\x7F   -1 {}         {Second trail byte must be 80:BF}
    utf-8 E1BF7F replace \uFFFD\u7F         -1 {knownW3C} {Second trail byte must be 80:BF}
    utf-8 E1BF7F strict  {}                  0 {}         {Second trail byte must be 80:BF}
    utf-8 EC tcl8      \u00EC     -1 {} {Missing trail byte}
    utf-8 EC replace   \uFFFD     -1 {} {Missing trail byte}
    utf-8 EC strict    {}          0 {} {Missing trail byte}
    utf-8 EC7F tcl8    \u00EC\x7F -1 {} {Trail byte must be 80:BF}
    utf-8 EC7F replace \uFFFD\x7F -1 {} {Trail byte must be 80:BF}
    utf-8 EC7F strict  {}          0 {} {Trail byte must be 80:BF}
    utf-8 EC81 tcl8      \u00EC\u0081   -1 {} {Missing second trail byte}
    utf-8 EC81 replace   \uFFFD         -1 {knownW3C} {Missing second trail byte}
    utf-8 EC81 strict    {}              0 {} {Missing second trail byte}
    utf-8 ECBF tcl8      \u00EC\u00BF   -1 {} {Missing second trail byte}
    utf-8 ECBF replace   \uFFFD         -1 {knownW3C} {Missing second trail byte}
    utf-8 ECBF strict    {}              0 {} {Missing second trail byte}
    utf-8 EC807F tcl8    \u00EC\u20AC\x7F   -1 {} {Second trail byte must be 80:BF}
    utf-8 EC807F replace \uFFFD\u7F         -1 {knownW3C} {Second trail byte must be 80:BF}
    utf-8 EC807F strict  {}                  0 {}         {Second trail byte must be 80:BF}
    utf-8 ECBF7F tcl8    \u00EC\u00BF\x7F   -1 {}         {Second trail byte must be 80:BF}
    utf-8 ECBF7F replace \uFFFD\u7F         -1 {knownW3C} {Second trail byte must be 80:BF}
    utf-8 ECBF7F strict  {}                  0 {}         {Second trail byte must be 80:BF}

    utf-8 ED tcl8       \u00ED        -1 {} {Missing trail byte}
    utf-8 ED replace    \uFFFD        -1 {} {Missing trail byte}
    utf-8 ED strict     {}             0 {} {Missing trail byte}
    utf-8 ED7F tcl8     \u00ED\u7F    -1 {} {First trail byte must be 80:9F}
    utf-8 ED7F replace  \uFFFD\u7F    -1 {} {First trail byte must be 80:9F}
    utf-8 ED7F strict   {}             0 {} {First trail byte must be 80:9F}
    utf-8 EDA0 tcl8     \u00ED\u00A0  -1 {} {First trail byte must be 80:9F}
    utf-8 EDA0 replace  \uFFFD\uFFFD  -1 {} {First trail byte must be 80:9F}
    utf-8 EDA0 strict   {}             0 {} {First trail byte must be 80:9F}
    utf-8 ED81 tcl8      \u00ED\u0081   -1 {} {Missing second trail byte}
    utf-8 ED81 replace   \uFFFD         -1 {knownW3C} {Missing second trail byte}
    utf-8 ED81 strict    {}              0 {} {Missing second trail byte}
    utf-8 EDBF tcl8      \u00ED\u00BF   -1 {} {Missing second trail byte}
    utf-8 EDBF replace   \uFFFD         -1 {knownW3C} {Missing second trail byte}
    utf-8 EDBF strict    {}              0 {} {Missing second trail byte}
    utf-8 ED807F tcl8      \u00ED\u20AC\x7F -1 {} {Second trail byte must be 80:BF}
    utf-8 ED807F replace   \uFFFD\u7F       -1 {knownW3C} {Second trail byte must be 80:BF}
    utf-8 ED807F strict    {}                0 {}  {Second trail byte must be 80:BF}
    utf-8 ED9F7F tcl8      \u00ED\u0178\x7F -1 {} {Second trail byte must be 80:BF}
    utf-8 ED9F7F replace   \uFFFD\u7F       -1 {knownW3C} {Second trail byte must be 80:BF}
    utf-8 ED9F7F strict    {}                0 {}  {Second trail byte must be 80:BF}
    utf-8 EDA080 tcl8       \uD800          -1 {}  {High surrogate}
    utf-8 EDA080 replace    \uFFFD          -1 {knownBug}  {High surrogate}
    utf-8 EDA080 strict     {}               0 {}  {High surrogate}
    utf-8 EDAFBF tcl8       \uDBFF          -1 {}  {High surrogate}
    utf-8 EDAFBF replace    \uFFFD          -1 {knownBug}  {High surrogate}
    utf-8 EDAFBF strict     {}               0 {}  {High surrogate}
    utf-8 EDB080 tcl8       \uDC00          -1 {}  {Low surrogate}
    utf-8 EDB080 replace    \uFFFD          -1 {knownBug}  {Low surrogate}
    utf-8 EDB080 strict     {}               0 {}  {Low surrogate}
    utf-8 EDBFBF tcl8       \uDFFF          -1 {knownBug}  {Low surrogate}
    utf-8 EDBFBF replace    \uFFFD          -1 {knownBug}  {Low surrogate}
    utf-8 EDBFBF strict     {}               0 {}  {Low surrogate}
    utf-8 EDA080EDB080 tcl8 \U00010000      -1 {knownBug}  {High low surrogate pair}
    utf-8 EDA080EDB080 replace \uFFFD\uFFFD -1 {knownBug}  {High low surrogate pair}
    utf-8 EDA080EDB080 strict {}             0 {}  {High low surrogate pair}
    utf-8 EDAFBFEDBFBF tcl8 \U0010FFFF      -1 {knownBug}  {High low surrogate pair}
    utf-8 EDAFBFEDBFBF replace \uFFFD\uFFFD -1 {knownBug}  {High low surrogate pair}
    utf-8 EDAFBFEDBFBF strict {}             0 {}  {High low surrogate pair}

    utf-8 EE tcl8       \u00EE        -1 {} {Missing trail byte}
    utf-8 EE replace    \uFFFD        -1 {} {Missing trail byte}
    utf-8 EE strict     {}             0 {} {Missing trail byte}
    utf-8 EE7F tcl8     \u00EE\u7F    -1 {} {First trail byte must be 80:BF}
    utf-8 EE7F replace  \uFFFD\u7F    -1 {} {First trail byte must be 80:BF}
    utf-8 EE7F strict   {}             0 {} {First trail byte must be 80:BF}
    utf-8 EED0 tcl8     \u00EE\u00D0  -1 {} {First trail byte must be 80:BF}
    utf-8 EED0 replace  \uFFFD\uFFFD  -1 {} {First trail byte must be 80:BF}
    utf-8 EED0 strict   {}             0 {} {First trail byte must be 80:BF}
    utf-8 EE81 tcl8      \u00EE\u0081   -1 {} {Missing second trail byte}
    utf-8 EE81 replace   \uFFFD         -1 {knownW3C} {Missing second trail byte}
    utf-8 EE81 strict    {}              0 {} {Missing second trail byte}
    utf-8 EEBF tcl8      \u00EE\u00BF   -1 {} {Missing second trail byte}
    utf-8 EEBF replace   \uFFFD         -1 {knownW3C} {Missing second trail byte}
    utf-8 EEBF strict    {}              0 {} {Missing second trail byte}
    utf-8 EE807F tcl8      \u00EE\u20AC\x7F -1 {} {Second trail byte must be 80:BF}
    utf-8 EE807F replace   \uFFFD\u7F       -1 {knownW3C} {Second trail byte must be 80:BF}
    utf-8 EE807F strict    {}                0 {}  {Second trail byte must be 80:BF}
    utf-8 EEBF7F tcl8      \u00EE\u00BF\x7F -1 {} {Second trail byte must be 80:BF}
    utf-8 EEBF7F replace   \uFFFD\u7F       -1 {knownW3C} {Second trail byte must be 80:BF}
    utf-8 EEBF7F strict    {}                0 {}  {Second trail byte must be 80:BF}
    utf-8 EF tcl8       \u00EF        -1 {} {Missing trail byte}
    utf-8 EF replace    \uFFFD        -1 {} {Missing trail byte}
    utf-8 EF strict     {}             0 {} {Missing trail byte}
    utf-8 EF7F tcl8     \u00EF\u7F    -1 {} {First trail byte must be 80:BF}
    utf-8 EF7F replace  \uFFFD\u7F    -1 {} {First trail byte must be 80:BF}
    utf-8 EF7F strict   {}             0 {} {First trail byte must be 80:BF}
    utf-8 EFD0 tcl8     \u00EF\u00D0  -1 {} {First trail byte must be 80:BF}
    utf-8 EFD0 replace  \uFFFD\uFFFD  -1 {} {First trail byte must be 80:BF}
    utf-8 EFD0 strict   {}             0 {} {First trail byte must be 80:BF}
    utf-8 EF81 tcl8      \u00EF\u0081   -1 {} {Missing second trail byte}
    utf-8 EF81 replace   \uFFFD         -1 {knownW3C} {Missing second trail byte}
    utf-8 EF81 strict    {}              0 {} {Missing second trail byte}
    utf-8 EFBF tcl8      \u00EF\u00BF   -1 {} {Missing second trail byte}
    utf-8 EFBF replace   \uFFFD         -1 {knownW3C} {Missing second trail byte}
    utf-8 EFBF strict    {}              0 {} {Missing second trail byte}
    utf-8 EF807F tcl8      \u00EF\u20AC\x7F -1 {} {Second trail byte must be 80:BF}
    utf-8 EF807F replace   \uFFFD\u7F       -1 {knownW3C} {Second trail byte must be 80:BF}
    utf-8 EF807F strict    {}                0 {}  {Second trail byte must be 80:BF}
    utf-8 EFBF7F tcl8      \u00EF\u00BF\x7F -1 {} {Second trail byte must be 80:BF}
    utf-8 EFBF7F replace   \uFFFD\u7F       -1 {knownW3C} {Second trail byte must be 80:BF}
    utf-8 EFBF7F strict    {}                0 {}  {Second trail byte must be 80:BF}

    utf-8 F0 tcl8       \u00F0        -1 {} {Missing trail byte}
    utf-8 F0 replace    \uFFFD        -1 {} {Missing trail byte}
    utf-8 F0 strict     {}             0 {} {Missing trail byte}
    utf-8 F080 tcl8     \u00F0\u20AC  -1 {} {First trail byte must be 90:BF}
    utf-8 F080 replace  \uFFFD        -1 {knownW3C} {First trail byte must be 90:BF}
    utf-8 F080 strict   {}             0 {} {First trail byte must be 90:BF}
    utf-8 F08F tcl8     \u00F0\u8F    -1 {} {First trail byte must be 90:BF}
    utf-8 F08F replace  \uFFFD        -1 {knownW3C} {First trail byte must be 90:BF}
    utf-8 F08F strict   {}             0 {} {First trail byte must be 90:BF}
    utf-8 F0D0 tcl8     \u00F0\u00D0  -1 {} {First trail byte must be 90:BF}
    utf-8 F0D0 replace  \uFFFD\uFFFD  -1 {} {First trail byte must be 90:BF}
    utf-8 F0D0 strict   {}             0 {} {First trail byte must be 90:BF}
    utf-8 F090 tcl8      \u00F0\u0090   -1 {} {Missing second trail byte}
    utf-8 F090 replace   \uFFFD         -1 {knownW3C} {Missing second trail byte}
    utf-8 F090 strict    {}              0 {} {Missing second trail byte}
    utf-8 F0BF tcl8      \u00F0\u00BF   -1 {} {Missing second trail byte}
    utf-8 F0BF replace   \uFFFD         -1 {knownW3C} {Missing second trail byte}
    utf-8 F0BF strict    {}              0 {} {Missing second trail byte}
    utf-8 F0907F tcl8      \u00F0\u0090\x7F -1 {} {Second trail byte must be 80:BF}
    utf-8 F0907F replace   \uFFFD\u7F       -1 {knownW3C} {Second trail byte must be 80:BF}
    utf-8 F0907F strict    {}                0 {}  {Second trail byte must be 80:BF}
    utf-8 F0BF7F tcl8      \u00F0\u00BF\x7F -1 {} {Second trail byte must be 80:BF}
    utf-8 F0BF7F replace   \uFFFD\u7F       -1 {knownW3C} {Second trail byte must be 80:BF}
    utf-8 F0BF7F strict    {}                0 {}  {Second trail byte must be 80:BF}
    utf-8 F090BF tcl8      \u00F0\u0090\u00BF   -1 {} {Missing third trail byte}
    utf-8 F090BF replace   \uFFFD         -1 {knownW3C} {Missing third trail byte}
    utf-8 F090BF strict    {}              0 {} {Missing third trail byte}
    utf-8 F0BF81 tcl8      \u00F0\u00BF\u0081   -1 {} {Missing third trail byte}
    utf-8 F0BF81 replace   \uFFFD         -1 {knownW3C} {Missing third trail byte}
    utf-8 F0BF81 strict    {}              0 {} {Missing third trail byte}
    utf-8 F0BF807F tcl8      \u00F0\u00BF\u20AC\x7F   -1 {} {Third trail byte must be 80:BF}
    utf-8 F0BF817F replace   \uFFFD\x7F           -1 {knownW3C} {Third trail byte must be 80:BF}
    utf-8 F0BF817F strict    {}              0 {} {Third trail byte must be 80:BF}
    utf-8 F090BFD0 tcl8      \u00F0\u0090\u00BF\u00D0   -1 {} {Third trail byte must be 80:BF}
    utf-8 F090BFD0 replace   \uFFFD         -1 {knownW3C} {Third trail byte must be 80:BF}
    utf-8 F090BFD0 strict    {}              0 {} {Third trail byte must be 80:BF}

    utf-8 F1 tcl8       \u00F1        -1 {} {Missing trail byte}
    utf-8 F1 replace    \uFFFD        -1 {} {Missing trail byte}
    utf-8 F1 strict     {}             0 {} {Missing trail byte}
    utf-8 F17F tcl8     \u00F1\u7F    -1 {} {First trail byte must be 80:BF}
    utf-8 F17F replace  \uFFFD        -1 {knownW3C} {First trail byte must be 80:BF}
    utf-8 F17F strict   {}             0 {} {First trail byte must be 80:BF}
    utf-8 F1D0 tcl8     \u00F1\u00D0  -1 {} {First trail byte must be 80:BF}
    utf-8 F1D0 replace  \uFFFD\uFFFD  -1 {} {First trail byte must be 80:BF}
    utf-8 F1D0 strict   {}             0 {} {First trail byte must be 80:BF}
    utf-8 F180 tcl8      \u00F1\u20AC   -1 {} {Missing second trail byte}
    utf-8 F180 replace   \uFFFD         -1 {knownW3C} {Missing second trail byte}
    utf-8 F180 strict    {}              0 {} {Missing second trail byte}
    utf-8 F1BF tcl8      \u00F1\u00BF   -1 {} {Missing second trail byte}
    utf-8 F1BF replace   \uFFFD         -1 {knownW3C} {Missing second trail byte}
    utf-8 F1BF strict    {}              0 {} {Missing second trail byte}
    utf-8 F1807F tcl8      \u00F1\u20AC\x7F -1 {} {Second trail byte must be 80:BF}
    utf-8 F1807F replace   \uFFFD\u7F       -1 {knownW3C} {Second trail byte must be 80:BF}
    utf-8 F1807F strict    {}                0 {}  {Second trail byte must be 80:BF}
    utf-8 F1BF7F tcl8      \u00F1\u00BF\x7F -1 {} {Second trail byte must be 80:BF}
    utf-8 F1BF7F replace   \uFFFD\u7F       -1 {knownW3C} {Second trail byte must be 80:BF}
    utf-8 F1BF7F strict    {}                0 {}  {Second trail byte must be 80:BF}
    utf-8 F180BF tcl8      \u00F1\u20AC\u00BF   -1 {} {Missing third trail byte}
    utf-8 F180BF replace   \uFFFD         -1 {knownW3C} {Missing third trail byte}
    utf-8 F180BF strict    {}              0 {} {Missing third trail byte}
    utf-8 F1BF81 tcl8      \u00F1\u00BF\u0081   -1 {} {Missing third trail byte}
    utf-8 F1BF81 replace   \uFFFD         -1 {knownW3C} {Missing third trail byte}
    utf-8 F1BF81 strict    {}              0 {} {Missing third trail byte}
    utf-8 F1BF807F tcl8      \u00F1\u00BF\u20AC\x7F   -1 {} {Third trail byte must be 80:BF}
    utf-8 F1BF817F replace   \uFFFD\x7F           -1 {knownW3C} {Third trail byte must be 80:BF}
    utf-8 F1BF817F strict    {}              0 {} {Third trail byte must be 80:BF}
    utf-8 F180BFD0 tcl8      \u00F1\u20AC\u00BF\u00D0   -1 {} {Third trail byte must be 80:BF}
    utf-8 F180BFD0 replace   \uFFFD         -1 {knownW3C} {Third trail byte must be 80:BF}
    utf-8 F180BFD0 strict    {}              0 {} {Third trail byte must be 80:BF}
    utf-8 F3 tcl8       \u00F3        -1 {} {Missing trail byte}
    utf-8 F3 replace    \uFFFD        -1 {} {Missing trail byte}
    utf-8 F3 strict     {}             0 {} {Missing trail byte}
    utf-8 F37F tcl8     \u00F3\x7F    -1 {} {First trail byte must be 80:BF}
    utf-8 F37F replace  \uFFFD        -1 {knownW3C} {First trail byte must be 80:BF}
    utf-8 F37F strict   {}             0 {} {First trail byte must be 80:BF}
    utf-8 F3D0 tcl8     \u00F3\u00D0  -1 {} {First trail byte must be 80:BF}
    utf-8 F3D0 replace  \uFFFD\uFFFD  -1 {} {First trail byte must be 80:BF}
    utf-8 F3D0 strict   {}             0 {} {First trail byte must be 80:BF}
    utf-8 F380 tcl8      \u00F3\u20AC   -1 {} {Missing second trail byte}
    utf-8 F380 replace   \uFFFD         -1 {knownW3C} {Missing second trail byte}
    utf-8 F380 strict    {}              0 {} {Missing second trail byte}
    utf-8 F3BF tcl8      \u00F3\u00BF   -1 {} {Missing second trail byte}
    utf-8 F3BF replace   \uFFFD         -1 {knownW3C} {Missing second trail byte}
    utf-8 F3BF strict    {}              0 {} {Missing second trail byte}
    utf-8 F3807F tcl8      \u00F3\u20AC\x7F -1 {} {Second trail byte must be 80:BF}
    utf-8 F3807F replace   \uFFFD\u7F       -1 {knownW3C} {Second trail byte must be 80:BF}
    utf-8 F3807F strict    {}                0 {}  {Second trail byte must be 80:BF}
    utf-8 F3BF7F tcl8      \u00F3\u00BF\x7F -1 {} {Second trail byte must be 80:BF}
    utf-8 F3BF7F replace   \uFFFD\u7F       -1 {knownW3C} {Second trail byte must be 80:BF}
    utf-8 F3BF7F strict    {}                0 {}  {Second trail byte must be 80:BF}
    utf-8 F380BF tcl8      \u00F3\u20AC\u00BF   -1 {} {Missing third trail byte}
    utf-8 F380BF replace   \uFFFD         -1 {knownW3C} {Missing third trail byte}
    utf-8 F380BF strict    {}              0 {} {Missing third trail byte}
    utf-8 F3BF81 tcl8      \u00F3\u00BF\u0081   -1 {} {Missing third trail byte}
    utf-8 F3BF81 replace   \uFFFD         -1 {knownW3C} {Missing third trail byte}
    utf-8 F3BF81 strict    {}              0 {} {Missing third trail byte}
    utf-8 F3BF807F tcl8      \u00F3\u00BF\u20AC\x7F   -1 {} {Third trail byte must be 80:BF}
    utf-8 F3BF817F replace   \uFFFD\x7F           -1 {knownW3C} {Third trail byte must be 80:BF}
    utf-8 F3BF817F strict    {}              0 {} {Third trail byte must be 80:BF}
    utf-8 F380BFD0 tcl8      \u00F3\u20AC\u00BF\u00D0   -1 {} {Third trail byte must be 80:BF}
    utf-8 F380BFD0 replace   \uFFFD         -1 {knownW3C} {Third trail byte must be 80:BF}
    utf-8 F380BFD0 strict    {}              0 {} {Third trail byte must be 80:BF}

    utf-8 F4 tcl8       \u00F4        -1 {} {Missing trail byte}
    utf-8 F4 replace    \uFFFD        -1 {} {Missing trail byte}
    utf-8 F4 strict     {}             0 {} {Missing trail byte}
    utf-8 F47F tcl8     \u00F4\u7F    -1 {} {First trail byte must be 80:8F}
    utf-8 F47F replace  \uFFFD\u7F    -1 {knownW3C} {First trail byte must be 80:8F}
    utf-8 F47F strict   {}             0 {} {First trail byte must be 80:8F}
    utf-8 F490 tcl8     \u00F4\u0090  -1 {} {First trail byte must be 80:8F}
    utf-8 F490 replace  \uFFFD\uFFFD  -1 {} {First trail byte must be 80:8F}
    utf-8 F490 strict   {}             0 {} {First trail byte must be 80:8F}
    utf-8 F480 tcl8      \u00F4\u20AC   -1 {} {Missing second trail byte}
    utf-8 F480 replace   \uFFFD         -1 {knownW3C} {Missing second trail byte}
    utf-8 F480 strict    {}              0 {} {Missing second trail byte}
    utf-8 F48F tcl8      \u00F4\u008F   -1 {} {Missing second trail byte}
    utf-8 F48F replace   \uFFFD         -1 {knownW3C} {Missing second trail byte}
    utf-8 F48F strict    {}              0 {} {Missing second trail byte}
    utf-8 F4807F tcl8      \u00F4\u20AC\x7F -1 {} {Second trail byte must be 80:BF}
    utf-8 F4807F replace   \uFFFD\u7F       -1 {knownW3C} {Second trail byte must be 80:BF}
    utf-8 F4807F strict    {}                0 {}  {Second trail byte must be 80:BF}
    utf-8 F48F7F tcl8      \u00F4\u008F\x7F -1 {} {Second trail byte must be 80:BF}
    utf-8 F48F7F replace   \uFFFD\u7F       -1 {knownW3C} {Second trail byte must be 80:BF}
    utf-8 F48F7F strict    {}                0 {}  {Second trail byte must be 80:BF}
    utf-8 F48081 tcl8      \u00F4\u20AC\u0081   -1 {} {Missing third trail byte}
    utf-8 F48081 replace   \uFFFD         -1 {knownW3C} {Missing third trail byte}
    utf-8 F48081 strict    {}              0 {} {Missing third trail byte}
    utf-8 F48F81 tcl8      \u00F4\u008F\u0081   -1 {} {Missing third trail byte}
    utf-8 F48F81 replace   \uFFFD         -1 {knownW3C} {Missing third trail byte}
    utf-8 F48F81 strict    {}              0 {} {Missing third trail byte}
    utf-8 F481817F tcl8      \u00F4\u0081\u0081\x7F   -1 {} {Third trail byte must be 80:BF}
    utf-8 F480817F replace   \uFFFD\x7F           -1 {knownW3C} {Third trail byte must be 80:BF}
    utf-8 F480817F strict    {}              0 {} {Third trail byte must be 80:BF}
    utf-8 F48FBFD0 tcl8      \u00F4\u008F\u00BF\u00D0   -1 {} {Third trail byte must be 80:BF}
    utf-8 F48FBFD0 replace   \uFFFD         -1 {knownW3C} {Third trail byte must be 80:BF}
    utf-8 F48FBFD0 strict    {}              0 {} {Third trail byte must be 80:BF}

    utf-8 F5 tcl8    \u00F5 -1 {} {F5:FF are invalid everywhere}
    utf-8 F5 replace \uFFFD -1 {} {F5:FF are invalid everywhere}
    utf-8 F5 strict  {}      0 {} {F5:FF are invalid everywhere}
    utf-8 FF tcl8    \u00FF -1 {} {F5:FF are invalid everywhere}
    utf-8 FF replace \uFFFD -1 {} {F5:FF are invalid everywhere}
    utf-8 FF strict  {}      0 {} {F5:FF are invalid everywhere}

    utf-8 C0AFE080BFF0818130 replace \uFFFD\uFFFD\uFFFD\uFFFD\uFFFD\uFFFD\uFFFD\uFFFD\x30 -1 {} {Unicode Table 3-8}
    utf-8 EDA080EDBFBFEDAF30 replace \uFFFD\uFFFD\uFFFD\uFFFD\uFFFD\uFFFD\uFFFD\uFFFD\x30 -1 {knownW3C} {Unicode Table 3-9}
    utf-8 F4919293FF4180BF30 replace \uFFFD\uFFFD\uFFFD\uFFFD\uFFFD\u0041\uFFFD\uFFFD\x30 -1 {} {Unicode Table 3-10}
    utf-8 E180E2F09192F1BF30 replace \uFFFD\uFFFD\uFFFD\uFFFD\x30                         -1 {knownW3C} {Unicode Table 3.11}
}

# utf16-le and utf16-be test cases. Note utf16 cases are automatically generated
# based on these depending on platform endianness. Note truncated tests can only
# happen when the sequence is at the end (including by itself) Thus {solo tail}
# in some cases.
lappend encInvalidBytes {*}{
    utf-16le 41      tcl8      \uFFFD -1 {solo tail} {Truncated}
    utf-16le 41      replace   \uFFFD -1 {solo tail} {Truncated}
    utf-16le 41      strict    {}      0 {solo tail} {Truncated}
    utf-16le 00D8    tcl8      \uD800 -1 {} {Missing low surrogate}
    utf-16le 00D8    replace   \uFFFD -1 {} {Missing low surrogate}
    utf-16le 00D8    strict    {}      0 {knownBug} {Missing low surrogate}
    utf-16le 00DC    tcl8      \uDC00 -1 {} {Missing high surrogate}
    utf-16le 00DC    replace   \uFFFD -1 {} {Missing high surrogate}
    utf-16le 00DC    strict    {}      0 {knownBug} {Missing high surrogate}

    utf-16be 41      tcl8      \uFFFD -1 {solo tail} {Truncated}
    utf-16be 41      replace   \uFFFD -1 {solo tail} {Truncated}
    utf-16be 41      strict    {}      0 {solo tail} {Truncated}
    utf-16be D800    tcl8      \uD800 -1 {} {Missing low surrogate}
    utf-16be D800    replace   \uFFFD -1 {knownBug} {Missing low surrogate}
    utf-16be D800    strict    {}      0 {knownBug} {Missing low surrogate}
    utf-16be DC00    tcl8      \uDC00 -1 {} {Missing high surrogate}
    utf-16be DC00    replace   \uFFFD -1 {knownBug} {Missing high surrogate}
    utf-16be DC00    strict    {}      0 {knownBug} {Missing high surrogate}
}

# utf32-le and utf32-be test cases. Note utf32 cases are automatically generated
# based on these depending on platform endianness. Note truncated tests can only
# happen when the sequence is at the end (including by itself) Thus {solo tail}
# in some cases.
lappend encInvalidBytes {*}{
    utf-32le 41      tcl8      \uFFFD  -1 {solo tail} {Truncated}
    utf-32le 41      replace   \uFFFD  -1 {solo} {Truncated}
    utf-32le 41      strict    {}   0 {solo tail} {Truncated}
    utf-32le 4100    tcl8      \uFFFD  -1 {solo tail} {Truncated}
    utf-32le 4100    replace   \uFFFD  -1 {solo} {Truncated}
    utf-32le 4100    strict    {}   0 {solo tail} {Truncated}
    utf-32le 410000  tcl8      \uFFFD  -1 {solo tail} {Truncated}
    utf-32le 410000  replace   \uFFFD  -1 {solo} {Truncated}
    utf-32le 410000  strict    {}       0 {solo tail} {Truncated}
    utf-32le 00D80000 tcl8     \uD800   -1 {} {High-surrogate}
    utf-32le 00D80000 replace  \uFFFD   -1 {} {High-surrogate}
    utf-32le 00D80000 strict   {}        0 {} {High-surrogate}
    utf-32le 00DC0000 tcl8     \uDC00   -1 {} {Low-surrogate}
    utf-32le 00DC0000 replace  \uFFFD   -1 {} {Low-surrogate}
    utf-32le 00DC0000 strict   {}        0 {} {Low-surrogate}
    utf-32le 00D8000000DC0000 tcl8 \uD800\uDC00    -1 {} {High-low-surrogate-pair}
    utf-32le 00D8000000DC0000 replace \uFFFD\uFFFD -1 {} {High-low-surrogate-pair}
    utf-32le 00D8000000DC0000 strict  {}            0 {} {High-low-surrogate-pair}
    utf-32le 00001100 tcl8 \uFFFD    -1 {} {Out of range}
    utf-32le 00001100 replace \uFFFD -1 {} {Out of range}
    utf-32le 00001100 strict {}       0 {} {Out of range}
    utf-32le FFFFFFFF tcl8 \uFFFD    -1 {} {Out of range}
    utf-32le FFFFFFFF replace \uFFFD -1 {} {Out of range}
    utf-32le FFFFFFFF strict {}       0 {} {Out of range}

    utf-32be 41      tcl8      \uFFFD  -1 {solo tail} {Truncated}
    utf-32be 41      replace   \uFFFD  -1 {solo tail} {Truncated}
    utf-32be 41      strict    {}       0 {solo tail} {Truncated}
    utf-32be 0041    tcl8      \uFFFD  -1 {solo tail} {Truncated}
    utf-32be 0041    replace   \uFFFD  -1 {solo} {Truncated}
    utf-32be 0041    strict    {}   0 {solo tail} {Truncated}
    utf-32be 000041  tcl8      \uFFFD  -1 {solo tail} {Truncated}
    utf-32be 000041  replace   \uFFFD  -1 {solo} {Truncated}
    utf-32be 000041  strict    {}       0 {solo tail} {Truncated}
    utf-32be 0000D800 tcl8     \uD800   -1 {} {High-surrogate}
    utf-32be 0000D800 replace  \uFFFD   -1 {} {High-surrogate}
    utf-32be 0000D800 strict   {}        0 {} {High-surrogate}
    utf-32be 0000DC00 tcl8     \uDC00   -1 {} {Low-surrogate}
    utf-32be 0000DC00 replace  \uFFFD   -1 {} {Low-surrogate}
    utf-32be 0000DC00 strict   {}        0 {} {Low-surrogate}
    utf-32be 0000D8000000DC00 tcl8 \uD800\uDC00    -1 {} {High-low-surrogate-pair}
    utf-32be 0000D8000000DC00 replace \uFFFD\uFFFD -1 {} {High-low-surrogate-pair}
    utf-32be 0000D8000000DC00 strict  {}            0 {} {High-low-surrogate-pair}
    utf-32be 00110000 tcl8 \uFFFD    -1 {} {Out of range}
    utf-32be 00110000 replace \uFFFD -1 {} {Out of range}
    utf-32be 00110000 strict {}       0 {} {Out of range}
    utf-32be FFFFFFFF tcl8 \uFFFD    -1 {} {Out of range}
    utf-32be FFFFFFFF replace \uFFFD -1 {} {Out of range}
    utf-32be FFFFFFFF strict {}       0 {} {Out of range}
}

# Strings that cannot be encoded for specific encoding / profiles
# <ENCODING STRING PROFILE EXPECTEDRESULT EXPECTEDFAILINDEX CTRL COMMENT>
# <ENCODING,STRING,PROFILE> should be unique for test ids to be unique.
# See earlier comments about CTRL field.
#
# Note utf-16, utf-32 missing because they are automatically
# generated based on le/be versions.
# TODO - out of range code point (note cannot be generated by \U notation)
lappend encUnencodableStrings {*}{
    ascii \u00e0 tcl8    3f -1 {} {unencodable}
    ascii \u00e0 strict  {}  0 {} {unencodable}

    iso8859-1 \u0141 tcl8    3f -1 {} unencodable
    iso8859-1 \u0141 strict  {}  0 {} unencodable

    utf-8 \uD800 tcl8    eda080 -1 {} High-surrogate
    utf-8 \uD800 strict  {}      0 {} High-surrogate
    utf-8 \uDC00 tcl8    edb080 -1 {} High-surrogate
    utf-8 \uDC00 strict  {}      0 {} High-surrogate
}


# The icuUcmTests.tcl is generated by the tools/ucm2tests.tcl script
# and generates test vectors for the above tables for various encodings
# based on ICU UCM files.
# TODO - commented out for now as generating a lot of mismatches.
# source [file join [file dirname [info script]] icuUcmTests.tcl]

Changes to tests/env.test.

12
13
14
15
16
17
18
19
20


21

22
23
24
25
26
27
28
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]


package require tcltests


# [exec] is required here to see the actual environment received by child
# processes.
proc getenv {} {
    global printenvScript
    catch {exec [interpreter] $printenvScript} out
    if {$out eq "child process exited abnormally"} {







|
|
>
>
|
>







12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

source [file join [file dirname [info script]] tcltests.tcl]

testConstraint utf8system [string equal [encoding system] utf-8]
if {[llength [auto_execok bash]]} {
    testConstraint haveBash 1
}

# [exec] is required here to see the actual environment received by child
# processes.
proc getenv {} {
    global printenvScript
    catch {exec [interpreter] $printenvScript} out
    if {$out eq "child process exited abnormally"} {
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
    getenv
} -cleanup { cleanup1
} -result {NAME1=test string
NAME2=more
XYZZY=garbage}

test env-2.5 {different encoding (wide chars)} -constraints {win exec} -setup {
    # be sure set of (unicode) environment occurs if single-byte encoding is used:
    encodingswitch cp1252
    # german (cp1252) and russian (cp1251) characters together encoded as utf-8:
    set val 2d2dc3a4c3b6c3bcc39f2dd182d0b5d181d1822d2d
    set env(XYZZY) [encoding convertfrom utf-8 [binary decode hex $val]]
    # now switch to utf-8 (to see correct values from test):
    encoding system utf-8
} -body {
    exec [interpreter] << [string map [list \$val $val] {
	encoding system utf-8; fconfigure stdout -encoding utf-8







|

|







222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
    getenv
} -cleanup { cleanup1
} -result {NAME1=test string
NAME2=more
XYZZY=garbage}

test env-2.5 {different encoding (wide chars)} -constraints {win exec} -setup {
    # be sure set of (Unicode) environment occurs if single-byte encoding is used:
    encodingswitch cp1252
    # German (cp1252) and Russian (cp1251) characters together encoded as utf-8:
    set val 2d2dc3a4c3b6c3bcc39f2dd182d0b5d181d1822d2d
    set env(XYZZY) [encoding convertfrom utf-8 [binary decode hex $val]]
    # now switch to utf-8 (to see correct values from test):
    encoding system utf-8
} -body {
    exec [interpreter] << [string map [list \$val $val] {
	encoding system utf-8; fconfigure stdout -encoding utf-8
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
} -cleanup cleanup1 -result a


test env-5.1 {
    corner cases - remove one elem at a time
} -setup setup1 -body {
    # When no environment variables exist, the env var will contain no
    # entries. The "array names" call synchs up the C-level environ array with
    # the Tcl level env array. Make sure an empty Tcl array is created.
    foreach e [array names env] {
	unset env($e)
    }
    array size env
} -cleanup cleanup1 -result 0








|







304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
} -cleanup cleanup1 -result a


test env-5.1 {
    corner cases - remove one elem at a time
} -setup setup1 -body {
    # When no environment variables exist, the env var will contain no
    # entries. The "array names" call syncs up the C-level environ array with
    # the Tcl level env array. Make sure an empty Tcl array is created.
    foreach e [array names env] {
	unset env($e)
    }
    array size env
} -cleanup cleanup1 -result 0

345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
} -result {a 1}


test env-5.4 {corner cases - unset the env array} -setup {
    setup1
    interp create i
} -body {
    # The info exists command should be in synch with the env array.
    # Know Bug: 1737
    i eval {set env(THIS_SHOULD_EXIST) a}
    set     result [info exists env(THIS_SHOULD_EXIST)]
    lappend result [set env(THIS_SHOULD_EXIST)]
    lappend result [info exists env(THIS_SHOULD_EXIST)]
} -cleanup {
    cleanup1







|







348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
} -result {a 1}


test env-5.4 {corner cases - unset the env array} -setup {
    setup1
    interp create i
} -body {
    # The info exists command should be in sync with the env array.
    # Know Bug: 1737
    i eval {set env(THIS_SHOULD_EXIST) a}
    set     result [info exists env(THIS_SHOULD_EXIST)]
    lappend result [set env(THIS_SHOULD_EXIST)]
    lappend result [info exists env(THIS_SHOULD_EXIST)]
} -cleanup {
    cleanup1
505
506
507
508
509
510
511
















512
513
514
515
516
517
518
    flush $pipe
    set result [gets $pipe]
    close $pipe
    if {$result ne $::env(USERPROFILE)} {
	list ERROR $result ne $::env(USERPROFILE)
    }
} -result {}



















# cleanup
rename getenv {}
rename envrestore {}
rename envprep {}







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







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
    flush $pipe
    set result [gets $pipe]
    close $pipe
    if {$result ne $::env(USERPROFILE)} {
	list ERROR $result ne $::env(USERPROFILE)
    }
} -result {}

test env-10.0 {
    Unequal environment strings test should test unequal
} -constraints {unix haveBash utf8system knownBug} -setup {
    set tclScript [makeFile {
        puts [string equal $env(XX) $env(YY)]
    } tclScript]
    set shellCode {
        export XX=$'\351'
        export YY=$'\303\251'
    }
    append shellCode "[info nameofexecutable] $tclScript\n"
    set shScript [makeFile $shellCode shScript]
} -body {
    exec {*}[auto_execok bash] $shScript
} -result 0



# cleanup
rename getenv {}
rename envrestore {}
rename envprep {}

Changes to tests/error.test.

920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
	} finally {
	    throw BAR baz
	}
    }
    list $em [dict get $opts -errorcode]
} {bar FOO}

# try tests - fallthough body cases

test error-19.1 {try with fallthrough body #1} {
    set RES {}
    try { list a b c } on ok { set RES 0 } - on error {} { set RES 1 }
    set RES
} {1}
test error-19.2 {try with fallthrough body #2} {







|







920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
	} finally {
	    throw BAR baz
	}
    }
    list $em [dict get $opts -errorcode]
} {bar FOO}

# try tests - fall-through body cases

test error-19.1 {try with fallthrough body #1} {
    set RES {}
    try { list a b c } on ok { set RES 0 } - on error {} { set RES 1 }
    set RES
} {1}
test error-19.2 {try with fallthrough body #2} {

Changes to tests/eval.test.

60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
    eval [list list 1 2 3 4 5]
} {1 2 3 4 5}
test eval-3.2 {concatenating eval and pure lists} {
    eval [list list 1] [list 2 3 4 5]
} {1 2 3 4 5}
test eval-3.3 {eval and canonical lists} {
    set cmd [list list 1 2 3 4 5]
    # Force existance of utf-8 rep
    set dummy($cmd) $cmd
    unset dummy
    eval $cmd
} {1 2 3 4 5}
test eval-3.4 {concatenating eval and canonical lists} {
    set cmd  [list list 1]
    set cmd2 [list 2 3 4 5]
    # Force existance of utf-8 rep
    set dummy($cmd) $cmd
    set dummy($cmd2) $cmd2
    unset dummy
    eval $cmd $cmd2
} {1 2 3 4 5}

# cleanup







|







|







60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
    eval [list list 1 2 3 4 5]
} {1 2 3 4 5}
test eval-3.2 {concatenating eval and pure lists} {
    eval [list list 1] [list 2 3 4 5]
} {1 2 3 4 5}
test eval-3.3 {eval and canonical lists} {
    set cmd [list list 1 2 3 4 5]
    # Force existence of utf-8 rep
    set dummy($cmd) $cmd
    unset dummy
    eval $cmd
} {1 2 3 4 5}
test eval-3.4 {concatenating eval and canonical lists} {
    set cmd  [list list 1]
    set cmd2 [list 2 3 4 5]
    # Force existence of utf-8 rep
    set dummy($cmd) $cmd
    set dummy($cmd2) $cmd2
    unset dummy
    eval $cmd $cmd2
} {1 2 3 4 5}

# cleanup

Changes to tests/event.test.

423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
    while executing
"error foo"
    ("after" script)
}

# someday : add a test checking that when there is no bgerror, an error msg
# goes to stderr ideally one would use sub interp and transfer a fake stderr
# to it, unfortunatly the current interp tcl API does not allow that. The
# other option would be to use fork a test but it then becomes more a
# file/exec test than a bgerror test.

# end of bgerror tests
catch {rename bgerror {}}

test event-8.1 {Tcl_CreateExitHandler procedure} {stdio testexithandler} {







|







423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
    while executing
"error foo"
    ("after" script)
}

# someday : add a test checking that when there is no bgerror, an error msg
# goes to stderr ideally one would use sub interp and transfer a fake stderr
# to it, unfortunately the current interp tcl API does not allow that. The
# other option would be to use fork a test but it then becomes more a
# file/exec test than a bgerror test.

# end of bgerror tests
catch {rename bgerror {}}

test event-8.1 {Tcl_CreateExitHandler procedure} {stdio testexithandler} {

Changes to tests/exec.test.

14
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
# There is no point in running Valgrind on cases where [exec] forks but then
# fails and the child process doesn't go through full cleanup.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]
package require tcltests

# All tests require the "exec" command.
# Skip them if exec is not defined.
testConstraint exec [llength [info commands exec]]
# Some skips when running in a macOS CI environment
testConstraint noosxCI [expr {![info exists ::env(MAC_CI)]}]

unset -nocomplain path

# Utilities that are like bourne shell stalwarts, but cross-platform.
set path(echo) [makeFile {
    puts -nonewline [lindex $argv 0]
    foreach str [lrange $argv 1 end] {
	puts -nonewline " $str"
    }
    puts {}
    exit







|
<
<
<

<
<
<





|







14
15
16
17
18
19
20
21



22



23
24
25
26
27
28
29
30
31
32
33
34
35
# 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::*
}
source [file join [file dirname [info script]] tcltests.tcl]







# Some skips when running in a macOS CI environment
testConstraint noosxCI [expr {![info exists ::env(MAC_CI)]}]

unset -nocomplain path

# Utilities that are like Bourne shell stalwarts, but cross-platform.
set path(echo) [makeFile {
    puts -nonewline [lindex $argv 0]
    foreach str [lrange $argv 1 end] {
	puts -nonewline " $str"
    }
    puts {}
    exit
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
test exec-10.19 {errors in exec invocation} -constraints {exec} -body {
    exec cat >@ $f
} -returnCodes error -result "channel \"$f\" wasn't opened for writing"
close $f
test exec-10.20.1 {errors in exec invocation} -constraints {unix exec notValgrind} -body {
    exec ~non_existent_user/foo/bar
} -returnCodes error -result {couldn't execute "~non_existent_user/foo/bar": no such file or directory}
test exec-10.20.1 {errors in exec invocation} -constraints {win exec notValgrind} -body {
    exec ~non_existent_user/foo/bar
} -returnCodes error -result {couldn't execute "~non_existent_user\foo\bar": no such file or directory}
test exec-10.21.1 {errors in exec invocation} -constraints {unix exec notValgrind} -body {
    exec [interpreter] true | ~xyzzy_bad_user/x | false
} -returnCodes error -result {couldn't execute "~xyzzy_bad_user/x": no such file or directory}
test exec-10.21.2 {errors in exec invocation} -constraints {win exec notValgrind} -body {
    exec [interpreter] true | ~xyzzy_bad_user/x | false







|







433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
test exec-10.19 {errors in exec invocation} -constraints {exec} -body {
    exec cat >@ $f
} -returnCodes error -result "channel \"$f\" wasn't opened for writing"
close $f
test exec-10.20.1 {errors in exec invocation} -constraints {unix exec notValgrind} -body {
    exec ~non_existent_user/foo/bar
} -returnCodes error -result {couldn't execute "~non_existent_user/foo/bar": no such file or directory}
test exec-10.20.2 {errors in exec invocation} -constraints {win exec notValgrind} -body {
    exec ~non_existent_user/foo/bar
} -returnCodes error -result {couldn't execute "~non_existent_user\foo\bar": no such file or directory}
test exec-10.21.1 {errors in exec invocation} -constraints {unix exec notValgrind} -body {
    exec [interpreter] true | ~xyzzy_bad_user/x | false
} -returnCodes error -result {couldn't execute "~xyzzy_bad_user/x": no such file or directory}
test exec-10.21.2 {errors in exec invocation} -constraints {win exec notValgrind} -body {
    exec [interpreter] true | ~xyzzy_bad_user/x | false

Changes to tests/execute.test.

30
31
32
33
34
35
36
37
38
39
40
41
42
43
44

testConstraint testobj [expr {
    [llength [info commands testobj]]
    && [llength [info commands testdoubleobj]]
    && [llength [info commands teststringobj]]
}]

testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
testConstraint testexprlongobj [llength [info commands testexprlongobj]]


if {[namespace which -command testbumpinterpepoch] eq ""} {
  proc testbumpinterpepoch {} { rename ::set ::dummy; rename ::dummy ::set }
}








<







30
31
32
33
34
35
36

37
38
39
40
41
42
43

testConstraint testobj [expr {
    [llength [info commands testobj]]
    && [llength [info commands testdoubleobj]]
    && [llength [info commands teststringobj]]
}]


testConstraint testexprlongobj [llength [info commands testexprlongobj]]


if {[namespace which -command testbumpinterpepoch] eq ""} {
  proc testbumpinterpepoch {} { rename ::set ::dummy; rename ::dummy ::set }
}

Changes to tests/expr-old.test.

21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testexprlong   [llength [info commands testexprlong]]
testConstraint testexprdouble [llength [info commands testexprdouble]]
testConstraint testexprstring [llength [info commands testexprstring]]
testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}]

# Big test for correct ordering of data in [expr]

proc testIEEE {} {
    variable ieeeValues
    binary scan [binary format dd -1.0 1.0] c* c
    switch -exact -- $c {







<







21
22
23
24
25
26
27

28
29
30
31
32
33
34
::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testexprlong   [llength [info commands testexprlong]]
testConstraint testexprdouble [llength [info commands testexprdouble]]
testConstraint testexprstring [llength [info commands testexprstring]]
testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]


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

Changes to tests/expr.test.

17
18
19
20
21
22
23
24
25
26
27
28
29
30
31

::tcltest::loadTestedCommands

# Determine if "long int" type is a 32 bit number and if the wide
# type is a 64 bit number on this machine.

testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}]
testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}]

# Big test for correct ordering of data in [expr]

proc testIEEE {} {
    variable ieeeValues
    binary scan [binary format dd -1.0 1.0] c* c







<







17
18
19
20
21
22
23

24
25
26
27
28
29
30

::tcltest::loadTestedCommands

# Determine if "long int" type is a 32 bit number and if the wide
# type is a 64 bit number on this machine.

testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]

testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}]

# Big test for correct ordering of data in [expr]

proc testIEEE {} {
    variable ieeeValues
    binary scan [binary format dd -1.0 1.0] c* c
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
       upvar 1 $name var
       if {[incr counter] % 2 == 1} {
           set var "$counter oops [concat $extraargs]"
       } else {
           set var "$counter + [concat $extraargs]"
       }
    }
    trace variable exprtracevar r [list exprtraceproc 10]
    list [catch {expr "$exprtracevar + 20"} a] $a \
        [catch {expr "$exprtracevar + 20"} b] $b \
        [unset exprtracevar exprtracecounter]
} -match glob -result {1 * 0 32 {}}
test expr-20.3 {broken substitution of integer digits} {
    # fails with 8.0.x, but not 8.1b2
    list [set a 000; expr 0x1$a] [set a 1; expr ${a}000]







|







773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
       upvar 1 $name var
       if {[incr counter] % 2 == 1} {
           set var "$counter oops [concat $extraargs]"
       } else {
           set var "$counter + [concat $extraargs]"
       }
    }
    trace add variable exprtracevar read [list exprtraceproc 10]
    list [catch {expr "$exprtracevar + 20"} a] $a \
        [catch {expr "$exprtracevar + 20"} b] $b \
        [unset exprtracevar exprtracecounter]
} -match glob -result {1 * 0 32 {}}
test expr-20.3 {broken substitution of integer digits} {
    # fails with 8.0.x, but not 8.1b2
    list [set a 000; expr 0x1$a] [set a 1; expr ${a}000]
7446
7447
7448
7449
7450
7451
7452
7453








































7454
7455
7456
7457

7458
7459
7460
7461
7462
7463
    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:







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




>






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
    expr {max(# comment
	      1,2)}
} 2
test expr-62.10 {TIP 582: comments can go inside function calls} {
    expr {max# comment
	     (1,2)}
} 2

# Bug e3dcab1d14 TODO: Need to work out a test case that fails
# without tcl_precision, which has been eliminated in 9.0

# proc do-one-test-expr-63 {e p float athreshold} {
#     # e - power of 2 to test
#     # p - tcl_precision to test wuth
#     # float - floating point value 2**-$p
#     # athreshold - tolerable absolute error (1/2 decimal digit in
#     #              least significant place plus 1/2 least significant bit)
#     set trouble {}
#     set ::tcl_precision $p
#     set xfmt x[expr $float]
#     set ::tcl_precision 0
#     set fmt [string range $xfmt 1 end]
#     set aerror [expr {abs($fmt - $float)}]
#     if {$aerror > $athreshold} {
#         return "Result $fmt is more than $athreshold away from $float"
#     } else {
#         return {}
#     }
# }

# proc run-test-expr-63 {} {
#     for {set e 0} {$e <= 1023} {incr e} {
#         set pt [expr {floor($e*log(2)/log(10))}]
#         for {set p 6} {$p <= 17} {incr p} {
#             set athreshold [expr {0.5*10.0**-($pt+$p) + 2.0**-($e+53)}]
#             set numer [expr {5**$e}]
#             set xfloat x[expr {2.**-$e}]
#             set float [string range $xfloat 1 end]
#             test expr-63.$p.$e "convert 2**-$e to decimal at precision $p" {
#                 do-one-test-expr-63 $e $p $float $athreshold
#             } {}
#         }
#     }
#     rename do-one-test-expr-63 {}
#     rename run-test-expr-63 {}
# }
# run-test-expr-63

# cleanup
unset -nocomplain a
unset -nocomplain min
unset -nocomplain max

::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/fCmd.test.

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
testConstraint testsetplatform [llength [info commands testsetplatform]]
testConstraint testchmod [llength [info commands testchmod]]
testConstraint winLessThan10 0
# Don't know how to determine this constraint correctly
testConstraint notNetworkFilesystem 0
testConstraint reg 0
if {[testConstraint win]} {
    catch {
	# Is the registry extension already static to this shell?
	try {
	    load {} Registry
	    set ::reglib {}
	} on error {} {
	    # try the location given to use on the commandline to tcltest
	    ::tcltest::loadTestedCommands
	    load $::reglib Registry
	}
	testConstraint reg 1


    }
}

testConstraint notInCIenv [expr {![info exists ::env(CI)] || !$::env(CI)}]




set tmpspace /tmp;# default value
# Find a group that exists on this Unix system, or else skip tests that
# require Unix groups.
testConstraint foundGroup [expr {![testConstraint unix]}]
if {[testConstraint unix]} {
    catch {







|










>
>


>

>
>
>







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
testConstraint testsetplatform [llength [info commands testsetplatform]]
testConstraint testchmod [llength [info commands testchmod]]
testConstraint winLessThan10 0
# Don't know how to determine this constraint correctly
testConstraint notNetworkFilesystem 0
testConstraint reg 0
if {[testConstraint win]} {
    if {[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
    } regError]} {
        catch {package require registry; testConstraint reg 1}
    }
}

testConstraint notInCIenv [expr {![info exists ::env(CI)] || !$::env(CI)}]

# File permissions broken on wsl without some "exotic" wsl configuration
testConstraint notWsl [expr {[llength [array names ::env *WSL*]] == 0}]

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 {
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
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
set user {}
if {[testConstraint unix]} {
    catch {
	set user [exec whoami]
    }
    if {$user eq ""} {
	catch {







|







83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
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
set user {}
if {[testConstraint unix]} {
    catch {
	set user [exec whoami]
    }
    if {$user eq ""} {
	catch {
100
101
102
103
104
105
106







































107
108
109
110
111
112
113
    catch {
        set user $::env(USERNAME)
    }
    if {$user eq ""} {
        set user Administrator
    }
}








































proc createfile {file {string a}} {
    set f [open $file w]
    puts -nonewline $f $string
    close $f
    return $string
}







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







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
    catch {
        set user $::env(USERNAME)
    }
    if {$user eq ""} {
        set user Administrator
    }
}

# Try getting a lower case glob pattern that will match the home directory of
# a given user to test ~user and [file tildeexpand ~user]. Note this may not
# be the same as ~ even when "user" is current user. For example, on Unix
# platforms ~ will return HOME envvar, but ~user will lookup password file
# bypassing HOME. If home directory not found, returns *$user* so caller can
# succeed by using glob matching under the hope that the path contains
# the user name.
proc gethomedirglob {user} {
    if {[testConstraint unix]} {
        if {![catch {
            exec {*}[auto_execok sh] -c "echo ~$user"
        } home]} {
            set home [string trim $home]
            if {$home ne ""} {
                # Expect exact match (except case), no glob * added
                return [string tolower $home]
            }
        }
    } elseif {[testConstraint reg]} {
        # Windows with registry extension loaded
        if {![catch {
            set sid [exec {*}[auto_execok powershell] -Command "(Get-LocalUser -Name '$user')\[0\].sid.Value"]
            set sid [string trim $sid]
            # Get path from the Windows registry
            set home [registry get "HKEY_LOCAL_MACHINE\\Software\\Microsoft\\Windows NT\\CurrentVersion\\ProfileList\\$sid" ProfileImagePath]
            set home [string trim [string tolower $home]]
        } result]} {
            if {$home ne ""} {
                # file join for \ -> /
                return [file join [string tolower $home]]
            }
        }
    }

    # Caller will need to use glob matching and hope user
    # name is in the home directory path
    return *[string tolower $user]*
}

proc createfile {file {string a}} {
    set f [open $file w]
    puts -nonewline $f $string
    close $f
    return $string
}
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
    file rename ~_totally_bogus_user td1
} -result {error renaming "~_totally_bogus_user": no such file or directory}
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
} -constraints {notRoot} -returnCodes error -body {
    createfile tf1
    createfile tf2
    createfile tf3
    createfile tf4
    file mkdir td1
    createfile [file join td1 tf3]
    file rename tf1 tf2 tf3 tf4 td1
} -result [subst {error renaming "tf3" to "[file join td1 tf3]": file already exists}]

test fCmd-4.1 {TclFileMakeDirsCmd: make each dir: 1 dir} -setup {
    cleanup
} -constraints {notRoot} -body {
    file mkdir td1
    glob td*
} -result {td1}







|










|







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
    file rename ~_totally_bogus_user td1
} -result {error renaming "~_totally_bogus_user": no such file or directory}
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 exists}
test fCmd-3.16 {FileCopyRename: break on first error} -setup {
    cleanup
} -constraints {notRoot} -returnCodes error -body {
    createfile tf1
    createfile tf2
    createfile tf3
    createfile tf4
    file mkdir td1
    createfile [file join td1 tf3]
    file rename tf1 tf2 tf3 tf4 td1
} -result [subst {error renaming "tf3" to "[file join td1 tf3]": file exists}]

test fCmd-4.1 {TclFileMakeDirsCmd: make each dir: 1 dir} -setup {
    cleanup
} -constraints {notRoot} -body {
    file mkdir td1
    glob td*
} -result {td1}
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
    list $x [file exists td1]
} -result {1 1}
test fCmd-4.9 {TclFileMakeDirsCmd: exists, not dir} -setup {
    cleanup
} -constraints {notRoot} -returnCodes error -body {
    createfile tf1
    file mkdir tf1
} -result [subst {can't create directory "[file join tf1]": file already exists}]
test fCmd-4.10 {TclFileMakeDirsCmd: exists, is dir} -setup {
    cleanup
} -constraints {notRoot} -body {
    file mkdir td1
    set x [file exists td1]
    file mkdir td1
    list $x [file exists td1]
} -result {1 1}
test fCmd-4.11 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} -setup {
    cleanup
} -constraints {unix notRoot testchmod} -returnCodes error -body {
    file mkdir td1/td2/td3
    testchmod 0 td1/td2
    file mkdir td1/td2/td3/td4
} -cleanup {
    testchmod 0o755 td1/td2
    cleanup
} -result {can't create directory "td1/td2/td3": permission denied}
test fCmd-4.13 {TclFileMakeDirsCmd: doesn't exist: errno == ENOENT} -setup {
    cleanup
} -constraints {notRoot} -body {
    set x [file exists td1]
    file mkdir td1
    list $x [file exists td1]
} -result {0 1}
test fCmd-4.14 {TclFileMakeDirsCmd: TclpCreateDirectory fails} -setup {
    cleanup
    file delete -force foo
} -constraints {unix notRoot} -body {
    file mkdir foo
    file attr foo -perm 0o40000
    file mkdir foo/tf1
} -returnCodes error -cleanup {
    file delete -force foo
} -result {can't create directory "foo/tf1": permission denied}
test fCmd-4.16 {TclFileMakeDirsCmd: TclpCreateDirectory succeeds} -setup {
    cleanup
} -constraints {notRoot} -body {
    file mkdir tf1
    file exists tf1
} -result {1}

test fCmd-5.1 {TclFileDeleteCmd: FileForceOption fails} -constraints {notRoot} -body {
    file delete -xyz
} -returnCodes error -result {bad option "-xyz": must be -force or --}
test fCmd-5.2 {TclFileDeleteCmd: accept 0 files (TIP 323)} -body {
    file delete -force -force
} -result {}







|










|

















|











|







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
    list $x [file exists td1]
} -result {1 1}
test fCmd-4.9 {TclFileMakeDirsCmd: exists, not dir} -setup {
    cleanup
} -constraints {notRoot} -returnCodes error -body {
    createfile tf1
    file mkdir tf1
} -result [subst {can't create directory "[file join tf1]": file exists}]
test fCmd-4.10 {TclFileMakeDirsCmd: exists, is dir} -setup {
    cleanup
} -constraints {notRoot} -body {
    file mkdir td1
    set x [file exists td1]
    file mkdir td1
    list $x [file exists td1]
} -result {1 1}
test fCmd-4.11 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} -setup {
    cleanup
} -constraints {unix notRoot testchmod notWsl} -returnCodes error -body {
    file mkdir td1/td2/td3
    testchmod 0 td1/td2
    file mkdir td1/td2/td3/td4
} -cleanup {
    testchmod 0o755 td1/td2
    cleanup
} -result {can't create directory "td1/td2/td3": permission denied}
test fCmd-4.13 {TclFileMakeDirsCmd: doesn't exist: errno == ENOENT} -setup {
    cleanup
} -constraints {notRoot} -body {
    set x [file exists td1]
    file mkdir td1
    list $x [file exists td1]
} -result {0 1}
test fCmd-4.14 {TclFileMakeDirsCmd: TclpCreateDirectory fails} -setup {
    cleanup
    file delete -force foo
} -constraints {unix notRoot notWsl} -body {
    file mkdir foo
    file attr foo -perm 0o40000
    file mkdir foo/tf1
} -returnCodes error -cleanup {
    file delete -force foo
} -result {can't create directory "foo/tf1": permission denied}
test fCmd-4.16 {TclFileMakeDirsCmd: TclpCreateDirectory succeeds} -setup {
    cleanup
} -constraints {notRoot} -body {
    file mkdir tf1
    file exists tf1
} -result 1

test fCmd-5.1 {TclFileDeleteCmd: FileForceOption fails} -constraints {notRoot} -body {
    file delete -xyz
} -returnCodes error -result {bad option "-xyz": must be -force or --}
test fCmd-5.2 {TclFileDeleteCmd: accept 0 files (TIP 323)} -body {
    file delete -force -force
} -result {}
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
} -constraints {notRoot} -body {
    createfile tf1
    file rename tf1 tf2
    glob tf*
} -result {tf2}
test fCmd-6.6 {CopyRenameOneFile: errno != ENOENT} -setup {
    cleanup
} -constraints {unix notRoot testchmod} -body {
    file mkdir td1
    testchmod 0 td1
    createfile tf1
    file rename tf1 td1
} -returnCodes error -cleanup {
    testchmod 0o755 td1
} -result {error renaming "tf1" to "td1/tf1": permission denied}
test fCmd-6.9 {CopyRenameOneFile: errno == ENOENT} -setup {
    cleanup
} -constraints {unix notRoot} -body {
    createfile tf1
    file rename tf1 tf2
    glob tf*
} -result {tf2}
test fCmd-6.10 {CopyRenameOneFile: lstat(target) == 0} -setup {
    cleanup
} -constraints {notRoot} -returnCodes error -body {
    createfile tf1
    createfile tf2
    file rename tf1 tf2
} -result {error renaming "tf1" to "tf2": file already exists}
test fCmd-6.11 {CopyRenameOneFile: force == 0} -setup {
    cleanup
} -constraints {notRoot} -returnCodes error -body {
    createfile tf1
    createfile tf2
    file rename tf1 tf2
} -result {error renaming "tf1" to "tf2": file already exists}
test fCmd-6.12 {CopyRenameOneFile: force != 0} -setup {
    cleanup
} -constraints {notRoot} -body {
    createfile tf1
    createfile tf2
    file rename -force tf1 tf2
    glob tf*







|




















|






|







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
} -constraints {notRoot} -body {
    createfile tf1
    file rename tf1 tf2
    glob tf*
} -result {tf2}
test fCmd-6.6 {CopyRenameOneFile: errno != ENOENT} -setup {
    cleanup
} -constraints {unix notRoot testchmod notWsl} -body {
    file mkdir td1
    testchmod 0 td1
    createfile tf1
    file rename tf1 td1
} -returnCodes error -cleanup {
    testchmod 0o755 td1
} -result {error renaming "tf1" to "td1/tf1": permission denied}
test fCmd-6.9 {CopyRenameOneFile: errno == ENOENT} -setup {
    cleanup
} -constraints {unix notRoot} -body {
    createfile tf1
    file rename tf1 tf2
    glob tf*
} -result {tf2}
test fCmd-6.10 {CopyRenameOneFile: lstat(target) == 0} -setup {
    cleanup
} -constraints {notRoot} -returnCodes error -body {
    createfile tf1
    createfile tf2
    file rename tf1 tf2
} -result {error renaming "tf1" to "tf2": file exists}
test fCmd-6.11 {CopyRenameOneFile: force == 0} -setup {
    cleanup
} -constraints {notRoot} -returnCodes error -body {
    createfile tf1
    createfile tf2
    file rename tf1 tf2
} -result {error renaming "tf1" to "tf2": file exists}
test fCmd-6.12 {CopyRenameOneFile: force != 0} -setup {
    cleanup
} -constraints {notRoot} -body {
    createfile tf1
    createfile tf2
    file rename -force tf1 tf2
    glob tf*
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
} -constraints {unix notRoot} -body {
    createfile tf1
    file rename tf1 $tmpspace
    glob -nocomplain tf* [file join $tmpspace tf*]
} -result [file join $tmpspace tf1]
test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} -setup {
    cleanup $tmpspace
} -constraints {xdev notRoot} -body {
    file mkdir td1/td2/td3
    file attributes td1 -permissions 0
    file rename td1 $tmpspace
} -returnCodes error -cleanup {
    file attributes td1 -permissions 0o755
    cleanup
} -match regexp -result {^error renaming "td1"( to "/tmp/tcl\d+/td1")?: permission denied$}







|







753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
} -constraints {unix notRoot} -body {
    createfile tf1
    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 notWsl} -body {
    file mkdir td1/td2/td3
    file attributes td1 -permissions 0
    file rename td1 $tmpspace
} -returnCodes error -cleanup {
    file attributes td1 -permissions 0o755
    cleanup
} -match regexp -result {^error renaming "td1"( to "/tmp/tcl\d+/td1")?: permission denied$}
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
test fCmd-6.27 {CopyRenameOneFile: TclpCopyDirectory failed} -setup {
    cleanup $tmpspace
} -constraints {notRoot xdev} -returnCodes error -body {
    file mkdir td1/td2/td3
    file mkdir [file join $tmpspace td1]
    createfile [file join $tmpspace td1 tf1]
    file rename -force td1 $tmpspace
} -match glob -result {error renaming "td1" to "/tmp/tcl*/td1": file already exists}
test fCmd-6.28 {CopyRenameOneFile: TclpCopyDirectory failed} -setup {
    cleanup $tmpspace
} -constraints {notRoot xdev} -body {
    file mkdir td1/td2/td3
    file attributes td1/td2/td3 -permissions 0
    file rename td1 $tmpspace
} -returnCodes error -cleanup {
    file attributes td1/td2/td3 -permissions 0o755
    cleanup $tmpspace
} -match glob -result {error renaming "td1" to "/tmp/tcl*/td1": "td1/td2/td3": permission denied}
test fCmd-6.29 {CopyRenameOneFile: TclpCopyDirectory passed} -setup {
    cleanup $tmpspace
} -constraints {notRoot xdev} -body {
    file mkdir td1/td2/td3
    file rename td1 $tmpspace
    glob td* [file join $tmpspace td1 t*]
} -result [file join $tmpspace td1 td2]
test fCmd-6.30 {CopyRenameOneFile: TclpRemoveDirectory failed} -setup {
    cleanup $tmpspace
} -constraints {unix notRoot} -body {
    file mkdir foo/bar
    file attr foo -perm 0o40555
    file rename foo/bar $tmpspace
} -returnCodes error -cleanup {
    catch {file delete [file join $tmpspace bar]}
    catch {file attr foo -perm 0o40777}
    catch {file delete -force foo}







|


|
















|







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
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 exists}
test fCmd-6.28 {CopyRenameOneFile: TclpCopyDirectory failed} -setup {
    cleanup $tmpspace
} -constraints {notRoot xdev notWsl} -body {
    file mkdir td1/td2/td3
    file attributes td1/td2/td3 -permissions 0
    file rename td1 $tmpspace
} -returnCodes error -cleanup {
    file attributes td1/td2/td3 -permissions 0o755
    cleanup $tmpspace
} -match glob -result {error renaming "td1" to "/tmp/tcl*/td1": "td1/td2/td3": permission denied}
test fCmd-6.29 {CopyRenameOneFile: TclpCopyDirectory passed} -setup {
    cleanup $tmpspace
} -constraints {notRoot xdev} -body {
    file mkdir td1/td2/td3
    file rename td1 $tmpspace
    glob td* [file join $tmpspace td1 t*]
} -result [file join $tmpspace td1 td2]
test fCmd-6.30 {CopyRenameOneFile: TclpRemoveDirectory failed} -setup {
    cleanup $tmpspace
} -constraints {unix notRoot notWsl} -body {
    file mkdir foo/bar
    file attr foo -perm 0o40555
    file rename foo/bar $tmpspace
} -returnCodes error -cleanup {
    catch {file delete [file join $tmpspace bar]}
    catch {file attr foo -perm 0o40777}
    catch {file delete -force foo}
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
    createfile -force
    file delete -force -force -- -- -force
    glob -- -- -force
} -result {}

test fCmd-8.1 {FileBasename: basename of ~user: argc == 1 && *path == ~} \
    -constraints {unix notRoot knownBug tildeexpansion} -body {
    # Labelled knownBug because it is dangerous [Bug: 3881]
    file mkdir td1
    file attr td1 -perm 0o40000
    file rename ~$user td1
} -returnCodes error -cleanup {
    file delete -force td1
} -result "error renaming \"~$user\" to \"td1/[file tail ~$user]\": permission denied"
test fCmd-8.2 {FileBasename: basename of ~user: argc == 1 && *path == ~} \
	-constraints {unix notRoot} -body {
    string equal [file tail ~$user] ~$user
} -result 1
test fCmd-8.3 {file copy and path translation: ensure correct error} -body {
    file copy [file home] [file join this file doesnt exist]
} -returnCodes error -result [subst \
   {error copying "[file home]" to "[file join this file doesnt exist]": no such file or directory}]

test fCmd-9.1 {file rename: comprehensive: EACCES} -setup {
    cleanup
} -constraints {unix notRoot} -body {
    file mkdir td1
    file mkdir td2
    file attr td2 -perm 0o40000
    file rename td1 td2/
} -returnCodes error -cleanup {
    file delete -force td2
    file delete -force td1







|

















|







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
    createfile -force
    file delete -force -force -- -- -force
    glob -- -- -force
} -result {}

test fCmd-8.1 {FileBasename: basename of ~user: argc == 1 && *path == ~} \
    -constraints {unix notRoot knownBug tildeexpansion} -body {
    # Labeled knownBug because it is dangerous [Bug: 3881]
    file mkdir td1
    file attr td1 -perm 0o40000
    file rename ~$user td1
} -returnCodes error -cleanup {
    file delete -force td1
} -result "error renaming \"~$user\" to \"td1/[file tail ~$user]\": permission denied"
test fCmd-8.2 {FileBasename: basename of ~user: argc == 1 && *path == ~} \
	-constraints {unix notRoot} -body {
    string equal [file tail ~$user] ~$user
} -result 1
test fCmd-8.3 {file copy and path translation: ensure correct error} -body {
    file copy [file home] [file join this file doesnt exist]
} -returnCodes error -result [subst \
   {error copying "[file home]" to "[file join this file doesnt exist]": no such file or directory}]

test fCmd-9.1 {file rename: comprehensive: EACCES} -setup {
    cleanup
} -constraints {unix notRoot notWsl} -body {
    file mkdir td1
    file mkdir td2
    file attr td2 -perm 0o40000
    file rename td1 td2/
} -returnCodes error -cleanup {
    file delete -force td2
    file delete -force td1
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
    testchmod 0o444 tf2
    file rename tf1 tf3
    file rename tf2 tf4
    list [lsort [glob tf*]] [file writable tf3] [file writable tf4]
} -result {{tf3 tf4} 1 0}
test fCmd-9.4 {file rename: comprehensive: dir to new name} -setup {
    cleanup
} -constraints {unix notRoot testchmod notDarwin9} -body {
    file mkdir td1 td2
    testchmod 0o555 td2
    file rename td1 td3
    file rename td2 td4
    list [lsort [glob td*]] [file writable td3] [file writable td4]
} -cleanup {
    cleanup
} -result {{td3 td4} 1 0}
test fCmd-9.5 {file rename: comprehensive: file to self} -setup {
    cleanup
} -constraints {notRoot testchmod notWine} -body {
    createfile tf1 tf1
    createfile tf2 tf2
    testchmod 0o444 tf2
    file rename -force tf1 tf1
    file rename -force tf2 tf2
    list [contents tf1] [contents tf2] [file writable tf1] [file writable tf2]
} -result {tf1 tf2 1 0}
test fCmd-9.6 {file rename: comprehensive: dir to self} -setup {
    cleanup
} -constraints {unix notRoot testchmod} -body {
    file mkdir td1
    file mkdir td2
    testchmod 0o555 td2
    file rename -force td1 .
    file rename -force td2 .
    list [lsort [glob td*]] [file writable td1] [file writable td2]
} -result {{td1 td2} 1 0}







|




















|







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
    testchmod 0o444 tf2
    file rename tf1 tf3
    file rename tf2 tf4
    list [lsort [glob tf*]] [file writable tf3] [file writable tf4]
} -result {{tf3 tf4} 1 0}
test fCmd-9.4 {file rename: comprehensive: dir to new name} -setup {
    cleanup
} -constraints {unix notRoot testchmod notDarwin9 notWsl} -body {
    file mkdir td1 td2
    testchmod 0o555 td2
    file rename td1 td3
    file rename td2 td4
    list [lsort [glob td*]] [file writable td3] [file writable td4]
} -cleanup {
    cleanup
} -result {{td3 td4} 1 0}
test fCmd-9.5 {file rename: comprehensive: file to self} -setup {
    cleanup
} -constraints {notRoot testchmod notWine} -body {
    createfile tf1 tf1
    createfile tf2 tf2
    testchmod 0o444 tf2
    file rename -force tf1 tf1
    file rename -force tf2 tf2
    list [contents tf1] [contents tf2] [file writable tf1] [file writable tf2]
} -result {tf1 tf2 1 0}
test fCmd-9.6 {file rename: comprehensive: dir to self} -setup {
    cleanup
} -constraints {unix notRoot testchmod notWsl} -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}
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
    testchmod 0o444 tfd4
    set msg [list [catch {file rename tf1 tf2} msg] $msg]
    file rename -force tfs1 tfd1
    file rename -force tfs2 tfd2
    file rename -force tfs3 tfd3
    file rename -force tfs4 tfd4
    list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4]
} -result {{tf1 tf2 tfd1 tfd2 tfd3 tfd4} {1 {error renaming "tf1" to "tf2": file already exists}} 1 1 0 0}
test fCmd-9.8 {file rename: comprehensive: dir to empty dir} -setup {
    cleanup
} -constraints {notRoot testchmod notNetworkFilesystem} -body {
    # Under unix, you can rename a read-only directory, but you can't move it
    # into another directory.
    file mkdir td1
    file mkdir [file join td2 td1]
    file mkdir tds1
    file mkdir tds2
    file mkdir tds3
    file mkdir tds4







|



|







975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
    testchmod 0o444 tfd4
    set msg [list [catch {file rename tf1 tf2} msg] $msg]
    file rename -force tfs1 tfd1
    file rename -force tfs2 tfd2
    file rename -force tfs3 tfd3
    file rename -force tfs4 tfd4
    list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4]
} -result {{tf1 tf2 tfd1 tfd2 tfd3 tfd4} {1 {error renaming "tf1" to "tf2": file exists}} 1 1 0 0}
test fCmd-9.8 {file rename: comprehensive: dir to empty dir} -setup {
    cleanup
} -constraints {notRoot testchmod notNetworkFilesystem} -body {
    # Under Unix you can rename a read-only directory, but you can't move it
    # into another directory.
    file mkdir td1
    file mkdir [file join td2 td1]
    file mkdir tds1
    file mkdir tds2
    file mkdir tds3
    file mkdir tds4
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
	set w4 0
    } else {
	set w3 [file writable [file join tdd3 tds3]]
	set w4 [file writable [file join tdd4 tds4]]
    }
    list [lsort [glob td*]] $msg [file writable [file join tdd1 tds1]] \
    [file writable [file join tdd2 tds2]] $w3 $w4
} -result [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4} {1 {error renaming "td1" to "[file join td2 td1]": file already exists}} 1 1 0 0}]
# Test can hit EEXIST or EBUSY, depending on underlying filesystem
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]







|







1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
	set w4 0
    } else {
	set w3 [file writable [file join tdd3 tds3]]
	set w4 [file writable [file join tdd4 tds4]]
    }
    list [lsort [glob td*]] $msg [file writable [file join tdd1 tds1]] \
    [file writable [file join tdd2 tds2]] $w3 $w4
} -result [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4} {1 {error renaming "td1" to "[file join td2 td1]": file exists}} 1 1 0 0}]
# Test can hit EEXIST or EBUSY, depending on underlying filesystem
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]
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
    testchmod 0o555 [file join td2 td1]
    file mkdir [file join td3 td4] [file join td4 td3]
    file rename -force td3 td4
    list [file exists td3] [file exists [file join td4 td3 td4]] \
	[catch {file rename td1 td2} msg] $msg
} -cleanup {
    testchmod 0o755 [file join td2 td1]
} -result [subst {0 1 1 {error renaming "td1" to "[file join td2 td1]": file already exists}}]
# Test can hit EEXIST or EBUSY, depending on underlying filesystem
test fCmd-9.13 {file rename: comprehensive: can't overwrite target} -setup {
    cleanup
} -constraints {notRoot notWine} -body {
    file mkdir [file join td1 td2] [file join td2 td1 td4]
    file rename -force td1 td2
} -returnCodes error -match glob -result \







|







1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
    testchmod 0o555 [file join td2 td1]
    file mkdir [file join td3 td4] [file join td4 td3]
    file rename -force td3 td4
    list [file exists td3] [file exists [file join td4 td3 td4]] \
	[catch {file rename td1 td2} msg] $msg
} -cleanup {
    testchmod 0o755 [file join td2 td1]
} -result [subst {0 1 1 {error renaming "td1" to "[file join td2 td1]": file exists}}]
# Test can hit EEXIST or EBUSY, depending on underlying filesystem
test fCmd-9.13 {file rename: comprehensive: can't overwrite target} -setup {
    cleanup
} -constraints {notRoot notWine} -body {
    file mkdir [file join td1 td2] [file join td2 td1 td4]
    file rename -force td1 td2
} -returnCodes error -match glob -result \
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
    testchmod 0o444 tf2
    file copy tf1 tf3
    file copy tf2 tf4
    list [lsort [glob tf*]] [contents tf3] [contents tf4] [file writable tf3] [file writable tf4]
} -result {{tf1 tf2 tf3 tf4} tf1 tf2 1 0}
test fCmd-10.3 {file copy: comprehensive: dir to new name} -setup {
    cleanup
} -constraints {unix notRoot testchmod} -body {
    file mkdir [file join td1 tdx]
    file mkdir [file join td2 tdy]
    testchmod 0o555 td2
    file copy td1 td3
    file copy td2 td4
    list [lsort [glob td*]] [glob -directory td3 t*] \
	    [glob -directory td4 t*] [file writable td3] [file writable td4]
} -cleanup {
    testchmod 0o755 td2
    testchmod 0o755 td4
} -result [list {td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 0]
test fCmd-10.3.1 {file copy: comprehensive: dir to new name} -setup {
    cleanup
} -constraints {win notRoot testchmod} -body {
    # On Windows with ACLs, copying a directory is defined like this
    file mkdir [file join td1 tdx]
    file mkdir [file join td2 tdy]
    testchmod 0o555 td2

    file copy td1 td3
    file copy td2 td4
    list [lsort [glob td*]] [glob -directory td3 t*] \
	    [glob -directory td4 t*] [file writable td3] [file writable td4]
} -cleanup {
    testchmod 0o755 td2
    testchmod 0o755 td4







|


















>







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
    testchmod 0o444 tf2
    file copy tf1 tf3
    file copy tf2 tf4
    list [lsort [glob tf*]] [contents tf3] [contents tf4] [file writable tf3] [file writable tf4]
} -result {{tf1 tf2 tf3 tf4} tf1 tf2 1 0}
test fCmd-10.3 {file copy: comprehensive: dir to new name} -setup {
    cleanup
} -constraints {unix notRoot testchmod notWsl} -body {
    file mkdir [file join td1 tdx]
    file mkdir [file join td2 tdy]
    testchmod 0o555 td2
    file copy td1 td3
    file copy td2 td4
    list [lsort [glob td*]] [glob -directory td3 t*] \
	    [glob -directory td4 t*] [file writable td3] [file writable td4]
} -cleanup {
    testchmod 0o755 td2
    testchmod 0o755 td4
} -result [list {td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 0]
test fCmd-10.3.1 {file copy: comprehensive: dir to new name} -setup {
    cleanup
} -constraints {win notRoot testchmod} -body {
    # On Windows with ACLs, copying a directory is defined like this
    file mkdir [file join td1 tdx]
    file mkdir [file join td2 tdy]
    testchmod 0o555 td2
    testchmod 0o555 td2/tdy; # Above line removes inherited perms. So restore.
    file copy td1 td3
    file copy td2 td4
    list [lsort [glob td*]] [glob -directory td3 t*] \
	    [glob -directory td4 t*] [file writable td3] [file writable td4]
} -cleanup {
    testchmod 0o755 td2
    testchmod 0o755 td4
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
    createfile tfs2
    createfile tfs3
    createfile tfs4
    createfile tfd1
    createfile tfd2
    createfile tfd3
    createfile tfd4








    testchmod 0o444 tfs3
    testchmod 0o444 tfs4
    testchmod 0o444 tfd2
    testchmod 0o444 tfd4

    set msg [list [catch {file copy tf1 tf2} msg] $msg]
    file copy -force tfs1 tfd1
    file copy -force tfs2 tfd2
    file copy -force tfs3 tfd3
    file copy -force tfs4 tfd4
    list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4]
} -result {{tf1 tf2 tfd1 tfd2 tfd3 tfd4 tfs1 tfs2 tfs3 tfs4} {1 {error copying "tf1" to "tf2": file already exists}} 1 1 0 0}
test fCmd-10.5 {file copy: comprehensive: dir to empty dir} -setup {
    cleanup
} -constraints {notRoot testchmod} -body {
    file mkdir td1
    file mkdir [file join td2 td1]
    file mkdir tds1
    file mkdir tds2







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






|







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
    createfile tfs2
    createfile tfs3
    createfile tfs4
    createfile tfd1
    createfile tfd2
    createfile tfd3
    createfile tfd4
    if {$::tcl_platform(platform) eq "windows"} {
        # On Windows testchmode will attach an ACL which file copy cannot handle
        # so use good old attributes which file copy does understand
        file attribute tfs3 -readonly 1
        file attribute tfs4 -readonly 1
        file attribute tfd2 -readonly 1
        file attribute tfd4 -readonly 1
    } else {
        testchmod 0o444 tfs3
        testchmod 0o444 tfs4
        testchmod 0o444 tfd2
        testchmod 0o444 tfd4
    }
    set msg [list [catch {file copy tf1 tf2} msg] $msg]
    file copy -force tfs1 tfd1
    file copy -force tfs2 tfd2
    file copy -force tfs3 tfd3
    file copy -force tfs4 tfd4
    list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4]
} -result {{tf1 tf2 tfd1 tfd2 tfd3 tfd4 tfs1 tfs2 tfs3 tfs4} {1 {error copying "tf1" to "tf2": file exists}} 1 1 0 0}
test fCmd-10.5 {file copy: comprehensive: dir to empty dir} -setup {
    cleanup
} -constraints {notRoot testchmod} -body {
    file mkdir td1
    file mkdir [file join td2 td1]
    file mkdir tds1
    file mkdir tds2
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
    testchmod 0o555 [file join tdd4 tds4]
    set a1 [list [catch {file copy td1 td2} msg] $msg]
    set a2 [list [catch {file copy -force tds1 tdd1} msg] $msg]
    set a3 [catch {file copy -force tds2 tdd2}]
    set a4 [catch {file copy -force tds3 tdd3}]
    set a5 [catch {file copy -force tds4 tdd4}]
    list [lsort [glob td*]] $a1 $a2 $a3 $a4 $a5
} -result [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4 tds1 tds2 tds3 tds4} {1 {error copying "td1" to "[file join td2 td1]": file already exists}} {1 {error copying "tds1" to "[file join tdd1 tds1]": file already exists}} 1 1 1}]
test fCmd-10.6 {file copy: comprehensive: dir to non-empty dir} -setup {
    cleanup
} -constraints {notRoot unixOrWin testchmod} -body {
    file mkdir tds1
    file mkdir tds2
    file mkdir [file join tdd1 tds1 xxx]
    file mkdir [file join tdd2 tds2 xxx]
    testchmod 0o555 tds2
    set a1 [list [catch {file copy -force tds1 tdd1} msg] $msg]
    set a2 [list [catch {file copy -force tds2 tdd2} msg] $msg]
    list [lsort [glob td*]] $a1 $a2 [file writable tds1] [file writable tds2]
} -result [subst {{tdd1 tdd2 tds1 tds2} {1 {error copying "tds1" to "[file join tdd1 tds1]": file already exists}} {1 {error copying "tds2" to "[file join tdd2 tds2]": file already exists}} 1 0}]
test fCmd-10.7 {file rename: comprehensive: file to new name and dir} -setup {
    cleanup
} -constraints {notRoot testchmod} -body {
    createfile tf1
    createfile tf2
    file mkdir td1
    testchmod 0o444 tf2
    file copy tf1 [file join td1 tf3]
    file copy tf2 [file join td1 tf4]
    list [lsort [glob tf*]] [lsort [glob -directory td1 t*]] \
    [file writable [file join td1 tf3]] [file writable [file join td1 tf4]]
} -result [subst {{tf1 tf2} {[file join td1 tf3] [file join td1 tf4]} 1 0}]
test fCmd-10.8 {file rename: comprehensive: dir to new name and dir} -setup {
    cleanup
} -constraints {unix notRoot testchmod} -body {
    file mkdir td1
    file mkdir td2
    file mkdir td3
    testchmod 0o555 td2
    file copy td1 [file join td3 td3]
    file copy td2 [file join td3 td4]
    list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \







|


|








|














|







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
    testchmod 0o555 [file join tdd4 tds4]
    set a1 [list [catch {file copy td1 td2} msg] $msg]
    set a2 [list [catch {file copy -force tds1 tdd1} msg] $msg]
    set a3 [catch {file copy -force tds2 tdd2}]
    set a4 [catch {file copy -force tds3 tdd3}]
    set a5 [catch {file copy -force tds4 tdd4}]
    list [lsort [glob td*]] $a1 $a2 $a3 $a4 $a5
} -result [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4 tds1 tds2 tds3 tds4} {1 {error copying "td1" to "[file join td2 td1]": file exists}} {1 {error copying "tds1" to "[file join tdd1 tds1]": file exists}} 1 1 1}]
test fCmd-10.6 {file copy: comprehensive: dir to non-empty dir} -setup {
    cleanup
} -constraints {notRoot unixOrWin testchmod notWsl} -body {
    file mkdir tds1
    file mkdir tds2
    file mkdir [file join tdd1 tds1 xxx]
    file mkdir [file join tdd2 tds2 xxx]
    testchmod 0o555 tds2
    set a1 [list [catch {file copy -force tds1 tdd1} msg] $msg]
    set a2 [list [catch {file copy -force tds2 tdd2} msg] $msg]
    list [lsort [glob td*]] $a1 $a2 [file writable tds1] [file writable tds2]
} -result [subst {{tdd1 tdd2 tds1 tds2} {1 {error copying "tds1" to "[file join tdd1 tds1]": file exists}} {1 {error copying "tds2" to "[file join tdd2 tds2]": file exists}} 1 0}]
test fCmd-10.7 {file rename: comprehensive: file to new name and dir} -setup {
    cleanup
} -constraints {notRoot testchmod} -body {
    createfile tf1
    createfile tf2
    file mkdir td1
    testchmod 0o444 tf2
    file copy tf1 [file join td1 tf3]
    file copy tf2 [file join td1 tf4]
    list [lsort [glob tf*]] [lsort [glob -directory td1 t*]] \
    [file writable [file join td1 tf3]] [file writable [file join td1 tf4]]
} -result [subst {{tf1 tf2} {[file join td1 tf3] [file join td1 tf4]} 1 0}]
test fCmd-10.8 {file rename: comprehensive: dir to new name and dir} -setup {
    cleanup
} -constraints {unix notRoot testchmod notWsl} -body {
    file mkdir td1
    file mkdir td2
    file mkdir td3
    testchmod 0o555 td2
    file copy td1 [file join td3 td3]
    file copy td2 [file join td3 td4]
    list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
} -constraints {notRoot} -body {
    createfile tfa1
    createfile tfa2
    createfile tfa3
    catch {file rename tfa1 tfa2 tfa3}
} -cleanup {
    file delete tfa1 tfa2 tfa3
} -result {1}
test fCmd-11.6 {TclFileRenameCmd: : single file into directory} -setup {
    catch {file delete -force -- tfa1 tfad}
} -constraints {notRoot} -body {
    set s [createfile tfa1]
    file mkdir tfad
    file rename tfa1 tfad
    list [checkcontent tfad/tfa1 $s] [file exists tfa1]







|







1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
} -constraints {notRoot} -body {
    createfile tfa1
    createfile tfa2
    createfile tfa3
    catch {file rename tfa1 tfa2 tfa3}
} -cleanup {
    file delete tfa1 tfa2 tfa3
} -result 1
test fCmd-11.6 {TclFileRenameCmd: : single file into directory} -setup {
    catch {file delete -force -- tfa1 tfad}
} -constraints {notRoot} -body {
    set s [createfile tfa1]
    file mkdir tfad
    file rename tfa1 tfad
    list [checkcontent tfad/tfa1 $s] [file exists tfa1]
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
    set temp $::env(HOME)
} -constraints {notRoot} -body {
    global env
    unset env(HOME)
    catch {file rename ~/tfa1 tfa2}
} -cleanup {
    set ::env(HOME) $temp
} -result {1}
test fCmd-12.2 {renamefile: src filename translation failing} -setup {
    set temp $::env(HOME)
} -constraints {notRoot} -body {
    global env
    unset env(HOME)
    set s [createfile tfa1]
    file mkdir tfad
    catch {file rename tfa1 ~/tfa2 tfad}
} -cleanup {
    set ::env(HOME) $temp
    file delete -force tfad
} -result {1}
test fCmd-12.3 {renamefile: stat failing on source} -setup {
    catch {file delete -force -- tfa1 tfa2}
} -constraints {notRoot} -body {
    list [catch {file rename tfa1 tfa2}] [file exists tfa1] [file exists tfa2]
} -result {1 0 0}
test fCmd-12.4 {renamefile: error renaming file to directory} -setup {
    catch {file delete -force -- tfa tfad}







|











|







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
    set temp $::env(HOME)
} -constraints {notRoot} -body {
    global env
    unset env(HOME)
    catch {file rename ~/tfa1 tfa2}
} -cleanup {
    set ::env(HOME) $temp
} -result 1
test fCmd-12.2 {renamefile: src filename translation failing} -setup {
    set temp $::env(HOME)
} -constraints {notRoot} -body {
    global env
    unset env(HOME)
    set s [createfile tfa1]
    file mkdir tfad
    catch {file rename tfa1 ~/tfa2 tfad}
} -cleanup {
    set ::env(HOME) $temp
    file delete -force tfad
} -result 1
test fCmd-12.3 {renamefile: stat failing on source} -setup {
    catch {file delete -force -- tfa1 tfa2}
} -constraints {notRoot} -body {
    list [catch {file rename tfa1 tfa2}] [file exists tfa1] [file exists tfa2]
} -result {1 0 0}
test fCmd-12.4 {renamefile: error renaming file to directory} -setup {
    catch {file delete -force -- tfa tfad}
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
    catch {file delete -force -- tfad}
} -constraints {notRoot} -body {
    file mkdir tfad
    file mkdir tfad/dir
    catch {file rename tfad tfad/dir}
} -cleanup {
    file delete -force tfad
} -result {1}
test fCmd-12.8 {renamefile: generic error} -setup {
    catch {file delete -force -- tfa}
} -constraints {unix notRoot} -body {
    file mkdir tfa
    file mkdir tfa/dir
    file attributes tfa -permissions 0o555
    catch {file rename tfa/dir tfa2}
} -cleanup {
    catch {file attributes tfa -permissions 0o777}
    file delete -force tfa
} -result {1}
test fCmd-12.9 {renamefile: moving a file across volumes} -setup {
    cleanup $tmpspace
} -constraints {unix notRoot} -body {
    set s [createfile tfa]
    file rename tfa $tmpspace
    list [checkcontent [file join $tmpspace tfa] $s] [file exists tfa]
} -cleanup {







|


|







|







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
    catch {file delete -force -- tfad}
} -constraints {notRoot} -body {
    file mkdir tfad
    file mkdir tfad/dir
    catch {file rename tfad tfad/dir}
} -cleanup {
    file delete -force tfad
} -result 1
test fCmd-12.8 {renamefile: generic error} -setup {
    catch {file delete -force -- tfa}
} -constraints {unix notRoot notWsl} -body {
    file mkdir tfa
    file mkdir tfa/dir
    file attributes tfa -permissions 0o555
    catch {file rename tfa/dir tfa2}
} -cleanup {
    catch {file attributes tfa -permissions 0o777}
    file delete -force tfa
} -result 1
test fCmd-12.9 {renamefile: moving a file across volumes} -setup {
    cleanup $tmpspace
} -constraints {unix notRoot} -body {
    set s [createfile tfa]
    file rename tfa $tmpspace
    list [checkcontent [file join $tmpspace tfa] $s] [file exists tfa]
} -cleanup {
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
    set temp $::env(HOME)
} -body {
    global env
    unset env(HOME)
    catch { file copy tfa ~/foobar }
} -cleanup {
    set ::env(HOME) $temp
} -result {1}
test fCmd-13.6 {TclCopyFilesCmd: > 1 source & target is not a dir} -setup {
    catch {file delete -force -- tfa1 tfa2 tfa3}
} -constraints {notRoot} -body {
    createfile tfa1
    createfile tfa2
    createfile tfa3
    catch {file copy tfa1 tfa2 tfa3}
} -cleanup {
    file delete tfa1 tfa2 tfa3
} -result {1}
test fCmd-13.7 {TclCopyFilesCmd: single file into directory} -setup {
    catch {file delete -force -- tfa1 tfad}
} -constraints {notRoot} -body {
    set s [createfile tfa1]
    file mkdir tfad
    file copy tfa1 tfad
    list [checkcontent tfad/tfa1 $s] [checkcontent tfa1 $s]







|









|







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
    set temp $::env(HOME)
} -body {
    global env
    unset env(HOME)
    catch { file copy tfa ~/foobar }
} -cleanup {
    set ::env(HOME) $temp
} -result 1
test fCmd-13.6 {TclCopyFilesCmd: > 1 source & target is not a dir} -setup {
    catch {file delete -force -- tfa1 tfa2 tfa3}
} -constraints {notRoot} -body {
    createfile tfa1
    createfile tfa2
    createfile tfa3
    catch {file copy tfa1 tfa2 tfa3}
} -cleanup {
    file delete tfa1 tfa2 tfa3
} -result 1
test fCmd-13.7 {TclCopyFilesCmd: single file into directory} -setup {
    catch {file delete -force -- tfa1 tfad}
} -constraints {notRoot} -body {
    set s [createfile tfa1]
    file mkdir tfad
    file copy tfa1 tfad
    list [checkcontent tfad/tfa1 $s] [checkcontent tfa1 $s]
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
    set temp $::env(HOME)
} -constraints {notRoot} -body {
    global env
    unset env(HOME)
    catch {file copy ~/tfa1 tfa2}
} -cleanup {
    set ::env(HOME) $temp
} -result {1}
test fCmd-14.2 {copyfile: dst filename translation failing} -setup {
    set temp $::env(HOME)
} -constraints {notRoot} -body {
    global env
    unset env(HOME)
    set s [createfile tfa1]
    file mkdir tfad







|







1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
    set temp $::env(HOME)
} -constraints {notRoot} -body {
    global env
    unset env(HOME)
    catch {file copy ~/tfa1 tfa2}
} -cleanup {
    set ::env(HOME) $temp
} -result 1
test fCmd-14.2 {copyfile: dst filename translation failing} -setup {
    set temp $::env(HOME)
} -constraints {notRoot} -body {
    global env
    unset env(HOME)
    set s [createfile tfa1]
    file mkdir tfad
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
    file copy tfa tfa2
    list [checkcontent tfa/file $s] [checkcontent tfa2/file $s]
} -cleanup {
    file delete -force tfa tfa2
} -result {1 1}
test fCmd-14.8 {copyfile: copy directory failing} -setup {
    catch {file delete -force -- tfa}
} -constraints {unix notRoot} -body {
    file mkdir tfa/dir/a/b/c
    file attributes tfa/dir -permissions 0
    catch {file copy tfa tfa2}
} -cleanup {
    file attributes tfa/dir -permissions 0o777
    file delete -force tfa tfa2
} -result {1}

#
# Coverage tests for TclMkdirCmd()
#

# ~ is no longer a special char. Need a test case where translation fails.
test fCmd-15.1 {TclMakeDirsCmd: target filename translation failing} -setup {







|






|







1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
    file copy tfa tfa2
    list [checkcontent tfa/file $s] [checkcontent tfa2/file $s]
} -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 notWsl} -body {
    file mkdir tfa/dir/a/b/c
    file attributes tfa/dir -permissions 0
    catch {file copy tfa tfa2}
} -cleanup {
    file attributes tfa/dir -permissions 0o777
    file delete -force tfa tfa2
} -result 1

#
# Coverage tests for TclMkdirCmd()
#

# ~ is no longer a special char. Need a test case where translation fails.
test fCmd-15.1 {TclMakeDirsCmd: target filename translation failing} -setup {
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
test fCmd-15.2 {TclMakeDirsCmd - one directory} -setup {
    catch {file delete -force -- tfa}
} -constraints {notRoot} -body {
    file mkdir tfa
    file isdirectory tfa
} -cleanup {
    file delete tfa
} -result {1}
test fCmd-15.3 {TclMakeDirsCmd: - two directories} -setup {
    catch {file delete -force -- tfa1 tfa2}
} -constraints {notRoot} -body {
    file mkdir tfa1 tfa2
    list [file isdirectory tfa1] [file isdirectory tfa2]
} -cleanup {
    file delete tfa1 tfa2
} -result {1 1}
test fCmd-15.4 {TclMakeDirsCmd - stat failing} -setup {
    catch {file delete -force -- tfa}
} -constraints {unix notRoot} -body {
    file mkdir tfa
    createfile tfa/file
    file attributes tfa -permissions 0
    catch {file mkdir tfa/file}
} -cleanup {
    file attributes tfa -permissions 0o777
    file delete -force tfa
} -result {1}
test fCmd-15.5 {TclMakeDirsCmd: - making a directory several levels deep} -setup {
    catch {file delete -force -- tfa}
} -constraints {notRoot} -body {
    file mkdir tfa/a/b/c
    file isdir tfa/a/b/c
} -cleanup {
    file delete -force tfa
} -result {1}
test fCmd-15.6 {TclMakeDirsCmd: - trying to overwrite a file} -setup {
    catch {file delete -force -- tfa}
} -constraints {notRoot} -body {
    set s [createfile tfa]
    list [catch {file mkdir tfa}] [file isdir tfa] [file exists tfa] \
	[checkcontent tfa $s]
} -cleanup {







|


















|







|







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
test fCmd-15.2 {TclMakeDirsCmd - one directory} -setup {
    catch {file delete -force -- tfa}
} -constraints {notRoot} -body {
    file mkdir tfa
    file isdirectory tfa
} -cleanup {
    file delete tfa
} -result 1
test fCmd-15.3 {TclMakeDirsCmd: - two directories} -setup {
    catch {file delete -force -- tfa1 tfa2}
} -constraints {notRoot} -body {
    file mkdir tfa1 tfa2
    list [file isdirectory tfa1] [file isdirectory tfa2]
} -cleanup {
    file delete tfa1 tfa2
} -result {1 1}
test fCmd-15.4 {TclMakeDirsCmd - stat failing} -setup {
    catch {file delete -force -- tfa}
} -constraints {unix notRoot} -body {
    file mkdir tfa
    createfile tfa/file
    file attributes tfa -permissions 0
    catch {file mkdir tfa/file}
} -cleanup {
    file attributes tfa -permissions 0o777
    file delete -force tfa
} -result 1
test fCmd-15.5 {TclMakeDirsCmd: - making a directory several levels deep} -setup {
    catch {file delete -force -- tfa}
} -constraints {notRoot} -body {
    file mkdir tfa/a/b/c
    file isdir tfa/a/b/c
} -cleanup {
    file delete -force tfa
} -result 1
test fCmd-15.6 {TclMakeDirsCmd: - trying to overwrite a file} -setup {
    catch {file delete -force -- tfa}
} -constraints {notRoot} -body {
    set s [createfile tfa]
    list [catch {file mkdir tfa}] [file isdir tfa] [file exists tfa] \
	[checkcontent tfa $s]
} -cleanup {
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
} -result {1 1}
test fCmd-15.8 {TclFileMakeDirsCmd: trying to create an existing dir} -body {
    file mkdir tfa
    file mkdir tfa
    file isdir tfa
} -constraints {notRoot} -cleanup {
    file delete tfa
} -result {1}

# Coverage tests for TclDeleteFilesCommand()
test fCmd-16.1 {test the -- argument} -constraints {notRoot} -setup {
    catch {file delete -force -- tfa}
} -body {
    createfile tfa
    file delete -- tfa







|







1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
} -result {1 1}
test fCmd-15.8 {TclFileMakeDirsCmd: trying to create an existing dir} -body {
    file mkdir tfa
    file mkdir tfa
    file isdir tfa
} -constraints {notRoot} -cleanup {
    file delete tfa
} -result 1

# Coverage tests for TclDeleteFilesCommand()
test fCmd-16.1 {test the -- argument} -constraints {notRoot} -setup {
    catch {file delete -force -- tfa}
} -body {
    createfile tfa
    file delete -- tfa
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
test fCmd-16.3 {test bad option} -constraints {notRoot} -setup {
    catch {file delete -force -- tfa}
} -body {
    createfile tfa
    catch {file delete -dog tfa}
} -cleanup {
    file delete tfa
} -result {1}
test fCmd-16.4 {accept zero files (TIP 323)} -body {
    file delete
} -result {}
test fCmd-16.5 {accept zero files (TIP 323)} -body {
    file delete --
} -result {}
# ~ is no longer a special char. Need a test case where translation fails.
test fCmd-16.6 {delete: source filename translation failing} -setup {
    set temp $::env(HOME)
} -constraints {notRoot TODO} -body {
    global env
    unset env(HOME)
    catch {file delete ~/tfa}
} -cleanup {
    set ::env(HOME) $temp
} -result {1}
test fCmd-16.7 {remove a non-empty directory without -force} -setup {
    catch {file delete -force -- tfa}
} -constraints {notRoot} -body {
    file mkdir tfa
    createfile tfa/a
    catch {file delete tfa}
} -cleanup {
    file delete -force tfa
} -result {1}
test fCmd-16.8 {remove a normal file} -constraints {notRoot} -setup {
    catch {file delete -force -- tfa}
} -body {
    file mkdir tfa
    createfile tfa/a
    catch {file delete tfa}
} -cleanup {
    file delete -force tfa
} -result {1}
test fCmd-16.9 {error while deleting file} -setup {
    catch {file delete -force -- tfa}
} -constraints {unix notRoot} -body {
    file mkdir tfa
    createfile tfa/a
    file attributes tfa -permissions 0o555
    catch {file delete tfa/a}
    #######
    #######  If any directory in a tree that is being removed does not have
    #######  write permission, the process will fail! This is also the case
    #######  with "rm -rf"
    #######
} -cleanup {
    file attributes tfa -permissions 0o777
    file delete -force tfa
} -result {1}
test fCmd-16.10 {deleting multiple files} -constraints {notRoot} -setup {
    catch {file delete -force -- tfa1 tfa2}
} -body {
    createfile tfa1
    createfile tfa2
    file delete tfa1 tfa2
    list [file exists tfa1] [file exists tfa2]
} -result {0 0}
test fCmd-16.11 {TclFileDeleteCmd: removing a nonexistant file} -setup {
    catch {file delete -force -- tfa}
} -constraints {notRoot} -body {
    file delete tfa
} -result {}

# More coverage tests for mkpath()
test fCmd-17.1 {mkdir stat failing on target but not ENOENT} -setup {
     catch {file delete -force -- tfa1}
} -constraints {unix notRoot} -body {
     file mkdir tfa1
     file attributes tfa1 -permissions 0o555
     catch {file mkdir tfa1/tfa2}
} -cleanup {
     file attributes tfa1 -permissions 0o777
     file delete -force tfa1
} -result {1}
test fCmd-17.2 {mkdir several levels deep - relative} -setup {
    catch {file delete -force -- tfa}
} -constraints {notRoot} -body {
    file mkdir tfa/a/b
    file isdir tfa/a/b
} -cleanup {
    file delete tfa/a/b tfa/a tfa
} -result 1
test fCmd-17.3 {mkdir several levels deep - absolute} -setup {
    catch {file delete -force -- tfa}
} -constraints {notRoot} -body {
    set f [file join [pwd] tfa a]
    file mkdir $f
    file isdir $f
} -cleanup {
    file delete $f [file join [pwd] tfa]
} -result {1}

#
# Functionality tests for TclFileRenameCmd()
#
test fCmd-18.1 {TclFileRenameCmd: rename (first form) in the same directory} \
	-setup {
    catch {file delete -force -- tfad}







|















|








|








|


|












|

















|






|
















|







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
test fCmd-16.3 {test bad option} -constraints {notRoot} -setup {
    catch {file delete -force -- tfa}
} -body {
    createfile tfa
    catch {file delete -dog tfa}
} -cleanup {
    file delete tfa
} -result 1
test fCmd-16.4 {accept zero files (TIP 323)} -body {
    file delete
} -result {}
test fCmd-16.5 {accept zero files (TIP 323)} -body {
    file delete --
} -result {}
# ~ is no longer a special char. Need a test case where translation fails.
test fCmd-16.6 {delete: source filename translation failing} -setup {
    set temp $::env(HOME)
} -constraints {notRoot TODO} -body {
    global env
    unset env(HOME)
    catch {file delete ~/tfa}
} -cleanup {
    set ::env(HOME) $temp
} -result 1
test fCmd-16.7 {remove a non-empty directory without -force} -setup {
    catch {file delete -force -- tfa}
} -constraints {notRoot} -body {
    file mkdir tfa
    createfile tfa/a
    catch {file delete tfa}
} -cleanup {
    file delete -force tfa
} -result 1
test fCmd-16.8 {remove a normal file} -constraints {notRoot} -setup {
    catch {file delete -force -- tfa}
} -body {
    file mkdir tfa
    createfile tfa/a
    catch {file delete tfa}
} -cleanup {
    file delete -force tfa
} -result 1
test fCmd-16.9 {error while deleting file} -setup {
    catch {file delete -force -- tfa}
} -constraints {unix notRoot notWsl} -body {
    file mkdir tfa
    createfile tfa/a
    file attributes tfa -permissions 0o555
    catch {file delete tfa/a}
    #######
    #######  If any directory in a tree that is being removed does not have
    #######  write permission, the process will fail! This is also the case
    #######  with "rm -rf"
    #######
} -cleanup {
    file attributes tfa -permissions 0o777
    file delete -force tfa
} -result 1
test fCmd-16.10 {deleting multiple files} -constraints {notRoot} -setup {
    catch {file delete -force -- tfa1 tfa2}
} -body {
    createfile tfa1
    createfile tfa2
    file delete tfa1 tfa2
    list [file exists tfa1] [file exists tfa2]
} -result {0 0}
test fCmd-16.11 {TclFileDeleteCmd: removing a nonexistant file} -setup {
    catch {file delete -force -- tfa}
} -constraints {notRoot} -body {
    file delete tfa
} -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 notWsl} -body {
     file mkdir tfa1
     file attributes tfa1 -permissions 0o555
     catch {file mkdir tfa1/tfa2}
} -cleanup {
     file attributes tfa1 -permissions 0o777
     file delete -force tfa1
} -result 1
test fCmd-17.2 {mkdir several levels deep - relative} -setup {
    catch {file delete -force -- tfa}
} -constraints {notRoot} -body {
    file mkdir tfa/a/b
    file isdir tfa/a/b
} -cleanup {
    file delete tfa/a/b tfa/a tfa
} -result 1
test fCmd-17.3 {mkdir several levels deep - absolute} -setup {
    catch {file delete -force -- tfa}
} -constraints {notRoot} -body {
    set f [file join [pwd] tfa a]
    file mkdir $f
    file isdir $f
} -cleanup {
    file delete $f [file join [pwd] tfa]
} -result 1

#
# Functionality tests for TclFileRenameCmd()
#
test fCmd-18.1 {TclFileRenameCmd: rename (first form) in the same directory} \
	-setup {
    catch {file delete -force -- tfad}
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
    file mkdir tfa1
    set s [createfile tfa2]
    file link -symbolic tfalink tfa1
    file rename tfa2 tfalink
    checkcontent tfa1/tfa2 $s
} -cleanup {
    file delete -force tfa1 tfalink
} -result {1}
test fCmd-18.16 {TclFileRenameCmd: rename a dangling symlink} -setup {
    catch {file delete -force -- tfa1 tfalink}
} -constraints {unix notRoot} -body {
    file mkdir tfa1
    file link -symbolic tfalink tfa1
    file delete tfa1
    file rename tfalink tfa2







|







1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
    file mkdir tfa1
    set s [createfile tfa2]
    file link -symbolic tfalink tfa1
    file rename tfa2 tfalink
    checkcontent tfa1/tfa2 $s
} -cleanup {
    file delete -force tfa1 tfalink
} -result 1
test fCmd-18.16 {TclFileRenameCmd: rename a dangling symlink} -setup {
    catch {file delete -force -- tfa1 tfalink}
} -constraints {unix notRoot} -body {
    file mkdir tfa1
    file link -symbolic tfalink tfa1
    file delete tfa1
    file rename tfalink tfa2
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
} -body {
    file mkdir tfa
    file delete tfa
    file exists tfa
} -result {0}
test fCmd-19.2 {rmdir error besides EEXIST} -setup {
    catch {file delete -force -- tfa}
} -constraints {unix notRoot} -body {
    file mkdir tfa
    file mkdir tfa/a
    file attributes tfa -permissions 0o555
    catch {file delete tfa/a}
} -cleanup {
    file attributes tfa -permissions 0o777
    file delete -force tfa
} -result {1}
test fCmd-19.3 {recursive remove} -constraints {notRoot} -setup {
    catch {file delete -force -- tfa}
} -body {
    file mkdir tfa
    file mkdir tfa/a
    file delete -force tfa
    file exists tfa
} -result {0}

#
# TclUnixDeleteFile and TraversalDelete are covered by tests from the
# TclDeleteFilesCmd suite
#

#
# Coverage tests for TraverseUnixTree(), called from TclDeleteFilesCmd
#
test fCmd-20.1 {TraverseUnixTree : failure opening a subdirectory directory} -setup {
    catch {file delete -force -- tfa}
} -constraints {unix notRoot} -body {
    file mkdir tfa
    file mkdir tfa/a
    file attributes tfa/a -permissions 00000
    catch {file delete -force tfa}
} -cleanup {
    file attributes tfa/a -permissions 0o777
    file delete -force tfa
} -result {1}
test fCmd-20.2 {TraverseUnixTree : recursive delete of large directory: Bug 1034337} -setup {
    catch {file delete -force -- tfa}
} -constraints {unix notRoot} -body {
    file mkdir tfa
    for {set i 1} {$i <= 300} {incr i} {
	createfile tfa/testfile_$i
    }







|







|



















|







|







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
} -body {
    file mkdir tfa
    file delete tfa
    file exists tfa
} -result {0}
test fCmd-19.2 {rmdir error besides EEXIST} -setup {
    catch {file delete -force -- tfa}
} -constraints {unix notRoot notWsl} -body {
    file mkdir tfa
    file mkdir tfa/a
    file attributes tfa -permissions 0o555
    catch {file delete tfa/a}
} -cleanup {
    file attributes tfa -permissions 0o777
    file delete -force tfa
} -result 1
test fCmd-19.3 {recursive remove} -constraints {notRoot} -setup {
    catch {file delete -force -- tfa}
} -body {
    file mkdir tfa
    file mkdir tfa/a
    file delete -force tfa
    file exists tfa
} -result {0}

#
# TclUnixDeleteFile and TraversalDelete are covered by tests from the
# TclDeleteFilesCmd suite
#

#
# 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 notWsl} -body {
    file mkdir tfa
    file mkdir tfa/a
    file attributes tfa/a -permissions 00000
    catch {file delete -force tfa}
} -cleanup {
    file attributes tfa/a -permissions 0o777
    file delete -force tfa
} -result 1
test fCmd-20.2 {TraverseUnixTree : recursive delete of large directory: Bug 1034337} -setup {
    catch {file delete -force -- tfa}
} -constraints {unix notRoot} -body {
    file mkdir tfa
    for {set i 1} {$i <= 300} {incr i} {
	createfile tfa/testfile_$i
    }
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
} -constraints {notRoot} -body {
    createfile tfa1
    createfile tfa2
    createfile tfa3
    catch {file copy tfa1 tfa2 tfa3}
} -cleanup {
    file delete tfa1 tfa2 tfa3
} -result {1}
test fCmd-21.5 {copy : multiple files into directory} -constraints {notRoot} -setup {
    catch {file delete -force -- tfa1 tfa2 tfad}
} -body {
    set s1 [createfile tfa1]
    set s2 [createfile tfa2]
    file mkdir tfad
    file copy tfa1 tfa2 tfad







|







2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
} -constraints {notRoot} -body {
    createfile tfa1
    createfile tfa2
    createfile tfa3
    catch {file copy tfa1 tfa2 tfa3}
} -cleanup {
    file delete tfa1 tfa2 tfa3
} -result 1
test fCmd-21.5 {copy : multiple files into directory} -constraints {notRoot} -setup {
    catch {file delete -force -- tfa1 tfa2 tfad}
} -body {
    set s1 [createfile tfa1]
    set s2 [createfile tfa2]
    file mkdir tfad
    file copy tfa1 tfa2 tfad
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
    catch {file delete -force -- tfa1}
} -constraints {unix notRoot} -body {
    set s [createfile tfa1]
    file rename -force tfa1 tfa1
    checkcontent tfa1 $s
} -cleanup {
    file delete tfa1
} -result {1}
test fCmd-22.3 {TclpRenameFile: rename dir to existing dir} -setup {
    catch {file delete -force -- d1 tfad}
} -constraints {notRoot} -body {
    file mkdir d1 [file join tfad d1]
    list [catch {file rename d1 tfad}] [file isdir d1] \
	[file isdir [file join tfad d1]]
} -cleanup {







|







2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
    catch {file delete -force -- tfa1}
} -constraints {unix notRoot} -body {
    set s [createfile tfa1]
    file rename -force tfa1 tfa1
    checkcontent tfa1 $s
} -cleanup {
    file delete tfa1
} -result 1
test fCmd-22.3 {TclpRenameFile: rename dir to existing dir} -setup {
    catch {file delete -force -- d1 tfad}
} -constraints {notRoot} -body {
    file mkdir d1 [file join tfad d1]
    list [catch {file rename d1 tfad}] [file isdir d1] \
	[file isdir [file join tfad d1]]
} -cleanup {
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
} -result {could not create new link "abc.dir": that path already exists}
test fCmd-28.6 {file link: unsupported operation} -setup {
    cd [temporaryDirectory]
} -constraints {linkDirectory win} -body {
    file link -hard abc.link abc.dir
} -returnCodes error -cleanup {
    cd [workingDirectory]
} -result {could not create new link "abc.link" pointing to "abc.dir": illegal operation on a directory}
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}







|







2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
} -result {could not create new link "abc.dir": that path already exists}
test fCmd-28.6 {file link: unsupported operation} -setup {
    cd [temporaryDirectory]
} -constraints {linkDirectory win} -body {
    file link -hard abc.link abc.dir
} -returnCodes error -cleanup {
    cd [workingDirectory]
} -result {could not create new link "abc.link" pointing to "abc.dir": is a directory}
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}
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
    cd abc.link
    set dir [pwd]
    cd ..
    set up [pwd]
    cd $orig
    # Now '$up' should be either $orig or [file dirname abc.dir], depending on
    # whether 'cd' actually moves to the destination of a link, or simply
    # treats the link as a directory. (On windows the former, on unix the
    # latter, I believe)
    if {
	([file normalize $up] ne [file normalize $orig]) &&
	([file normalize $up] ne [file normalize [file dirname abc.dir]])
    } then {
	return "wrong directory with 'cd abc.link ; cd ..': \
		\"[file normalize $up]\" should be \"[file normalize $orig]\"\







|







2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
    cd abc.link
    set dir [pwd]
    cd ..
    set up [pwd]
    cd $orig
    # Now '$up' should be either $orig or [file dirname abc.dir], depending on
    # whether 'cd' actually moves to the destination of a link, or simply
    # treats the link as a directory. (On windows the former, on Unix the
    # latter, I believe)
    if {
	([file normalize $up] ne [file normalize $orig]) &&
	([file normalize $up] ne [file normalize [file dirname abc.dir]])
    } then {
	return "wrong directory with 'cd abc.link ; cd ..': \
		\"[file normalize $up]\" should be \"[file normalize $orig]\"\
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
} -constraints {win reg} -body {
    file writable $mydocsname
} -result 1
test fCmd-30.2 {file readable on 'NTUSER.DAT'} -constraints {win notWine} -body {
    expr {[info exists env(USERPROFILE)]
          && [file exists $env(USERPROFILE)/NTUSER.DAT]
          && [file readable $env(USERPROFILE)/NTUSER.DAT]}
} -result {1}
# At least one CI environment (GitHub Actions) is set up with the page file in
# an unusual location; skip the test if that is so.
test fCmd-30.3 {file readable on 'pagefile.sys'} -constraints {win notInCIenv} -body {
    set r {}
    if {[info exists env(SystemDrive)]} {
        set path $env(SystemDrive)/pagefile.sys
        lappend r exists [file exists $path]







|







2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
} -constraints {win reg} -body {
    file writable $mydocsname
} -result 1
test fCmd-30.2 {file readable on 'NTUSER.DAT'} -constraints {win notWine} -body {
    expr {[info exists env(USERPROFILE)]
          && [file exists $env(USERPROFILE)/NTUSER.DAT]
          && [file readable $env(USERPROFILE)/NTUSER.DAT]}
} -result 1
# At least one CI environment (GitHub Actions) is set up with the page file in
# an unusual location; skip the test if that is so.
test fCmd-30.3 {file readable on 'pagefile.sys'} -constraints {win notInCIenv} -body {
    set r {}
    if {[info exists env(SystemDrive)]} {
        set path $env(SystemDrive)/pagefile.sys
        lappend r exists [file exists $path]
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707







2708
2709
2710
2711
2712
2713
2714
    file home
} -result relative/path
test fCmd-31.6 {file home USER} -body {
    # Note - as in 8.x this form does NOT necessarily give same result as
    # env(HOME) even when user is current user. Assume result contains user
    # name, else not sure how to check
    string tolower [file home $::tcl_platform(user)]
} -match glob -result [string tolower "*$::tcl_platform(user)*"]
test fCmd-31.7 {file home UNKNOWNUSER} -body {
    file home nosuchuser
} -returnCodes error -result {user "nosuchuser" doesn't exist}
test fCmd-31.8 {file home extra arg} -body {
    file home $::tcl_platform(user) arg
} -returnCodes error -result {wrong # args: should be "file home ?user?"}








test fCmd-32.1 {file tildeexpand ~} -body {
    file tildeexpand ~
} -result [file join $::env(HOME)]
test fCmd-32.2 {file tildeexpand ~ - obeys env} -setup {
    set ::env(HOME) $::env(HOME)/xxx
} -cleanup {







|






>
>
>
>
>
>
>







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
    file home
} -result relative/path
test fCmd-31.6 {file home USER} -body {
    # Note - as in 8.x this form does NOT necessarily give same result as
    # env(HOME) even when user is current user. Assume result contains user
    # name, else not sure how to check
    string tolower [file home $::tcl_platform(user)]
} -match glob -result [gethomedirglob $::tcl_platform(user)]
test fCmd-31.7 {file home UNKNOWNUSER} -body {
    file home nosuchuser
} -returnCodes error -result {user "nosuchuser" doesn't exist}
test fCmd-31.8 {file home extra arg} -body {
    file home $::tcl_platform(user) arg
} -returnCodes error -result {wrong # args: should be "file home ?user?"}
test fCmd-31.9 {file home USER does not follow env(HOME)} -setup {
    set ::env(HOME) [file join $::env(HOME) foo]
} -cleanup {
    set ::env(HOME) [file dirname $::env(HOME)]
} -body {
    string tolower [file home $::tcl_platform(user)]
} -match glob -result [gethomedirglob $::tcl_platform(user)]

test fCmd-32.1 {file tildeexpand ~} -body {
    file tildeexpand ~
} -result [file join $::env(HOME)]
test fCmd-32.2 {file tildeexpand ~ - obeys env} -setup {
    set ::env(HOME) $::env(HOME)/xxx
} -cleanup {
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
    file tildeexpand ~
} -result relative/path
test fCmd-32.5 {file tildeexpand ~USER} -body {
    # Note - as in 8.x this form does NOT necessarily give same result as
    # env(HOME) even when user is current user. Assume result contains user
    # name, else not sure how to check
    string tolower [file tildeexpand ~$::tcl_platform(user)]
} -match glob -result [string tolower "*$::tcl_platform(user)*"]
test fCmd-32.6 {file tildeexpand ~UNKNOWNUSER} -body {
    file tildeexpand ~nosuchuser
} -returnCodes error -result {user "nosuchuser" doesn't exist}
test fCmd-32.7 {file tildeexpand ~extra arg} -body {
    file tildeexpand ~ arg
} -returnCodes error -result {wrong # args: should be "file tildeexpand path"}
test fCmd-32.8 {file tildeexpand ~/path} -body {
    file tildeexpand ~/foo
} -result [file join $::env(HOME)/foo]
test fCmd-32.9 {file tildeexpand ~USER/bar} -body {
    # Note - as in 8.x this form does NOT necessarily give same result as
    # env(HOME) even when user is current user. Assume result contains user
    # name, else not sure how to check
    string tolower [file tildeexpand ~$::tcl_platform(user)/bar]
} -match glob -result [string tolower "*$::tcl_platform(user)*/bar"]
test fCmd-32.10 {file tildeexpand ~UNKNOWNUSER} -body {
    file tildeexpand ~nosuchuser/foo
} -returnCodes error -result {user "nosuchuser" doesn't exist}
test fCmd-32.11 {file tildeexpand /~/path} -body {
    file tildeexpand /~/foo
} -result /~/foo
test fCmd-32.12 {file tildeexpand /~user/path} -body {







|














|







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
    file tildeexpand ~
} -result relative/path
test fCmd-32.5 {file tildeexpand ~USER} -body {
    # Note - as in 8.x this form does NOT necessarily give same result as
    # env(HOME) even when user is current user. Assume result contains user
    # name, else not sure how to check
    string tolower [file tildeexpand ~$::tcl_platform(user)]
} -match glob -result [gethomedirglob $::tcl_platform(user)]
test fCmd-32.6 {file tildeexpand ~UNKNOWNUSER} -body {
    file tildeexpand ~nosuchuser
} -returnCodes error -result {user "nosuchuser" doesn't exist}
test fCmd-32.7 {file tildeexpand ~extra arg} -body {
    file tildeexpand ~ arg
} -returnCodes error -result {wrong # args: should be "file tildeexpand path"}
test fCmd-32.8 {file tildeexpand ~/path} -body {
    file tildeexpand ~/foo
} -result [file join $::env(HOME)/foo]
test fCmd-32.9 {file tildeexpand ~USER/bar} -body {
    # Note - as in 8.x this form does NOT necessarily give same result as
    # env(HOME) even when user is current user. Assume result contains user
    # name, else not sure how to check
    string tolower [file tildeexpand ~$::tcl_platform(user)/bar]
} -match glob -result [file join [gethomedirglob $::tcl_platform(user)] bar]
test fCmd-32.10 {file tildeexpand ~UNKNOWNUSER} -body {
    file tildeexpand ~nosuchuser/foo
} -returnCodes error -result {user "nosuchuser" doesn't exist}
test fCmd-32.11 {file tildeexpand /~/path} -body {
    file tildeexpand /~/foo
} -result /~/foo
test fCmd-32.12 {file tildeexpand /~user/path} -body {
2775
2776
2777
2778
2779
2780
2781
2782







2783
2784
2785
2786
2787
2788
2789
    file tildeexpand ~\\foo
} -constraints win -result [file join $::env(HOME)/foo]
test fCmd-32.16 {file tildeexpand ~USER\\bar} -body {
    # Note - as in 8.x this form does NOT necessarily give same result as
    # env(HOME) even when user is current user. Assume result contains user
    # name, else not sure how to check
    string tolower [file tildeexpand ~$::tcl_platform(user)\\bar]
} -constraints win -match glob -result [string tolower "*$::tcl_platform(user)*/bar"]









# cleanup
cleanup
if {[testConstraint unix]} {
    removeDirectory tcl[pid] /tmp
}







|
>
>
>
>
>
>
>







2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
    file tildeexpand ~\\foo
} -constraints win -result [file join $::env(HOME)/foo]
test fCmd-32.16 {file tildeexpand ~USER\\bar} -body {
    # Note - as in 8.x this form does NOT necessarily give same result as
    # env(HOME) even when user is current user. Assume result contains user
    # name, else not sure how to check
    string tolower [file tildeexpand ~$::tcl_platform(user)\\bar]
} -constraints win -match glob -result [file join [gethomedirglob $::tcl_platform(user)] bar]
test fCmd-32.17 {file tildeexpand ~USER does not mirror HOME} -setup {
    set ::env(HOME) [file join $::env(HOME) foo]
} -cleanup {
    set ::env(HOME) [file dirname $::env(HOME)]
} -body {
    string tolower [file tildeexpand ~$::tcl_platform(user)]
} -match glob -result [gethomedirglob $::tcl_platform(user)]


# cleanup
cleanup
if {[testConstraint unix]} {
    removeDirectory tcl[pid] /tmp
}

Changes to tests/fileName.test.

14
15
16
17
18
19
20

21
22
23
24
25
26
27
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}


::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]


testConstraint testsetplatform [llength [info commands testsetplatform]]
testConstraint testtranslatefilename [llength [info commands testtranslatefilename]]
testConstraint linkDirectory 1
testConstraint symbolicLinkFile 1
if {[testConstraint win]} {
    if {$::tcl_platform(osVersion) < 5.0 \







>







14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}


::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]
source [file join [file dirname [info script]] tcltests.tcl]

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 \
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
    # test fails because if an error occurs, the interp's result is reset...
    glob -nocomplain globTest/a2 globTest/a1/* globTest/a3
} {globTest/a2 globTest/a3}
catch {file attributes globTest/a1 -permissions 0o755}
test filename-15.4 {unix specific no complain: no errors, good result} \
	{unix nonPortable} {
    # test fails because if an error occurs, the interp's result is reset...
    # or you don't run at scriptics where the outser and welch users exists
    glob -nocomplain ~ouster ~foo ~welch
} {/home/ouster /home/welch}
test filename-15.4.1 {no complain: errors, sequencing} {
    # ~xxx no longer expanded so errors about unknown users should not occur
    list [catch {glob -nocomplain ~wontexist ~blahxyz ~} res1] $res1 \
	[catch {glob -nocomplain ~ ~blahxyz ~wontexist} res2] $res2
} {0 {} 0 {}}







|







1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
    # test fails because if an error occurs, the interp's result is reset...
    glob -nocomplain globTest/a2 globTest/a1/* globTest/a3
} {globTest/a2 globTest/a3}
catch {file attributes globTest/a1 -permissions 0o755}
test filename-15.4 {unix specific no complain: no errors, good result} \
	{unix nonPortable} {
    # test fails because if an error occurs, the interp's result is reset...
    # or you don't run at scriptics where the ouster and welch users exists
    glob -nocomplain ~ouster ~foo ~welch
} {/home/ouster /home/welch}
test filename-15.4.1 {no complain: errors, sequencing} {
    # ~xxx no longer expanded so errors about unknown users should not occur
    list [catch {glob -nocomplain ~wontexist ~blahxyz ~} res1] $res1 \
	[catch {glob -nocomplain ~ ~blahxyz ~wontexist} res2] $res2
} {0 {} 0 {}}
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
    cd $dd
} -body {
    glob -nocomplain */test
} -cleanup {
    cd $savewd
    removeDirectory ./~ $dd
    removeDirectory isolate
    removeFile test ~
} -result {}
test fileName-20.7 {Bug 2806250} -setup {
    set savewd [pwd]
    cd [temporaryDirectory]
    set d [makeDirectory isolate]
    makeFile {} ./~test $d
} -body {







|







1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
    cd $dd
} -body {
    glob -nocomplain */test
} -cleanup {
    cd $savewd
    removeDirectory ./~ $dd
    removeDirectory isolate
    removeFile test [file home]
} -result {}
test fileName-20.7 {Bug 2806250} -setup {
    set savewd [pwd]
    cd [temporaryDirectory]
    set d [makeDirectory isolate]
    makeFile {} ./~test $d
} -body {
1605
1606
1607
1608
1609
1610
1611











































































1612
1613
1614
1615
1616
1617
1618
    glob -nocomplain -directory [file home] -join * fileName-20.10
} -cleanup {
    cd $savewd
    removeDirectory isolate
    removeFile fileName-20.10 $s
    removeDirectory sub [file home]
} -result [file home]/sub/fileName-20.10












































































# cleanup
catch {file delete -force C:/globTest}
cd [temporaryDirectory]
file delete -force globTest
cd $oldpwd
catch {removeDirectory tcl[pid]}







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







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
    glob -nocomplain -directory [file home] -join * fileName-20.10
} -cleanup {
    cd $savewd
    removeDirectory isolate
    removeFile fileName-20.10 $s
    removeDirectory sub [file home]
} -result [file home]/sub/fileName-20.10
test fileName-20.11 {glob dir with undecodable file names} -setup {
    # Specifically use /tmp as on WSL [temporaryDirectory]
    # on NTFS prevents creation of arbitrary byte sequences in names.
    set prevDir [pwd]
    set testDir /tmp/tcltest/fileName-20.11
    file delete -force $testDir; # Clear it
    file mkdir $testDir
    cd $testDir
    set prevEnc [encoding system]
    # Create a file name that is invalid if interpreted as utf-8
    encoding system iso8859-1
    close [open \xe9 w]
} -cleanup {
    encoding system $prevEnc
    cd $prevDir
    file delete -force $testDir
} -constraints {unix knownBug} -body {
    set result [file exists [lindex [glob *] 0]]
    encoding system utf-8
    lappend result [file exists [lindex [glob *] 0]]
} -result {1 1}

apply [list {} {
    test fileName-6d4e9d1af5bf5b7d {
	memory leak in SetFsPathFromAny

	Runs under both a TCL_DEBUG_MEM build and a -DPURIFY build for
	valgrind, which is useful since Valgrind provides information about the
	error location, but [memory] doesn't.
    } -setup {
	if {[namespace which ::memory] eq {}} {
	    set memcheckcmd [list ::apply [list script {
		uplevel 1 $script
		return 0
	    } [namespace current]]]
	} else {
	    set memcheckcmd ::tcltests::scriptmemcheck
	}
    } -body {
	{*}$memcheckcmd {
	    set interp [interp create]
	    interp eval $interp {
		apply [list {} {
		    upvar 1 f f

		    # A unique name so that no internal representation of this
		    # literal value has been picked up from any other script
		    # that has alredy been sourced into this interpreter.
		    set variableUniqueInTheEntireTclCodebase a
		    set name variableUniqueInTheEntireTclCodebase

		    # give the Tcl_Obj for "var1" an internal representation of
		    # type 'localVarNameType'.
		    set $name

		    set f [open variableUniqueInTheEntireTclCodebase w]
			try {
				puts $f {some data}
			} finally {
				close $f
			}

		    set f [open variableUniqueInTheEntireTclCodebase]
			try {
				read $f
			} finally {
				catch {file delete variableUniqueInTheEntireTclCodebase}
				close $f
			}
		} [namespace current]]
	    }
	    interp delete $interp
	}
    } -result 0
} [namespace current]]

# cleanup
catch {file delete -force C:/globTest}
cd [temporaryDirectory]
file delete -force globTest
cd $oldpwd
catch {removeDirectory tcl[pid]}

Changes to tests/fileSystem.test.

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
    normalisation of nonexistent user - verify no tilde expansion
} -body {
    file normalize ~noonewiththisname
} -result [file join [pwd] ~noonewiththisname]
test filesystem-1.30.1 {normalisation of existing user} -body {
    file normalize ~$::tcl_platform(user)
} -result [file join [pwd] ~$::tcl_platform(user)]










test filesystem-1.31 {link normalisation: link near filesystem root} {testsetplatform} {
    testsetplatform unix
    file normalize /foo/../bar
} {/bar}
test filesystem-1.32 {link normalisation: link near filesystem root} {testsetplatform} {
    testsetplatform unix
    file normalize /../bar
} {/bar}
test filesystem-1.33 {link normalisation: link near filesystem root} {testsetplatform} {
    testsetplatform windows
    set res [file normalize C:/../bar]
    if {[testConstraint unix]} {
	# Some unices go further in normalizing this -- not really a problem
	# since this is a Windows test.
	regexp {C:/bar$} $res res
    }
    set res
} {C:/bar}
if {[testConstraint testsetplatform]} {
    testsetplatform $platform







>
>
>
>
>
>
>
>
>
>












|







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
    normalisation of nonexistent user - verify no tilde expansion
} -body {
    file normalize ~noonewiththisname
} -result [file join [pwd] ~noonewiththisname]
test filesystem-1.30.1 {normalisation of existing user} -body {
    file normalize ~$::tcl_platform(user)
} -result [file join [pwd] ~$::tcl_platform(user)]
test filesystem-1.30.3 {file normalization should distinguish between ~ and ~user} -setup {
    set oldhome $::env(HOME)
    set olduserhome [file home $::tcl_platform(user)]
    set ::env(HOME) [file join $oldhome temp]
} -cleanup {
    set env(HOME) $oldhome
} -body {
    list [string equal [file home] $::env(HOME)] \
        [string equal $olduserhome [file home $::tcl_platform(user)]]
} -result {1 1}
test filesystem-1.31 {link normalisation: link near filesystem root} {testsetplatform} {
    testsetplatform unix
    file normalize /foo/../bar
} {/bar}
test filesystem-1.32 {link normalisation: link near filesystem root} {testsetplatform} {
    testsetplatform unix
    file normalize /../bar
} {/bar}
test filesystem-1.33 {link normalisation: link near filesystem root} {testsetplatform} {
    testsetplatform windows
    set res [file normalize C:/../bar]
    if {[testConstraint unix]} {
	# Some Unices go further in normalizing this -- not really a problem
	# since this is a Windows test.
	regexp {C:/bar$} $res res
    }
    set res
} {C:/bar}
if {[testConstraint testsetplatform]} {
    testsetplatform $platform
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
    lappend res $err
    lappend res [file exists file2]
} -cleanup {
    catch {testsimplefilesystem 0}
    file delete -force simplefile
    file delete -force file2
    cd $dir
} -result {0 {} 1 {error copying "simplefs:/simplefile" to "file2": file already exists} 0 {} 1}
test filesystem-7.5 {cross-filesystem file copy with -force} -setup {
    set dir [pwd]
    cd [tcltest::temporaryDirectory]
    set fout [open [file join simplefile] w]
    puts -nonewline $fout "1234567890"
    close $fout
    testsimplefilesystem 1







|







690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
    lappend res $err
    lappend res [file exists file2]
} -cleanup {
    catch {testsimplefilesystem 0}
    file delete -force simplefile
    file delete -force file2
    cd $dir
} -result {0 {} 1 {error copying "simplefs:/simplefile" to "file2": file exists} 0 {} 1}
test filesystem-7.5 {cross-filesystem file copy with -force} -setup {
    set dir [pwd]
    cd [tcltest::temporaryDirectory]
    set fout [open [file join simplefile] w]
    puts -nonewline $fout "1234567890"
    close $fout
    testsimplefilesystem 1
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
    lappend res $err
    lappend res [file exists file2]
} -cleanup {
    testsimplefilesystem 0
    file delete -force simplefile
    file delete -force file2
    cd $dir
} -result {0 {} 1 {error copying "simplefs:/simplefile" to "file2": file already exists} 0 {} 1}
test filesystem-7.6 {cross-filesystem dir copy with -force} -setup {
    set dir [pwd]
    cd [tcltest::temporaryDirectory]
    file delete -force simpledir
    file mkdir simpledir
    file mkdir dir2
    set fout [open [file join simpledir simplefile] w]







|







715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
    lappend res $err
    lappend res [file exists file2]
} -cleanup {
    testsimplefilesystem 0
    file delete -force simplefile
    file delete -force file2
    cd $dir
} -result {0 {} 1 {error copying "simplefs:/simplefile" to "file2": file exists} 0 {} 1}
test filesystem-7.6 {cross-filesystem dir copy with -force} -setup {
    set dir [pwd]
    cd [tcltest::temporaryDirectory]
    file delete -force simpledir
    file mkdir simpledir
    file mkdir dir2
    set fout [open [file join simpledir simplefile] w]
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
    lappend res [file exists [file join dir2 simpledir]] \
	    [file exists [file join dir2 simpledir simplefile]]
} -cleanup {
    testsimplefilesystem 0
    file delete -force simpledir
    file delete -force dir2
    cd $dir
} -result {0 {} 1 {error copying "simplefs:/simpledir" to "dir2/simpledir": file already exists} 0 {} 1 1}
test filesystem-7.7 {cross-filesystem dir copy with -force} -setup {
    set dir [pwd]
    cd [tcltest::temporaryDirectory]
    file delete -force simpledir
    file mkdir simpledir
    file mkdir dir2
    set fout [open [file join simpledir simplefile] w]







|







743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
    lappend res [file exists [file join dir2 simpledir]] \
	    [file exists [file join dir2 simpledir simplefile]]
} -cleanup {
    testsimplefilesystem 0
    file delete -force simpledir
    file delete -force dir2
    cd $dir
} -result {0 {} 1 {error copying "simplefs:/simpledir" to "dir2/simpledir": file exists} 0 {} 1 1}
test filesystem-7.7 {cross-filesystem dir copy with -force} -setup {
    set dir [pwd]
    cd [tcltest::temporaryDirectory]
    file delete -force simpledir
    file mkdir simpledir
    file mkdir dir2
    set fout [open [file join simpledir simplefile] w]
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
    lappend res [file exists [file join dir2 simpledir]] \
	    [file exists [file join dir2 simpledir simplefile]]
} -cleanup {
    testsimplefilesystem 0
    file delete -force simpledir
    file delete -force dir2
    cd $dir
} -result {0 {} 1 {error copying "simplefs:/simpledir" to "dir2/simpledir": file already exists} 0 {} 1 1}
removeFile gorp.file
test filesystem-7.8 {vfs cd} -setup {
    set dir [pwd]
    cd [tcltest::temporaryDirectory]
    file delete -force simpledir
    file mkdir simpledir
    testsimplefilesystem 1







|







773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
    lappend res [file exists [file join dir2 simpledir]] \
	    [file exists [file join dir2 simpledir simplefile]]
} -cleanup {
    testsimplefilesystem 0
    file delete -force simpledir
    file delete -force dir2
    cd $dir
} -result {0 {} 1 {error copying "simplefs:/simpledir" to "dir2/simpledir": file exists} 0 {} 1 1}
removeFile gorp.file
test filesystem-7.8 {vfs cd} -setup {
    set dir [pwd]
    cd [tcltest::temporaryDirectory]
    file delete -force simpledir
    file mkdir simpledir
    testsimplefilesystem 1

Changes to tests/fileSystemEncoding.test.

11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
    if {"::tcltest" ni [namespace children]} {
	package require tcltest 2.5
	namespace import -force ::tcltest::*
    }

    variable fname1 登鸛鵲樓

    proc autopath {} {
	global auto_path
	set scriptpath [info script]
	set scriptpathnorm [file dirname [file normalize $scriptpath/...]]
	set dirnorm [file dirname $scriptpathnorm]
	set idx [lsearch -exact $auto_path $dirnorm]
	if {$idx >= 0} {
	    set auto_path [lreplace $auto_path[set auto_path {}] $idx $idx {}]
	}
	set auto_path [linsert $auto_path[set auto_path {}] 0 0 $dirnorm]
    }
    autopath

    package require tcltests

    test filesystemEncoding-1.0 {
	issue bcd100410465
    } -body {
	set dir [tcltests::tempdir]
	set saved [encoding system]
	encoding system iso8859-1







<
<
<
<
<
<
<
<
<
<
<
<
|
<







11
12
13
14
15
16
17












18

19
20
21
22
23
24
25
    if {"::tcltest" ni [namespace children]} {
	package require tcltest 2.5
	namespace import -force ::tcltest::*
    }

    variable fname1 登鸛鵲樓













    source [file join [file dirname [info script]] tcltests.tcl]


    test filesystemEncoding-1.0 {
	issue bcd100410465
    } -body {
	set dir [tcltests::tempdir]
	set saved [encoding system]
	encoding system iso8859-1

Changes to tests/for.test.

333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
        46 {changes in the C APIs for custom channel drivers. Scripts written for earlier releases} \
        47 {should work on these new releases as well.} \
        48 {} \
        49 {Obtaining The Releases} \
        50 {} \
        51 {Binary Releases} \
        52 {} \
        53 {Pre-compiled releases are available for the following platforms: } \
        54 {} \
        55 {     Windows 3.1, Windows 95, and Windows NT: Fetch} \
        56 {     ftp://ftp.sunlabs.com/pub/tcl/win42b1.exe, then execute it. The file is a} \
        57 {     self-extracting executable. It will install the Tcl and Tk libraries, the wish and} \
        58 {     tclsh programs, and documentation.} \
        59 {     Macintosh (both 68K and PowerPC): Fetch} \
        60 {     ftp://ftp.sunlabs.com/pub/tcl/mactk4.2b1.sea.hqx. The file is in binhex format,} \







|







333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
        46 {changes in the C APIs for custom channel drivers. Scripts written for earlier releases} \
        47 {should work on these new releases as well.} \
        48 {} \
        49 {Obtaining The Releases} \
        50 {} \
        51 {Binary Releases} \
        52 {} \
        53 {Precompiled releases are available for the following platforms: } \
        54 {} \
        55 {     Windows 3.1, Windows 95, and Windows NT: Fetch} \
        56 {     ftp://ftp.sunlabs.com/pub/tcl/win42b1.exe, then execute it. The file is a} \
        57 {     self-extracting executable. It will install the Tcl and Tk libraries, the wish and} \
        58 {     tclsh programs, and documentation.} \
        59 {     Macintosh (both 68K and PowerPC): Fetch} \
        60 {     ftp://ftp.sunlabs.com/pub/tcl/mactk4.2b1.sea.hqx. The file is in binhex format,} \
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
ts written for earlier releases
should work on these new releases as well.

Obtaining The Releases

Binary Releases

Pre-compiled releases are available for the following
platforms:

     Windows 3.1, Windows 95, and Windows NT: Fetch
     ftp://ftp.sunlabs.com/pub/tcl/win42b1.exe, then
execute it. The file is a
     self-extracting executable. It will install the
Tcl and Tk libraries, the wish and







|







552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
ts written for earlier releases
should work on these new releases as well.

Obtaining The Releases

Binary Releases

Precompiled releases are available for the following
platforms:

     Windows 3.1, Windows 95, and Windows NT: Fetch
     ftp://ftp.sunlabs.com/pub/tcl/win42b1.exe, then
execute it. The file is a
     self-extracting executable. It will install the
Tcl and Tk libraries, the wish and

Changes to tests/format.test.

398
399
400
401
402
403
404



405
406
407
408
409
410
411
# function Tcl_AppendPrintfToObj (et al).
test format-8.26 {Undocumented formats} -body {
    format "%p %#x" [expr {2**31}] [expr {2**31}]
} -result {0x80000000 0x80000000}
test format-8.27 {Undocumented formats} -constraints pointerIs64bit -body {
    format "%p %#llx" [expr {2**33}] [expr {2**33}]
} -result {0x200000000 0x200000000}




test format-9.1 {long result} {
    set a {1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ 1 2 3 4 5 6 7 8 9 0 a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z}
    format {1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG %s %s} $a $a
} {1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG 1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ 1 2 3 4 5 6 7 8 9 0 a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z 1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ 1 2 3 4 5 6 7 8 9 0 a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z}

test format-10.1 {"h" format specifier} {







>
>
>







398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
# function Tcl_AppendPrintfToObj (et al).
test format-8.26 {Undocumented formats} -body {
    format "%p %#x" [expr {2**31}] [expr {2**31}]
} -result {0x80000000 0x80000000}
test format-8.27 {Undocumented formats} -constraints pointerIs64bit -body {
    format "%p %#llx" [expr {2**33}] [expr {2**33}]
} -result {0x200000000 0x200000000}
test format-8.28 {Internal use of TCL_COMBINE flag should not be visiable at script level} {
    format %c 0x10000041
} \uFFFD

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}

test format-10.1 {"h" format specifier} {

Changes to tests/http.test.

625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
    if {$token eq ""} {
	error "bogus return from http::geturl"
    }
    http::wait $token
    lindex [http::error $token] 0
} -cleanup {
    catch {http::cleanup $token}
} -result {connect failed connection refused}

# Bogus host
test http-4.15.$ThreadLevel {http::Event} -body {
    # This test may fail if you use a proxy server. That is to be
    # expected and is not a problem with Tcl.
    # With http::config -threadlevel 1 or 2, the script enters the event loop
    # during the DNS lookup, and has the opportunity to time out.







|







625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
    if {$token eq ""} {
	error "bogus return from http::geturl"
    }
    http::wait $token
    lindex [http::error $token] 0
} -cleanup {
    catch {http::cleanup $token}
} -result {connect failed: connection refused}

# Bogus host
test http-4.15.$ThreadLevel {http::Event} -body {
    # This test may fail if you use a proxy server. That is to be
    # expected and is not a problem with Tcl.
    # With http::config -threadlevel 1 or 2, the script enters the event loop
    # during the DNS lookup, and has the opportunity to time out.
708
709
710
711
712
713
714


715
716
717
718
719
720
721
    http::config -urlencoding ""
    http::mapReply "∈"
} -cleanup {
    http::config -urlencoding $enc
} -result {unknown encoding ""}
test http-7.4.$ThreadLevel {http::formatQuery} -setup {
    set enc [http::config -urlencoding]


} -body {
    # this would be reverting to http <=2.4 behavior w/o errors
    # with Tcl 8.x (unknown chars become '?'), generating a
    # proper exception with Tcl 9.0
    http::config -urlencoding "iso8859-1"
    http::mapReply "∈"
} -cleanup {







>
>







708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
    http::config -urlencoding ""
    http::mapReply "∈"
} -cleanup {
    http::config -urlencoding $enc
} -result {unknown encoding ""}
test http-7.4.$ThreadLevel {http::formatQuery} -setup {
    set enc [http::config -urlencoding]
} -constraints {
    knownProfileBug
} -body {
    # this would be reverting to http <=2.4 behavior w/o errors
    # with Tcl 8.x (unknown chars become '?'), generating a
    # proper exception with Tcl 9.0
    http::config -urlencoding "iso8859-1"
    http::mapReply "∈"
} -cleanup {

Changes to tests/httpProxy.test.

21
22
23
24
25
26
27




28
29
30
31
32
33
34

proc bgerror {args} {
    global errorInfo
    puts stderr "httpProxy.test bgerror"
    puts stderr [join $args]
    puts stderr $errorInfo
}





if {![info exists ThreadLevel]} {
    if {[catch {package require Thread}] == 0} {
        set ValueRange {0 1 2}
    } else {
        set ValueRange {0 1}
    }







>
>
>
>







21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38

proc bgerror {args} {
    global errorInfo
    puts stderr "httpProxy.test bgerror"
    puts stderr [join $args]
    puts stderr $errorInfo
}

proc stopMe {token} {
    set ${token}(z) done
}

if {![info exists ThreadLevel]} {
    if {[catch {package require Thread}] == 0} {
        set ValueRange {0 1 2}
    } else {
        set ValueRange {0 1}
    }
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
# concat Basic [base64::encode intruder:intruder]
set badCreds {Basic aW50cnVkZXI6aW50cnVkZXI=}

test httpProxy-1.1.$ThreadLevel {squid is running - ipv4 noauth} -constraints {needsSquid} -setup {
} -body {
    set token [http::geturl http://$n4host:$n4port/]
    set ri [http::responseInfo $token]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] [dict get $ri proxyUsed]"

} -result {complete ok 400 none} -cleanup {
    http::cleanup $token
    unset -nocomplain ri res
}

test httpProxy-1.2.$ThreadLevel {squid is running - ipv6 noauth} -constraints {needsSquid} -setup {
} -body {
    set token [http::geturl http://\[$n6host\]:$n6port/]
    set ri [http::responseInfo $token]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] [dict get $ri proxyUsed]"

} -result {complete ok 400 none} -cleanup {
    http::cleanup $token
    unset -nocomplain ri res
}

test httpProxy-1.3.$ThreadLevel {squid is running - ipv4 auth} -constraints {needsSquid} -setup {
} -body {
    set token [http::geturl http://$a4host:$a4port/]
    set ri [http::responseInfo $token]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] [dict get $ri proxyUsed]"

} -result {complete ok 400 none} -cleanup {
    http::cleanup $token
    unset -nocomplain ri res
}

test httpProxy-1.4.$ThreadLevel {squid is running - ipv6 auth} -constraints {needsSquid} -setup {
} -body {
    set token [http::geturl http://\[$a6host\]:$a6port/]
    set ri [http::responseInfo $token]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] [dict get $ri proxyUsed]"

} -result {complete ok 400 none} -cleanup {
    http::cleanup $token
    unset -nocomplain ri res
}

test httpProxy-2.1.$ThreadLevel {http no-proxy no-auth} -constraints {needsSquid} -setup {
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
} -body {
    set token [http::geturl http://www.google.com/]
    set ri [http::responseInfo $token]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] [dict get $ri proxyUsed]"


} -result {complete ok 200 none} -cleanup {
    http::cleanup $token
    unset -nocomplain ri res
}

test httpProxy-2.2.$ThreadLevel {https no-proxy no-auth} -constraints {needsSquid needsTls} -setup {
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
} -body {
    set token [http::geturl https://www.google.com/]
    set ri [http::responseInfo $token]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] [dict get $ri proxyUsed]"


} -result {complete ok 200 none} -cleanup {
    http::cleanup $token
    unset -nocomplain ri res
}

test httpProxy-2.3.$ThreadLevel {http with-proxy ipv4 no-auth} -constraints {needsSquid} -setup {
   http::config -proxyhost $n4host -proxyport $n4port -proxynot {127.0.0.1 localhost} -proxyauth {}
} -body {
    set token [http::geturl http://www.google.com/]
    set ri [http::responseInfo $token]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] [dict get $ri proxyUsed]"


} -result {complete ok 200 HttpProxy} -cleanup {
    http::cleanup $token
    unset -nocomplain ri res
    http::config -proxyhost {} -proxyport {} -proxynot {}
}

test httpProxy-2.4.$ThreadLevel {https with-proxy ipv4 no-auth} -constraints {needsSquid needsTls} -setup {
   http::config -proxyhost $n4host -proxyport $n4port -proxynot {127.0.0.1 localhost} -proxyauth {}
} -body {
    set token [http::geturl https://www.google.com/]
    set ri [http::responseInfo $token]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] [dict get $ri proxyUsed]"


} -result {complete ok 200 SecureProxy} -cleanup {
    http::cleanup $token
    unset -nocomplain ri res
    http::config -proxyhost {} -proxyport {} -proxynot {}
}

test httpProxy-2.5.$ThreadLevel {http with-proxy ipv6 no-auth} -constraints {needsSquid} -setup {
   http::config -proxyhost $n6host -proxyport $n6port -proxynot {127.0.0.1 localhost} -proxyauth {}
} -body {
    set token [http::geturl http://www.google.com/]
    set ri [http::responseInfo $token]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] [dict get $ri proxyUsed]"


} -result {complete ok 200 HttpProxy} -cleanup {
    http::cleanup $token
    unset -nocomplain ri res
    http::config -proxyhost {} -proxyport {} -proxynot {}
}

test httpProxy-2.6.$ThreadLevel {https with-proxy ipv6 no-auth} -constraints {needsSquid needsTls} -setup {
   http::config -proxyhost $n6host -proxyport $n6port -proxynot {127.0.0.1 localhost} -proxyauth {}
} -body {
    set token [http::geturl https://www.google.com/]
    set ri [http::responseInfo $token]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] [dict get $ri proxyUsed]"


} -result {complete ok 200 SecureProxy} -cleanup {
    http::cleanup $token
    unset -nocomplain ri res
    http::config -proxyhost {} -proxyport {} -proxynot {}
}

test httpProxy-3.1.$ThreadLevel {http no-proxy with-auth valid-creds-provided} -constraints {needsSquid} -setup {
   http::config -proxyhost {} -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $aliceCreds
} -body {
    set token [http::geturl http://www.google.com/]
    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}]"


} -result {complete ok 200 none 0 0} -cleanup {
    http::cleanup $token
    unset -nocomplain ri res pos1 pos2
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-3.2.$ThreadLevel {https no-proxy with-auth valid-creds-provided} -constraints {needsSquid needsTls} -setup {
   http::config -proxyhost {} -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $aliceCreds
} -body {
    set token [http::geturl https://www.google.com/]
    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}]"


} -result {complete ok 200 none 0 0} -cleanup {
    http::cleanup $token
    unset -nocomplain ri res pos1 pos2
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-3.3.$ThreadLevel {http with-proxy ipv4 with-auth valid-creds-provided} -constraints {needsSquid} -setup {
   http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $aliceCreds
} -body {
    set token [http::geturl http://www.google.com/]
    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}]"


} -result {complete ok 200 HttpProxy 1 1} -cleanup {
    http::cleanup $token
    unset -nocomplain ri res pos1 pos2
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-3.4.$ThreadLevel {https with-proxy ipv4 with-auth valid-creds-provided} -constraints {needsSquid needsTls} -setup {
   http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $aliceCreds
} -body {
    set token [http::geturl https://www.google.com/]
    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}]"


} -result {complete ok 200 SecureProxy 0 0} -cleanup {
    http::cleanup $token
    unset -nocomplain ri res pos1 pos2
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-3.5.$ThreadLevel {http with-proxy ipv6 with-auth valid-creds-provided} -constraints {needsSquid} -setup {
   http::config -proxyhost $a6host -proxyport $a6port -proxynot {127.0.0.1 localhost} -proxyauth $aliceCreds
} -body {
    set token [http::geturl http://www.google.com/]
    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}]"


} -result {complete ok 200 HttpProxy 1 1} -cleanup {
    http::cleanup $token
    unset -nocomplain ri res pos1 pos2
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-3.6.$ThreadLevel {https with-proxy ipv6 with-auth valid-creds-provided} -constraints {needsSquid needsTls} -setup {
   http::config -proxyhost $a6host -proxyport $a6port -proxynot {127.0.0.1 localhost} -proxyauth $aliceCreds
} -body {
    set token [http::geturl https://www.google.com/]
    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}]"


} -result {complete ok 200 SecureProxy 0 0} -cleanup {
    http::cleanup $token
    unset -nocomplain ri res pos1 pos2
































































































































































































































































































    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-4.1.$ThreadLevel {http no-proxy with-auth no-creds-provided} -constraints {needsSquid} -setup {
   http::config -proxyhost {} -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth {}
} -body {
    set token [http::geturl http://www.google.com/]
    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}]"


} -result {complete ok 200 none 0 0} -cleanup {
    http::cleanup $token
    unset -nocomplain ri res pos1 pos2
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-4.2.$ThreadLevel {https no-proxy with-auth no-creds-provided} -constraints {needsSquid needsTls} -setup {
   http::config -proxyhost {} -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth {}
} -body {
    set token [http::geturl https://www.google.com/]
    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}]"


} -result {complete ok 200 none 0 0} -cleanup {
    http::cleanup $token
    unset -nocomplain ri res pos1 pos2
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-4.3.$ThreadLevel {http with-proxy ipv4 with-auth no-creds-provided} -constraints {needsSquid} -setup {
   http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth {}
} -body {
    set token [http::geturl http://www.google.com/]
    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}]"


} -result {complete ok 407 HttpProxy 0 0} -cleanup {
    http::cleanup $token
    unset -nocomplain ri res pos1 pos2
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-4.4.$ThreadLevel {https with-proxy ipv4 with-auth no-creds-provided} -constraints {needsSquid needsTls} -setup {
   http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth {}
} -body {
    set token [http::geturl https://www.google.com/]
    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}]"


} -result {complete ok 407 SecureProxy 0 0} -cleanup {
    http::cleanup $token
    unset -nocomplain ri res pos1 pos2
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-4.5.$ThreadLevel {http with-proxy ipv6 with-auth no-creds-provided} -constraints {needsSquid} -setup {
   http::config -proxyhost $a6host -proxyport $a6port -proxynot {127.0.0.1 localhost} -proxyauth {}
} -body {
    set token [http::geturl http://www.google.com/]
    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}]"


} -result {complete ok 407 HttpProxy 0 0} -cleanup {
    http::cleanup $token
    unset -nocomplain ri res pos1 pos2
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-4.6.$ThreadLevel {https with-proxy ipv6 with-auth no-creds-provided} -constraints {needsSquid needsTls} -setup {
   http::config -proxyhost $a6host -proxyport $a6port -proxynot {127.0.0.1 localhost} -proxyauth {}
} -body {
    set token [http::geturl https://www.google.com/]
    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}]"


} -result {complete ok 407 SecureProxy 0 0} -cleanup {
    http::cleanup $token
    unset -nocomplain ri res pos1 pos2













































































































































































    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-5.1.$ThreadLevel {http no-proxy with-auth bad-creds-provided} -constraints {needsSquid} -setup {
   http::config -proxyhost {} -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $badCreds
} -body {
    set token [http::geturl http://www.google.com/]
    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $badCreds]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}]"


} -result {complete ok 200 none 0 0} -cleanup {
    http::cleanup $token
    unset -nocomplain ri res pos1 pos2
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-5.2.$ThreadLevel {https no-proxy with-auth bad-creds-provided} -constraints {needsSquid needsTls} -setup {
   http::config -proxyhost {} -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $badCreds
} -body {
    set token [http::geturl https://www.google.com/]
    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $badCreds]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}]"


} -result {complete ok 200 none 0 0} -cleanup {
    http::cleanup $token
    unset -nocomplain ri res pos1 pos2
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-5.3.$ThreadLevel {http with-proxy ipv4 with-auth bad-creds-provided} -constraints {needsSquid} -setup {
   http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $badCreds
} -body {
    set token [http::geturl http://www.google.com/]
    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $badCreds]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}]"


} -result {complete ok 407 HttpProxy 1 1} -cleanup {
    http::cleanup $token
    unset -nocomplain ri res pos1 pos2
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-5.4.$ThreadLevel {https with-proxy ipv4 with-auth bad-creds-provided} -constraints {needsSquid needsTls} -setup {
   http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $badCreds
} -body {
    set token [http::geturl https://www.google.com/]
    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $badCreds]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}]"


} -result {complete ok 407 SecureProxy 1 1} -cleanup {
    http::cleanup $token
    unset -nocomplain ri res pos1 pos2
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-5.5.$ThreadLevel {http with-proxy ipv6 with-auth bad-creds-provided} -constraints {needsSquid} -setup {
   http::config -proxyhost $a6host -proxyport $a6port -proxynot {127.0.0.1 localhost} -proxyauth $badCreds
} -body {
    set token [http::geturl http://www.google.com/]
    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $badCreds]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}]"


} -result {complete ok 407 HttpProxy 1 1} -cleanup {
    http::cleanup $token
    unset -nocomplain ri res pos1 pos2
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-5.6.$ThreadLevel {https with-proxy ipv6 with-auth bad-creds-provided} -constraints {needsSquid needsTls} -setup {
   http::config -proxyhost $a6host -proxyport $a6port -proxynot {127.0.0.1 localhost} -proxyauth $badCreds
} -body {
    set token [http::geturl https://www.google.com/]
    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $badCreds]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}]"


} -result {complete ok 407 SecureProxy 1 1} -cleanup {
    http::cleanup $token
    unset -nocomplain ri res pos1 pos2












































































































































































    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

# cleanup
unset -nocomplain n4host n6host n4port n6port a4host a6host a4port a6port aliceCreds badCreds

rename bgerror {}


::tcltest::cleanupTests

# Local variables:
# mode: tcl
# End:








|
>
|

|






|
>
|

|






|
>
|

|






|
>
|

|







|
>
>
|

|







|
>
>
|

|







|
>
>
|

|








|
>
>
|

|




|



|
>
>
|

|




|



|
>
>
|

|










|
>
>
|

|










|
>
>
|

|










|
>
>
|

|










|
>
>
|

|




|





|
>
>
|

|




|





|
>
>
|

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










|
>
>
|

|










|
>
>
|

|










|
>
>
|

|










|
>
>
|

|




|





|
>
>
|

|




|





|
>
>
|

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










|
>
>
|

|










|
>
>
|

|










|
>
>
|

|










|
>
>
|

|




|





|
>
>
|

|




|





|
>
>
|

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







>







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
# concat Basic [base64::encode intruder:intruder]
set badCreds {Basic aW50cnVkZXI6aW50cnVkZXI=}

test httpProxy-1.1.$ThreadLevel {squid is running - ipv4 noauth} -constraints {needsSquid} -setup {
} -body {
    set token [http::geturl http://$n4host:$n4port/]
    set ri [http::responseInfo $token]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed]"
} -result {complete ok 400 -- none} -cleanup {
    http::cleanup $token
    unset -nocomplain token ri res
}

test httpProxy-1.2.$ThreadLevel {squid is running - ipv6 noauth} -constraints {needsSquid} -setup {
} -body {
    set token [http::geturl http://\[$n6host\]:$n6port/]
    set ri [http::responseInfo $token]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed]"
} -result {complete ok 400 -- none} -cleanup {
    http::cleanup $token
    unset -nocomplain token ri res
}

test httpProxy-1.3.$ThreadLevel {squid is running - ipv4 auth} -constraints {needsSquid} -setup {
} -body {
    set token [http::geturl http://$a4host:$a4port/]
    set ri [http::responseInfo $token]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed]"
} -result {complete ok 400 -- none} -cleanup {
    http::cleanup $token
    unset -nocomplain token ri res
}

test httpProxy-1.4.$ThreadLevel {squid is running - ipv6 auth} -constraints {needsSquid} -setup {
} -body {
    set token [http::geturl http://\[$a6host\]:$a6port/]
    set ri [http::responseInfo $token]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed]"
} -result {complete ok 400 -- none} -cleanup {
    http::cleanup $token
    unset -nocomplain token ri res
}

test httpProxy-2.1.$ThreadLevel {http no-proxy no-auth} -constraints {needsSquid} -setup {
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
} -body {
    set token [http::geturl http://www.google.com/]
    set ri [http::responseInfo $token]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]"
} -result {complete ok 200 -- none -- -1} -cleanup {
    http::cleanup $token
    unset -nocomplain token ri res
}

test httpProxy-2.2.$ThreadLevel {https no-proxy no-auth} -constraints {needsSquid needsTls} -setup {
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
} -body {
    set token [http::geturl https://www.google.com/]
    set ri [http::responseInfo $token]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]"
} -result {complete ok 200 -- none -- -1} -cleanup {
    http::cleanup $token
    unset -nocomplain token ri res
}

test httpProxy-2.3.$ThreadLevel {http with-proxy ipv4 no-auth} -constraints {needsSquid} -setup {
   http::config -proxyhost $n4host -proxyport $n4port -proxynot {127.0.0.1 localhost} -proxyauth {}
} -body {
    set token [http::geturl http://www.google.com/]
    set ri [http::responseInfo $token]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]"
} -result {complete ok 200 -- HttpProxy -- -1} -cleanup {
    http::cleanup $token
    unset -nocomplain token ri res
    http::config -proxyhost {} -proxyport {} -proxynot {}
}

test httpProxy-2.4.$ThreadLevel {https with-proxy ipv4 no-auth} -constraints {needsSquid needsTls} -setup {
   http::config -proxyhost $n4host -proxyport $n4port -proxynot {127.0.0.1 localhost} -proxyauth {}
} -body {
    set token [http::geturl https://www.google.com/]
    set ri [http::responseInfo $token]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]"
} -result {complete ok 200 -- SecureProxy -- -1} -cleanup {
    http::cleanup $token
    unset -nocomplain token ri res
    http::config -proxyhost {} -proxyport {} -proxynot {}
}

test httpProxy-2.5.$ThreadLevel {http with-proxy ipv6 no-auth} -constraints {needsSquid} -setup {
   http::config -proxyhost $n6host -proxyport $n6port -proxynot {::1 localhost} -proxyauth {}
} -body {
    set token [http::geturl http://www.google.com/]
    set ri [http::responseInfo $token]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]"
} -result {complete ok 200 -- HttpProxy -- -1} -cleanup {
    http::cleanup $token
    unset -nocomplain token ri res
    http::config -proxyhost {} -proxyport {} -proxynot {}
}

test httpProxy-2.6.$ThreadLevel {https with-proxy ipv6 no-auth} -constraints {needsSquid needsTls} -setup {
   http::config -proxyhost $n6host -proxyport $n6port -proxynot {::1 localhost} -proxyauth {}
} -body {
    set token [http::geturl https://www.google.com/]
    set ri [http::responseInfo $token]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]"
} -result {complete ok 200 -- SecureProxy -- -1} -cleanup {
    http::cleanup $token
    unset -nocomplain token ri res
    http::config -proxyhost {} -proxyport {} -proxynot {}
}

test httpProxy-3.1.$ThreadLevel {http no-proxy with-auth valid-creds-provided} -constraints {needsSquid} -setup {
   http::config -proxyhost {} -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $aliceCreds
} -body {
    set token [http::geturl http://www.google.com/]
    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]"
} -result {complete ok 200 -- none 0 0 -- -1} -cleanup {
    http::cleanup $token
    unset -nocomplain token ri res pos1 pos2
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-3.2.$ThreadLevel {https no-proxy with-auth valid-creds-provided} -constraints {needsSquid needsTls} -setup {
   http::config -proxyhost {} -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $aliceCreds
} -body {
    set token [http::geturl https://www.google.com/]
    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]"
} -result {complete ok 200 -- none 0 0 -- -1} -cleanup {
    http::cleanup $token
    unset -nocomplain token ri res pos1 pos2
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-3.3.$ThreadLevel {http with-proxy ipv4 with-auth valid-creds-provided} -constraints {needsSquid} -setup {
   http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $aliceCreds
} -body {
    set token [http::geturl http://www.google.com/]
    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]"
} -result {complete ok 200 -- HttpProxy 1 1 -- -1} -cleanup {
    http::cleanup $token
    unset -nocomplain token ri res pos1 pos2
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-3.4.$ThreadLevel {https with-proxy ipv4 with-auth valid-creds-provided} -constraints {needsSquid needsTls} -setup {
   http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $aliceCreds
} -body {
    set token [http::geturl https://www.google.com/]
    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]"
} -result {complete ok 200 -- SecureProxy 0 0 -- -1} -cleanup {
    http::cleanup $token
    unset -nocomplain token ri res pos1 pos2
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-3.5.$ThreadLevel {http with-proxy ipv6 with-auth valid-creds-provided} -constraints {needsSquid} -setup {
   http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth $aliceCreds
} -body {
    set token [http::geturl http://www.google.com/]
    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]"
} -result {complete ok 200 -- HttpProxy 1 1 -- -1} -cleanup {
    http::cleanup $token
    unset -nocomplain token ri res pos1 pos2
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-3.6.$ThreadLevel {https with-proxy ipv6 with-auth valid-creds-provided} -constraints {needsSquid needsTls} -setup {
   http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth $aliceCreds
} -body {
    set token [http::geturl https://www.google.com/]
    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]"
} -result {complete ok 200 -- SecureProxy 0 0 -- -1} -cleanup {
    http::cleanup $token
    unset -nocomplain token ri res pos1 pos2
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-3.7.$ThreadLevel {http with-proxy ipv4 with-auth valid-creds-provided; check that 2nd valid request with creds is possible, and keep-alive works} -constraints {needsSquid} -setup {
    array unset ::http::socketMapping
    http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $aliceCreds
    set token0 [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000]
} -body {
    # Use the same caution as for the corresponding https test.
    set can [after 6000 {http::reset $token; set ${token}(z) timeout}]
    set token [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe]
    vwait ${token}(z)
    after cancel $can

    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds]
    set same [string equal [set ${token0}(sock)] [set ${token}(sock)]]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same"
} -result {complete ok 200 -- HttpProxy 1 1 -- -1 done 1} -cleanup {
    http::cleanup $token0
    http::cleanup $token
    unset -nocomplain token0 token ri res pos1 pos2 can same
    array unset ::http::socketMapping
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-3.7x.$ThreadLevel {http with-proxy ipv4 with-auth 1st request no-creds-provided; check that 2nd request with creds is possible} -constraints {needsSquid} -setup {
    array unset ::http::socketMapping
    http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth {}
    set token0 [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000]

    http::config -proxyauth $aliceCreds
} -body {
    # Use the same caution as for the corresponding https test.
    set can [after 6000 {http::reset $token; set ${token}(z) timeout}]
    set token [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe]
    vwait ${token}(z)
    after cancel $can

    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds]
    set same [string equal [set ${token0}(sock)] [set ${token}(sock)]]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same"
} -result {complete ok 200 -- HttpProxy 1 1 -- -1 done 1} -cleanup {
    http::cleanup $token0
    http::cleanup $token
    unset -nocomplain token0 token ri res pos1 pos2 can same
    array unset ::http::socketMapping
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-3.8.$ThreadLevel {https with-proxy ipv4 with-auth valid-creds-provided; check that 2nd valid request with creds is possible, and keep-alive works} -constraints {needsSquid needsTls} -setup {
    array unset ::http::socketMapping
    http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $aliceCreds
    set token0 [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000]
} -body {
    # If a bug passes the socket of a failed CONNECT to the main request, an infinite
    # wait can occur despite -timeout.  Fix this with http::reset; to do this the call
    # to http::geturl must be async so we have $token for use as argument of reset.
    set can [after 6000 {http::reset $token; set ${token}(z) timeout}]
    set token [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe]
    vwait ${token}(z)
    after cancel $can

    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds]
    set same [string equal [set ${token0}(sock)] [set ${token}(sock)]]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same"
} -result {complete ok 200 -- SecureProxy 0 0 -- -1 done 1} -cleanup {
    http::cleanup $token0
    http::cleanup $token
    unset -nocomplain token0 token ri res pos1 pos2 can same
    array unset ::http::socketMapping
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-3.8x.$ThreadLevel {https with-proxy ipv4 with-auth 1st request no-creds-provided; check that 2nd request with creds is possible} -constraints {needsSquid needsTls} -setup {
    array unset ::http::socketMapping
    http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth {}
    set token0 [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000]

    http::config -proxyauth $aliceCreds
} -body {
    # If a bug passes the socket of a failed CONNECT to the main request, an infinite
    # wait can occur despite -timeout.  Fix this with http::reset; to do this the call
    # to http::geturl must be async so we have $token for use as argument of reset.
    set can [after 6000 {http::reset $token; set ${token}(z) timeout}]
    set token [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe]
    vwait ${token}(z)
    after cancel $can

    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds]
    set same [string equal [set ${token0}(sock)] [set ${token}(sock)]]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same"
} -result {complete ok 200 -- SecureProxy 0 0 -- -1 done 0} -cleanup {
    http::cleanup $token0
    http::cleanup $token
    unset -nocomplain token0 token ri res pos1 pos2 can same
    array unset ::http::socketMapping
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-3.9.$ThreadLevel {http with-proxy ipv6 with-auth valid-creds-provided; check that 2nd valid request with creds is possible, and keep-alive works} -constraints {needsSquid} -setup {
    array unset ::http::socketMapping
    http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth $aliceCreds
    set token0 [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000]
} -body {
    # Use the same caution as for the corresponding https test.
    set can [after 6000 {http::reset $token; set ${token}(z) timeout}]
    set token [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe]
    vwait ${token}(z)
    after cancel $can

    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds]
    set same [string equal [set ${token0}(sock)] [set ${token}(sock)]]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same"
} -result {complete ok 200 -- HttpProxy 1 1 -- -1 done 1} -cleanup {
    http::cleanup $token0
    http::cleanup $token
    unset -nocomplain token0 token ri res pos1 pos2 can same
    array unset ::http::socketMapping
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-3.9p.$ThreadLevel {http with-proxy ipv6 with-auth valid-creds-provided; check that 2nd valid request with creds is possible, and keep-alive works, pipelining requested and possible} -constraints {needsSquid} -setup {
    array unset ::http::socketMapping
    http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth $aliceCreds
} -body {
    set can0 [after 6000 {http::reset $token0; set ${token0}(z) timeout}]
    set token0 [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe]
after idle {
    # Use the same caution as for the corresponding https test.
    set can [after 6000 {http::reset $token; set ${token}(z) timeout}]
    set token [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe]
    vwait ${token}(z)
    after cancel $can
}
    vwait ${token0}(z)
    after cancel $can0

    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds]
    set same [string equal [set ${token0}(sock)] [set ${token}(sock)]]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same"
} -result {complete ok 200 -- HttpProxy 1 1 -- -1 done 1} -cleanup {
    http::cleanup $token0
    http::cleanup $token
    unset -nocomplain token0 token ri res pos1 pos2 can0 can same
    array unset ::http::socketMapping
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-3.9x.$ThreadLevel {http with-proxy ipv6 with-auth 1st request no-creds-provided; check that 2nd request with creds is possible} -constraints {needsSquid} -setup {
    array unset ::http::socketMapping
    http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth {}
    set token0 [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000]

    http::config -proxyauth $aliceCreds
} -body {
    # Use the same caution as for the corresponding https test.
    set can [after 6000 {http::reset $token; set ${token}(z) timeout}]
    set token [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe]
    vwait ${token}(z)
    after cancel $can

    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds]
    set same [string equal [set ${token0}(sock)] [set ${token}(sock)]]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same"
} -result {complete ok 200 -- HttpProxy 1 1 -- -1 done 1} -cleanup {
    http::cleanup $token0
    http::cleanup $token
    unset -nocomplain token0 token ri res pos1 pos2 can same
    array unset ::http::socketMapping
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-3.10.$ThreadLevel {https with-proxy ipv6 with-auth valid-creds-provided; check that 2nd valid request with creds is possible, and keep-alive works} -constraints {needsSquid needsTls} -setup {
    array unset ::http::socketMapping
    http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth $aliceCreds
    set token0 [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000]
} -body {
    # If a bug passes the socket of a failed CONNECT to the main request, an infinite
    # wait can occur despite -timeout.  Fix this with http::reset; to do this the call
    # to http::geturl must be async so we have $token for use as argument of reset.
    set can [after 6000 {http::reset $token; set ${token}(z) timeout}]
    set token [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe]
    vwait ${token}(z)
    after cancel $can

    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds]
    set same [string equal [set ${token0}(sock)] [set ${token}(sock)]]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same"
} -result {complete ok 200 -- SecureProxy 0 0 -- -1 done 1} -cleanup {
    http::cleanup $token0
    http::cleanup $token
    unset -nocomplain token0 token ri res pos1 pos2 can same
    array unset ::http::socketMapping
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-3.10p.$ThreadLevel {https with-proxy ipv6 with-auth valid-creds-provided; check that 2nd valid request with creds is possible, and keep-alive works, pipelining requested and possible} -constraints {needsSquid needsTls} -setup {
    array unset ::http::socketMapping
    http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth $aliceCreds
} -body {
    set can0 [after 6000 {http::reset $token0; set ${token0}(z) timeout}]
    set token0 [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe]
after idle {
    # If a bug passes the socket of a failed CONNECT to the main request, an infinite
    # wait can occur despite -timeout.  Fix this with http::reset; to do this the call
    # to http::geturl must be async so we have $token for use as argument of reset.
    set can [after 6000 {http::reset $token0; set ${token}(z) timeout}]
    set token [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe]
    vwait ${token}(z)
    after cancel $can
}
    vwait ${token0}(z)
    after cancel $can0

    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds]
    set same [string equal [set ${token0}(sock)] [set ${token}(sock)]]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same"
} -result {complete ok 200 -- SecureProxy 0 0 -- -1 done 1} -cleanup {
    http::cleanup $token0
    http::cleanup $token
    unset -nocomplain token0 token ri res pos1 pos2 can0 can same
    array unset ::http::socketMapping
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-3.10x.$ThreadLevel {https with-proxy ipv6 with-auth 1st request no-creds-provided; check that 2nd request with creds is possible} -constraints {needsSquid needsTls} -setup {
    array unset ::http::socketMapping
    http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth {}
    set token0 [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000]

    http::config -proxyauth $aliceCreds
} -body {
    # If a bug passes the socket of a failed CONNECT to the main request, an infinite
    # wait can occur despite -timeout.  Fix this with http::reset; to do this the call
    # to http::geturl must be async so we have $token for use as argument of reset.
    set can [after 6000 {http::reset $token; set ${token}(z) timeout}]
    set token [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe]
    vwait ${token}(z)
    after cancel $can

    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds]
    set same [string equal [set ${token0}(sock)] [set ${token}(sock)]]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same"
} -result {complete ok 200 -- SecureProxy 0 0 -- -1 done 0} -cleanup {
    http::cleanup $token0
    http::cleanup $token
    unset -nocomplain token0 token ri res pos1 pos2 can same
    array unset ::http::socketMapping
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-4.1.$ThreadLevel {http no-proxy with-auth no-creds-provided} -constraints {needsSquid} -setup {
   http::config -proxyhost {} -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth {}
} -body {
    set token [http::geturl http://www.google.com/]
    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]"
} -result {complete ok 200 -- none 0 0 -- -1} -cleanup {
    http::cleanup $token
    unset -nocomplain token ri res pos1 pos2
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-4.2.$ThreadLevel {https no-proxy with-auth no-creds-provided} -constraints {needsSquid needsTls} -setup {
   http::config -proxyhost {} -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth {}
} -body {
    set token [http::geturl https://www.google.com/]
    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]"
} -result {complete ok 200 -- none 0 0 -- -1} -cleanup {
    http::cleanup $token
    unset -nocomplain token ri res pos1 pos2
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-4.3.$ThreadLevel {http with-proxy ipv4 with-auth no-creds-provided} -constraints {needsSquid} -setup {
   http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth {}
} -body {
    set token [http::geturl http://www.google.com/]
    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]"
} -result {complete ok 407 -- HttpProxy 0 0 -- -1} -cleanup {
    http::cleanup $token
    unset -nocomplain token ri res pos1 pos2
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-4.4.$ThreadLevel {https with-proxy ipv4 with-auth no-creds-provided} -constraints {needsSquid needsTls} -setup {
   http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth {}
} -body {
    set token [http::geturl https://www.google.com/]
    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]"
} -result {complete ok 407 -- SecureProxyFailed 0 0 -- -1} -cleanup {
    http::cleanup $token
    unset -nocomplain token ri res pos1 pos2
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-4.5.$ThreadLevel {http with-proxy ipv6 with-auth no-creds-provided} -constraints {needsSquid} -setup {
   http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth {}
} -body {
    set token [http::geturl http://www.google.com/]
    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]"
} -result {complete ok 407 -- HttpProxy 0 0 -- -1} -cleanup {
    http::cleanup $token
    unset -nocomplain token ri res pos1 pos2
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-4.6.$ThreadLevel {https with-proxy ipv6 with-auth no-creds-provided} -constraints {needsSquid needsTls} -setup {
   http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth {}
} -body {
    set token [http::geturl https://www.google.com/]
    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]"
} -result {complete ok 407 -- SecureProxyFailed 0 0 -- -1} -cleanup {
    http::cleanup $token
    unset -nocomplain token ri res pos1 pos2
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-4.7.$ThreadLevel {http with-proxy ipv4 with-auth no-creds-provided; check that 2nd request is possible} -constraints {needsSquid} -setup {
    array unset ::http::socketMapping
    http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth {}
    set token0 [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000]
} -body {
    # Use the same caution as for the corresponding https test.
    set can [after 6000 {http::reset $token; set ${token}(z) timeout}]
    set token [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe]
    vwait ${token}(z)
    after cancel $can

    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds]
    set same [string equal [set ${token0}(sock)] [set ${token}(sock)]]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same"
} -result {complete ok 407 -- HttpProxy 0 0 -- -1 done 1} -cleanup {
    http::cleanup $token0
    http::cleanup $token
    unset -nocomplain token0 token ri res pos1 pos2 can same
    array unset ::http::socketMapping
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-4.8.$ThreadLevel {https with-proxy ipv4 with-auth no-creds-provided; check that 2nd request is possible} -constraints {needsSquid needsTls} -setup {
    array unset ::http::socketMapping
    http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth {}
    set token0 [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000]
} -body {
    # If a bug passes the socket of a failed CONNECT to the main request, an infinite
    # wait can occur despite -timeout.  Fix this with http::reset; to do this the call
    # to http::geturl must be async so we have $token for use as argument of reset.
    set can [after 6000 {http::reset $token; set ${token}(z) timeout}]
    set token [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe]
    vwait ${token}(z)
    after cancel $can

    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds]
    set same [string equal [set ${token0}(sock)] [set ${token}(sock)]]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same"
} -result {complete ok 407 -- SecureProxyFailed 0 0 -- -1 done 0} -cleanup {
    http::cleanup $token0
    http::cleanup $token
    unset -nocomplain token0 token ri res pos1 pos2 can same
    array unset ::http::socketMapping
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-4.9.$ThreadLevel {http with-proxy ipv6 with-auth no-creds-provided; check that 2nd request is possible} -constraints {needsSquid} -setup {
    array unset ::http::socketMapping
    http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth {}
    set token0 [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000]
} -body {
    # Use the same caution as for the corresponding https test.
    set can [after 6000 {http::reset $token; set ${token}(z) timeout}]
    set token [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe]
    vwait ${token}(z)
    after cancel $can

    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds]
    set same [string equal [set ${token0}(sock)] [set ${token}(sock)]]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same"
} -result {complete ok 407 -- HttpProxy 0 0 -- -1 done 1} -cleanup {
    http::cleanup $token0
    http::cleanup $token
    unset -nocomplain token0 token ri res pos1 pos2 can same
    array unset ::http::socketMapping
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-4.9p.$ThreadLevel {http with-proxy ipv6 with-auth no-creds-provided; check that 2nd request is possible, pipelining requested and possible} -constraints {needsSquid} -setup {
    array unset ::http::socketMapping
    http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth {}
} -body {
    set can0 [after 6000 {http::reset $token0; set ${token0}(z) timeout}]
    set token0 [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe]
after idle {
    # Use the same caution as for the corresponding https test.
    set can [after 6000 {http::reset $token0; set ${token}(z) timeout}]
    set token [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe]
    vwait ${token}(z)
    after cancel $can
}
    vwait ${token0}(z)
    after cancel $can0

    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds]
    set same [string equal [set ${token0}(sock)] [set ${token}(sock)]]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same"
} -result {complete ok 407 -- HttpProxy 0 0 -- -1 done 1} -cleanup {
    http::cleanup $token0
    http::cleanup $token
    unset -nocomplain token0 token ri res pos1 pos2 can0 can same
    array unset ::http::socketMapping
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-4.10.$ThreadLevel {https with-proxy ipv6 with-auth no-creds-provided; check that 2nd request is possible} -constraints {needsSquid needsTls} -setup {
    array unset ::http::socketMapping
    http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth {}
    set token0 [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000]
} -body {
    # If a bug passes the socket of a failed CONNECT to the main request, an infinite
    # wait can occur despite -timeout.  Fix this with http::reset; to do this the call
    # to http::geturl must be async so we have $token for use as argument of reset.
    set can [after 6000 {http::reset $token; set ${token}(z) timeout}]
    set token [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe]
    vwait ${token}(z)
    after cancel $can

    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds]
    set same [string equal [set ${token0}(sock)] [set ${token}(sock)]]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same"
} -result {complete ok 407 -- SecureProxyFailed 0 0 -- -1 done 0} -cleanup {
    http::cleanup $token0
    http::cleanup $token
    unset -nocomplain token0 token ri res pos1 pos2 can same
    array unset ::http::socketMapping
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-4.10p.$ThreadLevel {https with-proxy ipv6 with-auth no-creds-provided; check that 2nd request is possible, pipelining requested but not possible} -constraints {needsSquid needsTls} -setup {
    array unset ::http::socketMapping
    http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth {}
} -body {
    set can0 [after 6000 {http::reset $token0; set ${token0}(z) timeout}]
    set token0 [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe]

after idle {
    # If a bug passes the socket of a failed CONNECT to the main request, an infinite
    # wait can occur despite -timeout.  Fix this with http::reset; to do this the call
    # to http::geturl must be async so we have $token for use as argument of reset.
    set can [after 6000 {http::reset $token; set ${token}(z) timeout}]
    set token [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe]
    vwait ${token}(z)
    after cancel $can
}
    vwait ${token0}(z)
    after cancel $can0

    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds]
    set same [string equal [set ${token0}(sock)] [set ${token}(sock)]]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same"
} -result {complete ok 407 -- SecureProxyFailed 0 0 -- -1 done 0} -cleanup {
    http::cleanup $token0
    http::cleanup $token
    unset -nocomplain token0 token ri res pos1 pos2 can0 can same
    array unset ::http::socketMapping
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-5.1.$ThreadLevel {http no-proxy with-auth bad-creds-provided} -constraints {needsSquid} -setup {
   http::config -proxyhost {} -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $badCreds
} -body {
    set token [http::geturl http://www.google.com/]
    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $badCreds]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]"
} -result {complete ok 200 -- none 0 0 -- -1} -cleanup {
    http::cleanup $token
    unset -nocomplain token ri res pos1 pos2
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-5.2.$ThreadLevel {https no-proxy with-auth bad-creds-provided} -constraints {needsSquid needsTls} -setup {
   http::config -proxyhost {} -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $badCreds
} -body {
    set token [http::geturl https://www.google.com/]
    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $badCreds]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]"
} -result {complete ok 200 -- none 0 0 -- -1} -cleanup {
    http::cleanup $token
    unset -nocomplain token ri res pos1 pos2
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-5.3.$ThreadLevel {http with-proxy ipv4 with-auth bad-creds-provided} -constraints {needsSquid} -setup {
   http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $badCreds
} -body {
    set token [http::geturl http://www.google.com/]
    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $badCreds]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]"
} -result {complete ok 407 -- HttpProxy 1 1 -- -1} -cleanup {
    http::cleanup $token
    unset -nocomplain token ri res pos1 pos2
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-5.4.$ThreadLevel {https with-proxy ipv4 with-auth bad-creds-provided} -constraints {needsSquid needsTls} -setup {
   http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $badCreds
} -body {
    set token [http::geturl https://www.google.com/]
    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $badCreds]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]"
} -result {complete ok 407 -- SecureProxyFailed 1 1 -- -1} -cleanup {
    http::cleanup $token
    unset -nocomplain token ri res pos1 pos2
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-5.5.$ThreadLevel {http with-proxy ipv6 with-auth bad-creds-provided} -constraints {needsSquid} -setup {
   http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth $badCreds
} -body {
    set token [http::geturl http://www.google.com/]
    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $badCreds]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]"
} -result {complete ok 407 -- HttpProxy 1 1 -- -1} -cleanup {
    http::cleanup $token
    unset -nocomplain token ri res pos1 pos2
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-5.6.$ThreadLevel {https with-proxy ipv6 with-auth bad-creds-provided} -constraints {needsSquid needsTls} -setup {
   http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth $badCreds
} -body {
    set token [http::geturl https://www.google.com/]
    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $badCreds]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]"
} -result {complete ok 407 -- SecureProxyFailed 1 1 -- -1} -cleanup {
    http::cleanup $token
    unset -nocomplain token ri res pos1 pos2
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-5.7.$ThreadLevel {http with-proxy ipv4 with-auth bad-creds-provided; check that 2nd request is possible} -constraints {needsSquid} -setup {
    array unset ::http::socketMapping
    http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $badCreds
    set token0 [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000]
} -body {
    # Use the same caution as for the corresponding https test.
    set can [after 6000 {http::reset $token; set ${token}(z) timeout}]
    set token [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe]
    vwait ${token}(z)
    after cancel $can

    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $badCreds]
    set same [string equal [set ${token0}(sock)] [set ${token}(sock)]]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same"
} -result {complete ok 407 -- HttpProxy 1 1 -- -1 done 1} -cleanup {
    http::cleanup $token0
    http::cleanup $token
    unset -nocomplain token0 token ri res pos1 pos2 can same
    array unset ::http::socketMapping
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-5.7p.$ThreadLevel {http with-proxy ipv4 with-auth bad-creds-provided; check that 2nd request is possible, pipelining requested and possible} -constraints {needsSquid} -setup {
    array unset ::http::socketMapping
    http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $badCreds
} -body {
    set can0 [after 6000 {http::reset $token0; set ${token0}(z) timeout}]
    set token0 [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe]
    # Use the same caution as for the corresponding https test.
after idle {
    set can [after 6000 {http::reset $token; set ${token}(z) timeout}]
    set token [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe]
    vwait ${token}(z)
    after cancel $can
}
    vwait ${token0}(z)
    after cancel $can0

    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $badCreds]
    set same [string equal [set ${token0}(sock)] [set ${token}(sock)]]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same"
} -result {complete ok 407 -- HttpProxy 1 1 -- -1 done 1} -cleanup {
    http::cleanup $token0
    http::cleanup $token
    unset -nocomplain token0 token ri res pos1 pos2 can0 can same
    array unset ::http::socketMapping
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-5.8.$ThreadLevel {https with-proxy ipv4 with-auth bad-creds-provided; check that 2nd request is possible} -constraints {needsSquid needsTls} -setup {
    array unset ::http::socketMapping
    http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $badCreds
    set token0 [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000]
} -body {
    # If a bug passes the socket of a failed CONNECT to the main request, an infinite
    # wait can occur despite -timeout.  Fix this with http::reset; to do this the call
    # to http::geturl must be async so we have $token for use as argument of reset.
    set can [after 6000 {http::reset $token; set ${token}(z) timeout}]
    set token [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe]
    vwait ${token}(z)
    after cancel $can

    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $badCreds]
    set same [string equal [set ${token0}(sock)] [set ${token}(sock)]]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same"
} -result {complete ok 407 -- SecureProxyFailed 1 1 -- -1 done 0} -cleanup {
    http::cleanup $token0
    http::cleanup $token
    unset -nocomplain token0 token ri res pos1 pos2 can same
    array unset ::http::socketMapping
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-5.8p.$ThreadLevel {https with-proxy ipv4 with-auth bad-creds-provided; check that 2nd request is possible, pipelining requested but not possible} -constraints {needsSquid needsTls} -setup {
    array unset ::http::socketMapping
    http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $badCreds
} -body {
    set can0 [after 6000 {http::reset $token0; set ${token0}(z) timeout}]
    set token0 [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe]
    # If a bug passes the socket of a failed CONNECT to the main request, an infinite
    # wait can occur despite -timeout.  Fix this with http::reset; to do this the call
    # to http::geturl must be async so we have $token for use as argument of reset.
after idle {
    set can [after 6000 {http::reset $token; set ${token}(z) timeout}]
    set token [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe]
    vwait ${token}(z)
    after cancel $can
}
    vwait ${token0}(z)
    after cancel $can0

    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $badCreds]
    set same [string equal [set ${token0}(sock)] [set ${token}(sock)]]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same"
} -result {complete ok 407 -- SecureProxyFailed 1 1 -- -1 done 0} -cleanup {
    http::cleanup $token0
    http::cleanup $token
    unset -nocomplain token0 token ri res pos1 pos2 can0 can same
    array unset ::http::socketMapping
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-5.9.$ThreadLevel {http with-proxy ipv6 with-auth bad-creds-provided; check that 2nd request is possible} -constraints {needsSquid} -setup {
    array unset ::http::socketMapping
    http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth $badCreds
    set token0 [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000]
} -body {
    # Use the same caution as for the corresponding https test.
    set can [after 6000 {http::reset $token; set ${token}(z) timeout}]
    set token [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe]
    vwait ${token}(z)
    after cancel $can

    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $badCreds]
    set same [string equal [set ${token0}(sock)] [set ${token}(sock)]]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same"
} -result {complete ok 407 -- HttpProxy 1 1 -- -1 done 1} -cleanup {
    http::cleanup $token0
    http::cleanup $token
    unset -nocomplain token0 token ri res pos1 pos2 can same
    array unset ::http::socketMapping
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

test httpProxy-5.10.$ThreadLevel {https with-proxy ipv6 with-auth bad-creds-provided; check that 2nd request is possible} -constraints {needsSquid needsTls} -setup {
    array unset ::http::socketMapping
    http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth $badCreds
    set token0 [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000]
} -body {
    # If a bug passes the socket of a failed CONNECT to the main request, an infinite
    # wait can occur despite -timeout.  Fix this with http::reset; to do this the call
    # to http::geturl must be async so we have $token for use as argument of reset.
    set can [after 6000 {http::reset $token; set ${token}(z) timeout}]
    set token [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe]
    vwait ${token}(z)
    after cancel $can

    set ri [http::responseInfo $token]
    set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization]
    set pos2 [lsearch -exact [set ${token}(requestHeaders)] $badCreds]
    set same [string equal [set ${token0}(sock)] [set ${token}(sock)]]
    set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\
             [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\
             [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same"
} -result {complete ok 407 -- SecureProxyFailed 1 1 -- -1 done 0} -cleanup {
    http::cleanup $token0
    http::cleanup $token
    unset -nocomplain token0 token ri res pos1 pos2 can same
    array unset ::http::socketMapping
    http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {}
}

# cleanup
unset -nocomplain n4host n6host n4port n6port a4host a6host a4port a6port aliceCreds badCreds

rename bgerror {}
rename stopMe {}

::tcltest::cleanupTests

# Local variables:
# mode: tcl
# End:

Changes to tests/httpd11.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
# httpd11.tcl --                                                -*- tcl -*-
#
#	A simple httpd for testing HTTP/1.1 client features.
#	Not suitable for use on a internet connected port.
#
# Copyright © 2009 Pat Thoyts <[email protected]>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require tcl

proc ::tcl::dict::get? {dict key} {
    if {[dict exists $dict $key]} {
        return [dict get $dict $key]
    }
    return
}










|







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 © 2009 Pat Thoyts <[email protected]>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require Tcl

proc ::tcl::dict::get? {dict key} {
    if {[dict exists $dict $key]} {
        return [dict get $dict $key]
    }
    return
}
146
147
148
149
150
151
152
153




154
155
156
157
158
159
160
        if {$query ne ""} {puts $query}

        set path [string trimleft $path /]
        set path [file join [pwd] $path]
        if {[file exists $path] && [file isfile $path]} {
            foreach {what type} [mime-type $path] break
            set f [open $path r]
            if {$what eq "binary"} {chan configure $f -translation binary}




            set data [read $f]
            close $f
            set code "200 OK"
            set close [expr {[dict get? $meta connection] eq "close"}]
        }

        if {$protocol eq "HTTP/1.1"} {







|
>
>
>
>







146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
        if {$query ne ""} {puts $query}

        set path [string trimleft $path /]
        set path [file join [pwd] $path]
        if {[file exists $path] && [file isfile $path]} {
            foreach {what type} [mime-type $path] break
            set f [open $path r]
            if {$what eq "binary"} {
                chan configure $f -translation binary
            } else {
                chan configure $f -encoding utf-8
            }
            set data [read $f]
            close $f
            set code "200 OK"
            set close [expr {[dict get? $meta connection] eq "close"}]
        }

        if {$protocol eq "HTTP/1.1"} {

Added tests/icuUcmTests.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
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

# This file is automatically generated by ucm2tests.tcl.
# Edits will be overwritten on next generation.
#
# Generates tests comparing Tcl encodings to ICU.
# The generated file is NOT standalone. It should be sourced into a test script.

proc ucmConvertfromMismatches {enc map} {
    set mismatches {}
    foreach {unihex hex} $map {
        set unihex [string range 00000000$unihex end-7 end]; # Make 8 digits
        set unich [subst "\\U$unihex"]
        if {[encoding convertfrom -profile strict $enc [binary decode hex $hex]] ne $unich} {
            lappend mismatches "<[printable $unich],$hex>"
        }
    }
    return $mismatches
}
proc ucmConverttoMismatches {enc map} {
    set mismatches {}
    foreach {unihex hex} $map {
        set unihex [string range 00000000$unihex end-7 end]; # Make 8 digits
        set unich [subst "\\U$unihex"]
        if {[encoding convertto -profile strict $enc $unich] ne [binary decode hex $hex]} {
            lappend mismatches "<[printable $unich],$hex>"
        }
    }
    return $mismatches
}
if {[info commands printable] eq ""} {
    proc printable {s} {
        set print ""
        foreach c [split $s ""] {
            set i [scan $c %c]
            if {[string is print $c] && ($i <= 127)} {
                append print $c
            } elseif {$i <= 0xff} {
                append print \\x[format %02X $i]
            } elseif {$i <= 0xffff} {
                append print \\u[format %04X $i]
            } else {
                append print \\U[format %08X $i]
            }
        }
        return $print
    }
}


#
# cp1250 (generated from glibc-CP1250-2.1.2)

test encoding-convertfrom-ucmCompare-cp1250 {Compare against ICU UCM} -body {
    ucmConvertfromMismatches cp1250 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 00A0 A0 00A4 A4 00A6 A6 00A7 A7 00A8 A8 00A9 A9 00AB AB 00AC AC 00AD AD 00AE AE 00B0 B0 00B1 B1 00B4 B4 00B5 B5 00B6 B6 00B7 B7 00B8 B8 00BB BB 00C1 C1 00C2 C2 00C4 C4 00C7 C7 00C9 C9 00CB CB 00CD CD 00CE CE 00D3 D3 00D4 D4 00D6 D6 00D7 D7 00DA DA 00DC DC 00DD DD 00DF DF 00E1 E1 00E2 E2 00E4 E4 00E7 E7 00E9 E9 00EB EB 00ED ED 00EE EE 00F3 F3 00F4 F4 00F6 F6 00F7 F7 00FA FA 00FC FC 00FD FD 0102 C3 0103 E3 0104 A5 0105 B9 0106 C6 0107 E6 010C C8 010D E8 010E CF 010F EF 0110 D0 0111 F0 0118 CA 0119 EA 011A CC 011B EC 0139 C5 013A E5 013D BC 013E BE 0141 A3 0142 B3 0143 D1 0144 F1 0147 D2 0148 F2 0150 D5 0151 F5 0154 C0 0155 E0 0158 D8 0159 F8 015A 8C 015B 9C 015E AA 015F BA 0160 8A 0161 9A 0162 DE 0163 FE 0164 8D 0165 9D 016E D9 016F F9 0170 DB 0171 FB 0179 8F 017A 9F 017B AF 017C BF 017D 8E 017E 9E 02C7 A1 02D8 A2 02D9 FF 02DB B2 02DD BD 2013 96 2014 97 2018 91 2019 92 201A 82 201C 93 201D 94 201E 84 2020 86 2021 87 2022 95 2026 85 2030 89 2039 8B 203A 9B 20AC 80 2122 99}
} -result {}

test encoding-convertto-ucmCompare-cp1250 {Compare against ICU UCM} -body {
    ucmConverttoMismatches cp1250 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 00A0 A0 00A4 A4 00A6 A6 00A7 A7 00A8 A8 00A9 A9 00AB AB 00AC AC 00AD AD 00AE AE 00B0 B0 00B1 B1 00B4 B4 00B5 B5 00B6 B6 00B7 B7 00B8 B8 00BB BB 00C1 C1 00C2 C2 00C4 C4 00C7 C7 00C9 C9 00CB CB 00CD CD 00CE CE 00D3 D3 00D4 D4 00D6 D6 00D7 D7 00DA DA 00DC DC 00DD DD 00DF DF 00E1 E1 00E2 E2 00E4 E4 00E7 E7 00E9 E9 00EB EB 00ED ED 00EE EE 00F3 F3 00F4 F4 00F6 F6 00F7 F7 00FA FA 00FC FC 00FD FD 0102 C3 0103 E3 0104 A5 0105 B9 0106 C6 0107 E6 010C C8 010D E8 010E CF 010F EF 0110 D0 0111 F0 0118 CA 0119 EA 011A CC 011B EC 0139 C5 013A E5 013D BC 013E BE 0141 A3 0142 B3 0143 D1 0144 F1 0147 D2 0148 F2 0150 D5 0151 F5 0154 C0 0155 E0 0158 D8 0159 F8 015A 8C 015B 9C 015E AA 015F BA 0160 8A 0161 9A 0162 DE 0163 FE 0164 8D 0165 9D 016E D9 016F F9 0170 DB 0171 FB 0179 8F 017A 9F 017B AF 017C BF 017D 8E 017E 9E 02C7 A1 02D8 A2 02D9 FF 02DB B2 02DD BD 2013 96 2014 97 2018 91 2019 92 201A 82 201C 93 201D 94 201E 84 2020 86 2021 87 2022 95 2026 85 2030 89 2039 8B 203A 9B 20AC 80 2122 99}
} -result {}

# cp1250 - invalid byte sequences
lappend encInvalidBytes {*}{
    cp1250 81 tcl8    \U00000081 -1 {} {}
    cp1250 81 replace \uFFFD -1 {} {}
    cp1250 81 strict  {}       0 {} {}
    cp1250 83 tcl8    \U00000083 -1 {} {}
    cp1250 83 replace \uFFFD -1 {} {}
    cp1250 83 strict  {}       0 {} {}
    cp1250 88 tcl8    \U00000088 -1 {} {}
    cp1250 88 replace \uFFFD -1 {} {}
    cp1250 88 strict  {}       0 {} {}
    cp1250 90 tcl8    \U00000090 -1 {} {}
    cp1250 90 replace \uFFFD -1 {} {}
    cp1250 90 strict  {}       0 {} {}
    cp1250 98 tcl8    \U00000098 -1 {} {}
    cp1250 98 replace \uFFFD -1 {} {}
    cp1250 98 strict  {}       0 {} {}
}; # cp1250

# cp1250 - invalid byte sequences
lappend encUnencodableStrings {*}{
    cp1250 \U00000080 tcl8    1A -1 {} {}
    cp1250 \U00000080 replace 1A -1 {} {}
    cp1250 \U00000080 strict  {}                      0 {} {}
    cp1250 \U00000400 tcl8    1A -1 {} {}
    cp1250 \U00000400 replace 1A -1 {} {}
    cp1250 \U00000400 strict  {}                      0 {} {}
    cp1250 \U0000D800 tcl8    1A -1 {} {}
    cp1250 \U0000D800 replace 1A -1 {} {}
    cp1250 \U0000D800 strict  {}                      0 {} {}
    cp1250 \U0000DC00 tcl8    1A -1 {} {}
    cp1250 \U0000DC00 replace 1A -1 {} {}
    cp1250 \U0000DC00 strict  {}                      0 {} {}
    cp1250 \U00010000 tcl8    1A -1 {} {}
    cp1250 \U00010000 replace 1A -1 {} {}
    cp1250 \U00010000 strict  {}                      0 {} {}
    cp1250 \U0010FFFF tcl8    1A -1 {} {}
    cp1250 \U0010FFFF replace 1A -1 {} {}
    cp1250 \U0010FFFF strict  {}                      0 {} {}
}; # cp1250

#
# cp1251 (generated from glibc-CP1251-2.1.2)

test encoding-convertfrom-ucmCompare-cp1251 {Compare against ICU UCM} -body {
    ucmConvertfromMismatches cp1251 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 00A0 A0 00A4 A4 00A6 A6 00A7 A7 00A9 A9 00AB AB 00AC AC 00AD AD 00AE AE 00B0 B0 00B1 B1 00B5 B5 00B6 B6 00B7 B7 00BB BB 0401 A8 0402 80 0403 81 0404 AA 0405 BD 0406 B2 0407 AF 0408 A3 0409 8A 040A 8C 040B 8E 040C 8D 040E A1 040F 8F 0410 C0 0411 C1 0412 C2 0413 C3 0414 C4 0415 C5 0416 C6 0417 C7 0418 C8 0419 C9 041A CA 041B CB 041C CC 041D CD 041E CE 041F CF 0420 D0 0421 D1 0422 D2 0423 D3 0424 D4 0425 D5 0426 D6 0427 D7 0428 D8 0429 D9 042A DA 042B DB 042C DC 042D DD 042E DE 042F DF 0430 E0 0431 E1 0432 E2 0433 E3 0434 E4 0435 E5 0436 E6 0437 E7 0438 E8 0439 E9 043A EA 043B EB 043C EC 043D ED 043E EE 043F EF 0440 F0 0441 F1 0442 F2 0443 F3 0444 F4 0445 F5 0446 F6 0447 F7 0448 F8 0449 F9 044A FA 044B FB 044C FC 044D FD 044E FE 044F FF 0451 B8 0452 90 0453 83 0454 BA 0455 BE 0456 B3 0457 BF 0458 BC 0459 9A 045A 9C 045B 9E 045C 9D 045E A2 045F 9F 0490 A5 0491 B4 2013 96 2014 97 2018 91 2019 92 201A 82 201C 93 201D 94 201E 84 2020 86 2021 87 2022 95 2026 85 2030 89 2039 8B 203A 9B 20AC 88 2116 B9 2122 99}
} -result {}

test encoding-convertto-ucmCompare-cp1251 {Compare against ICU UCM} -body {
    ucmConverttoMismatches cp1251 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 00A0 A0 00A4 A4 00A6 A6 00A7 A7 00A9 A9 00AB AB 00AC AC 00AD AD 00AE AE 00B0 B0 00B1 B1 00B5 B5 00B6 B6 00B7 B7 00BB BB 0401 A8 0402 80 0403 81 0404 AA 0405 BD 0406 B2 0407 AF 0408 A3 0409 8A 040A 8C 040B 8E 040C 8D 040E A1 040F 8F 0410 C0 0411 C1 0412 C2 0413 C3 0414 C4 0415 C5 0416 C6 0417 C7 0418 C8 0419 C9 041A CA 041B CB 041C CC 041D CD 041E CE 041F CF 0420 D0 0421 D1 0422 D2 0423 D3 0424 D4 0425 D5 0426 D6 0427 D7 0428 D8 0429 D9 042A DA 042B DB 042C DC 042D DD 042E DE 042F DF 0430 E0 0431 E1 0432 E2 0433 E3 0434 E4 0435 E5 0436 E6 0437 E7 0438 E8 0439 E9 043A EA 043B EB 043C EC 043D ED 043E EE 043F EF 0440 F0 0441 F1 0442 F2 0443 F3 0444 F4 0445 F5 0446 F6 0447 F7 0448 F8 0449 F9 044A FA 044B FB 044C FC 044D FD 044E FE 044F FF 0451 B8 0452 90 0453 83 0454 BA 0455 BE 0456 B3 0457 BF 0458 BC 0459 9A 045A 9C 045B 9E 045C 9D 045E A2 045F 9F 0490 A5 0491 B4 2013 96 2014 97 2018 91 2019 92 201A 82 201C 93 201D 94 201E 84 2020 86 2021 87 2022 95 2026 85 2030 89 2039 8B 203A 9B 20AC 88 2116 B9 2122 99}
} -result {}

# cp1251 - invalid byte sequences
lappend encInvalidBytes {*}{
    cp1251 98 tcl8    \U00000098 -1 {} {}
    cp1251 98 replace \uFFFD -1 {} {}
    cp1251 98 strict  {}       0 {} {}
}; # cp1251

# cp1251 - invalid byte sequences
lappend encUnencodableStrings {*}{
    cp1251 \U00000080 tcl8    1A -1 {} {}
    cp1251 \U00000080 replace 1A -1 {} {}
    cp1251 \U00000080 strict  {}                      0 {} {}
    cp1251 \U00000400 tcl8    1A -1 {} {}
    cp1251 \U00000400 replace 1A -1 {} {}
    cp1251 \U00000400 strict  {}                      0 {} {}
    cp1251 \U0000D800 tcl8    1A -1 {} {}
    cp1251 \U0000D800 replace 1A -1 {} {}
    cp1251 \U0000D800 strict  {}                      0 {} {}
    cp1251 \U0000DC00 tcl8    1A -1 {} {}
    cp1251 \U0000DC00 replace 1A -1 {} {}
    cp1251 \U0000DC00 strict  {}                      0 {} {}
    cp1251 \U00010000 tcl8    1A -1 {} {}
    cp1251 \U00010000 replace 1A -1 {} {}
    cp1251 \U00010000 strict  {}                      0 {} {}
    cp1251 \U0010FFFF tcl8    1A -1 {} {}
    cp1251 \U0010FFFF replace 1A -1 {} {}
    cp1251 \U0010FFFF strict  {}                      0 {} {}
}; # cp1251

#
# cp1252 (generated from glibc-CP1252-2.1.2)

test encoding-convertfrom-ucmCompare-cp1252 {Compare against ICU UCM} -body {
    ucmConvertfromMismatches cp1252 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 00A0 A0 00A1 A1 00A2 A2 00A3 A3 00A4 A4 00A5 A5 00A6 A6 00A7 A7 00A8 A8 00A9 A9 00AA AA 00AB AB 00AC AC 00AD AD 00AE AE 00AF AF 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B4 B4 00B5 B5 00B6 B6 00B7 B7 00B8 B8 00B9 B9 00BA BA 00BB BB 00BC BC 00BD BD 00BE BE 00BF BF 00C0 C0 00C1 C1 00C2 C2 00C3 C3 00C4 C4 00C5 C5 00C6 C6 00C7 C7 00C8 C8 00C9 C9 00CA CA 00CB CB 00CC CC 00CD CD 00CE CE 00CF CF 00D0 D0 00D1 D1 00D2 D2 00D3 D3 00D4 D4 00D5 D5 00D6 D6 00D7 D7 00D8 D8 00D9 D9 00DA DA 00DB DB 00DC DC 00DD DD 00DE DE 00DF DF 00E0 E0 00E1 E1 00E2 E2 00E3 E3 00E4 E4 00E5 E5 00E6 E6 00E7 E7 00E8 E8 00E9 E9 00EA EA 00EB EB 00EC EC 00ED ED 00EE EE 00EF EF 00F0 F0 00F1 F1 00F2 F2 00F3 F3 00F4 F4 00F5 F5 00F6 F6 00F7 F7 00F8 F8 00F9 F9 00FA FA 00FB FB 00FC FC 00FD FD 00FE FE 00FF FF 0152 8C 0153 9C 0160 8A 0161 9A 0178 9F 017D 8E 017E 9E 0192 83 02C6 88 02DC 98 2013 96 2014 97 2018 91 2019 92 201A 82 201C 93 201D 94 201E 84 2020 86 2021 87 2022 95 2026 85 2030 89 2039 8B 203A 9B 20AC 80 2122 99}
} -result {}

test encoding-convertto-ucmCompare-cp1252 {Compare against ICU UCM} -body {
    ucmConverttoMismatches cp1252 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 00A0 A0 00A1 A1 00A2 A2 00A3 A3 00A4 A4 00A5 A5 00A6 A6 00A7 A7 00A8 A8 00A9 A9 00AA AA 00AB AB 00AC AC 00AD AD 00AE AE 00AF AF 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B4 B4 00B5 B5 00B6 B6 00B7 B7 00B8 B8 00B9 B9 00BA BA 00BB BB 00BC BC 00BD BD 00BE BE 00BF BF 00C0 C0 00C1 C1 00C2 C2 00C3 C3 00C4 C4 00C5 C5 00C6 C6 00C7 C7 00C8 C8 00C9 C9 00CA CA 00CB CB 00CC CC 00CD CD 00CE CE 00CF CF 00D0 D0 00D1 D1 00D2 D2 00D3 D3 00D4 D4 00D5 D5 00D6 D6 00D7 D7 00D8 D8 00D9 D9 00DA DA 00DB DB 00DC DC 00DD DD 00DE DE 00DF DF 00E0 E0 00E1 E1 00E2 E2 00E3 E3 00E4 E4 00E5 E5 00E6 E6 00E7 E7 00E8 E8 00E9 E9 00EA EA 00EB EB 00EC EC 00ED ED 00EE EE 00EF EF 00F0 F0 00F1 F1 00F2 F2 00F3 F3 00F4 F4 00F5 F5 00F6 F6 00F7 F7 00F8 F8 00F9 F9 00FA FA 00FB FB 00FC FC 00FD FD 00FE FE 00FF FF 0152 8C 0153 9C 0160 8A 0161 9A 0178 9F 017D 8E 017E 9E 0192 83 02C6 88 02DC 98 2013 96 2014 97 2018 91 2019 92 201A 82 201C 93 201D 94 201E 84 2020 86 2021 87 2022 95 2026 85 2030 89 2039 8B 203A 9B 20AC 80 2122 99}
} -result {}

# cp1252 - invalid byte sequences
lappend encInvalidBytes {*}{
    cp1252 81 tcl8    \U00000081 -1 {} {}
    cp1252 81 replace \uFFFD -1 {} {}
    cp1252 81 strict  {}       0 {} {}
    cp1252 8D tcl8    \U0000008D -1 {} {}
    cp1252 8D replace \uFFFD -1 {} {}
    cp1252 8D strict  {}       0 {} {}
    cp1252 8F tcl8    \U0000008F -1 {} {}
    cp1252 8F replace \uFFFD -1 {} {}
    cp1252 8F strict  {}       0 {} {}
    cp1252 90 tcl8    \U00000090 -1 {} {}
    cp1252 90 replace \uFFFD -1 {} {}
    cp1252 90 strict  {}       0 {} {}
    cp1252 9D tcl8    \U0000009D -1 {} {}
    cp1252 9D replace \uFFFD -1 {} {}
    cp1252 9D strict  {}       0 {} {}
}; # cp1252

# cp1252 - invalid byte sequences
lappend encUnencodableStrings {*}{
    cp1252 \U00000080 tcl8    1A -1 {} {}
    cp1252 \U00000080 replace 1A -1 {} {}
    cp1252 \U00000080 strict  {}                      0 {} {}
    cp1252 \U00000400 tcl8    1A -1 {} {}
    cp1252 \U00000400 replace 1A -1 {} {}
    cp1252 \U00000400 strict  {}                      0 {} {}
    cp1252 \U0000D800 tcl8    1A -1 {} {}
    cp1252 \U0000D800 replace 1A -1 {} {}
    cp1252 \U0000D800 strict  {}                      0 {} {}
    cp1252 \U0000DC00 tcl8    1A -1 {} {}
    cp1252 \U0000DC00 replace 1A -1 {} {}
    cp1252 \U0000DC00 strict  {}                      0 {} {}
    cp1252 \U00010000 tcl8    1A -1 {} {}
    cp1252 \U00010000 replace 1A -1 {} {}
    cp1252 \U00010000 strict  {}                      0 {} {}
    cp1252 \U0010FFFF tcl8    1A -1 {} {}
    cp1252 \U0010FFFF replace 1A -1 {} {}
    cp1252 \U0010FFFF strict  {}                      0 {} {}
}; # cp1252

#
# cp1253 (generated from glibc-CP1253-2.1.2)

test encoding-convertfrom-ucmCompare-cp1253 {Compare against ICU UCM} -body {
    ucmConvertfromMismatches cp1253 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 00A0 A0 00A3 A3 00A4 A4 00A5 A5 00A6 A6 00A7 A7 00A8 A8 00A9 A9 00AB AB 00AC AC 00AD AD 00AE AE 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B5 B5 00B6 B6 00B7 B7 00BB BB 00BD BD 0192 83 0384 B4 0385 A1 0386 A2 0388 B8 0389 B9 038A BA 038C BC 038E BE 038F BF 0390 C0 0391 C1 0392 C2 0393 C3 0394 C4 0395 C5 0396 C6 0397 C7 0398 C8 0399 C9 039A CA 039B CB 039C CC 039D CD 039E CE 039F CF 03A0 D0 03A1 D1 03A3 D3 03A4 D4 03A5 D5 03A6 D6 03A7 D7 03A8 D8 03A9 D9 03AA DA 03AB DB 03AC DC 03AD DD 03AE DE 03AF DF 03B0 E0 03B1 E1 03B2 E2 03B3 E3 03B4 E4 03B5 E5 03B6 E6 03B7 E7 03B8 E8 03B9 E9 03BA EA 03BB EB 03BC EC 03BD ED 03BE EE 03BF EF 03C0 F0 03C1 F1 03C2 F2 03C3 F3 03C4 F4 03C5 F5 03C6 F6 03C7 F7 03C8 F8 03C9 F9 03CA FA 03CB FB 03CC FC 03CD FD 03CE FE 2013 96 2014 97 2015 AF 2018 91 2019 92 201A 82 201C 93 201D 94 201E 84 2020 86 2021 87 2022 95 2026 85 2030 89 2039 8B 203A 9B 20AC 80 2122 99}
} -result {}

test encoding-convertto-ucmCompare-cp1253 {Compare against ICU UCM} -body {
    ucmConverttoMismatches cp1253 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 00A0 A0 00A3 A3 00A4 A4 00A5 A5 00A6 A6 00A7 A7 00A8 A8 00A9 A9 00AB AB 00AC AC 00AD AD 00AE AE 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B5 B5 00B6 B6 00B7 B7 00BB BB 00BD BD 0192 83 0384 B4 0385 A1 0386 A2 0388 B8 0389 B9 038A BA 038C BC 038E BE 038F BF 0390 C0 0391 C1 0392 C2 0393 C3 0394 C4 0395 C5 0396 C6 0397 C7 0398 C8 0399 C9 039A CA 039B CB 039C CC 039D CD 039E CE 039F CF 03A0 D0 03A1 D1 03A3 D3 03A4 D4 03A5 D5 03A6 D6 03A7 D7 03A8 D8 03A9 D9 03AA DA 03AB DB 03AC DC 03AD DD 03AE DE 03AF DF 03B0 E0 03B1 E1 03B2 E2 03B3 E3 03B4 E4 03B5 E5 03B6 E6 03B7 E7 03B8 E8 03B9 E9 03BA EA 03BB EB 03BC EC 03BD ED 03BE EE 03BF EF 03C0 F0 03C1 F1 03C2 F2 03C3 F3 03C4 F4 03C5 F5 03C6 F6 03C7 F7 03C8 F8 03C9 F9 03CA FA 03CB FB 03CC FC 03CD FD 03CE FE 2013 96 2014 97 2015 AF 2018 91 2019 92 201A 82 201C 93 201D 94 201E 84 2020 86 2021 87 2022 95 2026 85 2030 89 2039 8B 203A 9B 20AC 80 2122 99}
} -result {}

# cp1253 - invalid byte sequences
lappend encInvalidBytes {*}{
    cp1253 81 tcl8    \U00000081 -1 {} {}
    cp1253 81 replace \uFFFD -1 {} {}
    cp1253 81 strict  {}       0 {} {}
    cp1253 88 tcl8    \U00000088 -1 {} {}
    cp1253 88 replace \uFFFD -1 {} {}
    cp1253 88 strict  {}       0 {} {}
    cp1253 8A tcl8    \U0000008A -1 {} {}
    cp1253 8A replace \uFFFD -1 {} {}
    cp1253 8A strict  {}       0 {} {}
    cp1253 8C tcl8    \U0000008C -1 {} {}
    cp1253 8C replace \uFFFD -1 {} {}
    cp1253 8C strict  {}       0 {} {}
    cp1253 8D tcl8    \U0000008D -1 {} {}
    cp1253 8D replace \uFFFD -1 {} {}
    cp1253 8D strict  {}       0 {} {}
    cp1253 8E tcl8    \U0000008E -1 {} {}
    cp1253 8E replace \uFFFD -1 {} {}
    cp1253 8E strict  {}       0 {} {}
    cp1253 8F tcl8    \U0000008F -1 {} {}
    cp1253 8F replace \uFFFD -1 {} {}
    cp1253 8F strict  {}       0 {} {}
    cp1253 90 tcl8    \U00000090 -1 {} {}
    cp1253 90 replace \uFFFD -1 {} {}
    cp1253 90 strict  {}       0 {} {}
    cp1253 98 tcl8    \U00000098 -1 {} {}
    cp1253 98 replace \uFFFD -1 {} {}
    cp1253 98 strict  {}       0 {} {}
    cp1253 9A tcl8    \U0000009A -1 {} {}
    cp1253 9A replace \uFFFD -1 {} {}
    cp1253 9A strict  {}       0 {} {}
    cp1253 9C tcl8    \U0000009C -1 {} {}
    cp1253 9C replace \uFFFD -1 {} {}
    cp1253 9C strict  {}       0 {} {}
    cp1253 9D tcl8    \U0000009D -1 {} {}
    cp1253 9D replace \uFFFD -1 {} {}
    cp1253 9D strict  {}       0 {} {}
    cp1253 9E tcl8    \U0000009E -1 {} {}
    cp1253 9E replace \uFFFD -1 {} {}
    cp1253 9E strict  {}       0 {} {}
    cp1253 9F tcl8    \U0000009F -1 {} {}
    cp1253 9F replace \uFFFD -1 {} {}
    cp1253 9F strict  {}       0 {} {}
    cp1253 AA tcl8    \U000000AA -1 {} {}
    cp1253 AA replace \uFFFD -1 {} {}
    cp1253 AA strict  {}       0 {} {}
    cp1253 D2 tcl8    \U000000D2 -1 {} {}
    cp1253 D2 replace \uFFFD -1 {} {}
    cp1253 D2 strict  {}       0 {} {}
    cp1253 FF tcl8    \U000000FF -1 {} {}
    cp1253 FF replace \uFFFD -1 {} {}
    cp1253 FF strict  {}       0 {} {}
}; # cp1253

# cp1253 - invalid byte sequences
lappend encUnencodableStrings {*}{
    cp1253 \U00000080 tcl8    1A -1 {} {}
    cp1253 \U00000080 replace 1A -1 {} {}
    cp1253 \U00000080 strict  {}                      0 {} {}
    cp1253 \U00000400 tcl8    1A -1 {} {}
    cp1253 \U00000400 replace 1A -1 {} {}
    cp1253 \U00000400 strict  {}                      0 {} {}
    cp1253 \U0000D800 tcl8    1A -1 {} {}
    cp1253 \U0000D800 replace 1A -1 {} {}
    cp1253 \U0000D800 strict  {}                      0 {} {}
    cp1253 \U0000DC00 tcl8    1A -1 {} {}
    cp1253 \U0000DC00 replace 1A -1 {} {}
    cp1253 \U0000DC00 strict  {}                      0 {} {}
    cp1253 \U00010000 tcl8    1A -1 {} {}
    cp1253 \U00010000 replace 1A -1 {} {}
    cp1253 \U00010000 strict  {}                      0 {} {}
    cp1253 \U0010FFFF tcl8    1A -1 {} {}
    cp1253 \U0010FFFF replace 1A -1 {} {}
    cp1253 \U0010FFFF strict  {}                      0 {} {}
}; # cp1253

#
# cp1254 (generated from glibc-CP1254-2.1.2)

test encoding-convertfrom-ucmCompare-cp1254 {Compare against ICU UCM} -body {
    ucmConvertfromMismatches cp1254 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 00A0 A0 00A1 A1 00A2 A2 00A3 A3 00A4 A4 00A5 A5 00A6 A6 00A7 A7 00A8 A8 00A9 A9 00AA AA 00AB AB 00AC AC 00AD AD 00AE AE 00AF AF 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B4 B4 00B5 B5 00B6 B6 00B7 B7 00B8 B8 00B9 B9 00BA BA 00BB BB 00BC BC 00BD BD 00BE BE 00BF BF 00C0 C0 00C1 C1 00C2 C2 00C3 C3 00C4 C4 00C5 C5 00C6 C6 00C7 C7 00C8 C8 00C9 C9 00CA CA 00CB CB 00CC CC 00CD CD 00CE CE 00CF CF 00D1 D1 00D2 D2 00D3 D3 00D4 D4 00D5 D5 00D6 D6 00D7 D7 00D8 D8 00D9 D9 00DA DA 00DB DB 00DC DC 00DF DF 00E0 E0 00E1 E1 00E2 E2 00E3 E3 00E4 E4 00E5 E5 00E6 E6 00E7 E7 00E8 E8 00E9 E9 00EA EA 00EB EB 00EC EC 00ED ED 00EE EE 00EF EF 00F1 F1 00F2 F2 00F3 F3 00F4 F4 00F5 F5 00F6 F6 00F7 F7 00F8 F8 00F9 F9 00FA FA 00FB FB 00FC FC 00FF FF 011E D0 011F F0 0130 DD 0131 FD 0152 8C 0153 9C 015E DE 015F FE 0160 8A 0161 9A 0178 9F 0192 83 02C6 88 02DC 98 2013 96 2014 97 2018 91 2019 92 201A 82 201C 93 201D 94 201E 84 2020 86 2021 87 2022 95 2026 85 2030 89 2039 8B 203A 9B 20AC 80 2122 99}
} -result {}

test encoding-convertto-ucmCompare-cp1254 {Compare against ICU UCM} -body {
    ucmConverttoMismatches cp1254 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 00A0 A0 00A1 A1 00A2 A2 00A3 A3 00A4 A4 00A5 A5 00A6 A6 00A7 A7 00A8 A8 00A9 A9 00AA AA 00AB AB 00AC AC 00AD AD 00AE AE 00AF AF 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B4 B4 00B5 B5 00B6 B6 00B7 B7 00B8 B8 00B9 B9 00BA BA 00BB BB 00BC BC 00BD BD 00BE BE 00BF BF 00C0 C0 00C1 C1 00C2 C2 00C3 C3 00C4 C4 00C5 C5 00C6 C6 00C7 C7 00C8 C8 00C9 C9 00CA CA 00CB CB 00CC CC 00CD CD 00CE CE 00CF CF 00D1 D1 00D2 D2 00D3 D3 00D4 D4 00D5 D5 00D6 D6 00D7 D7 00D8 D8 00D9 D9 00DA DA 00DB DB 00DC DC 00DF DF 00E0 E0 00E1 E1 00E2 E2 00E3 E3 00E4 E4 00E5 E5 00E6 E6 00E7 E7 00E8 E8 00E9 E9 00EA EA 00EB EB 00EC EC 00ED ED 00EE EE 00EF EF 00F1 F1 00F2 F2 00F3 F3 00F4 F4 00F5 F5 00F6 F6 00F7 F7 00F8 F8 00F9 F9 00FA FA 00FB FB 00FC FC 00FF FF 011E D0 011F F0 0130 DD 0131 FD 0152 8C 0153 9C 015E DE 015F FE 0160 8A 0161 9A 0178 9F 0192 83 02C6 88 02DC 98 2013 96 2014 97 2018 91 2019 92 201A 82 201C 93 201D 94 201E 84 2020 86 2021 87 2022 95 2026 85 2030 89 2039 8B 203A 9B 20AC 80 2122 99}
} -result {}

# cp1254 - invalid byte sequences
lappend encInvalidBytes {*}{
    cp1254 81 tcl8    \U00000081 -1 {} {}
    cp1254 81 replace \uFFFD -1 {} {}
    cp1254 81 strict  {}       0 {} {}
    cp1254 8D tcl8    \U0000008D -1 {} {}
    cp1254 8D replace \uFFFD -1 {} {}
    cp1254 8D strict  {}       0 {} {}
    cp1254 8E tcl8    \U0000008E -1 {} {}
    cp1254 8E replace \uFFFD -1 {} {}
    cp1254 8E strict  {}       0 {} {}
    cp1254 8F tcl8    \U0000008F -1 {} {}
    cp1254 8F replace \uFFFD -1 {} {}
    cp1254 8F strict  {}       0 {} {}
    cp1254 90 tcl8    \U00000090 -1 {} {}
    cp1254 90 replace \uFFFD -1 {} {}
    cp1254 90 strict  {}       0 {} {}
    cp1254 9D tcl8    \U0000009D -1 {} {}
    cp1254 9D replace \uFFFD -1 {} {}
    cp1254 9D strict  {}       0 {} {}
    cp1254 9E tcl8    \U0000009E -1 {} {}
    cp1254 9E replace \uFFFD -1 {} {}
    cp1254 9E strict  {}       0 {} {}
}; # cp1254

# cp1254 - invalid byte sequences
lappend encUnencodableStrings {*}{
    cp1254 \U00000080 tcl8    1A -1 {} {}
    cp1254 \U00000080 replace 1A -1 {} {}
    cp1254 \U00000080 strict  {}                      0 {} {}
    cp1254 \U00000400 tcl8    1A -1 {} {}
    cp1254 \U00000400 replace 1A -1 {} {}
    cp1254 \U00000400 strict  {}                      0 {} {}
    cp1254 \U0000D800 tcl8    1A -1 {} {}
    cp1254 \U0000D800 replace 1A -1 {} {}
    cp1254 \U0000D800 strict  {}                      0 {} {}
    cp1254 \U0000DC00 tcl8    1A -1 {} {}
    cp1254 \U0000DC00 replace 1A -1 {} {}
    cp1254 \U0000DC00 strict  {}                      0 {} {}
    cp1254 \U00010000 tcl8    1A -1 {} {}
    cp1254 \U00010000 replace 1A -1 {} {}
    cp1254 \U00010000 strict  {}                      0 {} {}
    cp1254 \U0010FFFF tcl8    1A -1 {} {}
    cp1254 \U0010FFFF replace 1A -1 {} {}
    cp1254 \U0010FFFF strict  {}                      0 {} {}
}; # cp1254

#
# cp1255 (generated from glibc-CP1255-2.1.2)

test encoding-convertfrom-ucmCompare-cp1255 {Compare against ICU UCM} -body {
    ucmConvertfromMismatches cp1255 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 00A0 A0 00A1 A1 00A2 A2 00A3 A3 00A5 A5 00A6 A6 00A7 A7 00A8 A8 00A9 A9 00AB AB 00AC AC 00AD AD 00AE AE 00AF AF 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B4 B4 00B5 B5 00B6 B6 00B7 B7 00B8 B8 00B9 B9 00BB BB 00BC BC 00BD BD 00BE BE 00BF BF 00D7 AA 00F7 BA 0192 83 02C6 88 02DC 98 05B0 C0 05B1 C1 05B2 C2 05B3 C3 05B4 C4 05B5 C5 05B6 C6 05B7 C7 05B8 C8 05B9 C9 05BB CB 05BC CC 05BD CD 05BE CE 05BF CF 05C0 D0 05C1 D1 05C2 D2 05C3 D3 05D0 E0 05D1 E1 05D2 E2 05D3 E3 05D4 E4 05D5 E5 05D6 E6 05D7 E7 05D8 E8 05D9 E9 05DA EA 05DB EB 05DC EC 05DD ED 05DE EE 05DF EF 05E0 F0 05E1 F1 05E2 F2 05E3 F3 05E4 F4 05E5 F5 05E6 F6 05E7 F7 05E8 F8 05E9 F9 05EA FA 05F0 D4 05F1 D5 05F2 D6 05F3 D7 05F4 D8 200E FD 200F FE 2013 96 2014 97 2018 91 2019 92 201A 82 201C 93 201D 94 201E 84 2020 86 2021 87 2022 95 2026 85 2030 89 2039 8B 203A 9B 20AA A4 20AC 80 2122 99}
} -result {}

test encoding-convertto-ucmCompare-cp1255 {Compare against ICU UCM} -body {
    ucmConverttoMismatches cp1255 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 00A0 A0 00A1 A1 00A2 A2 00A3 A3 00A5 A5 00A6 A6 00A7 A7 00A8 A8 00A9 A9 00AB AB 00AC AC 00AD AD 00AE AE 00AF AF 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B4 B4 00B5 B5 00B6 B6 00B7 B7 00B8 B8 00B9 B9 00BB BB 00BC BC 00BD BD 00BE BE 00BF BF 00D7 AA 00F7 BA 0192 83 02C6 88 02DC 98 05B0 C0 05B1 C1 05B2 C2 05B3 C3 05B4 C4 05B5 C5 05B6 C6 05B7 C7 05B8 C8 05B9 C9 05BB CB 05BC CC 05BD CD 05BE CE 05BF CF 05C0 D0 05C1 D1 05C2 D2 05C3 D3 05D0 E0 05D1 E1 05D2 E2 05D3 E3 05D4 E4 05D5 E5 05D6 E6 05D7 E7 05D8 E8 05D9 E9 05DA EA 05DB EB 05DC EC 05DD ED 05DE EE 05DF EF 05E0 F0 05E1 F1 05E2 F2 05E3 F3 05E4 F4 05E5 F5 05E6 F6 05E7 F7 05E8 F8 05E9 F9 05EA FA 05F0 D4 05F1 D5 05F2 D6 05F3 D7 05F4 D8 200E FD 200F FE 2013 96 2014 97 2018 91 2019 92 201A 82 201C 93 201D 94 201E 84 2020 86 2021 87 2022 95 2026 85 2030 89 2039 8B 203A 9B 20AA A4 20AC 80 2122 99}
} -result {}

# cp1255 - invalid byte sequences
lappend encInvalidBytes {*}{
    cp1255 81 tcl8    \U00000081 -1 {} {}
    cp1255 81 replace \uFFFD -1 {} {}
    cp1255 81 strict  {}       0 {} {}
    cp1255 8A tcl8    \U0000008A -1 {} {}
    cp1255 8A replace \uFFFD -1 {} {}
    cp1255 8A strict  {}       0 {} {}
    cp1255 8C tcl8    \U0000008C -1 {} {}
    cp1255 8C replace \uFFFD -1 {} {}
    cp1255 8C strict  {}       0 {} {}
    cp1255 8D tcl8    \U0000008D -1 {} {}
    cp1255 8D replace \uFFFD -1 {} {}
    cp1255 8D strict  {}       0 {} {}
    cp1255 8E tcl8    \U0000008E -1 {} {}
    cp1255 8E replace \uFFFD -1 {} {}
    cp1255 8E strict  {}       0 {} {}
    cp1255 8F tcl8    \U0000008F -1 {} {}
    cp1255 8F replace \uFFFD -1 {} {}
    cp1255 8F strict  {}       0 {} {}
    cp1255 90 tcl8    \U00000090 -1 {} {}
    cp1255 90 replace \uFFFD -1 {} {}
    cp1255 90 strict  {}       0 {} {}
    cp1255 9A tcl8    \U0000009A -1 {} {}
    cp1255 9A replace \uFFFD -1 {} {}
    cp1255 9A strict  {}       0 {} {}
    cp1255 9C tcl8    \U0000009C -1 {} {}
    cp1255 9C replace \uFFFD -1 {} {}
    cp1255 9C strict  {}       0 {} {}
    cp1255 9D tcl8    \U0000009D -1 {} {}
    cp1255 9D replace \uFFFD -1 {} {}
    cp1255 9D strict  {}       0 {} {}
    cp1255 9E tcl8    \U0000009E -1 {} {}
    cp1255 9E replace \uFFFD -1 {} {}
    cp1255 9E strict  {}       0 {} {}
    cp1255 9F tcl8    \U0000009F -1 {} {}
    cp1255 9F replace \uFFFD -1 {} {}
    cp1255 9F strict  {}       0 {} {}
    cp1255 CA tcl8    \U000000CA -1 {} {}
    cp1255 CA replace \uFFFD -1 {} {}
    cp1255 CA strict  {}       0 {} {}
    cp1255 D9 tcl8    \U000000D9 -1 {} {}
    cp1255 D9 replace \uFFFD -1 {} {}
    cp1255 D9 strict  {}       0 {} {}
    cp1255 DA tcl8    \U000000DA -1 {} {}
    cp1255 DA replace \uFFFD -1 {} {}
    cp1255 DA strict  {}       0 {} {}
    cp1255 DB tcl8    \U000000DB -1 {} {}
    cp1255 DB replace \uFFFD -1 {} {}
    cp1255 DB strict  {}       0 {} {}
    cp1255 DC tcl8    \U000000DC -1 {} {}
    cp1255 DC replace \uFFFD -1 {} {}
    cp1255 DC strict  {}       0 {} {}
    cp1255 DD tcl8    \U000000DD -1 {} {}
    cp1255 DD replace \uFFFD -1 {} {}
    cp1255 DD strict  {}       0 {} {}
    cp1255 DE tcl8    \U000000DE -1 {} {}
    cp1255 DE replace \uFFFD -1 {} {}
    cp1255 DE strict  {}       0 {} {}
    cp1255 DF tcl8    \U000000DF -1 {} {}
    cp1255 DF replace \uFFFD -1 {} {}
    cp1255 DF strict  {}       0 {} {}
    cp1255 FB tcl8    \U000000FB -1 {} {}
    cp1255 FB replace \uFFFD -1 {} {}
    cp1255 FB strict  {}       0 {} {}
    cp1255 FC tcl8    \U000000FC -1 {} {}
    cp1255 FC replace \uFFFD -1 {} {}
    cp1255 FC strict  {}       0 {} {}
    cp1255 FF tcl8    \U000000FF -1 {} {}
    cp1255 FF replace \uFFFD -1 {} {}
    cp1255 FF strict  {}       0 {} {}
}; # cp1255

# cp1255 - invalid byte sequences
lappend encUnencodableStrings {*}{
    cp1255 \U00000080 tcl8    1A -1 {} {}
    cp1255 \U00000080 replace 1A -1 {} {}
    cp1255 \U00000080 strict  {}                      0 {} {}
    cp1255 \U00000400 tcl8    1A -1 {} {}
    cp1255 \U00000400 replace 1A -1 {} {}
    cp1255 \U00000400 strict  {}                      0 {} {}
    cp1255 \U0000D800 tcl8    1A -1 {} {}
    cp1255 \U0000D800 replace 1A -1 {} {}
    cp1255 \U0000D800 strict  {}                      0 {} {}
    cp1255 \U0000DC00 tcl8    1A -1 {} {}
    cp1255 \U0000DC00 replace 1A -1 {} {}
    cp1255 \U0000DC00 strict  {}                      0 {} {}
    cp1255 \U00010000 tcl8    1A -1 {} {}
    cp1255 \U00010000 replace 1A -1 {} {}
    cp1255 \U00010000 strict  {}                      0 {} {}
    cp1255 \U0010FFFF tcl8    1A -1 {} {}
    cp1255 \U0010FFFF replace 1A -1 {} {}
    cp1255 \U0010FFFF strict  {}                      0 {} {}
}; # cp1255

#
# cp1256 (generated from glibc-CP1256-2.1.2)

test encoding-convertfrom-ucmCompare-cp1256 {Compare against ICU UCM} -body {
    ucmConvertfromMismatches cp1256 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 00A0 A0 00A2 A2 00A3 A3 00A4 A4 00A5 A5 00A6 A6 00A7 A7 00A8 A8 00A9 A9 00AB AB 00AC AC 00AD AD 00AE AE 00AF AF 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B4 B4 00B5 B5 00B6 B6 00B7 B7 00B8 B8 00B9 B9 00BB BB 00BC BC 00BD BD 00BE BE 00D7 D7 00E0 E0 00E2 E2 00E7 E7 00E8 E8 00E9 E9 00EA EA 00EB EB 00EE EE 00EF EF 00F4 F4 00F7 F7 00F9 F9 00FB FB 00FC FC 0152 8C 0153 9C 0192 83 02C6 88 060C A1 061B BA 061F BF 0621 C1 0622 C2 0623 C3 0624 C4 0625 C5 0626 C6 0627 C7 0628 C8 0629 C9 062A CA 062B CB 062C CC 062D CD 062E CE 062F CF 0630 D0 0631 D1 0632 D2 0633 D3 0634 D4 0635 D5 0636 D6 0637 D8 0638 D9 0639 DA 063A DB 0640 DC 0641 DD 0642 DE 0643 DF 0644 E1 0645 E3 0646 E4 0647 E5 0648 E6 0649 EC 064A ED 064B F0 064C F1 064D F2 064E F3 064F F5 0650 F6 0651 F8 0652 FA 0679 8A 067E 81 0686 8D 0688 8F 0691 9A 0698 8E 06A9 98 06AF 90 06BA 9F 06BE AA 06C1 C0 06D2 FF 200C 9D 200D 9E 200E FD 200F FE 2013 96 2014 97 2018 91 2019 92 201A 82 201C 93 201D 94 201E 84 2020 86 2021 87 2022 95 2026 85 2030 89 2039 8B 203A 9B 20AC 80 2122 99}
} -result {}

test encoding-convertto-ucmCompare-cp1256 {Compare against ICU UCM} -body {
    ucmConverttoMismatches cp1256 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 00A0 A0 00A2 A2 00A3 A3 00A4 A4 00A5 A5 00A6 A6 00A7 A7 00A8 A8 00A9 A9 00AB AB 00AC AC 00AD AD 00AE AE 00AF AF 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B4 B4 00B5 B5 00B6 B6 00B7 B7 00B8 B8 00B9 B9 00BB BB 00BC BC 00BD BD 00BE BE 00D7 D7 00E0 E0 00E2 E2 00E7 E7 00E8 E8 00E9 E9 00EA EA 00EB EB 00EE EE 00EF EF 00F4 F4 00F7 F7 00F9 F9 00FB FB 00FC FC 0152 8C 0153 9C 0192 83 02C6 88 060C A1 061B BA 061F BF 0621 C1 0622 C2 0623 C3 0624 C4 0625 C5 0626 C6 0627 C7 0628 C8 0629 C9 062A CA 062B CB 062C CC 062D CD 062E CE 062F CF 0630 D0 0631 D1 0632 D2 0633 D3 0634 D4 0635 D5 0636 D6 0637 D8 0638 D9 0639 DA 063A DB 0640 DC 0641 DD 0642 DE 0643 DF 0644 E1 0645 E3 0646 E4 0647 E5 0648 E6 0649 EC 064A ED 064B F0 064C F1 064D F2 064E F3 064F F5 0650 F6 0651 F8 0652 FA 0679 8A 067E 81 0686 8D 0688 8F 0691 9A 0698 8E 06A9 98 06AF 90 06BA 9F 06BE AA 06C1 C0 06D2 FF 200C 9D 200D 9E 200E FD 200F FE 2013 96 2014 97 2018 91 2019 92 201A 82 201C 93 201D 94 201E 84 2020 86 2021 87 2022 95 2026 85 2030 89 2039 8B 203A 9B 20AC 80 2122 99}
} -result {}

# cp1256 - invalid byte sequences
lappend encInvalidBytes {*}{
}; # cp1256

# cp1256 - invalid byte sequences
lappend encUnencodableStrings {*}{
    cp1256 \U00000080 tcl8    1A -1 {} {}
    cp1256 \U00000080 replace 1A -1 {} {}
    cp1256 \U00000080 strict  {}                      0 {} {}
    cp1256 \U00000400 tcl8    1A -1 {} {}
    cp1256 \U00000400 replace 1A -1 {} {}
    cp1256 \U00000400 strict  {}                      0 {} {}
    cp1256 \U0000D800 tcl8    1A -1 {} {}
    cp1256 \U0000D800 replace 1A -1 {} {}
    cp1256 \U0000D800 strict  {}                      0 {} {}
    cp1256 \U0000DC00 tcl8    1A -1 {} {}
    cp1256 \U0000DC00 replace 1A -1 {} {}
    cp1256 \U0000DC00 strict  {}                      0 {} {}
    cp1256 \U00010000 tcl8    1A -1 {} {}
    cp1256 \U00010000 replace 1A -1 {} {}
    cp1256 \U00010000 strict  {}                      0 {} {}
    cp1256 \U0010FFFF tcl8    1A -1 {} {}
    cp1256 \U0010FFFF replace 1A -1 {} {}
    cp1256 \U0010FFFF strict  {}                      0 {} {}
}; # cp1256

#
# cp1257 (generated from glibc-CP1257-2.1.2)

test encoding-convertfrom-ucmCompare-cp1257 {Compare against ICU UCM} -body {
    ucmConvertfromMismatches cp1257 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 00A0 A0 00A2 A2 00A3 A3 00A4 A4 00A6 A6 00A7 A7 00A8 8D 00A9 A9 00AB AB 00AC AC 00AD AD 00AE AE 00AF 9D 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B4 B4 00B5 B5 00B6 B6 00B7 B7 00B8 8F 00B9 B9 00BB BB 00BC BC 00BD BD 00BE BE 00C4 C4 00C5 C5 00C6 AF 00C9 C9 00D3 D3 00D5 D5 00D6 D6 00D7 D7 00D8 A8 00DC DC 00DF DF 00E4 E4 00E5 E5 00E6 BF 00E9 E9 00F3 F3 00F5 F5 00F6 F6 00F7 F7 00F8 B8 00FC FC 0100 C2 0101 E2 0104 C0 0105 E0 0106 C3 0107 E3 010C C8 010D E8 0112 C7 0113 E7 0116 CB 0117 EB 0118 C6 0119 E6 0122 CC 0123 EC 012A CE 012B EE 012E C1 012F E1 0136 CD 0137 ED 013B CF 013C EF 0141 D9 0142 F9 0143 D1 0144 F1 0145 D2 0146 F2 014C D4 014D F4 0156 AA 0157 BA 015A DA 015B FA 0160 D0 0161 F0 016A DB 016B FB 0172 D8 0173 F8 0179 CA 017A EA 017B DD 017C FD 017D DE 017E FE 02C7 8E 02D9 FF 02DB 9E 2013 96 2014 97 2018 91 2019 92 201A 82 201C 93 201D 94 201E 84 2020 86 2021 87 2022 95 2026 85 2030 89 2039 8B 203A 9B 20AC 80 2122 99}
} -result {}

test encoding-convertto-ucmCompare-cp1257 {Compare against ICU UCM} -body {
    ucmConverttoMismatches cp1257 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 00A0 A0 00A2 A2 00A3 A3 00A4 A4 00A6 A6 00A7 A7 00A8 8D 00A9 A9 00AB AB 00AC AC 00AD AD 00AE AE 00AF 9D 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B4 B4 00B5 B5 00B6 B6 00B7 B7 00B8 8F 00B9 B9 00BB BB 00BC BC 00BD BD 00BE BE 00C4 C4 00C5 C5 00C6 AF 00C9 C9 00D3 D3 00D5 D5 00D6 D6 00D7 D7 00D8 A8 00DC DC 00DF DF 00E4 E4 00E5 E5 00E6 BF 00E9 E9 00F3 F3 00F5 F5 00F6 F6 00F7 F7 00F8 B8 00FC FC 0100 C2 0101 E2 0104 C0 0105 E0 0106 C3 0107 E3 010C C8 010D E8 0112 C7 0113 E7 0116 CB 0117 EB 0118 C6 0119 E6 0122 CC 0123 EC 012A CE 012B EE 012E C1 012F E1 0136 CD 0137 ED 013B CF 013C EF 0141 D9 0142 F9 0143 D1 0144 F1 0145 D2 0146 F2 014C D4 014D F4 0156 AA 0157 BA 015A DA 015B FA 0160 D0 0161 F0 016A DB 016B FB 0172 D8 0173 F8 0179 CA 017A EA 017B DD 017C FD 017D DE 017E FE 02C7 8E 02D9 FF 02DB 9E 2013 96 2014 97 2018 91 2019 92 201A 82 201C 93 201D 94 201E 84 2020 86 2021 87 2022 95 2026 85 2030 89 2039 8B 203A 9B 20AC 80 2122 99}
} -result {}

# cp1257 - invalid byte sequences
lappend encInvalidBytes {*}{
    cp1257 81 tcl8    \U00000081 -1 {} {}
    cp1257 81 replace \uFFFD -1 {} {}
    cp1257 81 strict  {}       0 {} {}
    cp1257 83 tcl8    \U00000083 -1 {} {}
    cp1257 83 replace \uFFFD -1 {} {}
    cp1257 83 strict  {}       0 {} {}
    cp1257 88 tcl8    \U00000088 -1 {} {}
    cp1257 88 replace \uFFFD -1 {} {}
    cp1257 88 strict  {}       0 {} {}
    cp1257 8A tcl8    \U0000008A -1 {} {}
    cp1257 8A replace \uFFFD -1 {} {}
    cp1257 8A strict  {}       0 {} {}
    cp1257 8C tcl8    \U0000008C -1 {} {}
    cp1257 8C replace \uFFFD -1 {} {}
    cp1257 8C strict  {}       0 {} {}
    cp1257 90 tcl8    \U00000090 -1 {} {}
    cp1257 90 replace \uFFFD -1 {} {}
    cp1257 90 strict  {}       0 {} {}
    cp1257 98 tcl8    \U00000098 -1 {} {}
    cp1257 98 replace \uFFFD -1 {} {}
    cp1257 98 strict  {}       0 {} {}
    cp1257 9A tcl8    \U0000009A -1 {} {}
    cp1257 9A replace \uFFFD -1 {} {}
    cp1257 9A strict  {}       0 {} {}
    cp1257 9C tcl8    \U0000009C -1 {} {}
    cp1257 9C replace \uFFFD -1 {} {}
    cp1257 9C strict  {}       0 {} {}
    cp1257 9F tcl8    \U0000009F -1 {} {}
    cp1257 9F replace \uFFFD -1 {} {}
    cp1257 9F strict  {}       0 {} {}
    cp1257 A1 tcl8    \U000000A1 -1 {} {}
    cp1257 A1 replace \uFFFD -1 {} {}
    cp1257 A1 strict  {}       0 {} {}
    cp1257 A5 tcl8    \U000000A5 -1 {} {}
    cp1257 A5 replace \uFFFD -1 {} {}
    cp1257 A5 strict  {}       0 {} {}
}; # cp1257

# cp1257 - invalid byte sequences
lappend encUnencodableStrings {*}{
    cp1257 \U00000080 tcl8    1A -1 {} {}
    cp1257 \U00000080 replace 1A -1 {} {}
    cp1257 \U00000080 strict  {}                      0 {} {}
    cp1257 \U00000400 tcl8    1A -1 {} {}
    cp1257 \U00000400 replace 1A -1 {} {}
    cp1257 \U00000400 strict  {}                      0 {} {}
    cp1257 \U0000D800 tcl8    1A -1 {} {}
    cp1257 \U0000D800 replace 1A -1 {} {}
    cp1257 \U0000D800 strict  {}                      0 {} {}
    cp1257 \U0000DC00 tcl8    1A -1 {} {}
    cp1257 \U0000DC00 replace 1A -1 {} {}
    cp1257 \U0000DC00 strict  {}                      0 {} {}
    cp1257 \U00010000 tcl8    1A -1 {} {}
    cp1257 \U00010000 replace 1A -1 {} {}
    cp1257 \U00010000 strict  {}                      0 {} {}
    cp1257 \U0010FFFF tcl8    1A -1 {} {}
    cp1257 \U0010FFFF replace 1A -1 {} {}
    cp1257 \U0010FFFF strict  {}                      0 {} {}
}; # cp1257

#
# cp1258 (generated from glibc-CP1258-2.1.2)

test encoding-convertfrom-ucmCompare-cp1258 {Compare against ICU UCM} -body {
    ucmConvertfromMismatches cp1258 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 00A0 A0 00A1 A1 00A2 A2 00A3 A3 00A4 A4 00A5 A5 00A6 A6 00A7 A7 00A8 A8 00A9 A9 00AA AA 00AB AB 00AC AC 00AD AD 00AE AE 00AF AF 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B4 B4 00B5 B5 00B6 B6 00B7 B7 00B8 B8 00B9 B9 00BA BA 00BB BB 00BC BC 00BD BD 00BE BE 00BF BF 00C0 C0 00C1 C1 00C2 C2 00C4 C4 00C5 C5 00C6 C6 00C7 C7 00C8 C8 00C9 C9 00CA CA 00CB CB 00CD CD 00CE CE 00CF CF 00D1 D1 00D3 D3 00D4 D4 00D6 D6 00D7 D7 00D8 D8 00D9 D9 00DA DA 00DB DB 00DC DC 00DF DF 00E0 E0 00E1 E1 00E2 E2 00E4 E4 00E5 E5 00E6 E6 00E7 E7 00E8 E8 00E9 E9 00EA EA 00EB EB 00ED ED 00EE EE 00EF EF 00F1 F1 00F3 F3 00F4 F4 00F6 F6 00F7 F7 00F8 F8 00F9 F9 00FA FA 00FB FB 00FC FC 00FF FF 0102 C3 0103 E3 0110 D0 0111 F0 0152 8C 0153 9C 0178 9F 0192 83 01A0 D5 01A1 F5 01AF DD 01B0 FD 02C6 88 02DC 98 0300 CC 0303 DE 0309 D2 0323 F2 2013 96 2014 97 2018 91 2019 92 201A 82 201C 93 201D 94 201E 84 2020 86 2021 87 2022 95 2026 85 2030 89 2039 8B 203A 9B 20AB FE 20AC 80 2122 99}
} -result {}

test encoding-convertto-ucmCompare-cp1258 {Compare against ICU UCM} -body {
    ucmConverttoMismatches cp1258 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 00A0 A0 00A1 A1 00A2 A2 00A3 A3 00A4 A4 00A5 A5 00A6 A6 00A7 A7 00A8 A8 00A9 A9 00AA AA 00AB AB 00AC AC 00AD AD 00AE AE 00AF AF 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B4 B4 00B5 B5 00B6 B6 00B7 B7 00B8 B8 00B9 B9 00BA BA 00BB BB 00BC BC 00BD BD 00BE BE 00BF BF 00C0 C0 00C1 C1 00C2 C2 00C4 C4 00C5 C5 00C6 C6 00C7 C7 00C8 C8 00C9 C9 00CA CA 00CB CB 00CD CD 00CE CE 00CF CF 00D1 D1 00D3 D3 00D4 D4 00D6 D6 00D7 D7 00D8 D8 00D9 D9 00DA DA 00DB DB 00DC DC 00DF DF 00E0 E0 00E1 E1 00E2 E2 00E4 E4 00E5 E5 00E6 E6 00E7 E7 00E8 E8 00E9 E9 00EA EA 00EB EB 00ED ED 00EE EE 00EF EF 00F1 F1 00F3 F3 00F4 F4 00F6 F6 00F7 F7 00F8 F8 00F9 F9 00FA FA 00FB FB 00FC FC 00FF FF 0102 C3 0103 E3 0110 D0 0111 F0 0152 8C 0153 9C 0178 9F 0192 83 01A0 D5 01A1 F5 01AF DD 01B0 FD 02C6 88 02DC 98 0300 CC 0303 DE 0309 D2 0323 F2 2013 96 2014 97 2018 91 2019 92 201A 82 201C 93 201D 94 201E 84 2020 86 2021 87 2022 95 2026 85 2030 89 2039 8B 203A 9B 20AB FE 20AC 80 2122 99}
} -result {}

# cp1258 - invalid byte sequences
lappend encInvalidBytes {*}{
    cp1258 81 tcl8    \U00000081 -1 {} {}
    cp1258 81 replace \uFFFD -1 {} {}
    cp1258 81 strict  {}       0 {} {}
    cp1258 8A tcl8    \U0000008A -1 {} {}
    cp1258 8A replace \uFFFD -1 {} {}
    cp1258 8A strict  {}       0 {} {}
    cp1258 8D tcl8    \U0000008D -1 {} {}
    cp1258 8D replace \uFFFD -1 {} {}
    cp1258 8D strict  {}       0 {} {}
    cp1258 8E tcl8    \U0000008E -1 {} {}
    cp1258 8E replace \uFFFD -1 {} {}
    cp1258 8E strict  {}       0 {} {}
    cp1258 8F tcl8    \U0000008F -1 {} {}
    cp1258 8F replace \uFFFD -1 {} {}
    cp1258 8F strict  {}       0 {} {}
    cp1258 90 tcl8    \U00000090 -1 {} {}
    cp1258 90 replace \uFFFD -1 {} {}
    cp1258 90 strict  {}       0 {} {}
    cp1258 9A tcl8    \U0000009A -1 {} {}
    cp1258 9A replace \uFFFD -1 {} {}
    cp1258 9A strict  {}       0 {} {}
    cp1258 9D tcl8    \U0000009D -1 {} {}
    cp1258 9D replace \uFFFD -1 {} {}
    cp1258 9D strict  {}       0 {} {}
    cp1258 9E tcl8    \U0000009E -1 {} {}
    cp1258 9E replace \uFFFD -1 {} {}
    cp1258 9E strict  {}       0 {} {}
    cp1258 EC tcl8    \U000000EC -1 {} {}
    cp1258 EC replace \uFFFD -1 {} {}
    cp1258 EC strict  {}       0 {} {}
}; # cp1258

# cp1258 - invalid byte sequences
lappend encUnencodableStrings {*}{
    cp1258 \U00000080 tcl8    1A -1 {} {}
    cp1258 \U00000080 replace 1A -1 {} {}
    cp1258 \U00000080 strict  {}                      0 {} {}
    cp1258 \U00000400 tcl8    1A -1 {} {}
    cp1258 \U00000400 replace 1A -1 {} {}
    cp1258 \U00000400 strict  {}                      0 {} {}
    cp1258 \U0000D800 tcl8    1A -1 {} {}
    cp1258 \U0000D800 replace 1A -1 {} {}
    cp1258 \U0000D800 strict  {}                      0 {} {}
    cp1258 \U0000DC00 tcl8    1A -1 {} {}
    cp1258 \U0000DC00 replace 1A -1 {} {}
    cp1258 \U0000DC00 strict  {}                      0 {} {}
    cp1258 \U00010000 tcl8    1A -1 {} {}
    cp1258 \U00010000 replace 1A -1 {} {}
    cp1258 \U00010000 strict  {}                      0 {} {}
    cp1258 \U0010FFFF tcl8    1A -1 {} {}
    cp1258 \U0010FFFF replace 1A -1 {} {}
    cp1258 \U0010FFFF strict  {}                      0 {} {}
}; # cp1258

#
# gb1988 (generated from glibc-GB_1988_80-2.3.3)

test encoding-convertfrom-ucmCompare-gb1988 {Compare against ICU UCM} -body {
    ucmConvertfromMismatches gb1988 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007F 7F 00A5 24 203E 7E}
} -result {}

test encoding-convertto-ucmCompare-gb1988 {Compare against ICU UCM} -body {
    ucmConverttoMismatches gb1988 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007F 7F 00A5 24 203E 7E}
} -result {}

# gb1988 - invalid byte sequences
lappend encInvalidBytes {*}{
    gb1988 80 tcl8    \U00000080 -1 {} {}
    gb1988 80 replace \uFFFD -1 {} {}
    gb1988 80 strict  {}       0 {} {}
    gb1988 81 tcl8    \U00000081 -1 {} {}
    gb1988 81 replace \uFFFD -1 {} {}
    gb1988 81 strict  {}       0 {} {}
    gb1988 82 tcl8    \U00000082 -1 {} {}
    gb1988 82 replace \uFFFD -1 {} {}
    gb1988 82 strict  {}       0 {} {}
    gb1988 83 tcl8    \U00000083 -1 {} {}
    gb1988 83 replace \uFFFD -1 {} {}
    gb1988 83 strict  {}       0 {} {}
    gb1988 84 tcl8    \U00000084 -1 {} {}
    gb1988 84 replace \uFFFD -1 {} {}
    gb1988 84 strict  {}       0 {} {}
    gb1988 85 tcl8    \U00000085 -1 {} {}
    gb1988 85 replace \uFFFD -1 {} {}
    gb1988 85 strict  {}       0 {} {}
    gb1988 86 tcl8    \U00000086 -1 {} {}
    gb1988 86 replace \uFFFD -1 {} {}
    gb1988 86 strict  {}       0 {} {}
    gb1988 87 tcl8    \U00000087 -1 {} {}
    gb1988 87 replace \uFFFD -1 {} {}
    gb1988 87 strict  {}       0 {} {}
    gb1988 88 tcl8    \U00000088 -1 {} {}
    gb1988 88 replace \uFFFD -1 {} {}
    gb1988 88 strict  {}       0 {} {}
    gb1988 89 tcl8    \U00000089 -1 {} {}
    gb1988 89 replace \uFFFD -1 {} {}
    gb1988 89 strict  {}       0 {} {}
    gb1988 8A tcl8    \U0000008A -1 {} {}
    gb1988 8A replace \uFFFD -1 {} {}
    gb1988 8A strict  {}       0 {} {}
    gb1988 8B tcl8    \U0000008B -1 {} {}
    gb1988 8B replace \uFFFD -1 {} {}
    gb1988 8B strict  {}       0 {} {}
    gb1988 8C tcl8    \U0000008C -1 {} {}
    gb1988 8C replace \uFFFD -1 {} {}
    gb1988 8C strict  {}       0 {} {}
    gb1988 8D tcl8    \U0000008D -1 {} {}
    gb1988 8D replace \uFFFD -1 {} {}
    gb1988 8D strict  {}       0 {} {}
    gb1988 8E tcl8    \U0000008E -1 {} {}
    gb1988 8E replace \uFFFD -1 {} {}
    gb1988 8E strict  {}       0 {} {}
    gb1988 8F tcl8    \U0000008F -1 {} {}
    gb1988 8F replace \uFFFD -1 {} {}
    gb1988 8F strict  {}       0 {} {}
    gb1988 90 tcl8    \U00000090 -1 {} {}
    gb1988 90 replace \uFFFD -1 {} {}
    gb1988 90 strict  {}       0 {} {}
    gb1988 91 tcl8    \U00000091 -1 {} {}
    gb1988 91 replace \uFFFD -1 {} {}
    gb1988 91 strict  {}       0 {} {}
    gb1988 92 tcl8    \U00000092 -1 {} {}
    gb1988 92 replace \uFFFD -1 {} {}
    gb1988 92 strict  {}       0 {} {}
    gb1988 93 tcl8    \U00000093 -1 {} {}
    gb1988 93 replace \uFFFD -1 {} {}
    gb1988 93 strict  {}       0 {} {}
    gb1988 94 tcl8    \U00000094 -1 {} {}
    gb1988 94 replace \uFFFD -1 {} {}
    gb1988 94 strict  {}       0 {} {}
    gb1988 95 tcl8    \U00000095 -1 {} {}
    gb1988 95 replace \uFFFD -1 {} {}
    gb1988 95 strict  {}       0 {} {}
    gb1988 96 tcl8    \U00000096 -1 {} {}
    gb1988 96 replace \uFFFD -1 {} {}
    gb1988 96 strict  {}       0 {} {}
    gb1988 97 tcl8    \U00000097 -1 {} {}
    gb1988 97 replace \uFFFD -1 {} {}
    gb1988 97 strict  {}       0 {} {}
    gb1988 98 tcl8    \U00000098 -1 {} {}
    gb1988 98 replace \uFFFD -1 {} {}
    gb1988 98 strict  {}       0 {} {}
    gb1988 99 tcl8    \U00000099 -1 {} {}
    gb1988 99 replace \uFFFD -1 {} {}
    gb1988 99 strict  {}       0 {} {}
    gb1988 9A tcl8    \U0000009A -1 {} {}
    gb1988 9A replace \uFFFD -1 {} {}
    gb1988 9A strict  {}       0 {} {}
    gb1988 9B tcl8    \U0000009B -1 {} {}
    gb1988 9B replace \uFFFD -1 {} {}
    gb1988 9B strict  {}       0 {} {}
    gb1988 9C tcl8    \U0000009C -1 {} {}
    gb1988 9C replace \uFFFD -1 {} {}
    gb1988 9C strict  {}       0 {} {}
    gb1988 9D tcl8    \U0000009D -1 {} {}
    gb1988 9D replace \uFFFD -1 {} {}
    gb1988 9D strict  {}       0 {} {}
    gb1988 9E tcl8    \U0000009E -1 {} {}
    gb1988 9E replace \uFFFD -1 {} {}
    gb1988 9E strict  {}       0 {} {}
    gb1988 9F tcl8    \U0000009F -1 {} {}
    gb1988 9F replace \uFFFD -1 {} {}
    gb1988 9F strict  {}       0 {} {}
    gb1988 A0 tcl8    \U000000A0 -1 {} {}
    gb1988 A0 replace \uFFFD -1 {} {}
    gb1988 A0 strict  {}       0 {} {}
    gb1988 A1 tcl8    \U000000A1 -1 {} {}
    gb1988 A1 replace \uFFFD -1 {} {}
    gb1988 A1 strict  {}       0 {} {}
    gb1988 A2 tcl8    \U000000A2 -1 {} {}
    gb1988 A2 replace \uFFFD -1 {} {}
    gb1988 A2 strict  {}       0 {} {}
    gb1988 A3 tcl8    \U000000A3 -1 {} {}
    gb1988 A3 replace \uFFFD -1 {} {}
    gb1988 A3 strict  {}       0 {} {}
    gb1988 A4 tcl8    \U000000A4 -1 {} {}
    gb1988 A4 replace \uFFFD -1 {} {}
    gb1988 A4 strict  {}       0 {} {}
    gb1988 A5 tcl8    \U000000A5 -1 {} {}
    gb1988 A5 replace \uFFFD -1 {} {}
    gb1988 A5 strict  {}       0 {} {}
    gb1988 A6 tcl8    \U000000A6 -1 {} {}
    gb1988 A6 replace \uFFFD -1 {} {}
    gb1988 A6 strict  {}       0 {} {}
    gb1988 A7 tcl8    \U000000A7 -1 {} {}
    gb1988 A7 replace \uFFFD -1 {} {}
    gb1988 A7 strict  {}       0 {} {}
    gb1988 A8 tcl8    \U000000A8 -1 {} {}
    gb1988 A8 replace \uFFFD -1 {} {}
    gb1988 A8 strict  {}       0 {} {}
    gb1988 A9 tcl8    \U000000A9 -1 {} {}
    gb1988 A9 replace \uFFFD -1 {} {}
    gb1988 A9 strict  {}       0 {} {}
    gb1988 AA tcl8    \U000000AA -1 {} {}
    gb1988 AA replace \uFFFD -1 {} {}
    gb1988 AA strict  {}       0 {} {}
    gb1988 AB tcl8    \U000000AB -1 {} {}
    gb1988 AB replace \uFFFD -1 {} {}
    gb1988 AB strict  {}       0 {} {}
    gb1988 AC tcl8    \U000000AC -1 {} {}
    gb1988 AC replace \uFFFD -1 {} {}
    gb1988 AC strict  {}       0 {} {}
    gb1988 AD tcl8    \U000000AD -1 {} {}
    gb1988 AD replace \uFFFD -1 {} {}
    gb1988 AD strict  {}       0 {} {}
    gb1988 AE tcl8    \U000000AE -1 {} {}
    gb1988 AE replace \uFFFD -1 {} {}
    gb1988 AE strict  {}       0 {} {}
    gb1988 AF tcl8    \U000000AF -1 {} {}
    gb1988 AF replace \uFFFD -1 {} {}
    gb1988 AF strict  {}       0 {} {}
    gb1988 B0 tcl8    \U000000B0 -1 {} {}
    gb1988 B0 replace \uFFFD -1 {} {}
    gb1988 B0 strict  {}       0 {} {}
    gb1988 B1 tcl8    \U000000B1 -1 {} {}
    gb1988 B1 replace \uFFFD -1 {} {}
    gb1988 B1 strict  {}       0 {} {}
    gb1988 B2 tcl8    \U000000B2 -1 {} {}
    gb1988 B2 replace \uFFFD -1 {} {}
    gb1988 B2 strict  {}       0 {} {}
    gb1988 B3 tcl8    \U000000B3 -1 {} {}
    gb1988 B3 replace \uFFFD -1 {} {}
    gb1988 B3 strict  {}       0 {} {}
    gb1988 B4 tcl8    \U000000B4 -1 {} {}
    gb1988 B4 replace \uFFFD -1 {} {}
    gb1988 B4 strict  {}       0 {} {}
    gb1988 B5 tcl8    \U000000B5 -1 {} {}
    gb1988 B5 replace \uFFFD -1 {} {}
    gb1988 B5 strict  {}       0 {} {}
    gb1988 B6 tcl8    \U000000B6 -1 {} {}
    gb1988 B6 replace \uFFFD -1 {} {}
    gb1988 B6 strict  {}       0 {} {}
    gb1988 B7 tcl8    \U000000B7 -1 {} {}
    gb1988 B7 replace \uFFFD -1 {} {}
    gb1988 B7 strict  {}       0 {} {}
    gb1988 B8 tcl8    \U000000B8 -1 {} {}
    gb1988 B8 replace \uFFFD -1 {} {}
    gb1988 B8 strict  {}       0 {} {}
    gb1988 B9 tcl8    \U000000B9 -1 {} {}
    gb1988 B9 replace \uFFFD -1 {} {}
    gb1988 B9 strict  {}       0 {} {}
    gb1988 BA tcl8    \U000000BA -1 {} {}
    gb1988 BA replace \uFFFD -1 {} {}
    gb1988 BA strict  {}       0 {} {}
    gb1988 BB tcl8    \U000000BB -1 {} {}
    gb1988 BB replace \uFFFD -1 {} {}
    gb1988 BB strict  {}       0 {} {}
    gb1988 BC tcl8    \U000000BC -1 {} {}
    gb1988 BC replace \uFFFD -1 {} {}
    gb1988 BC strict  {}       0 {} {}
    gb1988 BD tcl8    \U000000BD -1 {} {}
    gb1988 BD replace \uFFFD -1 {} {}
    gb1988 BD strict  {}       0 {} {}
    gb1988 BE tcl8    \U000000BE -1 {} {}
    gb1988 BE replace \uFFFD -1 {} {}
    gb1988 BE strict  {}       0 {} {}
    gb1988 BF tcl8    \U000000BF -1 {} {}
    gb1988 BF replace \uFFFD -1 {} {}
    gb1988 BF strict  {}       0 {} {}
    gb1988 C0 tcl8    \U000000C0 -1 {} {}
    gb1988 C0 replace \uFFFD -1 {} {}
    gb1988 C0 strict  {}       0 {} {}
    gb1988 C1 tcl8    \U000000C1 -1 {} {}
    gb1988 C1 replace \uFFFD -1 {} {}
    gb1988 C1 strict  {}       0 {} {}
    gb1988 C2 tcl8    \U000000C2 -1 {} {}
    gb1988 C2 replace \uFFFD -1 {} {}
    gb1988 C2 strict  {}       0 {} {}
    gb1988 C3 tcl8    \U000000C3 -1 {} {}
    gb1988 C3 replace \uFFFD -1 {} {}
    gb1988 C3 strict  {}       0 {} {}
    gb1988 C4 tcl8    \U000000C4 -1 {} {}
    gb1988 C4 replace \uFFFD -1 {} {}
    gb1988 C4 strict  {}       0 {} {}
    gb1988 C5 tcl8    \U000000C5 -1 {} {}
    gb1988 C5 replace \uFFFD -1 {} {}
    gb1988 C5 strict  {}       0 {} {}
    gb1988 C6 tcl8    \U000000C6 -1 {} {}
    gb1988 C6 replace \uFFFD -1 {} {}
    gb1988 C6 strict  {}       0 {} {}
    gb1988 C7 tcl8    \U000000C7 -1 {} {}
    gb1988 C7 replace \uFFFD -1 {} {}
    gb1988 C7 strict  {}       0 {} {}
    gb1988 C8 tcl8    \U000000C8 -1 {} {}
    gb1988 C8 replace \uFFFD -1 {} {}
    gb1988 C8 strict  {}       0 {} {}
    gb1988 C9 tcl8    \U000000C9 -1 {} {}
    gb1988 C9 replace \uFFFD -1 {} {}
    gb1988 C9 strict  {}       0 {} {}
    gb1988 CA tcl8    \U000000CA -1 {} {}
    gb1988 CA replace \uFFFD -1 {} {}
    gb1988 CA strict  {}       0 {} {}
    gb1988 CB tcl8    \U000000CB -1 {} {}
    gb1988 CB replace \uFFFD -1 {} {}
    gb1988 CB strict  {}       0 {} {}
    gb1988 CC tcl8    \U000000CC -1 {} {}
    gb1988 CC replace \uFFFD -1 {} {}
    gb1988 CC strict  {}       0 {} {}
    gb1988 CD tcl8    \U000000CD -1 {} {}
    gb1988 CD replace \uFFFD -1 {} {}
    gb1988 CD strict  {}       0 {} {}
    gb1988 CE tcl8    \U000000CE -1 {} {}
    gb1988 CE replace \uFFFD -1 {} {}
    gb1988 CE strict  {}       0 {} {}
    gb1988 CF tcl8    \U000000CF -1 {} {}
    gb1988 CF replace \uFFFD -1 {} {}
    gb1988 CF strict  {}       0 {} {}
    gb1988 D0 tcl8    \U000000D0 -1 {} {}
    gb1988 D0 replace \uFFFD -1 {} {}
    gb1988 D0 strict  {}       0 {} {}
    gb1988 D1 tcl8    \U000000D1 -1 {} {}
    gb1988 D1 replace \uFFFD -1 {} {}
    gb1988 D1 strict  {}       0 {} {}
    gb1988 D2 tcl8    \U000000D2 -1 {} {}
    gb1988 D2 replace \uFFFD -1 {} {}
    gb1988 D2 strict  {}       0 {} {}
    gb1988 D3 tcl8    \U000000D3 -1 {} {}
    gb1988 D3 replace \uFFFD -1 {} {}
    gb1988 D3 strict  {}       0 {} {}
    gb1988 D4 tcl8    \U000000D4 -1 {} {}
    gb1988 D4 replace \uFFFD -1 {} {}
    gb1988 D4 strict  {}       0 {} {}
    gb1988 D5 tcl8    \U000000D5 -1 {} {}
    gb1988 D5 replace \uFFFD -1 {} {}
    gb1988 D5 strict  {}       0 {} {}
    gb1988 D6 tcl8    \U000000D6 -1 {} {}
    gb1988 D6 replace \uFFFD -1 {} {}
    gb1988 D6 strict  {}       0 {} {}
    gb1988 D7 tcl8    \U000000D7 -1 {} {}
    gb1988 D7 replace \uFFFD -1 {} {}
    gb1988 D7 strict  {}       0 {} {}
    gb1988 D8 tcl8    \U000000D8 -1 {} {}
    gb1988 D8 replace \uFFFD -1 {} {}
    gb1988 D8 strict  {}       0 {} {}
    gb1988 D9 tcl8    \U000000D9 -1 {} {}
    gb1988 D9 replace \uFFFD -1 {} {}
    gb1988 D9 strict  {}       0 {} {}
    gb1988 DA tcl8    \U000000DA -1 {} {}
    gb1988 DA replace \uFFFD -1 {} {}
    gb1988 DA strict  {}       0 {} {}
    gb1988 DB tcl8    \U000000DB -1 {} {}
    gb1988 DB replace \uFFFD -1 {} {}
    gb1988 DB strict  {}       0 {} {}
    gb1988 DC tcl8    \U000000DC -1 {} {}
    gb1988 DC replace \uFFFD -1 {} {}
    gb1988 DC strict  {}       0 {} {}
    gb1988 DD tcl8    \U000000DD -1 {} {}
    gb1988 DD replace \uFFFD -1 {} {}
    gb1988 DD strict  {}       0 {} {}
    gb1988 DE tcl8    \U000000DE -1 {} {}
    gb1988 DE replace \uFFFD -1 {} {}
    gb1988 DE strict  {}       0 {} {}
    gb1988 DF tcl8    \U000000DF -1 {} {}
    gb1988 DF replace \uFFFD -1 {} {}
    gb1988 DF strict  {}       0 {} {}
    gb1988 E0 tcl8    \U000000E0 -1 {} {}
    gb1988 E0 replace \uFFFD -1 {} {}
    gb1988 E0 strict  {}       0 {} {}
    gb1988 E1 tcl8    \U000000E1 -1 {} {}
    gb1988 E1 replace \uFFFD -1 {} {}
    gb1988 E1 strict  {}       0 {} {}
    gb1988 E2 tcl8    \U000000E2 -1 {} {}
    gb1988 E2 replace \uFFFD -1 {} {}
    gb1988 E2 strict  {}       0 {} {}
    gb1988 E3 tcl8    \U000000E3 -1 {} {}
    gb1988 E3 replace \uFFFD -1 {} {}
    gb1988 E3 strict  {}       0 {} {}
    gb1988 E4 tcl8    \U000000E4 -1 {} {}
    gb1988 E4 replace \uFFFD -1 {} {}
    gb1988 E4 strict  {}       0 {} {}
    gb1988 E5 tcl8    \U000000E5 -1 {} {}
    gb1988 E5 replace \uFFFD -1 {} {}
    gb1988 E5 strict  {}       0 {} {}
    gb1988 E6 tcl8    \U000000E6 -1 {} {}
    gb1988 E6 replace \uFFFD -1 {} {}
    gb1988 E6 strict  {}       0 {} {}
    gb1988 E7 tcl8    \U000000E7 -1 {} {}
    gb1988 E7 replace \uFFFD -1 {} {}
    gb1988 E7 strict  {}       0 {} {}
    gb1988 E8 tcl8    \U000000E8 -1 {} {}
    gb1988 E8 replace \uFFFD -1 {} {}
    gb1988 E8 strict  {}       0 {} {}
    gb1988 E9 tcl8    \U000000E9 -1 {} {}
    gb1988 E9 replace \uFFFD -1 {} {}
    gb1988 E9 strict  {}       0 {} {}
    gb1988 EA tcl8    \U000000EA -1 {} {}
    gb1988 EA replace \uFFFD -1 {} {}
    gb1988 EA strict  {}       0 {} {}
    gb1988 EB tcl8    \U000000EB -1 {} {}
    gb1988 EB replace \uFFFD -1 {} {}
    gb1988 EB strict  {}       0 {} {}
    gb1988 EC tcl8    \U000000EC -1 {} {}
    gb1988 EC replace \uFFFD -1 {} {}
    gb1988 EC strict  {}       0 {} {}
    gb1988 ED tcl8    \U000000ED -1 {} {}
    gb1988 ED replace \uFFFD -1 {} {}
    gb1988 ED strict  {}       0 {} {}
    gb1988 EE tcl8    \U000000EE -1 {} {}
    gb1988 EE replace \uFFFD -1 {} {}
    gb1988 EE strict  {}       0 {} {}
    gb1988 EF tcl8    \U000000EF -1 {} {}
    gb1988 EF replace \uFFFD -1 {} {}
    gb1988 EF strict  {}       0 {} {}
    gb1988 F0 tcl8    \U000000F0 -1 {} {}
    gb1988 F0 replace \uFFFD -1 {} {}
    gb1988 F0 strict  {}       0 {} {}
    gb1988 F1 tcl8    \U000000F1 -1 {} {}
    gb1988 F1 replace \uFFFD -1 {} {}
    gb1988 F1 strict  {}       0 {} {}
    gb1988 F2 tcl8    \U000000F2 -1 {} {}
    gb1988 F2 replace \uFFFD -1 {} {}
    gb1988 F2 strict  {}       0 {} {}
    gb1988 F3 tcl8    \U000000F3 -1 {} {}
    gb1988 F3 replace \uFFFD -1 {} {}
    gb1988 F3 strict  {}       0 {} {}
    gb1988 F4 tcl8    \U000000F4 -1 {} {}
    gb1988 F4 replace \uFFFD -1 {} {}
    gb1988 F4 strict  {}       0 {} {}
    gb1988 F5 tcl8    \U000000F5 -1 {} {}
    gb1988 F5 replace \uFFFD -1 {} {}
    gb1988 F5 strict  {}       0 {} {}
    gb1988 F6 tcl8    \U000000F6 -1 {} {}
    gb1988 F6 replace \uFFFD -1 {} {}
    gb1988 F6 strict  {}       0 {} {}
    gb1988 F7 tcl8    \U000000F7 -1 {} {}
    gb1988 F7 replace \uFFFD -1 {} {}
    gb1988 F7 strict  {}       0 {} {}
    gb1988 F8 tcl8    \U000000F8 -1 {} {}
    gb1988 F8 replace \uFFFD -1 {} {}
    gb1988 F8 strict  {}       0 {} {}
    gb1988 F9 tcl8    \U000000F9 -1 {} {}
    gb1988 F9 replace \uFFFD -1 {} {}
    gb1988 F9 strict  {}       0 {} {}
    gb1988 FA tcl8    \U000000FA -1 {} {}
    gb1988 FA replace \uFFFD -1 {} {}
    gb1988 FA strict  {}       0 {} {}
    gb1988 FB tcl8    \U000000FB -1 {} {}
    gb1988 FB replace \uFFFD -1 {} {}
    gb1988 FB strict  {}       0 {} {}
    gb1988 FC tcl8    \U000000FC -1 {} {}
    gb1988 FC replace \uFFFD -1 {} {}
    gb1988 FC strict  {}       0 {} {}
    gb1988 FD tcl8    \U000000FD -1 {} {}
    gb1988 FD replace \uFFFD -1 {} {}
    gb1988 FD strict  {}       0 {} {}
    gb1988 FE tcl8    \U000000FE -1 {} {}
    gb1988 FE replace \uFFFD -1 {} {}
    gb1988 FE strict  {}       0 {} {}
    gb1988 FF tcl8    \U000000FF -1 {} {}
    gb1988 FF replace \uFFFD -1 {} {}
    gb1988 FF strict  {}       0 {} {}
}; # gb1988

# gb1988 - invalid byte sequences
lappend encUnencodableStrings {*}{
    gb1988 \U00000024 tcl8    1A -1 {} {}
    gb1988 \U00000024 replace 1A -1 {} {}
    gb1988 \U00000024 strict  {}                      0 {} {}
    gb1988 \U00000400 tcl8    1A -1 {} {}
    gb1988 \U00000400 replace 1A -1 {} {}
    gb1988 \U00000400 strict  {}                      0 {} {}
    gb1988 \U0000D800 tcl8    1A -1 {} {}
    gb1988 \U0000D800 replace 1A -1 {} {}
    gb1988 \U0000D800 strict  {}                      0 {} {}
    gb1988 \U0000DC00 tcl8    1A -1 {} {}
    gb1988 \U0000DC00 replace 1A -1 {} {}
    gb1988 \U0000DC00 strict  {}                      0 {} {}
    gb1988 \U00010000 tcl8    1A -1 {} {}
    gb1988 \U00010000 replace 1A -1 {} {}
    gb1988 \U00010000 strict  {}                      0 {} {}
    gb1988 \U0010FFFF tcl8    1A -1 {} {}
    gb1988 \U0010FFFF replace 1A -1 {} {}
    gb1988 \U0010FFFF strict  {}                      0 {} {}
}; # gb1988

#
# iso8859-1 (generated from glibc-ISO_8859_1-2.1.2)

test encoding-convertfrom-ucmCompare-iso8859-1 {Compare against ICU UCM} -body {
    ucmConvertfromMismatches iso8859-1 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A1 A1 00A2 A2 00A3 A3 00A4 A4 00A5 A5 00A6 A6 00A7 A7 00A8 A8 00A9 A9 00AA AA 00AB AB 00AC AC 00AD AD 00AE AE 00AF AF 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B4 B4 00B5 B5 00B6 B6 00B7 B7 00B8 B8 00B9 B9 00BA BA 00BB BB 00BC BC 00BD BD 00BE BE 00BF BF 00C0 C0 00C1 C1 00C2 C2 00C3 C3 00C4 C4 00C5 C5 00C6 C6 00C7 C7 00C8 C8 00C9 C9 00CA CA 00CB CB 00CC CC 00CD CD 00CE CE 00CF CF 00D0 D0 00D1 D1 00D2 D2 00D3 D3 00D4 D4 00D5 D5 00D6 D6 00D7 D7 00D8 D8 00D9 D9 00DA DA 00DB DB 00DC DC 00DD DD 00DE DE 00DF DF 00E0 E0 00E1 E1 00E2 E2 00E3 E3 00E4 E4 00E5 E5 00E6 E6 00E7 E7 00E8 E8 00E9 E9 00EA EA 00EB EB 00EC EC 00ED ED 00EE EE 00EF EF 00F0 F0 00F1 F1 00F2 F2 00F3 F3 00F4 F4 00F5 F5 00F6 F6 00F7 F7 00F8 F8 00F9 F9 00FA FA 00FB FB 00FC FC 00FD FD 00FE FE 00FF FF}
} -result {}

test encoding-convertto-ucmCompare-iso8859-1 {Compare against ICU UCM} -body {
    ucmConverttoMismatches iso8859-1 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A1 A1 00A2 A2 00A3 A3 00A4 A4 00A5 A5 00A6 A6 00A7 A7 00A8 A8 00A9 A9 00AA AA 00AB AB 00AC AC 00AD AD 00AE AE 00AF AF 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B4 B4 00B5 B5 00B6 B6 00B7 B7 00B8 B8 00B9 B9 00BA BA 00BB BB 00BC BC 00BD BD 00BE BE 00BF BF 00C0 C0 00C1 C1 00C2 C2 00C3 C3 00C4 C4 00C5 C5 00C6 C6 00C7 C7 00C8 C8 00C9 C9 00CA CA 00CB CB 00CC CC 00CD CD 00CE CE 00CF CF 00D0 D0 00D1 D1 00D2 D2 00D3 D3 00D4 D4 00D5 D5 00D6 D6 00D7 D7 00D8 D8 00D9 D9 00DA DA 00DB DB 00DC DC 00DD DD 00DE DE 00DF DF 00E0 E0 00E1 E1 00E2 E2 00E3 E3 00E4 E4 00E5 E5 00E6 E6 00E7 E7 00E8 E8 00E9 E9 00EA EA 00EB EB 00EC EC 00ED ED 00EE EE 00EF EF 00F0 F0 00F1 F1 00F2 F2 00F3 F3 00F4 F4 00F5 F5 00F6 F6 00F7 F7 00F8 F8 00F9 F9 00FA FA 00FB FB 00FC FC 00FD FD 00FE FE 00FF FF}
} -result {}

# iso8859-1 - invalid byte sequences
lappend encInvalidBytes {*}{
}; # iso8859-1

# iso8859-1 - invalid byte sequences
lappend encUnencodableStrings {*}{
    iso8859-1 \U00000400 tcl8    1A -1 {} {}
    iso8859-1 \U00000400 replace 1A -1 {} {}
    iso8859-1 \U00000400 strict  {}                      0 {} {}
    iso8859-1 \U0000D800 tcl8    1A -1 {} {}
    iso8859-1 \U0000D800 replace 1A -1 {} {}
    iso8859-1 \U0000D800 strict  {}                      0 {} {}
    iso8859-1 \U0000DC00 tcl8    1A -1 {} {}
    iso8859-1 \U0000DC00 replace 1A -1 {} {}
    iso8859-1 \U0000DC00 strict  {}                      0 {} {}
    iso8859-1 \U00010000 tcl8    1A -1 {} {}
    iso8859-1 \U00010000 replace 1A -1 {} {}
    iso8859-1 \U00010000 strict  {}                      0 {} {}
    iso8859-1 \U0010FFFF tcl8    1A -1 {} {}
    iso8859-1 \U0010FFFF replace 1A -1 {} {}
    iso8859-1 \U0010FFFF strict  {}                      0 {} {}
}; # iso8859-1

#
# iso8859-2 (generated from glibc-ISO_8859_2-2.1.2)

test encoding-convertfrom-ucmCompare-iso8859-2 {Compare against ICU UCM} -body {
    ucmConvertfromMismatches iso8859-2 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A4 A4 00A7 A7 00A8 A8 00AD AD 00B0 B0 00B4 B4 00B8 B8 00C1 C1 00C2 C2 00C4 C4 00C7 C7 00C9 C9 00CB CB 00CD CD 00CE CE 00D3 D3 00D4 D4 00D6 D6 00D7 D7 00DA DA 00DC DC 00DD DD 00DF DF 00E1 E1 00E2 E2 00E4 E4 00E7 E7 00E9 E9 00EB EB 00ED ED 00EE EE 00F3 F3 00F4 F4 00F6 F6 00F7 F7 00FA FA 00FC FC 00FD FD 0102 C3 0103 E3 0104 A1 0105 B1 0106 C6 0107 E6 010C C8 010D E8 010E CF 010F EF 0110 D0 0111 F0 0118 CA 0119 EA 011A CC 011B EC 0139 C5 013A E5 013D A5 013E B5 0141 A3 0142 B3 0143 D1 0144 F1 0147 D2 0148 F2 0150 D5 0151 F5 0154 C0 0155 E0 0158 D8 0159 F8 015A A6 015B B6 015E AA 015F BA 0160 A9 0161 B9 0162 DE 0163 FE 0164 AB 0165 BB 016E D9 016F F9 0170 DB 0171 FB 0179 AC 017A BC 017B AF 017C BF 017D AE 017E BE 02C7 B7 02D8 A2 02D9 FF 02DB B2 02DD BD}
} -result {}

test encoding-convertto-ucmCompare-iso8859-2 {Compare against ICU UCM} -body {
    ucmConverttoMismatches iso8859-2 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A4 A4 00A7 A7 00A8 A8 00AD AD 00B0 B0 00B4 B4 00B8 B8 00C1 C1 00C2 C2 00C4 C4 00C7 C7 00C9 C9 00CB CB 00CD CD 00CE CE 00D3 D3 00D4 D4 00D6 D6 00D7 D7 00DA DA 00DC DC 00DD DD 00DF DF 00E1 E1 00E2 E2 00E4 E4 00E7 E7 00E9 E9 00EB EB 00ED ED 00EE EE 00F3 F3 00F4 F4 00F6 F6 00F7 F7 00FA FA 00FC FC 00FD FD 0102 C3 0103 E3 0104 A1 0105 B1 0106 C6 0107 E6 010C C8 010D E8 010E CF 010F EF 0110 D0 0111 F0 0118 CA 0119 EA 011A CC 011B EC 0139 C5 013A E5 013D A5 013E B5 0141 A3 0142 B3 0143 D1 0144 F1 0147 D2 0148 F2 0150 D5 0151 F5 0154 C0 0155 E0 0158 D8 0159 F8 015A A6 015B B6 015E AA 015F BA 0160 A9 0161 B9 0162 DE 0163 FE 0164 AB 0165 BB 016E D9 016F F9 0170 DB 0171 FB 0179 AC 017A BC 017B AF 017C BF 017D AE 017E BE 02C7 B7 02D8 A2 02D9 FF 02DB B2 02DD BD}
} -result {}

# iso8859-2 - invalid byte sequences
lappend encInvalidBytes {*}{
}; # iso8859-2

# iso8859-2 - invalid byte sequences
lappend encUnencodableStrings {*}{
    iso8859-2 \U000000A1 tcl8    1A -1 {} {}
    iso8859-2 \U000000A1 replace 1A -1 {} {}
    iso8859-2 \U000000A1 strict  {}                      0 {} {}
    iso8859-2 \U00000400 tcl8    1A -1 {} {}
    iso8859-2 \U00000400 replace 1A -1 {} {}
    iso8859-2 \U00000400 strict  {}                      0 {} {}
    iso8859-2 \U0000D800 tcl8    1A -1 {} {}
    iso8859-2 \U0000D800 replace 1A -1 {} {}
    iso8859-2 \U0000D800 strict  {}                      0 {} {}
    iso8859-2 \U0000DC00 tcl8    1A -1 {} {}
    iso8859-2 \U0000DC00 replace 1A -1 {} {}
    iso8859-2 \U0000DC00 strict  {}                      0 {} {}
    iso8859-2 \U00010000 tcl8    1A -1 {} {}
    iso8859-2 \U00010000 replace 1A -1 {} {}
    iso8859-2 \U00010000 strict  {}                      0 {} {}
    iso8859-2 \U0010FFFF tcl8    1A -1 {} {}
    iso8859-2 \U0010FFFF replace 1A -1 {} {}
    iso8859-2 \U0010FFFF strict  {}                      0 {} {}
}; # iso8859-2

#
# iso8859-3 (generated from glibc-ISO_8859_3-2.1.2)

test encoding-convertfrom-ucmCompare-iso8859-3 {Compare against ICU UCM} -body {
    ucmConvertfromMismatches iso8859-3 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A3 A3 00A4 A4 00A7 A7 00A8 A8 00AD AD 00B0 B0 00B2 B2 00B3 B3 00B4 B4 00B5 B5 00B7 B7 00B8 B8 00BD BD 00C0 C0 00C1 C1 00C2 C2 00C4 C4 00C7 C7 00C8 C8 00C9 C9 00CA CA 00CB CB 00CC CC 00CD CD 00CE CE 00CF CF 00D1 D1 00D2 D2 00D3 D3 00D4 D4 00D6 D6 00D7 D7 00D9 D9 00DA DA 00DB DB 00DC DC 00DF DF 00E0 E0 00E1 E1 00E2 E2 00E4 E4 00E7 E7 00E8 E8 00E9 E9 00EA EA 00EB EB 00EC EC 00ED ED 00EE EE 00EF EF 00F1 F1 00F2 F2 00F3 F3 00F4 F4 00F6 F6 00F7 F7 00F9 F9 00FA FA 00FB FB 00FC FC 0108 C6 0109 E6 010A C5 010B E5 011C D8 011D F8 011E AB 011F BB 0120 D5 0121 F5 0124 A6 0125 B6 0126 A1 0127 B1 0130 A9 0131 B9 0134 AC 0135 BC 015C DE 015D FE 015E AA 015F BA 016C DD 016D FD 017B AF 017C BF 02D8 A2 02D9 FF}
} -result {}

test encoding-convertto-ucmCompare-iso8859-3 {Compare against ICU UCM} -body {
    ucmConverttoMismatches iso8859-3 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A3 A3 00A4 A4 00A7 A7 00A8 A8 00AD AD 00B0 B0 00B2 B2 00B3 B3 00B4 B4 00B5 B5 00B7 B7 00B8 B8 00BD BD 00C0 C0 00C1 C1 00C2 C2 00C4 C4 00C7 C7 00C8 C8 00C9 C9 00CA CA 00CB CB 00CC CC 00CD CD 00CE CE 00CF CF 00D1 D1 00D2 D2 00D3 D3 00D4 D4 00D6 D6 00D7 D7 00D9 D9 00DA DA 00DB DB 00DC DC 00DF DF 00E0 E0 00E1 E1 00E2 E2 00E4 E4 00E7 E7 00E8 E8 00E9 E9 00EA EA 00EB EB 00EC EC 00ED ED 00EE EE 00EF EF 00F1 F1 00F2 F2 00F3 F3 00F4 F4 00F6 F6 00F7 F7 00F9 F9 00FA FA 00FB FB 00FC FC 0108 C6 0109 E6 010A C5 010B E5 011C D8 011D F8 011E AB 011F BB 0120 D5 0121 F5 0124 A6 0125 B6 0126 A1 0127 B1 0130 A9 0131 B9 0134 AC 0135 BC 015C DE 015D FE 015E AA 015F BA 016C DD 016D FD 017B AF 017C BF 02D8 A2 02D9 FF}
} -result {}

# iso8859-3 - invalid byte sequences
lappend encInvalidBytes {*}{
    iso8859-3 A5 tcl8    \U000000A5 -1 {} {}
    iso8859-3 A5 replace \uFFFD -1 {} {}
    iso8859-3 A5 strict  {}       0 {} {}
    iso8859-3 AE tcl8    \U000000AE -1 {} {}
    iso8859-3 AE replace \uFFFD -1 {} {}
    iso8859-3 AE strict  {}       0 {} {}
    iso8859-3 BE tcl8    \U000000BE -1 {} {}
    iso8859-3 BE replace \uFFFD -1 {} {}
    iso8859-3 BE strict  {}       0 {} {}
    iso8859-3 C3 tcl8    \U000000C3 -1 {} {}
    iso8859-3 C3 replace \uFFFD -1 {} {}
    iso8859-3 C3 strict  {}       0 {} {}
    iso8859-3 D0 tcl8    \U000000D0 -1 {} {}
    iso8859-3 D0 replace \uFFFD -1 {} {}
    iso8859-3 D0 strict  {}       0 {} {}
    iso8859-3 E3 tcl8    \U000000E3 -1 {} {}
    iso8859-3 E3 replace \uFFFD -1 {} {}
    iso8859-3 E3 strict  {}       0 {} {}
    iso8859-3 F0 tcl8    \U000000F0 -1 {} {}
    iso8859-3 F0 replace \uFFFD -1 {} {}
    iso8859-3 F0 strict  {}       0 {} {}
}; # iso8859-3

# iso8859-3 - invalid byte sequences
lappend encUnencodableStrings {*}{
    iso8859-3 \U000000A1 tcl8    1A -1 {} {}
    iso8859-3 \U000000A1 replace 1A -1 {} {}
    iso8859-3 \U000000A1 strict  {}                      0 {} {}
    iso8859-3 \U00000400 tcl8    1A -1 {} {}
    iso8859-3 \U00000400 replace 1A -1 {} {}
    iso8859-3 \U00000400 strict  {}                      0 {} {}
    iso8859-3 \U0000D800 tcl8    1A -1 {} {}
    iso8859-3 \U0000D800 replace 1A -1 {} {}
    iso8859-3 \U0000D800 strict  {}                      0 {} {}
    iso8859-3 \U0000DC00 tcl8    1A -1 {} {}
    iso8859-3 \U0000DC00 replace 1A -1 {} {}
    iso8859-3 \U0000DC00 strict  {}                      0 {} {}
    iso8859-3 \U00010000 tcl8    1A -1 {} {}
    iso8859-3 \U00010000 replace 1A -1 {} {}
    iso8859-3 \U00010000 strict  {}                      0 {} {}
    iso8859-3 \U0010FFFF tcl8    1A -1 {} {}
    iso8859-3 \U0010FFFF replace 1A -1 {} {}
    iso8859-3 \U0010FFFF strict  {}                      0 {} {}
}; # iso8859-3

#
# iso8859-4 (generated from glibc-ISO_8859_4-2.1.2)

test encoding-convertfrom-ucmCompare-iso8859-4 {Compare against ICU UCM} -body {
    ucmConvertfromMismatches iso8859-4 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A4 A4 00A7 A7 00A8 A8 00AD AD 00AF AF 00B0 B0 00B4 B4 00B8 B8 00C1 C1 00C2 C2 00C3 C3 00C4 C4 00C5 C5 00C6 C6 00C9 C9 00CB CB 00CD CD 00CE CE 00D4 D4 00D5 D5 00D6 D6 00D7 D7 00D8 D8 00DA DA 00DB DB 00DC DC 00DF DF 00E1 E1 00E2 E2 00E3 E3 00E4 E4 00E5 E5 00E6 E6 00E9 E9 00EB EB 00ED ED 00EE EE 00F4 F4 00F5 F5 00F6 F6 00F7 F7 00F8 F8 00FA FA 00FB FB 00FC FC 0100 C0 0101 E0 0104 A1 0105 B1 010C C8 010D E8 0110 D0 0111 F0 0112 AA 0113 BA 0116 CC 0117 EC 0118 CA 0119 EA 0122 AB 0123 BB 0128 A5 0129 B5 012A CF 012B EF 012E C7 012F E7 0136 D3 0137 F3 0138 A2 013B A6 013C B6 0145 D1 0146 F1 014A BD 014B BF 014C D2 014D F2 0156 A3 0157 B3 0160 A9 0161 B9 0166 AC 0167 BC 0168 DD 0169 FD 016A DE 016B FE 0172 D9 0173 F9 017D AE 017E BE 02C7 B7 02D9 FF 02DB B2}
} -result {}

test encoding-convertto-ucmCompare-iso8859-4 {Compare against ICU UCM} -body {
    ucmConverttoMismatches iso8859-4 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A4 A4 00A7 A7 00A8 A8 00AD AD 00AF AF 00B0 B0 00B4 B4 00B8 B8 00C1 C1 00C2 C2 00C3 C3 00C4 C4 00C5 C5 00C6 C6 00C9 C9 00CB CB 00CD CD 00CE CE 00D4 D4 00D5 D5 00D6 D6 00D7 D7 00D8 D8 00DA DA 00DB DB 00DC DC 00DF DF 00E1 E1 00E2 E2 00E3 E3 00E4 E4 00E5 E5 00E6 E6 00E9 E9 00EB EB 00ED ED 00EE EE 00F4 F4 00F5 F5 00F6 F6 00F7 F7 00F8 F8 00FA FA 00FB FB 00FC FC 0100 C0 0101 E0 0104 A1 0105 B1 010C C8 010D E8 0110 D0 0111 F0 0112 AA 0113 BA 0116 CC 0117 EC 0118 CA 0119 EA 0122 AB 0123 BB 0128 A5 0129 B5 012A CF 012B EF 012E C7 012F E7 0136 D3 0137 F3 0138 A2 013B A6 013C B6 0145 D1 0146 F1 014A BD 014B BF 014C D2 014D F2 0156 A3 0157 B3 0160 A9 0161 B9 0166 AC 0167 BC 0168 DD 0169 FD 016A DE 016B FE 0172 D9 0173 F9 017D AE 017E BE 02C7 B7 02D9 FF 02DB B2}
} -result {}

# iso8859-4 - invalid byte sequences
lappend encInvalidBytes {*}{
}; # iso8859-4

# iso8859-4 - invalid byte sequences
lappend encUnencodableStrings {*}{
    iso8859-4 \U000000A1 tcl8    1A -1 {} {}
    iso8859-4 \U000000A1 replace 1A -1 {} {}
    iso8859-4 \U000000A1 strict  {}                      0 {} {}
    iso8859-4 \U00000400 tcl8    1A -1 {} {}
    iso8859-4 \U00000400 replace 1A -1 {} {}
    iso8859-4 \U00000400 strict  {}                      0 {} {}
    iso8859-4 \U0000D800 tcl8    1A -1 {} {}
    iso8859-4 \U0000D800 replace 1A -1 {} {}
    iso8859-4 \U0000D800 strict  {}                      0 {} {}
    iso8859-4 \U0000DC00 tcl8    1A -1 {} {}
    iso8859-4 \U0000DC00 replace 1A -1 {} {}
    iso8859-4 \U0000DC00 strict  {}                      0 {} {}
    iso8859-4 \U00010000 tcl8    1A -1 {} {}
    iso8859-4 \U00010000 replace 1A -1 {} {}
    iso8859-4 \U00010000 strict  {}                      0 {} {}
    iso8859-4 \U0010FFFF tcl8    1A -1 {} {}
    iso8859-4 \U0010FFFF replace 1A -1 {} {}
    iso8859-4 \U0010FFFF strict  {}                      0 {} {}
}; # iso8859-4

#
# iso8859-5 (generated from glibc-ISO_8859_5-2.1.2)

test encoding-convertfrom-ucmCompare-iso8859-5 {Compare against ICU UCM} -body {
    ucmConvertfromMismatches iso8859-5 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A7 FD 00AD AD 0401 A1 0402 A2 0403 A3 0404 A4 0405 A5 0406 A6 0407 A7 0408 A8 0409 A9 040A AA 040B AB 040C AC 040E AE 040F AF 0410 B0 0411 B1 0412 B2 0413 B3 0414 B4 0415 B5 0416 B6 0417 B7 0418 B8 0419 B9 041A BA 041B BB 041C BC 041D BD 041E BE 041F BF 0420 C0 0421 C1 0422 C2 0423 C3 0424 C4 0425 C5 0426 C6 0427 C7 0428 C8 0429 C9 042A CA 042B CB 042C CC 042D CD 042E CE 042F CF 0430 D0 0431 D1 0432 D2 0433 D3 0434 D4 0435 D5 0436 D6 0437 D7 0438 D8 0439 D9 043A DA 043B DB 043C DC 043D DD 043E DE 043F DF 0440 E0 0441 E1 0442 E2 0443 E3 0444 E4 0445 E5 0446 E6 0447 E7 0448 E8 0449 E9 044A EA 044B EB 044C EC 044D ED 044E EE 044F EF 0451 F1 0452 F2 0453 F3 0454 F4 0455 F5 0456 F6 0457 F7 0458 F8 0459 F9 045A FA 045B FB 045C FC 045E FE 045F FF 2116 F0}
} -result {}

test encoding-convertto-ucmCompare-iso8859-5 {Compare against ICU UCM} -body {
    ucmConverttoMismatches iso8859-5 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A7 FD 00AD AD 0401 A1 0402 A2 0403 A3 0404 A4 0405 A5 0406 A6 0407 A7 0408 A8 0409 A9 040A AA 040B AB 040C AC 040E AE 040F AF 0410 B0 0411 B1 0412 B2 0413 B3 0414 B4 0415 B5 0416 B6 0417 B7 0418 B8 0419 B9 041A BA 041B BB 041C BC 041D BD 041E BE 041F BF 0420 C0 0421 C1 0422 C2 0423 C3 0424 C4 0425 C5 0426 C6 0427 C7 0428 C8 0429 C9 042A CA 042B CB 042C CC 042D CD 042E CE 042F CF 0430 D0 0431 D1 0432 D2 0433 D3 0434 D4 0435 D5 0436 D6 0437 D7 0438 D8 0439 D9 043A DA 043B DB 043C DC 043D DD 043E DE 043F DF 0440 E0 0441 E1 0442 E2 0443 E3 0444 E4 0445 E5 0446 E6 0447 E7 0448 E8 0449 E9 044A EA 044B EB 044C EC 044D ED 044E EE 044F EF 0451 F1 0452 F2 0453 F3 0454 F4 0455 F5 0456 F6 0457 F7 0458 F8 0459 F9 045A FA 045B FB 045C FC 045E FE 045F FF 2116 F0}
} -result {}

# iso8859-5 - invalid byte sequences
lappend encInvalidBytes {*}{
}; # iso8859-5

# iso8859-5 - invalid byte sequences
lappend encUnencodableStrings {*}{
    iso8859-5 \U000000A1 tcl8    1A -1 {} {}
    iso8859-5 \U000000A1 replace 1A -1 {} {}
    iso8859-5 \U000000A1 strict  {}                      0 {} {}
    iso8859-5 \U00000400 tcl8    1A -1 {} {}
    iso8859-5 \U00000400 replace 1A -1 {} {}
    iso8859-5 \U00000400 strict  {}                      0 {} {}
    iso8859-5 \U0000D800 tcl8    1A -1 {} {}
    iso8859-5 \U0000D800 replace 1A -1 {} {}
    iso8859-5 \U0000D800 strict  {}                      0 {} {}
    iso8859-5 \U0000DC00 tcl8    1A -1 {} {}
    iso8859-5 \U0000DC00 replace 1A -1 {} {}
    iso8859-5 \U0000DC00 strict  {}                      0 {} {}
    iso8859-5 \U00010000 tcl8    1A -1 {} {}
    iso8859-5 \U00010000 replace 1A -1 {} {}
    iso8859-5 \U00010000 strict  {}                      0 {} {}
    iso8859-5 \U0010FFFF tcl8    1A -1 {} {}
    iso8859-5 \U0010FFFF replace 1A -1 {} {}
    iso8859-5 \U0010FFFF strict  {}                      0 {} {}
}; # iso8859-5

#
# iso8859-6 (generated from glibc-ISO_8859_6-2.1.2)

test encoding-convertfrom-ucmCompare-iso8859-6 {Compare against ICU UCM} -body {
    ucmConvertfromMismatches iso8859-6 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A4 A4 00AD AD 060C AC 061B BB 061F BF 0621 C1 0622 C2 0623 C3 0624 C4 0625 C5 0626 C6 0627 C7 0628 C8 0629 C9 062A CA 062B CB 062C CC 062D CD 062E CE 062F CF 0630 D0 0631 D1 0632 D2 0633 D3 0634 D4 0635 D5 0636 D6 0637 D7 0638 D8 0639 D9 063A DA 0640 E0 0641 E1 0642 E2 0643 E3 0644 E4 0645 E5 0646 E6 0647 E7 0648 E8 0649 E9 064A EA 064B EB 064C EC 064D ED 064E EE 064F EF 0650 F0 0651 F1 0652 F2}
} -result {}

test encoding-convertto-ucmCompare-iso8859-6 {Compare against ICU UCM} -body {
    ucmConverttoMismatches iso8859-6 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A4 A4 00AD AD 060C AC 061B BB 061F BF 0621 C1 0622 C2 0623 C3 0624 C4 0625 C5 0626 C6 0627 C7 0628 C8 0629 C9 062A CA 062B CB 062C CC 062D CD 062E CE 062F CF 0630 D0 0631 D1 0632 D2 0633 D3 0634 D4 0635 D5 0636 D6 0637 D7 0638 D8 0639 D9 063A DA 0640 E0 0641 E1 0642 E2 0643 E3 0644 E4 0645 E5 0646 E6 0647 E7 0648 E8 0649 E9 064A EA 064B EB 064C EC 064D ED 064E EE 064F EF 0650 F0 0651 F1 0652 F2}
} -result {}

# iso8859-6 - invalid byte sequences
lappend encInvalidBytes {*}{
    iso8859-6 A1 tcl8    \U000000A1 -1 {} {}
    iso8859-6 A1 replace \uFFFD -1 {} {}
    iso8859-6 A1 strict  {}       0 {} {}
    iso8859-6 A2 tcl8    \U000000A2 -1 {} {}
    iso8859-6 A2 replace \uFFFD -1 {} {}
    iso8859-6 A2 strict  {}       0 {} {}
    iso8859-6 A3 tcl8    \U000000A3 -1 {} {}
    iso8859-6 A3 replace \uFFFD -1 {} {}
    iso8859-6 A3 strict  {}       0 {} {}
    iso8859-6 A5 tcl8    \U000000A5 -1 {} {}
    iso8859-6 A5 replace \uFFFD -1 {} {}
    iso8859-6 A5 strict  {}       0 {} {}
    iso8859-6 A6 tcl8    \U000000A6 -1 {} {}
    iso8859-6 A6 replace \uFFFD -1 {} {}
    iso8859-6 A6 strict  {}       0 {} {}
    iso8859-6 A7 tcl8    \U000000A7 -1 {} {}
    iso8859-6 A7 replace \uFFFD -1 {} {}
    iso8859-6 A7 strict  {}       0 {} {}
    iso8859-6 A8 tcl8    \U000000A8 -1 {} {}
    iso8859-6 A8 replace \uFFFD -1 {} {}
    iso8859-6 A8 strict  {}       0 {} {}
    iso8859-6 A9 tcl8    \U000000A9 -1 {} {}
    iso8859-6 A9 replace \uFFFD -1 {} {}
    iso8859-6 A9 strict  {}       0 {} {}
    iso8859-6 AA tcl8    \U000000AA -1 {} {}
    iso8859-6 AA replace \uFFFD -1 {} {}
    iso8859-6 AA strict  {}       0 {} {}
    iso8859-6 AB tcl8    \U000000AB -1 {} {}
    iso8859-6 AB replace \uFFFD -1 {} {}
    iso8859-6 AB strict  {}       0 {} {}
    iso8859-6 AE tcl8    \U000000AE -1 {} {}
    iso8859-6 AE replace \uFFFD -1 {} {}
    iso8859-6 AE strict  {}       0 {} {}
    iso8859-6 AF tcl8    \U000000AF -1 {} {}
    iso8859-6 AF replace \uFFFD -1 {} {}
    iso8859-6 AF strict  {}       0 {} {}
    iso8859-6 B0 tcl8    \U000000B0 -1 {} {}
    iso8859-6 B0 replace \uFFFD -1 {} {}
    iso8859-6 B0 strict  {}       0 {} {}
    iso8859-6 B1 tcl8    \U000000B1 -1 {} {}
    iso8859-6 B1 replace \uFFFD -1 {} {}
    iso8859-6 B1 strict  {}       0 {} {}
    iso8859-6 B2 tcl8    \U000000B2 -1 {} {}
    iso8859-6 B2 replace \uFFFD -1 {} {}
    iso8859-6 B2 strict  {}       0 {} {}
    iso8859-6 B3 tcl8    \U000000B3 -1 {} {}
    iso8859-6 B3 replace \uFFFD -1 {} {}
    iso8859-6 B3 strict  {}       0 {} {}
    iso8859-6 B4 tcl8    \U000000B4 -1 {} {}
    iso8859-6 B4 replace \uFFFD -1 {} {}
    iso8859-6 B4 strict  {}       0 {} {}
    iso8859-6 B5 tcl8    \U000000B5 -1 {} {}
    iso8859-6 B5 replace \uFFFD -1 {} {}
    iso8859-6 B5 strict  {}       0 {} {}
    iso8859-6 B6 tcl8    \U000000B6 -1 {} {}
    iso8859-6 B6 replace \uFFFD -1 {} {}
    iso8859-6 B6 strict  {}       0 {} {}
    iso8859-6 B7 tcl8    \U000000B7 -1 {} {}
    iso8859-6 B7 replace \uFFFD -1 {} {}
    iso8859-6 B7 strict  {}       0 {} {}
    iso8859-6 B8 tcl8    \U000000B8 -1 {} {}
    iso8859-6 B8 replace \uFFFD -1 {} {}
    iso8859-6 B8 strict  {}       0 {} {}
    iso8859-6 B9 tcl8    \U000000B9 -1 {} {}
    iso8859-6 B9 replace \uFFFD -1 {} {}
    iso8859-6 B9 strict  {}       0 {} {}
    iso8859-6 BA tcl8    \U000000BA -1 {} {}
    iso8859-6 BA replace \uFFFD -1 {} {}
    iso8859-6 BA strict  {}       0 {} {}
    iso8859-6 BC tcl8    \U000000BC -1 {} {}
    iso8859-6 BC replace \uFFFD -1 {} {}
    iso8859-6 BC strict  {}       0 {} {}
    iso8859-6 BD tcl8    \U000000BD -1 {} {}
    iso8859-6 BD replace \uFFFD -1 {} {}
    iso8859-6 BD strict  {}       0 {} {}
    iso8859-6 BE tcl8    \U000000BE -1 {} {}
    iso8859-6 BE replace \uFFFD -1 {} {}
    iso8859-6 BE strict  {}       0 {} {}
    iso8859-6 C0 tcl8    \U000000C0 -1 {} {}
    iso8859-6 C0 replace \uFFFD -1 {} {}
    iso8859-6 C0 strict  {}       0 {} {}
    iso8859-6 DB tcl8    \U000000DB -1 {} {}
    iso8859-6 DB replace \uFFFD -1 {} {}
    iso8859-6 DB strict  {}       0 {} {}
    iso8859-6 DC tcl8    \U000000DC -1 {} {}
    iso8859-6 DC replace \uFFFD -1 {} {}
    iso8859-6 DC strict  {}       0 {} {}
    iso8859-6 DD tcl8    \U000000DD -1 {} {}
    iso8859-6 DD replace \uFFFD -1 {} {}
    iso8859-6 DD strict  {}       0 {} {}
    iso8859-6 DE tcl8    \U000000DE -1 {} {}
    iso8859-6 DE replace \uFFFD -1 {} {}
    iso8859-6 DE strict  {}       0 {} {}
    iso8859-6 DF tcl8    \U000000DF -1 {} {}
    iso8859-6 DF replace \uFFFD -1 {} {}
    iso8859-6 DF strict  {}       0 {} {}
    iso8859-6 F3 tcl8    \U000000F3 -1 {} {}
    iso8859-6 F3 replace \uFFFD -1 {} {}
    iso8859-6 F3 strict  {}       0 {} {}
    iso8859-6 F4 tcl8    \U000000F4 -1 {} {}
    iso8859-6 F4 replace \uFFFD -1 {} {}
    iso8859-6 F4 strict  {}       0 {} {}
    iso8859-6 F5 tcl8    \U000000F5 -1 {} {}
    iso8859-6 F5 replace \uFFFD -1 {} {}
    iso8859-6 F5 strict  {}       0 {} {}
    iso8859-6 F6 tcl8    \U000000F6 -1 {} {}
    iso8859-6 F6 replace \uFFFD -1 {} {}
    iso8859-6 F6 strict  {}       0 {} {}
    iso8859-6 F7 tcl8    \U000000F7 -1 {} {}
    iso8859-6 F7 replace \uFFFD -1 {} {}
    iso8859-6 F7 strict  {}       0 {} {}
    iso8859-6 F8 tcl8    \U000000F8 -1 {} {}
    iso8859-6 F8 replace \uFFFD -1 {} {}
    iso8859-6 F8 strict  {}       0 {} {}
    iso8859-6 F9 tcl8    \U000000F9 -1 {} {}
    iso8859-6 F9 replace \uFFFD -1 {} {}
    iso8859-6 F9 strict  {}       0 {} {}
    iso8859-6 FA tcl8    \U000000FA -1 {} {}
    iso8859-6 FA replace \uFFFD -1 {} {}
    iso8859-6 FA strict  {}       0 {} {}
    iso8859-6 FB tcl8    \U000000FB -1 {} {}
    iso8859-6 FB replace \uFFFD -1 {} {}
    iso8859-6 FB strict  {}       0 {} {}
    iso8859-6 FC tcl8    \U000000FC -1 {} {}
    iso8859-6 FC replace \uFFFD -1 {} {}
    iso8859-6 FC strict  {}       0 {} {}
    iso8859-6 FD tcl8    \U000000FD -1 {} {}
    iso8859-6 FD replace \uFFFD -1 {} {}
    iso8859-6 FD strict  {}       0 {} {}
    iso8859-6 FE tcl8    \U000000FE -1 {} {}
    iso8859-6 FE replace \uFFFD -1 {} {}
    iso8859-6 FE strict  {}       0 {} {}
    iso8859-6 FF tcl8    \U000000FF -1 {} {}
    iso8859-6 FF replace \uFFFD -1 {} {}
    iso8859-6 FF strict  {}       0 {} {}
}; # iso8859-6

# iso8859-6 - invalid byte sequences
lappend encUnencodableStrings {*}{
    iso8859-6 \U000000A1 tcl8    1A -1 {} {}
    iso8859-6 \U000000A1 replace 1A -1 {} {}
    iso8859-6 \U000000A1 strict  {}                      0 {} {}
    iso8859-6 \U00000400 tcl8    1A -1 {} {}
    iso8859-6 \U00000400 replace 1A -1 {} {}
    iso8859-6 \U00000400 strict  {}                      0 {} {}
    iso8859-6 \U0000D800 tcl8    1A -1 {} {}
    iso8859-6 \U0000D800 replace 1A -1 {} {}
    iso8859-6 \U0000D800 strict  {}                      0 {} {}
    iso8859-6 \U0000DC00 tcl8    1A -1 {} {}
    iso8859-6 \U0000DC00 replace 1A -1 {} {}
    iso8859-6 \U0000DC00 strict  {}                      0 {} {}
    iso8859-6 \U00010000 tcl8    1A -1 {} {}
    iso8859-6 \U00010000 replace 1A -1 {} {}
    iso8859-6 \U00010000 strict  {}                      0 {} {}
    iso8859-6 \U0010FFFF tcl8    1A -1 {} {}
    iso8859-6 \U0010FFFF replace 1A -1 {} {}
    iso8859-6 \U0010FFFF strict  {}                      0 {} {}
}; # iso8859-6

#
# iso8859-7 (generated from glibc-ISO_8859_7-2.3.3)

test encoding-convertfrom-ucmCompare-iso8859-7 {Compare against ICU UCM} -body {
    ucmConvertfromMismatches iso8859-7 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A3 A3 00A6 A6 00A7 A7 00A8 A8 00A9 A9 00AB AB 00AC AC 00AD AD 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B7 B7 00BB BB 00BD BD 037A AA 0384 B4 0385 B5 0386 B6 0388 B8 0389 B9 038A BA 038C BC 038E BE 038F BF 0390 C0 0391 C1 0392 C2 0393 C3 0394 C4 0395 C5 0396 C6 0397 C7 0398 C8 0399 C9 039A CA 039B CB 039C CC 039D CD 039E CE 039F CF 03A0 D0 03A1 D1 03A3 D3 03A4 D4 03A5 D5 03A6 D6 03A7 D7 03A8 D8 03A9 D9 03AA DA 03AB DB 03AC DC 03AD DD 03AE DE 03AF DF 03B0 E0 03B1 E1 03B2 E2 03B3 E3 03B4 E4 03B5 E5 03B6 E6 03B7 E7 03B8 E8 03B9 E9 03BA EA 03BB EB 03BC EC 03BD ED 03BE EE 03BF EF 03C0 F0 03C1 F1 03C2 F2 03C3 F3 03C4 F4 03C5 F5 03C6 F6 03C7 F7 03C8 F8 03C9 F9 03CA FA 03CB FB 03CC FC 03CD FD 03CE FE 2015 AF 2018 A1 2019 A2 20AC A4 20AF A5}
} -result {}

test encoding-convertto-ucmCompare-iso8859-7 {Compare against ICU UCM} -body {
    ucmConverttoMismatches iso8859-7 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A3 A3 00A6 A6 00A7 A7 00A8 A8 00A9 A9 00AB AB 00AC AC 00AD AD 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B7 B7 00BB BB 00BD BD 037A AA 0384 B4 0385 B5 0386 B6 0388 B8 0389 B9 038A BA 038C BC 038E BE 038F BF 0390 C0 0391 C1 0392 C2 0393 C3 0394 C4 0395 C5 0396 C6 0397 C7 0398 C8 0399 C9 039A CA 039B CB 039C CC 039D CD 039E CE 039F CF 03A0 D0 03A1 D1 03A3 D3 03A4 D4 03A5 D5 03A6 D6 03A7 D7 03A8 D8 03A9 D9 03AA DA 03AB DB 03AC DC 03AD DD 03AE DE 03AF DF 03B0 E0 03B1 E1 03B2 E2 03B3 E3 03B4 E4 03B5 E5 03B6 E6 03B7 E7 03B8 E8 03B9 E9 03BA EA 03BB EB 03BC EC 03BD ED 03BE EE 03BF EF 03C0 F0 03C1 F1 03C2 F2 03C3 F3 03C4 F4 03C5 F5 03C6 F6 03C7 F7 03C8 F8 03C9 F9 03CA FA 03CB FB 03CC FC 03CD FD 03CE FE 2015 AF 2018 A1 2019 A2 20AC A4 20AF A5}
} -result {}

# iso8859-7 - invalid byte sequences
lappend encInvalidBytes {*}{
    iso8859-7 AE tcl8    \U000000AE -1 {} {}
    iso8859-7 AE replace \uFFFD -1 {} {}
    iso8859-7 AE strict  {}       0 {} {}
    iso8859-7 D2 tcl8    \U000000D2 -1 {} {}
    iso8859-7 D2 replace \uFFFD -1 {} {}
    iso8859-7 D2 strict  {}       0 {} {}
    iso8859-7 FF tcl8    \U000000FF -1 {} {}
    iso8859-7 FF replace \uFFFD -1 {} {}
    iso8859-7 FF strict  {}       0 {} {}
}; # iso8859-7

# iso8859-7 - invalid byte sequences
lappend encUnencodableStrings {*}{
    iso8859-7 \U000000A1 tcl8    1A -1 {} {}
    iso8859-7 \U000000A1 replace 1A -1 {} {}
    iso8859-7 \U000000A1 strict  {}                      0 {} {}
    iso8859-7 \U00000400 tcl8    1A -1 {} {}
    iso8859-7 \U00000400 replace 1A -1 {} {}
    iso8859-7 \U00000400 strict  {}                      0 {} {}
    iso8859-7 \U0000D800 tcl8    1A -1 {} {}
    iso8859-7 \U0000D800 replace 1A -1 {} {}
    iso8859-7 \U0000D800 strict  {}                      0 {} {}
    iso8859-7 \U0000DC00 tcl8    1A -1 {} {}
    iso8859-7 \U0000DC00 replace 1A -1 {} {}
    iso8859-7 \U0000DC00 strict  {}                      0 {} {}
    iso8859-7 \U00010000 tcl8    1A -1 {} {}
    iso8859-7 \U00010000 replace 1A -1 {} {}
    iso8859-7 \U00010000 strict  {}                      0 {} {}
    iso8859-7 \U0010FFFF tcl8    1A -1 {} {}
    iso8859-7 \U0010FFFF replace 1A -1 {} {}
    iso8859-7 \U0010FFFF strict  {}                      0 {} {}
}; # iso8859-7

#
# iso8859-8 (generated from glibc-ISO_8859_8-2.3.3)

test encoding-convertfrom-ucmCompare-iso8859-8 {Compare against ICU UCM} -body {
    ucmConvertfromMismatches iso8859-8 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A2 A2 00A3 A3 00A4 A4 00A5 A5 00A6 A6 00A7 A7 00A8 A8 00A9 A9 00AB AB 00AC AC 00AD AD 00AE AE 00AF AF 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B4 B4 00B5 B5 00B6 B6 00B7 B7 00B8 B8 00B9 B9 00BB BB 00BC BC 00BD BD 00BE BE 00D7 AA 00F7 BA 05D0 E0 05D1 E1 05D2 E2 05D3 E3 05D4 E4 05D5 E5 05D6 E6 05D7 E7 05D8 E8 05D9 E9 05DA EA 05DB EB 05DC EC 05DD ED 05DE EE 05DF EF 05E0 F0 05E1 F1 05E2 F2 05E3 F3 05E4 F4 05E5 F5 05E6 F6 05E7 F7 05E8 F8 05E9 F9 05EA FA 200E FD 200F FE 2017 DF}
} -result {}

test encoding-convertto-ucmCompare-iso8859-8 {Compare against ICU UCM} -body {
    ucmConverttoMismatches iso8859-8 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A2 A2 00A3 A3 00A4 A4 00A5 A5 00A6 A6 00A7 A7 00A8 A8 00A9 A9 00AB AB 00AC AC 00AD AD 00AE AE 00AF AF 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B4 B4 00B5 B5 00B6 B6 00B7 B7 00B8 B8 00B9 B9 00BB BB 00BC BC 00BD BD 00BE BE 00D7 AA 00F7 BA 05D0 E0 05D1 E1 05D2 E2 05D3 E3 05D4 E4 05D5 E5 05D6 E6 05D7 E7 05D8 E8 05D9 E9 05DA EA 05DB EB 05DC EC 05DD ED 05DE EE 05DF EF 05E0 F0 05E1 F1 05E2 F2 05E3 F3 05E4 F4 05E5 F5 05E6 F6 05E7 F7 05E8 F8 05E9 F9 05EA FA 200E FD 200F FE 2017 DF}
} -result {}

# iso8859-8 - invalid byte sequences
lappend encInvalidBytes {*}{
    iso8859-8 A1 tcl8    \U000000A1 -1 {} {}
    iso8859-8 A1 replace \uFFFD -1 {} {}
    iso8859-8 A1 strict  {}       0 {} {}
    iso8859-8 BF tcl8    \U000000BF -1 {} {}
    iso8859-8 BF replace \uFFFD -1 {} {}
    iso8859-8 BF strict  {}       0 {} {}
    iso8859-8 C0 tcl8    \U000000C0 -1 {} {}
    iso8859-8 C0 replace \uFFFD -1 {} {}
    iso8859-8 C0 strict  {}       0 {} {}
    iso8859-8 C1 tcl8    \U000000C1 -1 {} {}
    iso8859-8 C1 replace \uFFFD -1 {} {}
    iso8859-8 C1 strict  {}       0 {} {}
    iso8859-8 C2 tcl8    \U000000C2 -1 {} {}
    iso8859-8 C2 replace \uFFFD -1 {} {}
    iso8859-8 C2 strict  {}       0 {} {}
    iso8859-8 C3 tcl8    \U000000C3 -1 {} {}
    iso8859-8 C3 replace \uFFFD -1 {} {}
    iso8859-8 C3 strict  {}       0 {} {}
    iso8859-8 C4 tcl8    \U000000C4 -1 {} {}
    iso8859-8 C4 replace \uFFFD -1 {} {}
    iso8859-8 C4 strict  {}       0 {} {}
    iso8859-8 C5 tcl8    \U000000C5 -1 {} {}
    iso8859-8 C5 replace \uFFFD -1 {} {}
    iso8859-8 C5 strict  {}       0 {} {}
    iso8859-8 C6 tcl8    \U000000C6 -1 {} {}
    iso8859-8 C6 replace \uFFFD -1 {} {}
    iso8859-8 C6 strict  {}       0 {} {}
    iso8859-8 C7 tcl8    \U000000C7 -1 {} {}
    iso8859-8 C7 replace \uFFFD -1 {} {}
    iso8859-8 C7 strict  {}       0 {} {}
    iso8859-8 C8 tcl8    \U000000C8 -1 {} {}
    iso8859-8 C8 replace \uFFFD -1 {} {}
    iso8859-8 C8 strict  {}       0 {} {}
    iso8859-8 C9 tcl8    \U000000C9 -1 {} {}
    iso8859-8 C9 replace \uFFFD -1 {} {}
    iso8859-8 C9 strict  {}       0 {} {}
    iso8859-8 CA tcl8    \U000000CA -1 {} {}
    iso8859-8 CA replace \uFFFD -1 {} {}
    iso8859-8 CA strict  {}       0 {} {}
    iso8859-8 CB tcl8    \U000000CB -1 {} {}
    iso8859-8 CB replace \uFFFD -1 {} {}
    iso8859-8 CB strict  {}       0 {} {}
    iso8859-8 CC tcl8    \U000000CC -1 {} {}
    iso8859-8 CC replace \uFFFD -1 {} {}
    iso8859-8 CC strict  {}       0 {} {}
    iso8859-8 CD tcl8    \U000000CD -1 {} {}
    iso8859-8 CD replace \uFFFD -1 {} {}
    iso8859-8 CD strict  {}       0 {} {}
    iso8859-8 CE tcl8    \U000000CE -1 {} {}
    iso8859-8 CE replace \uFFFD -1 {} {}
    iso8859-8 CE strict  {}       0 {} {}
    iso8859-8 CF tcl8    \U000000CF -1 {} {}
    iso8859-8 CF replace \uFFFD -1 {} {}
    iso8859-8 CF strict  {}       0 {} {}
    iso8859-8 D0 tcl8    \U000000D0 -1 {} {}
    iso8859-8 D0 replace \uFFFD -1 {} {}
    iso8859-8 D0 strict  {}       0 {} {}
    iso8859-8 D1 tcl8    \U000000D1 -1 {} {}
    iso8859-8 D1 replace \uFFFD -1 {} {}
    iso8859-8 D1 strict  {}       0 {} {}
    iso8859-8 D2 tcl8    \U000000D2 -1 {} {}
    iso8859-8 D2 replace \uFFFD -1 {} {}
    iso8859-8 D2 strict  {}       0 {} {}
    iso8859-8 D3 tcl8    \U000000D3 -1 {} {}
    iso8859-8 D3 replace \uFFFD -1 {} {}
    iso8859-8 D3 strict  {}       0 {} {}
    iso8859-8 D4 tcl8    \U000000D4 -1 {} {}
    iso8859-8 D4 replace \uFFFD -1 {} {}
    iso8859-8 D4 strict  {}       0 {} {}
    iso8859-8 D5 tcl8    \U000000D5 -1 {} {}
    iso8859-8 D5 replace \uFFFD -1 {} {}
    iso8859-8 D5 strict  {}       0 {} {}
    iso8859-8 D6 tcl8    \U000000D6 -1 {} {}
    iso8859-8 D6 replace \uFFFD -1 {} {}
    iso8859-8 D6 strict  {}       0 {} {}
    iso8859-8 D7 tcl8    \U000000D7 -1 {} {}
    iso8859-8 D7 replace \uFFFD -1 {} {}
    iso8859-8 D7 strict  {}       0 {} {}
    iso8859-8 D8 tcl8    \U000000D8 -1 {} {}
    iso8859-8 D8 replace \uFFFD -1 {} {}
    iso8859-8 D8 strict  {}       0 {} {}
    iso8859-8 D9 tcl8    \U000000D9 -1 {} {}
    iso8859-8 D9 replace \uFFFD -1 {} {}
    iso8859-8 D9 strict  {}       0 {} {}
    iso8859-8 DA tcl8    \U000000DA -1 {} {}
    iso8859-8 DA replace \uFFFD -1 {} {}
    iso8859-8 DA strict  {}       0 {} {}
    iso8859-8 DB tcl8    \U000000DB -1 {} {}
    iso8859-8 DB replace \uFFFD -1 {} {}
    iso8859-8 DB strict  {}       0 {} {}
    iso8859-8 DC tcl8    \U000000DC -1 {} {}
    iso8859-8 DC replace \uFFFD -1 {} {}
    iso8859-8 DC strict  {}       0 {} {}
    iso8859-8 DD tcl8    \U000000DD -1 {} {}
    iso8859-8 DD replace \uFFFD -1 {} {}
    iso8859-8 DD strict  {}       0 {} {}
    iso8859-8 DE tcl8    \U000000DE -1 {} {}
    iso8859-8 DE replace \uFFFD -1 {} {}
    iso8859-8 DE strict  {}       0 {} {}
    iso8859-8 FB tcl8    \U000000FB -1 {} {}
    iso8859-8 FB replace \uFFFD -1 {} {}
    iso8859-8 FB strict  {}       0 {} {}
    iso8859-8 FC tcl8    \U000000FC -1 {} {}
    iso8859-8 FC replace \uFFFD -1 {} {}
    iso8859-8 FC strict  {}       0 {} {}
    iso8859-8 FF tcl8    \U000000FF -1 {} {}
    iso8859-8 FF replace \uFFFD -1 {} {}
    iso8859-8 FF strict  {}       0 {} {}
}; # iso8859-8

# iso8859-8 - invalid byte sequences
lappend encUnencodableStrings {*}{
    iso8859-8 \U000000A1 tcl8    1A -1 {} {}
    iso8859-8 \U000000A1 replace 1A -1 {} {}
    iso8859-8 \U000000A1 strict  {}                      0 {} {}
    iso8859-8 \U00000400 tcl8    1A -1 {} {}
    iso8859-8 \U00000400 replace 1A -1 {} {}
    iso8859-8 \U00000400 strict  {}                      0 {} {}
    iso8859-8 \U0000D800 tcl8    1A -1 {} {}
    iso8859-8 \U0000D800 replace 1A -1 {} {}
    iso8859-8 \U0000D800 strict  {}                      0 {} {}
    iso8859-8 \U0000DC00 tcl8    1A -1 {} {}
    iso8859-8 \U0000DC00 replace 1A -1 {} {}
    iso8859-8 \U0000DC00 strict  {}                      0 {} {}
    iso8859-8 \U00010000 tcl8    1A -1 {} {}
    iso8859-8 \U00010000 replace 1A -1 {} {}
    iso8859-8 \U00010000 strict  {}                      0 {} {}
    iso8859-8 \U0010FFFF tcl8    1A -1 {} {}
    iso8859-8 \U0010FFFF replace 1A -1 {} {}
    iso8859-8 \U0010FFFF strict  {}                      0 {} {}
}; # iso8859-8

#
# iso8859-9 (generated from glibc-ISO_8859_9-2.1.2)

test encoding-convertfrom-ucmCompare-iso8859-9 {Compare against ICU UCM} -body {
    ucmConvertfromMismatches iso8859-9 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A1 A1 00A2 A2 00A3 A3 00A4 A4 00A5 A5 00A6 A6 00A7 A7 00A8 A8 00A9 A9 00AA AA 00AB AB 00AC AC 00AD AD 00AE AE 00AF AF 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B4 B4 00B5 B5 00B6 B6 00B7 B7 00B8 B8 00B9 B9 00BA BA 00BB BB 00BC BC 00BD BD 00BE BE 00BF BF 00C0 C0 00C1 C1 00C2 C2 00C3 C3 00C4 C4 00C5 C5 00C6 C6 00C7 C7 00C8 C8 00C9 C9 00CA CA 00CB CB 00CC CC 00CD CD 00CE CE 00CF CF 00D1 D1 00D2 D2 00D3 D3 00D4 D4 00D5 D5 00D6 D6 00D7 D7 00D8 D8 00D9 D9 00DA DA 00DB DB 00DC DC 00DF DF 00E0 E0 00E1 E1 00E2 E2 00E3 E3 00E4 E4 00E5 E5 00E6 E6 00E7 E7 00E8 E8 00E9 E9 00EA EA 00EB EB 00EC EC 00ED ED 00EE EE 00EF EF 00F1 F1 00F2 F2 00F3 F3 00F4 F4 00F5 F5 00F6 F6 00F7 F7 00F8 F8 00F9 F9 00FA FA 00FB FB 00FC FC 00FF FF 011E D0 011F F0 0130 DD 0131 FD 015E DE 015F FE}
} -result {}

test encoding-convertto-ucmCompare-iso8859-9 {Compare against ICU UCM} -body {
    ucmConverttoMismatches iso8859-9 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A1 A1 00A2 A2 00A3 A3 00A4 A4 00A5 A5 00A6 A6 00A7 A7 00A8 A8 00A9 A9 00AA AA 00AB AB 00AC AC 00AD AD 00AE AE 00AF AF 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B4 B4 00B5 B5 00B6 B6 00B7 B7 00B8 B8 00B9 B9 00BA BA 00BB BB 00BC BC 00BD BD 00BE BE 00BF BF 00C0 C0 00C1 C1 00C2 C2 00C3 C3 00C4 C4 00C5 C5 00C6 C6 00C7 C7 00C8 C8 00C9 C9 00CA CA 00CB CB 00CC CC 00CD CD 00CE CE 00CF CF 00D1 D1 00D2 D2 00D3 D3 00D4 D4 00D5 D5 00D6 D6 00D7 D7 00D8 D8 00D9 D9 00DA DA 00DB DB 00DC DC 00DF DF 00E0 E0 00E1 E1 00E2 E2 00E3 E3 00E4 E4 00E5 E5 00E6 E6 00E7 E7 00E8 E8 00E9 E9 00EA EA 00EB EB 00EC EC 00ED ED 00EE EE 00EF EF 00F1 F1 00F2 F2 00F3 F3 00F4 F4 00F5 F5 00F6 F6 00F7 F7 00F8 F8 00F9 F9 00FA FA 00FB FB 00FC FC 00FF FF 011E D0 011F F0 0130 DD 0131 FD 015E DE 015F FE}
} -result {}

# iso8859-9 - invalid byte sequences
lappend encInvalidBytes {*}{
}; # iso8859-9

# iso8859-9 - invalid byte sequences
lappend encUnencodableStrings {*}{
    iso8859-9 \U000000D0 tcl8    1A -1 {} {}
    iso8859-9 \U000000D0 replace 1A -1 {} {}
    iso8859-9 \U000000D0 strict  {}                      0 {} {}
    iso8859-9 \U00000400 tcl8    1A -1 {} {}
    iso8859-9 \U00000400 replace 1A -1 {} {}
    iso8859-9 \U00000400 strict  {}                      0 {} {}
    iso8859-9 \U0000D800 tcl8    1A -1 {} {}
    iso8859-9 \U0000D800 replace 1A -1 {} {}
    iso8859-9 \U0000D800 strict  {}                      0 {} {}
    iso8859-9 \U0000DC00 tcl8    1A -1 {} {}
    iso8859-9 \U0000DC00 replace 1A -1 {} {}
    iso8859-9 \U0000DC00 strict  {}                      0 {} {}
    iso8859-9 \U00010000 tcl8    1A -1 {} {}
    iso8859-9 \U00010000 replace 1A -1 {} {}
    iso8859-9 \U00010000 strict  {}                      0 {} {}
    iso8859-9 \U0010FFFF tcl8    1A -1 {} {}
    iso8859-9 \U0010FFFF replace 1A -1 {} {}
    iso8859-9 \U0010FFFF strict  {}                      0 {} {}
}; # iso8859-9

#
# iso8859-10 (generated from glibc-ISO_8859_10-2.1.2)

test encoding-convertfrom-ucmCompare-iso8859-10 {Compare against ICU UCM} -body {
    ucmConvertfromMismatches iso8859-10 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A7 A7 00AD AD 00B0 B0 00B7 B7 00C1 C1 00C2 C2 00C3 C3 00C4 C4 00C5 C5 00C6 C6 00C9 C9 00CB CB 00CD CD 00CE CE 00CF CF 00D0 D0 00D3 D3 00D4 D4 00D5 D5 00D6 D6 00D8 D8 00DA DA 00DB DB 00DC DC 00DD DD 00DE DE 00DF DF 00E1 E1 00E2 E2 00E3 E3 00E4 E4 00E5 E5 00E6 E6 00E9 E9 00EB EB 00ED ED 00EE EE 00EF EF 00F0 F0 00F3 F3 00F4 F4 00F5 F5 00F6 F6 00F8 F8 00FA FA 00FB FB 00FC FC 00FD FD 00FE FE 0100 C0 0101 E0 0104 A1 0105 B1 010C C8 010D E8 0110 A9 0111 B9 0112 A2 0113 B2 0116 CC 0117 EC 0118 CA 0119 EA 0122 A3 0123 B3 0128 A5 0129 B5 012A A4 012B B4 012E C7 012F E7 0136 A6 0137 B6 0138 FF 013B A8 013C B8 0145 D1 0146 F1 014A AF 014B BF 014C D2 014D F2 0160 AA 0161 BA 0166 AB 0167 BB 0168 D7 0169 F7 016A AE 016B BE 0172 D9 0173 F9 017D AC 017E BC 2015 BD}
} -result {}

test encoding-convertto-ucmCompare-iso8859-10 {Compare against ICU UCM} -body {
    ucmConverttoMismatches iso8859-10 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A7 A7 00AD AD 00B0 B0 00B7 B7 00C1 C1 00C2 C2 00C3 C3 00C4 C4 00C5 C5 00C6 C6 00C9 C9 00CB CB 00CD CD 00CE CE 00CF CF 00D0 D0 00D3 D3 00D4 D4 00D5 D5 00D6 D6 00D8 D8 00DA DA 00DB DB 00DC DC 00DD DD 00DE DE 00DF DF 00E1 E1 00E2 E2 00E3 E3 00E4 E4 00E5 E5 00E6 E6 00E9 E9 00EB EB 00ED ED 00EE EE 00EF EF 00F0 F0 00F3 F3 00F4 F4 00F5 F5 00F6 F6 00F8 F8 00FA FA 00FB FB 00FC FC 00FD FD 00FE FE 0100 C0 0101 E0 0104 A1 0105 B1 010C C8 010D E8 0110 A9 0111 B9 0112 A2 0113 B2 0116 CC 0117 EC 0118 CA 0119 EA 0122 A3 0123 B3 0128 A5 0129 B5 012A A4 012B B4 012E C7 012F E7 0136 A6 0137 B6 0138 FF 013B A8 013C B8 0145 D1 0146 F1 014A AF 014B BF 014C D2 014D F2 0160 AA 0161 BA 0166 AB 0167 BB 0168 D7 0169 F7 016A AE 016B BE 0172 D9 0173 F9 017D AC 017E BC 2015 BD}
} -result {}

# iso8859-10 - invalid byte sequences
lappend encInvalidBytes {*}{
}; # iso8859-10

# iso8859-10 - invalid byte sequences
lappend encUnencodableStrings {*}{
    iso8859-10 \U000000A1 tcl8    1A -1 {} {}
    iso8859-10 \U000000A1 replace 1A -1 {} {}
    iso8859-10 \U000000A1 strict  {}                      0 {} {}
    iso8859-10 \U00000400 tcl8    1A -1 {} {}
    iso8859-10 \U00000400 replace 1A -1 {} {}
    iso8859-10 \U00000400 strict  {}                      0 {} {}
    iso8859-10 \U0000D800 tcl8    1A -1 {} {}
    iso8859-10 \U0000D800 replace 1A -1 {} {}
    iso8859-10 \U0000D800 strict  {}                      0 {} {}
    iso8859-10 \U0000DC00 tcl8    1A -1 {} {}
    iso8859-10 \U0000DC00 replace 1A -1 {} {}
    iso8859-10 \U0000DC00 strict  {}                      0 {} {}
    iso8859-10 \U00010000 tcl8    1A -1 {} {}
    iso8859-10 \U00010000 replace 1A -1 {} {}
    iso8859-10 \U00010000 strict  {}                      0 {} {}
    iso8859-10 \U0010FFFF tcl8    1A -1 {} {}
    iso8859-10 \U0010FFFF replace 1A -1 {} {}
    iso8859-10 \U0010FFFF strict  {}                      0 {} {}
}; # iso8859-10

#
# iso8859-11 (generated from glibc-ISO_8859_11-2.1.2)

test encoding-convertfrom-ucmCompare-iso8859-11 {Compare against ICU UCM} -body {
    ucmConvertfromMismatches iso8859-11 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 0E01 A1 0E02 A2 0E03 A3 0E04 A4 0E05 A5 0E06 A6 0E07 A7 0E08 A8 0E09 A9 0E0A AA 0E0B AB 0E0C AC 0E0D AD 0E0E AE 0E0F AF 0E10 B0 0E11 B1 0E12 B2 0E13 B3 0E14 B4 0E15 B5 0E16 B6 0E17 B7 0E18 B8 0E19 B9 0E1A BA 0E1B BB 0E1C BC 0E1D BD 0E1E BE 0E1F BF 0E20 C0 0E21 C1 0E22 C2 0E23 C3 0E24 C4 0E25 C5 0E26 C6 0E27 C7 0E28 C8 0E29 C9 0E2A CA 0E2B CB 0E2C CC 0E2D CD 0E2E CE 0E2F CF 0E30 D0 0E31 D1 0E32 D2 0E33 D3 0E34 D4 0E35 D5 0E36 D6 0E37 D7 0E38 D8 0E39 D9 0E3A DA 0E3F DF 0E40 E0 0E41 E1 0E42 E2 0E43 E3 0E44 E4 0E45 E5 0E46 E6 0E47 E7 0E48 E8 0E49 E9 0E4A EA 0E4B EB 0E4C EC 0E4D ED 0E4E EE 0E4F EF 0E50 F0 0E51 F1 0E52 F2 0E53 F3 0E54 F4 0E55 F5 0E56 F6 0E57 F7 0E58 F8 0E59 F9 0E5A FA 0E5B FB}
} -result {}

test encoding-convertto-ucmCompare-iso8859-11 {Compare against ICU UCM} -body {
    ucmConverttoMismatches iso8859-11 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 0E01 A1 0E02 A2 0E03 A3 0E04 A4 0E05 A5 0E06 A6 0E07 A7 0E08 A8 0E09 A9 0E0A AA 0E0B AB 0E0C AC 0E0D AD 0E0E AE 0E0F AF 0E10 B0 0E11 B1 0E12 B2 0E13 B3 0E14 B4 0E15 B5 0E16 B6 0E17 B7 0E18 B8 0E19 B9 0E1A BA 0E1B BB 0E1C BC 0E1D BD 0E1E BE 0E1F BF 0E20 C0 0E21 C1 0E22 C2 0E23 C3 0E24 C4 0E25 C5 0E26 C6 0E27 C7 0E28 C8 0E29 C9 0E2A CA 0E2B CB 0E2C CC 0E2D CD 0E2E CE 0E2F CF 0E30 D0 0E31 D1 0E32 D2 0E33 D3 0E34 D4 0E35 D5 0E36 D6 0E37 D7 0E38 D8 0E39 D9 0E3A DA 0E3F DF 0E40 E0 0E41 E1 0E42 E2 0E43 E3 0E44 E4 0E45 E5 0E46 E6 0E47 E7 0E48 E8 0E49 E9 0E4A EA 0E4B EB 0E4C EC 0E4D ED 0E4E EE 0E4F EF 0E50 F0 0E51 F1 0E52 F2 0E53 F3 0E54 F4 0E55 F5 0E56 F6 0E57 F7 0E58 F8 0E59 F9 0E5A FA 0E5B FB}
} -result {}

# iso8859-11 - invalid byte sequences
lappend encInvalidBytes {*}{
    iso8859-11 DB tcl8    \U000000DB -1 {} {}
    iso8859-11 DB replace \uFFFD -1 {} {}
    iso8859-11 DB strict  {}       0 {} {}
    iso8859-11 DC tcl8    \U000000DC -1 {} {}
    iso8859-11 DC replace \uFFFD -1 {} {}
    iso8859-11 DC strict  {}       0 {} {}
    iso8859-11 DD tcl8    \U000000DD -1 {} {}
    iso8859-11 DD replace \uFFFD -1 {} {}
    iso8859-11 DD strict  {}       0 {} {}
    iso8859-11 DE tcl8    \U000000DE -1 {} {}
    iso8859-11 DE replace \uFFFD -1 {} {}
    iso8859-11 DE strict  {}       0 {} {}
    iso8859-11 FC tcl8    \U000000FC -1 {} {}
    iso8859-11 FC replace \uFFFD -1 {} {}
    iso8859-11 FC strict  {}       0 {} {}
    iso8859-11 FD tcl8    \U000000FD -1 {} {}
    iso8859-11 FD replace \uFFFD -1 {} {}
    iso8859-11 FD strict  {}       0 {} {}
    iso8859-11 FE tcl8    \U000000FE -1 {} {}
    iso8859-11 FE replace \uFFFD -1 {} {}
    iso8859-11 FE strict  {}       0 {} {}
    iso8859-11 FF tcl8    \U000000FF -1 {} {}
    iso8859-11 FF replace \uFFFD -1 {} {}
    iso8859-11 FF strict  {}       0 {} {}
}; # iso8859-11

# iso8859-11 - invalid byte sequences
lappend encUnencodableStrings {*}{
    iso8859-11 \U000000A1 tcl8    1A -1 {} {}
    iso8859-11 \U000000A1 replace 1A -1 {} {}
    iso8859-11 \U000000A1 strict  {}                      0 {} {}
    iso8859-11 \U00000400 tcl8    1A -1 {} {}
    iso8859-11 \U00000400 replace 1A -1 {} {}
    iso8859-11 \U00000400 strict  {}                      0 {} {}
    iso8859-11 \U0000D800 tcl8    1A -1 {} {}
    iso8859-11 \U0000D800 replace 1A -1 {} {}
    iso8859-11 \U0000D800 strict  {}                      0 {} {}
    iso8859-11 \U0000DC00 tcl8    1A -1 {} {}
    iso8859-11 \U0000DC00 replace 1A -1 {} {}
    iso8859-11 \U0000DC00 strict  {}                      0 {} {}
    iso8859-11 \U00010000 tcl8    1A -1 {} {}
    iso8859-11 \U00010000 replace 1A -1 {} {}
    iso8859-11 \U00010000 strict  {}                      0 {} {}
    iso8859-11 \U0010FFFF tcl8    1A -1 {} {}
    iso8859-11 \U0010FFFF replace 1A -1 {} {}
    iso8859-11 \U0010FFFF strict  {}                      0 {} {}
}; # iso8859-11

#
# iso8859-13 (generated from glibc-ISO_8859_13-2.3.3)

test encoding-convertfrom-ucmCompare-iso8859-13 {Compare against ICU UCM} -body {
    ucmConvertfromMismatches iso8859-13 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A2 A2 00A3 A3 00A4 A4 00A6 A6 00A7 A7 00A9 A9 00AB AB 00AC AC 00AD AD 00AE AE 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B5 B5 00B6 B6 00B7 B7 00B9 B9 00BB BB 00BC BC 00BD BD 00BE BE 00C4 C4 00C5 C5 00C6 AF 00C9 C9 00D3 D3 00D5 D5 00D6 D6 00D7 D7 00D8 A8 00DC DC 00DF DF 00E4 E4 00E5 E5 00E6 BF 00E9 E9 00F3 F3 00F5 F5 00F6 F6 00F7 F7 00F8 B8 00FC FC 0100 C2 0101 E2 0104 C0 0105 E0 0106 C3 0107 E3 010C C8 010D E8 0112 C7 0113 E7 0116 CB 0117 EB 0118 C6 0119 E6 0122 CC 0123 EC 012A CE 012B EE 012E C1 012F E1 0136 CD 0137 ED 013B CF 013C EF 0141 D9 0142 F9 0143 D1 0144 F1 0145 D2 0146 F2 014C D4 014D F4 0156 AA 0157 BA 015A DA 015B FA 0160 D0 0161 F0 016A DB 016B FB 0172 D8 0173 F8 0179 CA 017A EA 017B DD 017C FD 017D DE 017E FE 2019 FF 201C B4 201D A1 201E A5}
} -result {}

test encoding-convertto-ucmCompare-iso8859-13 {Compare against ICU UCM} -body {
    ucmConverttoMismatches iso8859-13 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A2 A2 00A3 A3 00A4 A4 00A6 A6 00A7 A7 00A9 A9 00AB AB 00AC AC 00AD AD 00AE AE 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B5 B5 00B6 B6 00B7 B7 00B9 B9 00BB BB 00BC BC 00BD BD 00BE BE 00C4 C4 00C5 C5 00C6 AF 00C9 C9 00D3 D3 00D5 D5 00D6 D6 00D7 D7 00D8 A8 00DC DC 00DF DF 00E4 E4 00E5 E5 00E6 BF 00E9 E9 00F3 F3 00F5 F5 00F6 F6 00F7 F7 00F8 B8 00FC FC 0100 C2 0101 E2 0104 C0 0105 E0 0106 C3 0107 E3 010C C8 010D E8 0112 C7 0113 E7 0116 CB 0117 EB 0118 C6 0119 E6 0122 CC 0123 EC 012A CE 012B EE 012E C1 012F E1 0136 CD 0137 ED 013B CF 013C EF 0141 D9 0142 F9 0143 D1 0144 F1 0145 D2 0146 F2 014C D4 014D F4 0156 AA 0157 BA 015A DA 015B FA 0160 D0 0161 F0 016A DB 016B FB 0172 D8 0173 F8 0179 CA 017A EA 017B DD 017C FD 017D DE 017E FE 2019 FF 201C B4 201D A1 201E A5}
} -result {}

# iso8859-13 - invalid byte sequences
lappend encInvalidBytes {*}{
}; # iso8859-13

# iso8859-13 - invalid byte sequences
lappend encUnencodableStrings {*}{
    iso8859-13 \U000000A1 tcl8    1A -1 {} {}
    iso8859-13 \U000000A1 replace 1A -1 {} {}
    iso8859-13 \U000000A1 strict  {}                      0 {} {}
    iso8859-13 \U00000400 tcl8    1A -1 {} {}
    iso8859-13 \U00000400 replace 1A -1 {} {}
    iso8859-13 \U00000400 strict  {}                      0 {} {}
    iso8859-13 \U0000D800 tcl8    1A -1 {} {}
    iso8859-13 \U0000D800 replace 1A -1 {} {}
    iso8859-13 \U0000D800 strict  {}                      0 {} {}
    iso8859-13 \U0000DC00 tcl8    1A -1 {} {}
    iso8859-13 \U0000DC00 replace 1A -1 {} {}
    iso8859-13 \U0000DC00 strict  {}                      0 {} {}
    iso8859-13 \U00010000 tcl8    1A -1 {} {}
    iso8859-13 \U00010000 replace 1A -1 {} {}
    iso8859-13 \U00010000 strict  {}                      0 {} {}
    iso8859-13 \U0010FFFF tcl8    1A -1 {} {}
    iso8859-13 \U0010FFFF replace 1A -1 {} {}
    iso8859-13 \U0010FFFF strict  {}                      0 {} {}
}; # iso8859-13

#
# iso8859-14 (generated from glibc-ISO_8859_14-2.1.2)

test encoding-convertfrom-ucmCompare-iso8859-14 {Compare against ICU UCM} -body {
    ucmConvertfromMismatches iso8859-14 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A3 A3 00A7 A7 00A9 A9 00AD AD 00AE AE 00B6 B6 00C0 C0 00C1 C1 00C2 C2 00C3 C3 00C4 C4 00C5 C5 00C6 C6 00C7 C7 00C8 C8 00C9 C9 00CA CA 00CB CB 00CC CC 00CD CD 00CE CE 00CF CF 00D1 D1 00D2 D2 00D3 D3 00D4 D4 00D5 D5 00D6 D6 00D8 D8 00D9 D9 00DA DA 00DB DB 00DC DC 00DD DD 00DF DF 00E0 E0 00E1 E1 00E2 E2 00E3 E3 00E4 E4 00E5 E5 00E6 E6 00E7 E7 00E8 E8 00E9 E9 00EA EA 00EB EB 00EC EC 00ED ED 00EE EE 00EF EF 00F1 F1 00F2 F2 00F3 F3 00F4 F4 00F5 F5 00F6 F6 00F8 F8 00F9 F9 00FA FA 00FB FB 00FC FC 00FD FD 00FF FF 010A A4 010B A5 0120 B2 0121 B3 0174 D0 0175 F0 0176 DE 0177 FE 0178 AF 1E02 A1 1E03 A2 1E0A A6 1E0B AB 1E1E B0 1E1F B1 1E40 B4 1E41 B5 1E56 B7 1E57 B9 1E60 BB 1E61 BF 1E6A D7 1E6B F7 1E80 A8 1E81 B8 1E82 AA 1E83 BA 1E84 BD 1E85 BE 1EF2 AC 1EF3 BC}
} -result {}

test encoding-convertto-ucmCompare-iso8859-14 {Compare against ICU UCM} -body {
    ucmConverttoMismatches iso8859-14 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A3 A3 00A7 A7 00A9 A9 00AD AD 00AE AE 00B6 B6 00C0 C0 00C1 C1 00C2 C2 00C3 C3 00C4 C4 00C5 C5 00C6 C6 00C7 C7 00C8 C8 00C9 C9 00CA CA 00CB CB 00CC CC 00CD CD 00CE CE 00CF CF 00D1 D1 00D2 D2 00D3 D3 00D4 D4 00D5 D5 00D6 D6 00D8 D8 00D9 D9 00DA DA 00DB DB 00DC DC 00DD DD 00DF DF 00E0 E0 00E1 E1 00E2 E2 00E3 E3 00E4 E4 00E5 E5 00E6 E6 00E7 E7 00E8 E8 00E9 E9 00EA EA 00EB EB 00EC EC 00ED ED 00EE EE 00EF EF 00F1 F1 00F2 F2 00F3 F3 00F4 F4 00F5 F5 00F6 F6 00F8 F8 00F9 F9 00FA FA 00FB FB 00FC FC 00FD FD 00FF FF 010A A4 010B A5 0120 B2 0121 B3 0174 D0 0175 F0 0176 DE 0177 FE 0178 AF 1E02 A1 1E03 A2 1E0A A6 1E0B AB 1E1E B0 1E1F B1 1E40 B4 1E41 B5 1E56 B7 1E57 B9 1E60 BB 1E61 BF 1E6A D7 1E6B F7 1E80 A8 1E81 B8 1E82 AA 1E83 BA 1E84 BD 1E85 BE 1EF2 AC 1EF3 BC}
} -result {}

# iso8859-14 - invalid byte sequences
lappend encInvalidBytes {*}{
}; # iso8859-14

# iso8859-14 - invalid byte sequences
lappend encUnencodableStrings {*}{
    iso8859-14 \U000000A1 tcl8    1A -1 {} {}
    iso8859-14 \U000000A1 replace 1A -1 {} {}
    iso8859-14 \U000000A1 strict  {}                      0 {} {}
    iso8859-14 \U00000400 tcl8    1A -1 {} {}
    iso8859-14 \U00000400 replace 1A -1 {} {}
    iso8859-14 \U00000400 strict  {}                      0 {} {}
    iso8859-14 \U0000D800 tcl8    1A -1 {} {}
    iso8859-14 \U0000D800 replace 1A -1 {} {}
    iso8859-14 \U0000D800 strict  {}                      0 {} {}
    iso8859-14 \U0000DC00 tcl8    1A -1 {} {}
    iso8859-14 \U0000DC00 replace 1A -1 {} {}
    iso8859-14 \U0000DC00 strict  {}                      0 {} {}
    iso8859-14 \U00010000 tcl8    1A -1 {} {}
    iso8859-14 \U00010000 replace 1A -1 {} {}
    iso8859-14 \U00010000 strict  {}                      0 {} {}
    iso8859-14 \U0010FFFF tcl8    1A -1 {} {}
    iso8859-14 \U0010FFFF replace 1A -1 {} {}
    iso8859-14 \U0010FFFF strict  {}                      0 {} {}
}; # iso8859-14

#
# iso8859-15 (generated from glibc-ISO_8859_15-2.1.2)

test encoding-convertfrom-ucmCompare-iso8859-15 {Compare against ICU UCM} -body {
    ucmConvertfromMismatches iso8859-15 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A1 A1 00A2 A2 00A3 A3 00A5 A5 00A7 A7 00A9 A9 00AA AA 00AB AB 00AC AC 00AD AD 00AE AE 00AF AF 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B5 B5 00B6 B6 00B7 B7 00B9 B9 00BA BA 00BB BB 00BF BF 00C0 C0 00C1 C1 00C2 C2 00C3 C3 00C4 C4 00C5 C5 00C6 C6 00C7 C7 00C8 C8 00C9 C9 00CA CA 00CB CB 00CC CC 00CD CD 00CE CE 00CF CF 00D0 D0 00D1 D1 00D2 D2 00D3 D3 00D4 D4 00D5 D5 00D6 D6 00D7 D7 00D8 D8 00D9 D9 00DA DA 00DB DB 00DC DC 00DD DD 00DE DE 00DF DF 00E0 E0 00E1 E1 00E2 E2 00E3 E3 00E4 E4 00E5 E5 00E6 E6 00E7 E7 00E8 E8 00E9 E9 00EA EA 00EB EB 00EC EC 00ED ED 00EE EE 00EF EF 00F0 F0 00F1 F1 00F2 F2 00F3 F3 00F4 F4 00F5 F5 00F6 F6 00F7 F7 00F8 F8 00F9 F9 00FA FA 00FB FB 00FC FC 00FD FD 00FE FE 00FF FF 0152 BC 0153 BD 0160 A6 0161 A8 0178 BE 017D B4 017E B8 20AC A4}
} -result {}

test encoding-convertto-ucmCompare-iso8859-15 {Compare against ICU UCM} -body {
    ucmConverttoMismatches iso8859-15 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A1 A1 00A2 A2 00A3 A3 00A5 A5 00A7 A7 00A9 A9 00AA AA 00AB AB 00AC AC 00AD AD 00AE AE 00AF AF 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B5 B5 00B6 B6 00B7 B7 00B9 B9 00BA BA 00BB BB 00BF BF 00C0 C0 00C1 C1 00C2 C2 00C3 C3 00C4 C4 00C5 C5 00C6 C6 00C7 C7 00C8 C8 00C9 C9 00CA CA 00CB CB 00CC CC 00CD CD 00CE CE 00CF CF 00D0 D0 00D1 D1 00D2 D2 00D3 D3 00D4 D4 00D5 D5 00D6 D6 00D7 D7 00D8 D8 00D9 D9 00DA DA 00DB DB 00DC DC 00DD DD 00DE DE 00DF DF 00E0 E0 00E1 E1 00E2 E2 00E3 E3 00E4 E4 00E5 E5 00E6 E6 00E7 E7 00E8 E8 00E9 E9 00EA EA 00EB EB 00EC EC 00ED ED 00EE EE 00EF EF 00F0 F0 00F1 F1 00F2 F2 00F3 F3 00F4 F4 00F5 F5 00F6 F6 00F7 F7 00F8 F8 00F9 F9 00FA FA 00FB FB 00FC FC 00FD FD 00FE FE 00FF FF 0152 BC 0153 BD 0160 A6 0161 A8 0178 BE 017D B4 017E B8 20AC A4}
} -result {}

# iso8859-15 - invalid byte sequences
lappend encInvalidBytes {*}{
}; # iso8859-15

# iso8859-15 - invalid byte sequences
lappend encUnencodableStrings {*}{
    iso8859-15 \U000000A4 tcl8    1A -1 {} {}
    iso8859-15 \U000000A4 replace 1A -1 {} {}
    iso8859-15 \U000000A4 strict  {}                      0 {} {}
    iso8859-15 \U00000400 tcl8    1A -1 {} {}
    iso8859-15 \U00000400 replace 1A -1 {} {}
    iso8859-15 \U00000400 strict  {}                      0 {} {}
    iso8859-15 \U0000D800 tcl8    1A -1 {} {}
    iso8859-15 \U0000D800 replace 1A -1 {} {}
    iso8859-15 \U0000D800 strict  {}                      0 {} {}
    iso8859-15 \U0000DC00 tcl8    1A -1 {} {}
    iso8859-15 \U0000DC00 replace 1A -1 {} {}
    iso8859-15 \U0000DC00 strict  {}                      0 {} {}
    iso8859-15 \U00010000 tcl8    1A -1 {} {}
    iso8859-15 \U00010000 replace 1A -1 {} {}
    iso8859-15 \U00010000 strict  {}                      0 {} {}
    iso8859-15 \U0010FFFF tcl8    1A -1 {} {}
    iso8859-15 \U0010FFFF replace 1A -1 {} {}
    iso8859-15 \U0010FFFF strict  {}                      0 {} {}
}; # iso8859-15

#
# iso8859-16 (generated from glibc-ISO_8859_16-2.3.3)

test encoding-convertfrom-ucmCompare-iso8859-16 {Compare against ICU UCM} -body {
    ucmConvertfromMismatches iso8859-16 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A7 A7 00A9 A9 00AB AB 00AD AD 00B0 B0 00B1 B1 00B6 B6 00B7 B7 00BB BB 00C0 C0 00C1 C1 00C2 C2 00C4 C4 00C6 C6 00C7 C7 00C8 C8 00C9 C9 00CA CA 00CB CB 00CC CC 00CD CD 00CE CE 00CF CF 00D2 D2 00D3 D3 00D4 D4 00D6 D6 00D9 D9 00DA DA 00DB DB 00DC DC 00DF DF 00E0 E0 00E1 E1 00E2 E2 00E4 E4 00E6 E6 00E7 E7 00E8 E8 00E9 E9 00EA EA 00EB EB 00EC EC 00ED ED 00EE EE 00EF EF 00F2 F2 00F3 F3 00F4 F4 00F6 F6 00F9 F9 00FA FA 00FB FB 00FC FC 00FF FF 0102 C3 0103 E3 0104 A1 0105 A2 0106 C5 0107 E5 010C B2 010D B9 0110 D0 0111 F0 0118 DD 0119 FD 0141 A3 0142 B3 0143 D1 0144 F1 0150 D5 0151 F5 0152 BC 0153 BD 015A D7 015B F7 0160 A6 0161 A8 0170 D8 0171 F8 0178 BE 0179 AC 017A AE 017B AF 017C BF 017D B4 017E B8 0218 AA 0219 BA 021A DE 021B FE 201D B5 201E A5 20AC A4}
} -result {}

test encoding-convertto-ucmCompare-iso8859-16 {Compare against ICU UCM} -body {
    ucmConverttoMismatches iso8859-16 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A7 A7 00A9 A9 00AB AB 00AD AD 00B0 B0 00B1 B1 00B6 B6 00B7 B7 00BB BB 00C0 C0 00C1 C1 00C2 C2 00C4 C4 00C6 C6 00C7 C7 00C8 C8 00C9 C9 00CA CA 00CB CB 00CC CC 00CD CD 00CE CE 00CF CF 00D2 D2 00D3 D3 00D4 D4 00D6 D6 00D9 D9 00DA DA 00DB DB 00DC DC 00DF DF 00E0 E0 00E1 E1 00E2 E2 00E4 E4 00E6 E6 00E7 E7 00E8 E8 00E9 E9 00EA EA 00EB EB 00EC EC 00ED ED 00EE EE 00EF EF 00F2 F2 00F3 F3 00F4 F4 00F6 F6 00F9 F9 00FA FA 00FB FB 00FC FC 00FF FF 0102 C3 0103 E3 0104 A1 0105 A2 0106 C5 0107 E5 010C B2 010D B9 0110 D0 0111 F0 0118 DD 0119 FD 0141 A3 0142 B3 0143 D1 0144 F1 0150 D5 0151 F5 0152 BC 0153 BD 015A D7 015B F7 0160 A6 0161 A8 0170 D8 0171 F8 0178 BE 0179 AC 017A AE 017B AF 017C BF 017D B4 017E B8 0218 AA 0219 BA 021A DE 021B FE 201D B5 201E A5 20AC A4}
} -result {}

# iso8859-16 - invalid byte sequences
lappend encInvalidBytes {*}{
}; # iso8859-16

# iso8859-16 - invalid byte sequences
lappend encUnencodableStrings {*}{
    iso8859-16 \U000000A1 tcl8    1A -1 {} {}
    iso8859-16 \U000000A1 replace 1A -1 {} {}
    iso8859-16 \U000000A1 strict  {}                      0 {} {}
    iso8859-16 \U00000400 tcl8    1A -1 {} {}
    iso8859-16 \U00000400 replace 1A -1 {} {}
    iso8859-16 \U00000400 strict  {}                      0 {} {}
    iso8859-16 \U0000D800 tcl8    1A -1 {} {}
    iso8859-16 \U0000D800 replace 1A -1 {} {}
    iso8859-16 \U0000D800 strict  {}                      0 {} {}
    iso8859-16 \U0000DC00 tcl8    1A -1 {} {}
    iso8859-16 \U0000DC00 replace 1A -1 {} {}
    iso8859-16 \U0000DC00 strict  {}                      0 {} {}
    iso8859-16 \U00010000 tcl8    1A -1 {} {}
    iso8859-16 \U00010000 replace 1A -1 {} {}
    iso8859-16 \U00010000 strict  {}                      0 {} {}
    iso8859-16 \U0010FFFF tcl8    1A -1 {} {}
    iso8859-16 \U0010FFFF replace 1A -1 {} {}
    iso8859-16 \U0010FFFF strict  {}                      0 {} {}
}; # iso8859-16

Changes to tests/if.test.

1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
       upvar 1 $name var
       if {[incr counter] % 2 == 1} {
           set var "$counter oops [concat $extraargs]"
       } else {
           set var "$counter + [concat $extraargs]"
       }
    }
    trace variable iftracevar r [list iftraceproc 10]
    list [catch {if "$iftracevar + 20" {}} a] $a \
        [catch {if "$iftracevar + 20" {}} b] $b
} -cleanup {
    unset iftracevar iftracecounter a b
} -match glob -result {1 {*} 0 {}}

# cleanup







|







1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
       upvar 1 $name var
       if {[incr counter] % 2 == 1} {
           set var "$counter oops [concat $extraargs]"
       } else {
           set var "$counter + [concat $extraargs]"
       }
    }
    trace add variable iftracevar read [list iftraceproc 10]
    list [catch {if "$iftracevar + 20" {}} a] $a \
        [catch {if "$iftracevar + 20" {}} b] $b
} -cleanup {
    unset iftracevar iftracecounter a b
} -match glob -result {1 {*} 0 {}}

# cleanup

Changes to tests/incr-old.test.

59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
} {1 {expected integer but got "1a"} {expected integer but got "1a"
    (reading increment)
    invoked from within
"incr x 1a"}}
test incr-old-2.6 {incr errors} -body {
    proc readonly args {error "variable is read-only"}
    set x 123
    trace var x w readonly
    list [catch {incr x 1} msg] $msg $::errorInfo
} -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only
    while executing
*
"incr x 1"}}
catch {unset x}
test incr-old-2.7 {incr errors} {







|







59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
} {1 {expected integer but got "1a"} {expected integer but got "1a"
    (reading increment)
    invoked from within
"incr x 1a"}}
test incr-old-2.6 {incr errors} -body {
    proc readonly args {error "variable is read-only"}
    set x 123
    trace add var x write readonly
    list [catch {incr x 1} msg] $msg $::errorInfo
} -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only
    while executing
*
"incr x 1"}}
catch {unset x}
test incr-old-2.7 {incr errors} {

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
25
26
27
28
# This file is a Tcl script to test out the the procedures in file
# tkIndexObj.c, which implement indexed table lookups.  The tests here are
# organized in the standard fashion for Tcl tests.
#
# Copyright © 1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testindexobj [llength [info commands testindexobj]]
testConstraint testgetintforindex [llength [info commands testgetintforindex]]
testConstraint testparseargs [llength [info commands testparseargs]]


test indexObj-1.1 {exact match} testindexobj {
    testindexobj 1 1 xyz abc def xyz alm
} {2}
test indexObj-1.2 {exact match} testindexobj {
    testindexobj 1 1 abc abc def xyz alm
} {0}
|




















>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
# This file is a Tcl script to test out the procedures in file
# tkIndexObj.c, which implement indexed table lookups.  The tests here are
# organized in the standard fashion for Tcl tests.
#
# Copyright © 1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testindexobj [llength [info commands testindexobj]]
testConstraint testgetintforindex [llength [info commands testgetintforindex]]
testConstraint testparseargs [llength [info commands testparseargs]]
testConstraint has64BitLengths [expr {$tcl_platform(pointerSize) == 8}]

test indexObj-1.1 {exact match} testindexobj {
    testindexobj 1 1 xyz abc def xyz alm
} {2}
test indexObj-1.2 {exact match} testindexobj {
    testindexobj 1 1 abc abc def xyz alm
} {0}
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
    testgetintforindex -2 0
} -1
test indexObj-8.4 {Tcl_GetIntForIndex INT_MAX} testgetintforindex {
    testgetintforindex 2147483647 0
} 2147483647
test indexObj-8.5 {Tcl_GetIntForIndex INT_MAX+1} testgetintforindex {
    testgetintforindex 2147483648 0
} 2147483648
test indexObj-8.6 {Tcl_GetIntForIndex end-1} testgetintforindex {
    testgetintforindex end-1 2147483646
} 2147483645
test indexObj-8.7 {Tcl_GetIntForIndex end-1} testgetintforindex {
    testgetintforindex end-1 2147483647
} 2147483646
test indexObj-8.8 {Tcl_GetIntForIndex end} testgetintforindex {
    testgetintforindex end 2147483646
} 2147483646
test indexObj-8.9 {Tcl_GetIntForIndex end} testgetintforindex {
    testgetintforindex end 2147483647
} 2147483647
test indexObj-8.10 {Tcl_GetIntForIndex end-1} testgetintforindex {
    testgetintforindex end-1 -1
} -2
test indexObj-8.11 {Tcl_GetIntForIndex end-1} testgetintforindex {
    testgetintforindex end-1 -2
} -3
test indexObj-8.12 {Tcl_GetIntForIndex end} testgetintforindex {
    testgetintforindex end -1
} -1
test indexObj-8.13 {Tcl_GetIntForIndex end} testgetintforindex {
    testgetintforindex end -2
} -2
test indexObj-8.14 {Tcl_GetIntForIndex end+1} testgetintforindex {
    testgetintforindex end+1 -1
} 0
test indexObj-8.15 {Tcl_GetIntForIndex end+1} testgetintforindex {
    testgetintforindex end+1 -2
} -1







# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:







|

















|





|


|



>
>
>
>
>
>








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
    testgetintforindex -2 0
} -1
test indexObj-8.4 {Tcl_GetIntForIndex INT_MAX} testgetintforindex {
    testgetintforindex 2147483647 0
} 2147483647
test indexObj-8.5 {Tcl_GetIntForIndex INT_MAX+1} testgetintforindex {
    testgetintforindex 2147483648 0
} [expr {[testConstraint has64BitLengths] ? 2147483648 : 2147483647}]
test indexObj-8.6 {Tcl_GetIntForIndex end-1} testgetintforindex {
    testgetintforindex end-1 2147483646
} 2147483645
test indexObj-8.7 {Tcl_GetIntForIndex end-1} testgetintforindex {
    testgetintforindex end-1 2147483647
} 2147483646
test indexObj-8.8 {Tcl_GetIntForIndex end} testgetintforindex {
    testgetintforindex end 2147483646
} 2147483646
test indexObj-8.9 {Tcl_GetIntForIndex end} testgetintforindex {
    testgetintforindex end 2147483647
} 2147483647
test indexObj-8.10 {Tcl_GetIntForIndex end-1} testgetintforindex {
    testgetintforindex end-1 -1
} -2
test indexObj-8.11 {Tcl_GetIntForIndex end-1} testgetintforindex {
    testgetintforindex end-1 -2
} [expr {[testConstraint has64BitLengths] ? -3 : 2147483647}]
test indexObj-8.12 {Tcl_GetIntForIndex end} testgetintforindex {
    testgetintforindex end -1
} -1
test indexObj-8.13 {Tcl_GetIntForIndex end} testgetintforindex {
    testgetintforindex end -2
} [expr {[testConstraint has64BitLengths] ? -2 : 2147483647}]
test indexObj-8.14 {Tcl_GetIntForIndex end+1} testgetintforindex {
    testgetintforindex end+1 -1
} [expr {[testConstraint has64BitLengths] ? 9223372036854775807 : 2147483647}]
test indexObj-8.15 {Tcl_GetIntForIndex end+1} testgetintforindex {
    testgetintforindex end+1 -2
} -1
test indexObj-8.16 {Tcl_GetIntForIndex integer} testgetintforindex {
    testgetintforindex -1 -1
} [expr {[testConstraint has64BitLengths] ? -9223372036854775808 : -2147483648}]
test indexObj-8.17 {Tcl_GetIntForIndex integer} testgetintforindex {
    testgetintforindex -2 -1
} [expr {[testConstraint has64BitLengths] ? -9223372036854775808 : -2147483648}]

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/init.test.

166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
	catch {parray a b $arg}
	list $first $::errorInfo
    } -match pairwise -result equal
    test init-4.$count.1 {::errorInfo produced by [unknown]} -setup {
	auto_reset
    } -body {
	namespace eval junk [list array set $arg [list 1 2 3 4]]
	trace variable ::junk::$arg r \
		"[list error [subst {Variable \"$arg\" is write-only}]] ;# "
	catch {parray ::junk::$arg}
	set first $::errorInfo
	catch {parray ::junk::$arg}
	list $first $::errorInfo
    } -match pairwise -result equal








|







166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
	catch {parray a b $arg}
	list $first $::errorInfo
    } -match pairwise -result equal
    test init-4.$count.1 {::errorInfo produced by [unknown]} -setup {
	auto_reset
    } -body {
	namespace eval junk [list array set $arg [list 1 2 3 4]]
	trace add variable ::junk::$arg read \
		"[list error [subst {Variable \"$arg\" is write-only}]] ;# "
	catch {parray ::junk::$arg}
	set first $::errorInfo
	catch {parray ::junk::$arg}
	list $first $::errorInfo
    } -match pairwise -result equal

Changes to tests/internals.tcl.

32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
	set pipe [open |[list [interpreter]] r+]
	set ppid [pid $pipe]
	# create prlimit args:
	set args {}
	# with limited address space:
	if {[info exists in(-addmem)] || [info exists in(-maxmem)]} {
	    if {[info exists in(-addmem)]} {
		# as differnce to normal usage, so try to retrieve current memory usage:
		if {[catch {
		    # using ps (vsz is in KB):
		    incr in(-addmem) [expr {[lindex [exec ps -hq $ppid -o vsz] end] * 1024}]
		}]} {
		    # ps failed, use default size 20MB:
		    incr in(-addmem) 20000000
		    # + size of locale-archive (may be up to 100MB):







|







32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
	set pipe [open |[list [interpreter]] r+]
	set ppid [pid $pipe]
	# create prlimit args:
	set args {}
	# with limited address space:
	if {[info exists in(-addmem)] || [info exists in(-maxmem)]} {
	    if {[info exists in(-addmem)]} {
		# as difference to normal usage, so try to retrieve current memory usage:
		if {[catch {
		    # using ps (vsz is in KB):
		    incr in(-addmem) [expr {[lindex [exec ps -hq $ppid -o vsz] end] * 1024}]
		}]} {
		    # ps failed, use default size 20MB:
		    incr in(-addmem) 20000000
		    # + size of locale-archive (may be up to 100MB):

Changes to tests/interp.test.

2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
    list $result $msg
} {1 {expected integer but got "bar"}}
test interp-29.1.5 {interp recursionlimit argument checking} -body {
    interp create moo
    set result [catch {interp recursionlimit moo 0} msg]
    interp delete moo
    list $result $msg
} -match glob -result {1 {recursion limit must be > 0 and < *}}
test interp-29.1.6 {interp recursionlimit argument checking} -body {
    interp create moo
    set result [catch {interp recursionlimit moo -1} msg]
    interp delete moo
    list $result $msg
} -match glob -result {1 {recursion limit must be > 0 and < *}}
test interp-29.1.7 {interp recursionlimit argument checking} {
    interp create moo
    set result [catch {interp recursionlimit moo [expr {wide(1)<<64}]} msg]
    interp delete moo
    list $result [string range $msg 0 35]
} {1 {integer value too large to represent}}
test interp-29.1.8 {child recursionlimit argument checking} {







|





|







2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
    list $result $msg
} {1 {expected integer but got "bar"}}
test interp-29.1.5 {interp recursionlimit argument checking} -body {
    interp create moo
    set result [catch {interp recursionlimit moo 0} msg]
    interp delete moo
    list $result $msg
} -match glob -result {1 {recursion limit must be > 0}}
test interp-29.1.6 {interp recursionlimit argument checking} -body {
    interp create moo
    set result [catch {interp recursionlimit moo -1} msg]
    interp delete moo
    list $result $msg
} -match glob -result {1 {recursion limit must be > 0}}
test interp-29.1.7 {interp recursionlimit argument checking} {
    interp create moo
    set result [catch {interp recursionlimit moo [expr {wide(1)<<64}]} msg]
    interp delete moo
    list $result [string range $msg 0 35]
} {1 {integer value too large to represent}}
test interp-29.1.8 {child recursionlimit argument checking} {
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
    list $result $msg
} {1 {expected integer but got "foo"}}
test interp-29.1.10 {child recursionlimit argument checking} -body {
    interp create moo
    set result [catch {moo recursionlimit 0} msg]
    interp delete moo
    list $result $msg
} -match glob -result {1 {recursion limit must be > 0 and < *}}
test interp-29.1.11 {child recursionlimit argument checking} -body {
    interp create moo
    set result [catch {moo recursionlimit -1} msg]
    interp delete moo
    list $result $msg
} -match glob -result {1 {recursion limit must be > 0 and < *}}
test interp-29.1.12 {child recursionlimit argument checking} {
    interp create moo
    set result [catch {moo recursionlimit [expr {wide(1)<<64}]} msg]
    interp delete moo
    list $result [string range $msg 0 35]
} {1 {integer value too large to represent}}
test interp-29.2.1 {query recursion limit} {







|





|







2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
    list $result $msg
} {1 {expected integer but got "foo"}}
test interp-29.1.10 {child recursionlimit argument checking} -body {
    interp create moo
    set result [catch {moo recursionlimit 0} msg]
    interp delete moo
    list $result $msg
} -match glob -result {1 {recursion limit must be > 0}}
test interp-29.1.11 {child recursionlimit argument checking} -body {
    interp create moo
    set result [catch {moo recursionlimit -1} msg]
    interp delete moo
    list $result $msg
} -match glob -result {1 {recursion limit must be > 0}}
test interp-29.1.12 {child recursionlimit argument checking} {
    interp create moo
    set result [catch {moo recursionlimit [expr {wide(1)<<64}]} msg]
    interp delete moo
    list $result [string range $msg 0 35]
} {1 {integer value too large to represent}}
test interp-29.2.1 {query recursion limit} {

Changes to tests/io.test.

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

    catch {
	::tcltest::loadTestedCommands
	package require -exact tcl::test [info patchlevel]
	set ::tcltestlib [info loaded {} Tcltest]
    }
    package require tcltests


testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint testchannel      [llength [info commands testchannel]]
testConstraint testfevent       [llength [info commands testfevent]]
testConstraint testchannelevent [llength [info commands testchannelevent]]
testConstraint testmainthread   [llength [info commands testmainthread]]
testConstraint testobj		[llength [info commands testobj]]
testConstraint testservicemode  [llength [info commands testservicemode]]
# Some things fail under Windows in Continuous Integration systems for subtle
# reasons such as CI often running with elevated privileges in a container.
testConstraint notWinCI [expr {
    $::tcl_platform(platform) ne "windows" || ![info exists ::env(CI)]}]
testConstraint notOSX [expr {$::tcl_platform(os) ne "Darwin"}]



# You need a *very* special environment to do some tests.  In
# particular, many file systems do not support large-files...
testConstraint largefileSupport [expr {$::tcl_platform(os) ne "Darwin"}]

# some tests can only be run is umask is 2
# if "umask" cannot be run, the tests will be skipped.







|

>












>
>







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

    catch {
	::tcltest::loadTestedCommands
	package require -exact tcl::test [info patchlevel]
	set ::tcltestlib [info loaded {} Tcltest]
    }
    source [file join [file dirname [info script]] tcltests.tcl]

testConstraint pointerIs64bit [expr {$::tcl_platform(pointerSize) >= 8}]
testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint testchannel      [llength [info commands testchannel]]
testConstraint testfevent       [llength [info commands testfevent]]
testConstraint testchannelevent [llength [info commands testchannelevent]]
testConstraint testmainthread   [llength [info commands testmainthread]]
testConstraint testobj		[llength [info commands testobj]]
testConstraint testservicemode  [llength [info commands testservicemode]]
# Some things fail under Windows in Continuous Integration systems for subtle
# reasons such as CI often running with elevated privileges in a container.
testConstraint notWinCI [expr {
    $::tcl_platform(platform) ne "windows" || ![info exists ::env(CI)]}]
testConstraint notOSX [expr {$::tcl_platform(os) ne "Darwin"}]
# File permissions broken on wsl without some "exotic" wsl configuration
testConstraint notWsl [expr {[llength [array names ::env *WSL*]] == 0}]

# You need a *very* special environment to do some tests.  In
# particular, many file systems do not support large-files...
testConstraint largefileSupport [expr {$::tcl_platform(os) ne "Darwin"}]

# some tests can only be run is umask is 2
# if "umask" cannot be run, the tests will be skipped.
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
test io-1.5 {Tcl_WriteChars: CheckChannelErrors} {emptyTest} {
    # no test, need to cause an async error.
} {}
set path(test1) [makeFile {} test1]
test io-1.6 {Tcl_WriteChars: WriteBytes} {
    set f [open $path(test1) w]
    fconfigure $f -encoding binary
    puts -nonewline $f "a\x00"
    close $f
    contents $path(test1)
} "a\x4D\x00"
test io-1.7 {Tcl_WriteChars: WriteChars} {
    set f [open $path(test1) w]
    fconfigure $f -encoding shiftjis
    puts -nonewline $f "a乍\x00"







|







107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
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\x4D\x00"
    close $f
    contents $path(test1)
} "a\x4D\x00"
test io-1.7 {Tcl_WriteChars: WriteChars} {
    set f [open $path(test1) w]
    fconfigure $f -encoding shiftjis
    puts -nonewline $f "a乍\x00"
189
190
191
192
193
194
195













































196
197
198
199
200
201
202
    fconfigure      $f -encoding iso2022-jp -buffersize 19
    puts -nonewline $f $data
    close           $f
    lappend sizes [file size $path(test2)]

    set sizes
} {19 19 19 19 19}














































test io-2.1 {WriteBytes} {
    # loop until all bytes are written

    set f [open $path(test1) w]
    fconfigure $f  -encoding binary -buffersize 16 -translation crlf
    puts $f "abcdefghijklmnopqrstuvwxyz"







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







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
    fconfigure      $f -encoding iso2022-jp -buffersize 19
    puts -nonewline $f $data
    close           $f
    lappend sizes [file size $path(test2)]

    set sizes
} {19 19 19 19 19}

proc testreadwrite {size {mode ""} args} {
    set tmpfile [file join [temporaryDirectory] io-1.10.tmp]
    set w [string repeat A $size]
    try {
        set fd [open $tmpfile w$mode]
        try {
            if {[llength $args]} {
                fconfigure $fd {*}$args
            }
            puts -nonewline $fd $w
        } finally {
            close $fd
        }
        set fd [open $tmpfile r$mode]
        try {
            if {[llength $args]} {
                fconfigure $fd {*}$args
            }
            set r [read $fd]
        } finally {
            close $fd
        }
    } finally {
        file delete $tmpfile
    }
    string equal $w $r
}

test io-1.10 {WriteChars: large file (> INT_MAX). Bug 3d01d51bc4} -constraints {
    pointerIs64bit perf
} -body {
    testreadwrite 0x80000000
} -result 1
test io-1.11 {WriteChars: large file (> UINT_MAX). Bug 3d01d51bc4} -constraints {
    pointerIs64bit perf
} -body {
    testreadwrite 0x100000000 "" -buffersize 1000000
} -result 1
test io-1.12 {WriteChars: large file (== UINT_MAX). Bug 90ff9b7f73} -constraints {
    pointerIs64bit perf
} -body {
    # *Exactly* UINT_MAX - separate bug from the general large file tests
    testreadwrite 0xffffffff
} -result 1

test io-2.1 {WriteBytes} {
    # loop until all bytes are written

    set f [open $path(test1) w]
    fconfigure $f  -encoding binary -buffersize 16 -translation crlf
    puts $f "abcdefghijklmnopqrstuvwxyz"
231
232
233
234
235
236
237



















238
239
240
241
242
243
244
     fconfigure $f -encoding binary -buffering line -translation lf \
	     -buffersize 16
    puts -nonewline $f "abcdefg\nhijklmnopqrstuvwxyz"
    set x [list [contents $path(test1)]]
    close $f
    lappend x [contents $path(test1)]
} [list "abcdefg\nhijklmno" "abcdefg\nhijklmnopqrstuvwxyz"]




















test io-3.1 {WriteChars: compatibility with WriteBytes} {
    # loop until all bytes are written

    set f [open $path(test1) w]
    fconfigure $f -encoding ascii -buffersize 16 -translation crlf
    puts $f "abcdefghijklmnopqrstuvwxyz"







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







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
     fconfigure $f -encoding binary -buffering line -translation lf \
	     -buffersize 16
    puts -nonewline $f "abcdefg\nhijklmnopqrstuvwxyz"
    set x [list [contents $path(test1)]]
    close $f
    lappend x [contents $path(test1)]
} [list "abcdefg\nhijklmno" "abcdefg\nhijklmnopqrstuvwxyz"]
test io-2.5 {WriteBytes: large file (> INT_MAX). Bug 3d01d51bc4} -constraints {
    pointerIs64bit perf
} -body {
    # Binary mode
    testreadwrite 0x80000000 b
} -result 1
test io-2.6 {WriteBytes: large file (> UINT_MAX). Bug 3d01d51bc4} -constraints {
    pointerIs64bit perf
} -body {
    # Binary mode
    testreadwrite 0x100000000 b -buffersize 1000000
} -result 1
test io-2.7 {WriteBytes: large file (== UINT_MAX). Bug 90ff9b7f73} -constraints {
    pointerIs64bit perf
} -body {
    # *Exactly* UINT_MAX - separate bug from the general large file tests
    testreadwrite 0xffffffff b
} -result 1


test io-3.1 {WriteChars: compatibility with WriteBytes} {
    # loop until all bytes are written

    set f [open $path(test1) w]
    fconfigure $f -encoding ascii -buffersize 16 -translation crlf
    puts $f "abcdefghijklmnopqrstuvwxyz"
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
    close $f
    set x
} "\r\n12"
test io-3.4 {WriteChars: loop over stage buffer} -body {
    # stage buffer maps to more than can be queued at once.

    set f [open $path(test1) w]
    fconfigure $f -encoding jis0208 -buffersize 16
    puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
    set x [list [contents $path(test1)]]
    close $f
    lappend x [contents $path(test1)]
} -cleanup {
    catch {close $f}
} -result [list "!)!)!)!)!)!)!)!)" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
test io-3.5 {WriteChars: saved != 0} -body {
    # Bytes produced by UtfToExternal from end of last channel buffer
    # had to be moved to beginning of next channel buffer to preserve
    # requested buffersize.

    set f [open $path(test1) w]
    fconfigure $f -encoding jis0208 -buffersize 17
    puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
    set x [list [contents $path(test1)]]
    close $f
    lappend x [contents $path(test1)]
} -cleanup {
    catch {close $f}
} -result [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]







|













|







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
    close $f
    set x
} "\r\n12"
test io-3.4 {WriteChars: loop over stage buffer} -body {
    # stage buffer maps to more than can be queued at once.

    set f [open $path(test1) w]
    fconfigure $f -encoding jis0208 -buffersize 16 -profile tcl8
    puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
    set x [list [contents $path(test1)]]
    close $f
    lappend x [contents $path(test1)]
} -cleanup {
    catch {close $f}
} -result [list "!)!)!)!)!)!)!)!)" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
test io-3.5 {WriteChars: saved != 0} -body {
    # Bytes produced by UtfToExternal from end of last channel buffer
    # had to be moved to beginning of next channel buffer to preserve
    # requested buffersize.

    set f [open $path(test1) w]
    fconfigure $f -encoding jis0208 -buffersize 17 -profile tcl8
    puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
    set x [list [contents $path(test1)]]
    close $f
    lappend x [contents $path(test1)]
} -cleanup {
    catch {close $f}
} -result [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
    # When translating UTF-8 to external, the produced bytes went past end
    # of the channel buffer.  This is done purpose -- we then truncate the
    # bytes at the end of the partial character to preserve the requested
    # blocksize on flush.  The truncated bytes are moved to the beginning
    # of the next channel buffer.

    set f [open $path(test1) w]
    fconfigure $f -encoding jis0208 -buffersize 17
    puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
    set x [list [contents $path(test1)]]
    close $f
    lappend x [contents $path(test1)]
} -cleanup {
    catch {close $f}
} -result [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]







|







382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
    # When translating UTF-8 to external, the produced bytes went past end
    # of the channel buffer.  This is done purpose -- we then truncate the
    # bytes at the end of the partial character to preserve the requested
    # blocksize on flush.  The truncated bytes are moved to the beginning
    # of the next channel buffer.

    set f [open $path(test1) w]
    fconfigure $f -encoding jis0208 -buffersize 17 -profile tcl8
    puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
    set x [list [contents $path(test1)]]
    close $f
    lappend x [contents $path(test1)]
} -cleanup {
    catch {close $f}
} -result [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
    set x [list [tell $f] [gets $f line] [tell $f] [gets $f line] $line]
    close $f
    set x
} {0 3 5 4 defg}
test io-6.4 {Tcl_GetsObj: encoding == NULL} {
    set f [open $path(test1) w]
    fconfigure $f -translation binary
    puts $f "\x81\u1234\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"]







|







529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
    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\x34\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"]
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
    # (bufPtr->nextAdded < bufPtr->bufLength)

    set f [open $path(test1) w]
    fconfigure $f -encoding binary
    puts -nonewline $f "1234567890\n123\x82\x4F\x82\x50\x82"
    close $f
    set f [open $path(test1)]
    fconfigure $f -encoding shiftjis
    set x [list [gets $f line] $line [eof $f]]
    close $f
    set x
} [list 10 "1234567890" 0]
test io-7.3 {FilterInputBytes: split up character at EOF} {testchannel} {
    set f [open $path(test1) w]
    fconfigure $f -encoding binary
    puts -nonewline $f "1234567890123\x82\x4F\x82\x50\x82"
    close $f
    set f [open $path(test1)]
    fconfigure $f -encoding shiftjis
    set x [list [gets $f line] $line]
    lappend x [tell $f] [testchannel inputbuffered $f] [eof $f]
    lappend x [gets $f line] $line
    close $f
    set x
} [list 15 "123456789012301" 18 0 1 -1 ""]
test io-7.4 {FilterInputBytes: recover from split up character} {stdio fileevent} {
    set f [open "|[list [interpreter] $path(cat)]" w+]
    fconfigure $f -encoding binary -buffering none
    puts -nonewline $f "1234567890123\x82\x4F\x82\x50\x82"
    fconfigure $f -encoding shiftjis -blocking 0
    fileevent $f read [namespace code "ready $f"]
    variable x {}







|










|





|







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
    # (bufPtr->nextAdded < bufPtr->bufLength)

    set f [open $path(test1) w]
    fconfigure $f -encoding binary
    puts -nonewline $f "1234567890\n123\x82\x4F\x82\x50\x82"
    close $f
    set f [open $path(test1)]
    fconfigure $f -encoding shiftjis -profile tcl8
    set x [list [gets $f line] $line [eof $f]]
    close $f
    set x
} [list 10 "1234567890" 0]
test io-7.3 {FilterInputBytes: split up character at EOF} {testchannel} {
    set f [open $path(test1) w]
    fconfigure $f -encoding binary
    puts -nonewline $f "1234567890123\x82\x4F\x82\x50\x82"
    close $f
    set f [open $path(test1)]
    fconfigure $f -encoding shiftjis -profile tcl8
    set x [list [gets $f line] $line]
    lappend x [tell $f] [testchannel inputbuffered $f] [eof $f]
    lappend x [gets $f line] $line
    close $f
    set x
} [list 16 "123456789012301\x82" 18 0 1 -1 ""]
test io-7.4 {FilterInputBytes: recover from split up character} {stdio fileevent} {
    set f [open "|[list [interpreter] $path(cat)]" w+]
    fconfigure $f -encoding binary -buffering none
    puts -nonewline $f "1234567890123\x82\x4F\x82\x50\x82"
    fconfigure $f -encoding shiftjis -blocking 0
    fileevent $f read [namespace code "ready $f"]
    variable x {}
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
    vwait [namespace which -variable x]
    vwait [namespace which -variable x]
    lappend x [catch {close $f} msg] $msg
    set x
} "{} timeout {} timeout 牦 {} eof 0 {}"
test io-12.6 {ReadChars: too many chars read} {
    proc driver {cmd args} {
        variable buffer
        variable index
        set chan [lindex $args 0]
        switch -- $cmd {
            initialize {
                set index($chan) 0
                set buffer($chan) [encoding convertto utf-8 \
                        [string repeat 뻯 20][string repeat . 20]]
                return {initialize finalize watch read}
            }
            finalize {
                unset index($chan) buffer($chan)
                return
            }
            watch {}
            read {
                set n [lindex $args 1]
                set new [expr {$index($chan) + $n}]
                set result [string range $buffer($chan) $index($chan) $new-1]
                set index($chan) $new
                return $result
            }
        }
    }
    set c [chan create read [namespace which driver]]
    chan configure $c -encoding utf-8
    while {![eof $c]} {
        read $c 15
    }
    close $c
} {}
test io-12.7 {ReadChars: too many chars read [bc5b790099]} {
    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 뻯 10]....뻯]
                return {initialize finalize watch read}
            }
            finalize {
                unset index($chan) buffer($chan)
                return
            }
            watch {}
            read {
                set n [lindex $args 1]
                set new [expr {$index($chan) + $n}]
                set result [string range $buffer($chan) $index($chan) $new-1]
                set index($chan) $new
                return $result
            }
        }
    }
    set c [chan create read [namespace which driver]]
    chan configure $c -encoding utf-8
    while {![eof $c]} {
        read $c 7
    }
    close $c
} {}
test io-12.8 {ReadChars: multibyte chars split} {
    set f [open $path(test1) w]
    fconfigure $f -translation binary
    puts -nonewline $f [string repeat a 9]\xC2\xA0
    close $f
    set f [open $path(test1)]
    fconfigure $f -encoding utf-8 -buffersize 10
    set in [read $f]
    close $f
    scan [string index $in end] %c
} 160













test io-12.9 {ReadChars: multibyte chars split} -body {
    set f [open $path(test1) w]
    fconfigure $f -translation binary
    puts -nonewline $f [string repeat a 9]\xC2
    close $f
    set f [open $path(test1)]
    fconfigure $f -encoding utf-8 -buffersize 10
    set in [read $f]
    close $f
    scan [string index $in end] %c
} -cleanup {
    catch {close $f}


} -result 194

test io-12.10 {ReadChars: multibyte chars split} -body {
    set f [open $path(test1) w]
    fconfigure $f -translation binary
    puts -nonewline $f [string repeat a 9]\xC2
    close $f
    set f [open $path(test1)]
    fconfigure $f -encoding utf-8 -buffersize 11
    set in [read $f]
    close $f
    scan [string index $in end] %c
} -cleanup {
    catch {close $f}
} -result 194








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




|





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




|














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





|





>
>
|
>
|





|







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
    vwait [namespace which -variable x]
    vwait [namespace which -variable x]
    lappend x [catch {close $f} msg] $msg
    set x
} "{} timeout {} timeout 牦 {} eof 0 {}"
test io-12.6 {ReadChars: too many chars read} {
    proc driver {cmd args} {
	variable buffer
	variable index
	set chan [lindex $args 0]
	switch -- $cmd {
	    initialize {
		set index($chan) 0
		set buffer($chan) [encoding convertto utf-8 \
			[string repeat 뻯 20][string repeat . 20]]
		return {initialize finalize watch read}
	    }
	    finalize {
		unset index($chan) buffer($chan)
		return
	    }
	    watch {}
	    read {
		set n [lindex $args 1]
		set new [expr {$index($chan) + $n}]
		set result [string range $buffer($chan) $index($chan) $new-1]
		set index($chan) $new
		return $result
	    }
	}
    }
    set c [chan create read [namespace which driver]]
    chan configure $c -encoding utf-8
    while {![eof $c]} {
	read $c 15
    }
    close $c
} {}
test io-12.7 {ReadChars: too many chars read [bc5b790099]} {
    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 뻯 10]....뻯]
		return {initialize finalize watch read}
	    }
	    finalize {
		unset index($chan) buffer($chan)
		return
	    }
	    watch {}
	    read {
		set n [lindex $args 1]
		set new [expr {$index($chan) + $n}]
		set result [string range $buffer($chan) $index($chan) $new-1]
		set index($chan) $new
		return $result
	    }
	}
    }
    set c [chan create read [namespace which driver]]
    chan configure $c -encoding utf-8
    while {![eof $c]} {
	read $c 7
    }
    close $c
} {}
test io-12.8 {ReadChars: multibyte chars split} {
    set f [open $path(test1) w]
    fconfigure $f -translation binary
    puts -nonewline $f [string repeat a 9]\xC2\xA0
    close $f
    set f [open $path(test1)]
    fconfigure $f -encoding utf-8 -buffersize 10
    set in [read $f]
    close $f
    scan [string index $in end] %c
} 160
test {io-12.9 profile tcl8} {ReadChars: multibyte chars split} -body {
    set f [open $path(test1) w]
    fconfigure $f -translation binary
    puts -nonewline $f [string repeat a 9]\xC2
    close $f
    set f [open $path(test1)]
    fconfigure $f -encoding utf-8 -profile tcl8 -buffersize 10
    set in [read $f]
    read $f
    scan [string index $in end] %c
} -cleanup {
    catch {close $f}
} -result 194
test {io-12.10 strict} {ReadChars: multibyte chars split} -body {
    set f [open $path(test1) w]
    fconfigure $f -translation binary
    puts -nonewline $f [string repeat a 9]\xC2
    close $f
    set f [open $path(test1)]
    fconfigure $f -encoding utf-8 -profile strict -buffersize 10
    set in [read $f]
    close $f
    scan [string index $in end] %c
} -cleanup {
    catch {close $f}
} -returnCodes 1 -match glob -result {error reading "file*":\
	invalid or incomplete multibyte or wide character}


test {io-12.10 tcl8} {ReadChars: multibyte chars split} -body {
    set f [open $path(test1) w]
    fconfigure $f -translation binary
    puts -nonewline $f [string repeat a 9]\xC2
    close $f
    set f [open $path(test1)]
    fconfigure $f -encoding utf-8 -profile tcl8 -buffersize 10
    set in [read $f]
    close $f
    scan [string index $in end] %c
} -cleanup {
    catch {close $f}
} -result 194

1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
    set c
} hello
test io-14.9 {reuse of stdio special channels} {stdio fileevent} {
    file delete $path(script)
    file delete $path(test1)
    set f [open $path(script) w]
    puts $f {
        array set path [lindex $argv 0]
	set f [open $path(test1) w]
	puts $f hello
	close $f
	close stderr
	set f [open "|[list [info nameofexecutable] $path(cat) $path(test1)]" r]
	puts [gets $f]
    }







|







2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
    set c
} hello
test io-14.9 {reuse of stdio special channels} {stdio fileevent} {
    file delete $path(script)
    file delete $path(test1)
    set f [open $path(script) w]
    puts $f {
	array set path [lindex $argv 0]
	set f [open $path(test1) w]
	puts $f hello
	close $f
	close stderr
	set f [open "|[list [info nameofexecutable] $path(cat) $path(test1)]" r]
	puts [gets $f]
    }
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
	    puts -nonewline $f [read stdin 1024]
	}
	close $f
    }
    close $f
    set x 01234567890123456789012345678901
    for {set i 0} {$i < 11} {incr i} {
        set x "$x$x"
    }
    set f [open $path(output) w]
    close $f
    set f [open "|[list [interpreter] $path(pipe)]" w]
    fconfigure $f -blocking off
    puts -nonewline $f $x
    close $f
    set counter 0
    while {([file size $path(output)] < 65536) && ($counter < 1000)} {
	after 20 [list incr [namespace which -variable counter]]
	vwait [namespace which -variable counter]
    }
    if {$counter == 1000} {
        set result "file size only [file size $path(output)]"
    } else {
        set result ok
    }
} ok

# Tests closing a channel. The functions tested are CloseChannel and Tcl_Close.

test io-28.1 {CloseChannel called when all references are dropped} {testchannel} {
    file delete $path(test1)







|













|

|







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
	    puts -nonewline $f [read stdin 1024]
	}
	close $f
    }
    close $f
    set x 01234567890123456789012345678901
    for {set i 0} {$i < 11} {incr i} {
	set x "$x$x"
    }
    set f [open $path(output) w]
    close $f
    set f [open "|[list [interpreter] $path(pipe)]" w]
    fconfigure $f -blocking off
    puts -nonewline $f $x
    close $f
    set counter 0
    while {([file size $path(output)] < 65536) && ($counter < 1000)} {
	after 20 [list incr [namespace which -variable counter]]
	vwait [namespace which -variable counter]
    }
    if {$counter == 1000} {
	set result "file size only [file size $path(output)]"
    } else {
	set result ok
    }
} ok

# Tests closing a channel. The functions tested are CloseChannel and Tcl_Close.

test io-28.1 {CloseChannel called when all references are dropped} {testchannel} {
    file delete $path(test1)
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
	    puts -nonewline $f [read stdin 1024]
	}
	close $f
    }
    close $f
    set x 01234567890123456789012345678901
    for {set i 0} {$i < 11} {incr i} {
        set x "$x$x"
    }
    set f [open $path(output) w]
    close $f
    set f [open "|[list [interpreter] pipe]" r+]
    fconfigure $f -blocking off -eofchar {}

    puts -nonewline $f $x
    close $f
    set counter 0
    while {([file size $path(output)] < 20480) && ($counter < 1000)} {
	after 20 [list incr [namespace which -variable counter]]
	vwait [namespace which -variable counter]
    }
    if {$counter == 1000} {
        set result probably_broken
    } else {
        set result ok
    }
} ok
test io-28.4 Tcl_Close testchannel {
    file delete $path(test1)
    set l {}
    lappend l [lsort [testchannel open]]
    set f [open $path(test1) w]







|














|

|







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
	    puts -nonewline $f [read stdin 1024]
	}
	close $f
    }
    close $f
    set x 01234567890123456789012345678901
    for {set i 0} {$i < 11} {incr i} {
	set x "$x$x"
    }
    set f [open $path(output) w]
    close $f
    set f [open "|[list [interpreter] pipe]" r+]
    fconfigure $f -blocking off -eofchar {}

    puts -nonewline $f $x
    close $f
    set counter 0
    while {([file size $path(output)] < 20480) && ($counter < 1000)} {
	after 20 [list incr [namespace which -variable counter]]
	vwait [namespace which -variable counter]
    }
    if {$counter == 1000} {
	set result probably_broken
    } else {
	set result ok
    }
} ok
test io-28.4 Tcl_Close testchannel {
    file delete $path(test1)
    set l {}
    lappend l [lsort [testchannel open]]
    set f [open $path(test1) w]
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
    fconfigure $f -translation binary
    set x [fconfigure $f -translation]
    close $f
    set x
} lf
#
# Test io-9.14 has been removed because "auto" output translation mode is
# not supoprted.
#
test io-31.14 {Tcl_Write mixed, Tcl_Gets auto} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts $f hello\nthere\rand\r\nhere
    close $f







|







3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
    fconfigure $f -translation binary
    set x [fconfigure $f -translation]
    close $f
    set x
} lf
#
# Test io-9.14 has been removed because "auto" output translation mode is
# not supported.
#
test io-31.14 {Tcl_Write mixed, Tcl_Gets auto} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts $f hello\nthere\rand\r\nhere
    close $f
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
    fconfigure $f -translation lf
    for {set y 0} {$y < 300} {incr y} {gets $f}
    close $f
    set y
} 300
test io-33.11 {TclGetsObjBinary, [10dc6daa37]} -setup {
    proc driver {cmd args} {
        variable buffer
        variable index
        set chan [lindex $args 0]
        switch -- $cmd {
            initialize {
                set index($chan) 0
                set buffer($chan) .......
                return {initialize finalize watch read}
            }
            finalize {
                unset index($chan) buffer($chan)
                return
            }
            watch {}
            read {
                set n [lindex $args 1]
		if {$n > 3} {set n 3}
                set new [expr {$index($chan) + $n}]
                set result [string range $buffer($chan) $index($chan) $new-1]
                set index($chan) $new
                return $result
            }
        }
    }
} -body {
    set c [chan create read [namespace which driver]]
    chan configure $c -translation binary -blocking 0
    list [gets $c] [gets $c] [gets $c] [gets $c]
} -cleanup {
    close $c
    rename driver {}
} -result {{} {} {} .......}
test io-33.12 {Tcl_GetsObj, [10dc6daa37]} -setup {
    proc driver {cmd args} {
        variable buffer
        variable index
        set chan [lindex $args 0]
        switch -- $cmd {
            initialize {
                set index($chan) 0
                set buffer($chan) .......
                return {initialize finalize watch read}
            }
            finalize {
                unset index($chan) buffer($chan)
                return
            }
            watch {}
            read {
                set n [lindex $args 1]
		if {$n > 3} {set n 3}
                set new [expr {$index($chan) + $n}]
                set result [string range $buffer($chan) $index($chan) $new-1]
                set index($chan) $new
                return $result
            }
        }
    }
} -body {
    set c [chan create read [namespace which driver]]
    chan configure $c -blocking 0
    list [gets $c] [gets $c] [gets $c] [gets $c]
} -cleanup {
    close $c
    rename driver {}
} -result {{} {} {} .......}
test io-33.13 {Tcl_GetsObj, [10dc6daa37]} -setup {
    proc driver {cmd args} {
        variable buffer
        variable index
        set chan [lindex $args 0]
        switch -- $cmd {
            initialize {
                set index($chan) 0
                set buffer($chan) [string repeat \
                        [string repeat . 64]\n[string repeat . 25] 2]
                return {initialize finalize watch read}
            }
            finalize {
                unset index($chan) buffer($chan)
                return
            }
            watch {}
            read {
                set n [lindex $args 1]
                if {$n > 65} {set n 65}
                set new [expr {$index($chan) + $n}]
                set result [string range $buffer($chan) $index($chan) $new-1]
                set index($chan) $new
                return $result
            }
        }
    }
} -body {
    set c [chan create read [namespace which driver]]
    chan configure $c -blocking 0
    list [gets $c] [gets $c] [gets $c] [gets $c] [gets $c]
} -cleanup {
    close $c







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

|
|
|
|
|
|











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

|
|
|
|
|
|











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







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
    fconfigure $f -translation lf
    for {set y 0} {$y < 300} {incr y} {gets $f}
    close $f
    set y
} 300
test io-33.11 {TclGetsObjBinary, [10dc6daa37]} -setup {
    proc driver {cmd args} {
	variable buffer
	variable index
	set chan [lindex $args 0]
	switch -- $cmd {
	    initialize {
		set index($chan) 0
		set buffer($chan) .......
		return {initialize finalize watch read}
	    }
	    finalize {
		unset index($chan) buffer($chan)
		return
	    }
	    watch {}
	    read {
		set n [lindex $args 1]
		if {$n > 3} {set n 3}
		set new [expr {$index($chan) + $n}]
		set result [string range $buffer($chan) $index($chan) $new-1]
		set index($chan) $new
		return $result
	    }
	}
    }
} -body {
    set c [chan create read [namespace which driver]]
    chan configure $c -translation binary -blocking 0
    list [gets $c] [gets $c] [gets $c] [gets $c]
} -cleanup {
    close $c
    rename driver {}
} -result {{} {} {} .......}
test io-33.12 {Tcl_GetsObj, [10dc6daa37]} -setup {
    proc driver {cmd args} {
	variable buffer
	variable index
	set chan [lindex $args 0]
	switch -- $cmd {
	    initialize {
		set index($chan) 0
		set buffer($chan) .......
		return {initialize finalize watch read}
	    }
	    finalize {
		unset index($chan) buffer($chan)
		return
	    }
	    watch {}
	    read {
		set n [lindex $args 1]
		if {$n > 3} {set n 3}
		set new [expr {$index($chan) + $n}]
		set result [string range $buffer($chan) $index($chan) $new-1]
		set index($chan) $new
		return $result
	    }
	}
    }
} -body {
    set c [chan create read [namespace which driver]]
    chan configure $c -blocking 0
    list [gets $c] [gets $c] [gets $c] [gets $c]
} -cleanup {
    close $c
    rename driver {}
} -result {{} {} {} .......}
test io-33.13 {Tcl_GetsObj, [10dc6daa37]} -setup {
    proc driver {cmd args} {
	variable buffer
	variable index
	set chan [lindex $args 0]
	switch -- $cmd {
	    initialize {
		set index($chan) 0
		set buffer($chan) [string repeat \
			[string repeat . 64]\n[string repeat . 25] 2]
		return {initialize finalize watch read}
	    }
	    finalize {
		unset index($chan) buffer($chan)
		return
	    }
	    watch {}
	    read {
		set n [lindex $args 1]
		if {$n > 65} {set n 65}
		set new [expr {$index($chan) + $n}]
		set result [string range $buffer($chan) $index($chan) $new-1]
		set index($chan) $new
		return $result
	    }
	}
    }
} -body {
    set c [chan create read [namespace which driver]]
    chan configure $c -blocking 0
    list [gets $c] [gets $c] [gets $c] [gets $c] [gets $c]
} -cleanup {
    close $c
5358
5359
5360
5361
5362
5363
5364
5365
5366
5367
5368
5369
5370
5371
5372
5373
    lappend l [fblocked $f]
    lappend l [eof $f]
    close $f
    set l
} {0 abc 0 defghijklmnop 0 1}
test io-36.4 {Tcl_InputBlocked vs files, event driven read} {fileevent} {
    proc in {f} {
        variable l
        variable x
	lappend l [read $f 3]
	if {[eof $f]} {lappend l eof; close $f; set x done}
    }
    file delete $path(test1)
    set f [open $path(test1) w]
    puts $f abcdefghijklmnop
    close $f







|
|







5441
5442
5443
5444
5445
5446
5447
5448
5449
5450
5451
5452
5453
5454
5455
5456
    lappend l [fblocked $f]
    lappend l [eof $f]
    close $f
    set l
} {0 abc 0 defghijklmnop 0 1}
test io-36.4 {Tcl_InputBlocked vs files, event driven read} {fileevent} {
    proc in {f} {
	variable l
	variable x
	lappend l [read $f 3]
	if {[eof $f]} {lappend l eof; close $f; set x done}
    }
    file delete $path(test1)
    set f [open $path(test1) w]
    puts $f abcdefghijklmnop
    close $f
5394
5395
5396
5397
5398
5399
5400
5401
5402
5403
5404
5405
5406
5407
5408
5409
    lappend l [fblocked $f]
    lappend l [eof $f]
    close $f
    set l
} {0 abc 0 defghijklmnop 0 1}
test io-36.6 {Tcl_InputBlocked vs files, event driven read} {nonBlockFiles fileevent} {
    proc in {f} {
        variable l
        variable x
	lappend l [read $f 3]
	if {[eof $f]} {lappend l eof; close $f; set x done}
    }
    file delete $path(test1)
    set f [open $path(test1) w]
    puts $f abcdefghijklmnop
    close $f







|
|







5477
5478
5479
5480
5481
5482
5483
5484
5485
5486
5487
5488
5489
5490
5491
5492
    lappend l [fblocked $f]
    lappend l [eof $f]
    close $f
    set l
} {0 abc 0 defghijklmnop 0 1}
test io-36.6 {Tcl_InputBlocked vs files, event driven read} {nonBlockFiles fileevent} {
    proc in {f} {
	variable l
	variable x
	lappend l [read $f 3]
	if {[eof $f]} {lappend l eof; close $f; set x done}
    }
    file delete $path(test1)
    set f [open $path(test1) w]
    puts $f abcdefghijklmnop
    close $f
5470
5471
5472
5473
5474
5475
5476
5477
5478
5479
5480
5481
5482
5483
5484
    close $f
    set l
} {4096 10000 1 1 1 100000 1048576}
test io-38.3 {Tcl_SetChannelBufferSize, changing buffersize between reads} {
    # This test crashes the interp if Bug #427196 is not fixed

    set chan [open [info script] r]
    fconfigure $chan -buffersize 10
    set var [read $chan 2]
    fconfigure $chan -buffersize 32
    append var [read $chan]
    close $chan
} {}

# Test Tcl_SetChannelOption, Tcl_GetChannelOption







|







5553
5554
5555
5556
5557
5558
5559
5560
5561
5562
5563
5564
5565
5566
5567
    close $f
    set l
} {4096 10000 1 1 1 100000 1048576}
test io-38.3 {Tcl_SetChannelBufferSize, changing buffersize between reads} {
    # This test crashes the interp if Bug #427196 is not fixed

    set chan [open [info script] r]
    fconfigure $chan -buffersize 10 -encoding utf-8
    set var [read $chan 2]
    fconfigure $chan -buffersize 32
    append var [read $chan]
    close $chan
} {}

# Test Tcl_SetChannelOption, Tcl_GetChannelOption
5671
5672
5673
5674
5675
5676
5677
5678
5679
5680
5681

5682
5683
5684







5685
5686
5687
5688
5689
5690
5691
    close $f
    set f [open $path(test1) r]
    fconfigure $f -encoding utf-8
    set x [read $f]
    close $f
    set x
} 牦
test io-39.16 {Tcl_SetChannelOption: -encoding, errors} {
    file delete $path(test1)
    set f [open $path(test1) w]
    set result [list [catch {fconfigure $f -encoding foobar} msg] $msg]

    close $f
    set result
} {1 {unknown encoding "foobar"}}







test io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} {stdio fileevent} {
    set f [open "|[list [interpreter] $path(cat)]" r+]
    fconfigure $f -encoding binary
    puts -nonewline $f "\xE7"
    flush $f
    fconfigure $f -encoding utf-8 -blocking 0
    variable x {}







|


|
>

<
|
>
>
>
>
>
>
>







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
    close $f
    set f [open $path(test1) r]
    fconfigure $f -encoding utf-8
    set x [read $f]
    close $f
    set x
} 牦
test io-39.16 {Tcl_SetChannelOption: -encoding (shortened to "-en"), errors} -body {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -en foobar
} -cleanup {
    close $f

} -returnCodes 1 -result {unknown encoding "foobar"}
test io-39.16a {Tcl_SetChannelOption: -encoding (invalid shortening to "-e"), errors} -body {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -e foobar
} -cleanup {
    close $f
} -returnCodes 1 -match glob -result {bad option "-e": should be one of *}
test io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} {stdio fileevent} {
    set f [open "|[list [interpreter] $path(cat)]" r+]
    fconfigure $f -encoding binary
    puts -nonewline $f "\xE7"
    flush $f
    fconfigure $f -encoding utf-8 -blocking 0
    variable x {}
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
    update
    fconfigure $s2 -translation {auto auto}
    set modes [fconfigure $s2 -translation]
    close $s1
    close $s2
    set modes
} {auto crlf}
test io-39.22 {Tcl_SetChannelOption, invariance} {unix deprecated} {
    file delete $path(test1)
    set f1 [open $path(test1) w+]
    set l ""
    lappend l [fconfigure $f1 -eofchar]
    fconfigure $f1 -eofchar {O {}}
    lappend l [fconfigure $f1 -eofchar]
    fconfigure $f1 -eofchar D
    lappend l [fconfigure $f1 -eofchar]
    close $f1
    set l
} {{} O D}
test io-39.22a {Tcl_SetChannelOption, invariance} deprecated {
    file delete $path(test1)
    set f1 [open $path(test1) w+]
    set l [list]
    fconfigure $f1 -eofchar {O {}}
    lappend l [fconfigure $f1 -eofchar]
    fconfigure $f1 -eofchar D
    lappend l [fconfigure $f1 -eofchar]
    lappend l [list [catch {fconfigure $f1 -eofchar {1 2 3}} msg] $msg]
    close $f1
    set l
} {O D {1 {bad value for -eofchar: must be non-NUL ASCII character}}}
test io-39.23 {Tcl_GetChannelOption, server socket is not readable or
        writeable, it should still have valid -eofchar and -translation options } {
    set l [list]
    set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
    lappend l [fconfigure $sock -eofchar] [fconfigure $sock -translation]
    close $sock
    set l
} {{} auto}
test io-39.24 {Tcl_SetChannelOption, server socket is not readable or
        writable so we can't change -eofchar or -translation } {
    set l [list]
    set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
    fconfigure $sock -eofchar D -translation lf
    lappend l [fconfigure $sock -eofchar] [fconfigure $sock -translation]
    close $sock
    set l
} {{} auto}







|










|
|










|

|







|







5842
5843
5844
5845
5846
5847
5848
5849
5850
5851
5852
5853
5854
5855
5856
5857
5858
5859
5860
5861
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
    update
    fconfigure $s2 -translation {auto auto}
    set modes [fconfigure $s2 -translation]
    close $s1
    close $s2
    set modes
} {auto crlf}
test io-39.22 {Tcl_SetChannelOption, invariance} -constraints {unix deprecated} -body {
    file delete $path(test1)
    set f1 [open $path(test1) w+]
    set l ""
    lappend l [fconfigure $f1 -eofchar]
    fconfigure $f1 -eofchar {O {}}
    lappend l [fconfigure $f1 -eofchar]
    fconfigure $f1 -eofchar D
    lappend l [fconfigure $f1 -eofchar]
    close $f1
    set l
} -result {{} O D}
test io-39.22a {Tcl_SetChannelOption, invariance} -constraints deprecated -body {
    file delete $path(test1)
    set f1 [open $path(test1) w+]
    set l [list]
    fconfigure $f1 -eofchar {O {}}
    lappend l [fconfigure $f1 -eofchar]
    fconfigure $f1 -eofchar D
    lappend l [fconfigure $f1 -eofchar]
    lappend l [list [catch {fconfigure $f1 -eofchar {1 2 3}} msg] $msg]
    close $f1
    set l
} -result {O D {1 {bad value for -eofchar: must be non-NUL ASCII character}}}
test io-39.23 {Tcl_GetChannelOption, server socket is not readable or
        writable, it should still have valid -eofchar and -translation options } {
    set l [list]
    set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
    lappend l [fconfigure $sock -eofchar] [fconfigure $sock -translation]
    close $sock
    set l
} {{} auto}
test io-39.24 {Tcl_SetChannelOption, server socket is not readable or
    writable so we can't change -eofchar or -translation } {
    set l [list]
    set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
    fconfigure $sock -eofchar D -translation lf
    lappend l [fconfigure $sock -eofchar] [fconfigure $sock -translation]
    close $sock
    set l
} {{} auto}
5809
5810
5811
5812
5813
5814
5815
5816
5817
5818
5819
5820
5821
5822
5823
5824
5825
5826
5827
5828
5829
5830
5831
5832
5833
5834
5835
    set x [gets $f]
    close $f
    set f [open $path(test3) r]
    lappend x [gets $f]
    close $f
    set x
} {zzy abzzy}
test io-40.2 {POSIX open access modes: CREAT} {unix} {
    file delete $path(test3)
    set f [open $path(test3) {WRONLY CREAT} 0o600]
    file stat $path(test3) stats
    set x [format "%#o" [expr {$stats(mode)&0o777}]]
    puts $f "line 1"
    close $f
    set f [open $path(test3) r]
    lappend x [gets $f]
    close $f
    set x
} {0o600 {line 1}}
test io-40.3 {POSIX open access modes: CREAT} {unix umask} {
    # This test only works if your umask is 2, like ouster's.
    file delete $path(test3)
    set f [open $path(test3) {WRONLY CREAT}]
    close $f
    file stat $path(test3) stats
    format 0o%03o [expr {$stats(mode)&0o777}]
} [format 0o%03o [expr {0o666 & ~ $umaskValue}]]







|











|







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
    set x [gets $f]
    close $f
    set f [open $path(test3) r]
    lappend x [gets $f]
    close $f
    set x
} {zzy abzzy}
test io-40.2 {POSIX open access modes: CREAT} {unix notWsl} {
    file delete $path(test3)
    set f [open $path(test3) {WRONLY CREAT} 0o600]
    file stat $path(test3) stats
    set x [format "%#o" [expr {$stats(mode)&0o777}]]
    puts $f "line 1"
    close $f
    set f [open $path(test3) r]
    lappend x [gets $f]
    close $f
    set x
} {0o600 {line 1}}
test io-40.3 {POSIX open access modes: CREAT} {unix umask notWsl} {
    # This test only works if your umask is 2, like ouster's.
    file delete $path(test3)
    set f [open $path(test3) {WRONLY CREAT}]
    close $f
    file stat $path(test3) stats
    format 0o%03o [expr {$stats(mode)&0o777}]
} [format 0o%03o [expr {0o666 & ~ $umaskValue}]]
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
    after cancel $timer
    testfevent cmd {close $f}
    list [testfevent cmd {set x}] [testfevent cmd {info commands after}]
} {{f triggered: foo bar} after}
test io-46.2 {Tcl event loop vs multiple interpreters} testfevent {
    testfevent create
    testfevent cmd {
        variable x 0
        after 100 {set x triggered}
        vwait [namespace which -variable x]
        set x
    }
} {triggered}
test io-46.3 {Tcl event loop vs multiple interpreters} testfevent {
    testfevent create
    testfevent cmd {
        set x 0
        after 10 {lappend x timer}
        after 30
        set result $x
        update idletasks
        lappend result $x
        update
        lappend result $x
    }
} {0 0 {0 timer}}

test io-47.1 {fileevent vs multiple interpreters} {testfevent fileevent} {
    set f  [open $path(foo) r]
    set f2 [open $path(foo) r]
    set f3 [open $path(foo) r]
    fileevent $f readable {script 1}
    testfevent create
    testfevent share $f2
    testfevent cmd "fileevent $f2 readable {script 2}"
    fileevent $f3 readable {sript 3}
    set x {}
    lappend x [fileevent $f2 readable]
    testfevent delete
    lappend x [fileevent $f readable] [fileevent $f2 readable] \
        [fileevent $f3 readable]
    close $f
    close $f2
    close $f3
    set x
} {{} {script 1} {} {sript 3}}
test io-47.2 {deleting fileevent on interpreter delete} {testfevent fileevent} {
    set f  [open $path(foo) r]
    set f2 [open $path(foo) r]
    set f3 [open $path(foo) r]
    set f4 [open $path(foo) r]
    fileevent $f readable {script 1}
    testfevent create
    testfevent share $f2
    testfevent share $f3
    testfevent cmd "fileevent $f2 readable {script 2}
        fileevent $f3 readable {script 3}"
    fileevent $f4 readable {script 4}
    testfevent delete
    set x [list [fileevent $f readable] [fileevent $f2 readable] \
                [fileevent $f3 readable] [fileevent $f4 readable]]
    close $f
    close $f2
    close $f3
    close $f4
    set x
} {{script 1} {} {} {script 4}}
test io-47.3 {deleting fileevent on interpreter delete} {testfevent fileevent} {
    set f  [open $path(foo) r]
    set f2 [open $path(foo) r]
    set f3 [open $path(foo) r]
    set f4 [open $path(foo) r]
    testfevent create
    testfevent share $f3
    testfevent share $f4
    fileevent $f readable {script 1}
    fileevent $f2 readable {script 2}
    testfevent cmd "fileevent $f3 readable {script 3}
      fileevent $f4 readable {script 4}"
    testfevent delete
    set x [list [fileevent $f readable] [fileevent $f2 readable] \
                [fileevent $f3 readable] [fileevent $f4 readable]]
    close $f
    close $f2
    close $f3
    close $f4
    set x
} {{script 1} {script 2} {} {}}
test io-47.4 {file events on shared files and multiple interpreters} {testfevent fileevent} {
    set f  [open $path(foo) r]
    set f2 [open $path(foo) r]
    testfevent create
    testfevent share $f
    testfevent cmd "fileevent $f readable {script 1}"
    fileevent $f readable {script 2}
    fileevent $f2 readable {script 3}
    set x [list [fileevent $f2 readable] \
                [testfevent cmd "fileevent $f readable"] \
                [fileevent $f readable]]
    testfevent delete
    close $f
    close $f2
    set x
} {{script 3} {script 1} {script 2}}
test io-47.5 {file events on shared files, deleting file events} {testfevent fileevent} {
    set f [open $path(foo) r]
    testfevent create
    testfevent share $f
    testfevent cmd "fileevent $f readable {script 1}"
    fileevent $f readable {script 2}
    testfevent cmd "fileevent $f readable {}"
    set x [list [testfevent cmd "fileevent $f readable"] \
                [fileevent $f readable]]
    testfevent delete
    close $f
    set x
} {{} {script 2}}
test io-47.6 {file events on shared files, deleting file events} {testfevent fileevent} {
    set f [open $path(foo) r]
    testfevent create
    testfevent share $f
    testfevent cmd "fileevent $f readable {script 1}"
    fileevent $f readable {script 2}
    fileevent $f readable {}
    set x [list [testfevent cmd "fileevent $f readable"] \
                [fileevent $f readable]]
    testfevent delete
    close $f
    set x
} {{script 1} {}}
unset path(foo)
removeFile foo








|
|
|
|





|
|
|
|
|
|
|
|
















|















|



|

















|


|















|
|













|












|







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
6449
6450
6451
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
    after cancel $timer
    testfevent cmd {close $f}
    list [testfevent cmd {set x}] [testfevent cmd {info commands after}]
} {{f triggered: foo bar} after}
test io-46.2 {Tcl event loop vs multiple interpreters} testfevent {
    testfevent create
    testfevent cmd {
	variable x 0
	after 100 {set x triggered}
	vwait [namespace which -variable x]
	set x
    }
} {triggered}
test io-46.3 {Tcl event loop vs multiple interpreters} testfevent {
    testfevent create
    testfevent cmd {
	set x 0
	after 10 {lappend x timer}
	after 30
	set result $x
	update idletasks
	lappend result $x
	update
	lappend result $x
    }
} {0 0 {0 timer}}

test io-47.1 {fileevent vs multiple interpreters} {testfevent fileevent} {
    set f  [open $path(foo) r]
    set f2 [open $path(foo) r]
    set f3 [open $path(foo) r]
    fileevent $f readable {script 1}
    testfevent create
    testfevent share $f2
    testfevent cmd "fileevent $f2 readable {script 2}"
    fileevent $f3 readable {sript 3}
    set x {}
    lappend x [fileevent $f2 readable]
    testfevent delete
    lappend x [fileevent $f readable] [fileevent $f2 readable] \
	[fileevent $f3 readable]
    close $f
    close $f2
    close $f3
    set x
} {{} {script 1} {} {sript 3}}
test io-47.2 {deleting fileevent on interpreter delete} {testfevent fileevent} {
    set f  [open $path(foo) r]
    set f2 [open $path(foo) r]
    set f3 [open $path(foo) r]
    set f4 [open $path(foo) r]
    fileevent $f readable {script 1}
    testfevent create
    testfevent share $f2
    testfevent share $f3
    testfevent cmd "fileevent $f2 readable {script 2}
	fileevent $f3 readable {script 3}"
    fileevent $f4 readable {script 4}
    testfevent delete
    set x [list [fileevent $f readable] [fileevent $f2 readable] \
		[fileevent $f3 readable] [fileevent $f4 readable]]
    close $f
    close $f2
    close $f3
    close $f4
    set x
} {{script 1} {} {} {script 4}}
test io-47.3 {deleting fileevent on interpreter delete} {testfevent fileevent} {
    set f  [open $path(foo) r]
    set f2 [open $path(foo) r]
    set f3 [open $path(foo) r]
    set f4 [open $path(foo) r]
    testfevent create
    testfevent share $f3
    testfevent share $f4
    fileevent $f readable {script 1}
    fileevent $f2 readable {script 2}
    testfevent cmd "fileevent $f3 readable {script 3}
    fileevent $f4 readable {script 4}"
    testfevent delete
    set x [list [fileevent $f readable] [fileevent $f2 readable] \
		[fileevent $f3 readable] [fileevent $f4 readable]]
    close $f
    close $f2
    close $f3
    close $f4
    set x
} {{script 1} {script 2} {} {}}
test io-47.4 {file events on shared files and multiple interpreters} {testfevent fileevent} {
    set f  [open $path(foo) r]
    set f2 [open $path(foo) r]
    testfevent create
    testfevent share $f
    testfevent cmd "fileevent $f readable {script 1}"
    fileevent $f readable {script 2}
    fileevent $f2 readable {script 3}
    set x [list [fileevent $f2 readable] \
		[testfevent cmd "fileevent $f readable"] \
		[fileevent $f readable]]
    testfevent delete
    close $f
    close $f2
    set x
} {{script 3} {script 1} {script 2}}
test io-47.5 {file events on shared files, deleting file events} {testfevent fileevent} {
    set f [open $path(foo) r]
    testfevent create
    testfevent share $f
    testfevent cmd "fileevent $f readable {script 1}"
    fileevent $f readable {script 2}
    testfevent cmd "fileevent $f readable {}"
    set x [list [testfevent cmd "fileevent $f readable"] \
		[fileevent $f readable]]
    testfevent delete
    close $f
    set x
} {{} {script 2}}
test io-47.6 {file events on shared files, deleting file events} {testfevent fileevent} {
    set f [open $path(foo) r]
    testfevent create
    testfevent share $f
    testfevent cmd "fileevent $f readable {script 1}"
    fileevent $f readable {script 2}
    fileevent $f readable {}
    set x [list [testfevent cmd "fileevent $f readable"] \
		[fileevent $f readable]]
    testfevent delete
    close $f
    set x
} {{script 1} {}}
unset path(foo)
removeFile foo

7235
7236
7237
7238
7239
7240
7241
7242
7243
7244
7245
7246
7247
7248
7249
7250
7251
7252
7253
7254
7255
7256
7257
7258
    close $f3
    string compare $msg "channel \"$f2\" is busy"
} {0}
test io-52.3 {TclCopyChannel} {fcopy} {
    file delete $path(test1)
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    fconfigure $f1 -translation lf -blocking 0
    fconfigure $f2 -translation cr -blocking 0
    set s0 [fcopy $f1 $f2]
    set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
    close $f1
    close $f2
    set s1 [file size $thisScript]
    set s2 [file size $path(test1)]
    if {("$s1" == "$s2") && ($s0 == $s1)} {
        lappend result ok
    }
    set result
} {0 0 ok}
test io-52.4 {TclCopyChannel} {fcopy} {
    file delete $path(test1)
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]







|
|







|







7325
7326
7327
7328
7329
7330
7331
7332
7333
7334
7335
7336
7337
7338
7339
7340
7341
7342
7343
7344
7345
7346
7347
7348
    close $f3
    string compare $msg "channel \"$f2\" is busy"
} {0}
test io-52.3 {TclCopyChannel} {fcopy} {
    file delete $path(test1)
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    fconfigure $f1 -translation lf -encoding iso8859-1 -blocking 0
    fconfigure $f2 -translation cr -encoding iso8859-1 -blocking 0
    set s0 [fcopy $f1 $f2]
    set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
    close $f1
    close $f2
    set s1 [file size $thisScript]
    set s2 [file size $path(test1)]
    if {("$s1" == "$s2") && ($s0 == $s1)} {
	lappend result ok
    }
    set result
} {0 0 ok}
test io-52.4 {TclCopyChannel} {fcopy} {
    file delete $path(test1)
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
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
    close $f2
    lappend result [file size $path(test1)]
} {0 0 0 40}
test io-52.5 {TclCopyChannel, all} {fcopy} {
    file delete $path(test1)
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    fconfigure $f1 -translation lf -blocking 0
    fconfigure $f2 -translation lf -blocking 0
    fcopy $f1 $f2 -size -1 ;# -1 means 'copy all', same as if no -size specified.
    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"} {
        lappend result ok
    }
    set result
} {0 0 ok}
test io-52.5a {TclCopyChannel, all, other negative value} {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
    fcopy $f1 $f2 -size -2 ;# < 0 behaves like -1, copy all
    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"} {
        lappend result ok
    }
    set result
} {0 0 ok}
test io-52.5b {TclCopyChannel, all, wrap to negative value} {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
    fcopy $f1 $f2 -size 3221176172 ;# Wrapped to < 0, behaves like -1, copy all
    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"} {
        lappend result ok
    }
    set result
} {0 0 ok}
test io-52.6 {TclCopyChannel} {fcopy} {
    file delete $path(test1)
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    fconfigure $f1 -translation lf -blocking 0
    fconfigure $f2 -translation lf -blocking 0
    set s0 [fcopy $f1 $f2 -size [expr {[file size $thisScript] + 5}]]
    set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
    close $f1
    close $f2
    set s1 [file size $thisScript]
    set s2 [file size $path(test1)]
    if {("$s1" == "$s2") && ($s0 == $s1)} {
        lappend result ok
    }
    set result
} {0 0 ok}
test io-52.7 {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
    fcopy $f1 $f2
    set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
    set s1 [file size $thisScript]
    set s2 [file size $path(test1)]
    close $f1
    close $f2
    if {"$s1" == "$s2"} {
        lappend result ok
    }
    set result
} {0 0 ok}
test io-52.8 {TclCopyChannel} {stdio fcopy} {
    file delete $path(test1)
    file delete $path(pipe)
    set f1 [open $path(pipe) w]







|
|







|







|
|







|







|
|







|







|
|







|







|
|







|







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
    close $f2
    lappend result [file size $path(test1)]
} {0 0 0 40}
test io-52.5 {TclCopyChannel, all} {fcopy} {
    file delete $path(test1)
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    fconfigure $f1 -translation lf -encoding iso8859-1 -blocking 0
    fconfigure $f2 -translation lf -encoding iso8859-1 -blocking 0
    fcopy $f1 $f2 -size -1 ;# -1 means 'copy all', same as if no -size specified.
    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"} {
	lappend result ok
    }
    set result
} {0 0 ok}
test io-52.5a {TclCopyChannel, all, other negative value} {fcopy} {
    file delete $path(test1)
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    fconfigure $f1 -translation lf -encoding iso8859-1 -blocking 0
    fconfigure $f2 -translation lf -encoding iso8859-1 -blocking 0
    fcopy $f1 $f2 -size -2 ;# < 0 behaves like -1, copy all
    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"} {
	lappend result ok
    }
    set result
} {0 0 ok}
test io-52.5b {TclCopyChannel, all, wrap to negative value} {fcopy} {
    file delete $path(test1)
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    fconfigure $f1 -translation lf -encoding iso8859-1 -blocking 0
    fconfigure $f2 -translation lf -encoding iso8859-1 -blocking 0
    fcopy $f1 $f2 -size 3221176172 ;# Wrapped to < 0, behaves like -1, copy all
    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"} {
	lappend result ok
    }
    set result
} {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 -encoding iso8859-1 -blocking 0
    fconfigure $f2 -translation lf -encoding iso8859-1 -blocking 0
    set s0 [fcopy $f1 $f2 -size [expr {[file size $thisScript] + 5}]]
    set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
    close $f1
    close $f2
    set s1 [file size $thisScript]
    set s2 [file size $path(test1)]
    if {("$s1" == "$s2") && ($s0 == $s1)} {
	lappend result ok
    }
    set result
} {0 0 ok}
test io-52.7 {TclCopyChannel} {fcopy} {
    file delete $path(test1)
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    fconfigure $f1 -translation lf -encoding iso8859-1 -blocking 0
    fconfigure $f2 -translation lf -encoding iso8859-1 -blocking 0
    fcopy $f1 $f2
    set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
    set s1 [file size $thisScript]
    set s2 [file size $path(test1)]
    close $f1
    close $f2
    if {"$s1" == "$s2"} {
	lappend result ok
    }
    set result
} {0 0 ok}
test io-52.8 {TclCopyChannel} {stdio fcopy} {
    file delete $path(test1)
    file delete $path(pipe)
    set f1 [open $path(pipe) w]
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
    close $in
    close $out

    list [file size $path(kyrillic.txt)] \
	    [file size $path(utf8-fcopy.txt)] \
	    [file size $path(utf8-rp.txt)]
} {3 5 5}
test io-52.10 {TclCopyChannel & encodings} {fcopy} {
    # encoding to binary (=> implies that the
    # internal utf-8 is written)

    set in  [open $path(kyrillic.txt) r]
    set out [open $path(utf8-fcopy.txt) w]

    fconfigure $in  -encoding koi8-r -translation lf
    # -translation binary is also -encoding binary
    fconfigure $out -translation binary

    fcopy $in $out
    close $in
    close $out

    file size $path(utf8-fcopy.txt)
} 5

test io-52.11 {TclCopyChannel & encodings} -setup {
    set out [open $path(utf8-fcopy.txt) w]
    fconfigure $out -encoding utf-8 -translation lf
    puts $out "АА"
    close $out
} -constraints {fcopy} -body {
    # binary to encoding => the input has to be
    # in utf-8 to make sense to the encoder

    set in  [open $path(utf8-fcopy.txt) r]
    set out [open $path(kyrillic.txt) w]

    # -translation binary is also -encoding binary
    fconfigure $in  -translation binary
    fconfigure $out -encoding koi8-r -translation lf

    fcopy $in $out



    close $in


    close $out

    file size $path(kyrillic.txt)
} -result 3



test io-52.12 {coverage of -translation auto} {
    file delete $path(test1) $path(test2)
    set out [open $path(test1) wb]
    chan configure $out -translation lf
    puts -nonewline $out abcdefg\rhijklmn\nopqrstu\r\nvwxyz
    close $out







|
<
<
<












|
>


|
|


<
<
<


<


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







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
    close $in
    close $out

    list [file size $path(kyrillic.txt)] \
	    [file size $path(utf8-fcopy.txt)] \
	    [file size $path(utf8-rp.txt)]
} {3 5 5}
test io-52.10 {TclCopyChannel & encodings} -constraints fcopy -body {



    set in  [open $path(kyrillic.txt) r]
    set out [open $path(utf8-fcopy.txt) w]

    fconfigure $in  -encoding koi8-r -translation lf
    # -translation binary is also -encoding binary
    fconfigure $out -translation binary

    fcopy $in $out
    close $in
    close $out

    file size $path(utf8-fcopy.txt)
} -returnCodes 1 -match glob -result {error writing "*":\
    invalid or incomplete multibyte or wide character}
test io-52.11 {TclCopyChannel & encodings} -setup {
    set out [open $path(utf8-fcopy.txt) w]
    fconfigure $out -encoding utf-8 -translation lf -profile strict
    puts $out АА
    close $out
} -constraints {fcopy} -body {



    set in  [open $path(utf8-fcopy.txt) r]
    set out [open $path(kyrillic.txt) w]

    # -translation binary is also -encoding binary
    fconfigure $in  -translation binary
    fconfigure $out -encoding koi8-r -translation lf -profile strict

    catch {fcopy $in $out} cres copts
	return $cres
} -cleanup {
	if {$in in [chan names]} {
		close $in
	}
	if {$out in [chan names]} {
		close $out
	}

    catch {unset cres}
} -match glob -result  {error writing "*": invalid or incomplete\
	multibyte or wide character}

test io-52.12 {coverage of -translation auto} {
    file delete $path(test1) $path(test2)
    set out [open $path(test1) wb]
    chan configure $out -translation lf
    puts -nonewline $out abcdefg\rhijklmn\nopqrstu\r\nvwxyz
    close $out
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
    chan configure $in -buffersize 10 -translation crlf -eofchar h
    set out [open $path(test2) w]
    fcopy $in $out
    close $in
    close $out
    file size $path(test2)
} 8

























































































































test io-53.1 {CopyData} {fcopy} {
    file delete $path(test1)
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    fconfigure $f1 -translation lf -blocking 0
    fconfigure $f2 -translation cr -blocking 0
    fcopy $f1 $f2 -size 0
    set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
    close $f1
    close $f2
    lappend result [file size $path(test1)]
} {0 0 0}
test io-53.2 {CopyData} {fcopy} {
    file delete $path(test1)
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    fconfigure $f1 -translation lf -blocking 0
    fconfigure $f2 -translation cr -blocking 0
    fcopy $f1 $f2 -command [namespace code {set s0}]
    set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
    variable s0
    vwait [namespace which -variable s0]
    close $f1
    close $f2
    set s1 [file size $thisScript]
    set s2 [file size $path(test1)]
    if {("$s1" == "$s2") && ($s0 == $s1)} {
        lappend result ok
    }
    set result
} {0 0 ok}
test io-53.3 {CopyData: background read underflow} {stdio unix fcopy} {
    file delete $path(test1)
    file delete $path(pipe)
    set f1 [open $path(pipe) w]







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

















|
|









|







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
    chan configure $in -buffersize 10 -translation crlf -eofchar h
    set out [open $path(test2) w]
    fcopy $in $out
    close $in
    close $out
    file size $path(test2)
} 8
test io-52.20 {TclCopyChannel & encodings} -setup {
    set out [open $path(utf8-fcopy.txt) w]
    fconfigure $out -encoding utf-8 -translation lf
    puts $out "Á"
    close $out
} -constraints {fcopy} -body {
    # binary to encoding => the input has to be
    # in utf-8 to make sense to the encoder

    set in  [open $path(utf8-fcopy.txt) r]
    set out [open $path(kyrillic.txt) w]

    # Using "-encoding ascii" means reading the "Á" gives an error
    fconfigure $in  -encoding ascii -profile strict
    fconfigure $out -encoding koi8-r -translation lf

    fcopy $in $out
} -cleanup {
    close $in
    close $out
} -returnCodes 1 -match glob -result {error reading "file*": invalid or incomplete multibyte or wide character}
test io-52.21 {TclCopyChannel & encodings} -setup {
    set out [open $path(utf8-fcopy.txt) w]
    fconfigure $out -encoding utf-8 -translation lf
    puts $out "Á"
    close $out
} -constraints {fcopy} -body {
    # binary to encoding => the input has to be
    # in utf-8 to make sense to the encoder

    set in  [open $path(utf8-fcopy.txt) r]
    set out [open $path(kyrillic.txt) w]

    # Using "-encoding ascii" means writing the "Á" gives an error
    fconfigure $in  -encoding utf-8
    fconfigure $out -encoding ascii -translation lf -profile strict

    fcopy $in $out
} -cleanup {
    close $in
    close $out
} -returnCodes 1 -match glob -result {error writing "file*": invalid or incomplete multibyte or wide character}
test io-52.22 {TclCopyChannel & encodings} -setup {
    set out [open $path(utf8-fcopy.txt) w]
    fconfigure $out -encoding utf-8 -translation lf
    puts $out "Á"
    close $out
} -constraints {fcopy} -body {
    # binary to encoding => the input has to be
    # in utf-8 to make sense to the encoder

    set in  [open $path(utf8-fcopy.txt) r]
    set out [open $path(kyrillic.txt) w]

    # Using "-encoding ascii" means reading the "Á" gives an error
    fconfigure $in  -encoding ascii -profile strict
    fconfigure $out -encoding koi8-r -translation lf
    proc ::xxx args {
	set ::s0 $args
    }

    fcopy $in $out -command ::xxx
    vwait ::s0
    set ::s0
} -cleanup {
    close $in
    close $out
    unset ::s0
} -match glob -result {0 {error reading "file*": invalid or incomplete multibyte or wide character}}
test io-52.23 {TclCopyChannel & encodings} -setup {
    set out [open $path(utf8-fcopy.txt) w]
    fconfigure $out -encoding utf-8 -translation lf
    puts $out "Á"
    close $out
} -constraints {fcopy} -body {
    # binary to encoding => the input has to be
    # in utf-8 to make sense to the encoder

    set in  [open $path(utf8-fcopy.txt) r]
    set out [open $path(kyrillic.txt) w]

    # Using "-encoding ascii" means writing the "Á" gives an error
    fconfigure $in  -encoding utf-8
    fconfigure $out -encoding ascii -translation lf -profile strict
    proc ::xxx args {
	set ::s0 $args
    }

    fcopy $in $out -command ::xxx
    vwait ::s0
    set ::s0
} -cleanup {
    close $in
    close $out
    unset ::s0
} -match glob -result {0 {error writing "file*": invalid or incomplete multibyte or wide character}}

test io-52.24 {fcopy -size should always be characters} -setup {
    set out [open utf8-fcopy-52.24.txt w]
    fconfigure $out -encoding utf-8 -translation lf
    puts $out "Á"
    close $out
} -constraints {fcopy} -body {
    set in  [open utf8-fcopy-52.24.txt r]
    set out [open utf8-fcopy-52.24.out.txt w+]

    fconfigure $in  -encoding utf-8 -profile tcl8
    fconfigure $out -encoding utf-8 -profile tcl8
    fcopy $in $out -size 1
	seek $out 0
	# a result of \xc3 means that only the first byte of the utf-8 encoding of
	# Á made it into to the output file.
	read $out
} -cleanup {
    close $in
    close $out
	catch {file delete utf8-fcopy-52.24.txt}
    catch {file delete utf8-fcopy-52.24.out.txt}
} -result Á


test io-53.1 {CopyData} {fcopy} {
    file delete $path(test1)
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    fconfigure $f1 -translation lf -blocking 0
    fconfigure $f2 -translation cr -blocking 0
    fcopy $f1 $f2 -size 0
    set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
    close $f1
    close $f2
    lappend result [file size $path(test1)]
} {0 0 0}
test io-53.2 {CopyData} {fcopy} {
    file delete $path(test1)
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    fconfigure $f1 -translation lf -encoding iso8859-1 -blocking 0
    fconfigure $f2 -translation cr -encoding iso8859-1 -blocking 0
    fcopy $f1 $f2 -command [namespace code {set s0}]
    set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
    variable s0
    vwait [namespace which -variable s0]
    close $f1
    close $f2
    set s1 [file size $thisScript]
    set s2 [file size $path(test1)]
    if {("$s1" == "$s2") && ($s0 == $s1)} {
	lappend result ok
    }
    set result
} {0 0 ok}
test io-53.3 {CopyData: background read underflow} {stdio unix fcopy} {
    file delete $path(test1)
    file delete $path(pipe)
    set f1 [open $path(pipe) w]
7751
7752
7753
7754
7755
7756
7757


7758
7759
7760
7761
7762
7763
7764
test io-53.5 {CopyData: error during fcopy} {socket fcopy} {
    variable fcopyTestDone
    set listen [socket -server [namespace code FcopyTestAccept] -myaddr 127.0.0.1 0]
    set in [open $thisScript]	;# 126 K
    set out [socket 127.0.0.1 [lindex [fconfigure $listen -sockname] 2]]
    catch {unset fcopyTestDone}
    close $listen	;# This means the socket open never really succeeds


    fcopy $in $out -command [namespace code FcopyTestDone]
    variable fcopyTestDone
    if {![info exists fcopyTestDone]} {
	vwait [namespace which -variable fcopyTestDone]		;# The error occurs here in the b.g.
    }
    close $in
    close $out







>
>







7960
7961
7962
7963
7964
7965
7966
7967
7968
7969
7970
7971
7972
7973
7974
7975
test io-53.5 {CopyData: error during fcopy} {socket fcopy} {
    variable fcopyTestDone
    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
    fconfigure $in -encoding utf-8
    fconfigure $out -encoding utf-8
    fcopy $in $out -command [namespace code FcopyTestDone]
    variable fcopyTestDone
    if {![info exists fcopyTestDone]} {
	vwait [namespace which -variable fcopyTestDone]		;# The error occurs here in the b.g.
    }
    close $in
    close $out
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
    variable fcopyTestCount
    incr fcopyTestCount $bytes
    if {[string length $error]} {
	set fcopyTestDone 1
    } elseif {[eof $in]} {
	set fcopyTestDone 0
    } else {
        # Delay next fcopy to wait for size>0 input bytes
        after 100 [list fcopy $in $out -size 1000 \
		-command [namespace code [list doFcopy $in $out]]]
    }
}
test io-53.7 {CopyData: Flooding fcopy from pipe} {stdio fcopy} {
    variable fcopyTestDone
    file delete $path(pipe)
    catch {unset fcopyTestDone}
    set fcopyTestCount 0
    set f1 [open $path(pipe) w]
    puts $f1 {
	# Write  10 bytes / 10 msec
	proc Write {count} {
	    puts -nonewline "1234567890"
	    if {[incr count -1]} {
	        after 10 [list Write $count]
	    } else {
	        set ::ready 1
	    }
	}
	fconfigure stdout -buffering none
	Write 345 ;# 3450 bytes ~3.45 sec
	vwait ready
	exit 0
    }







|
|














|

|







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
    variable fcopyTestCount
    incr fcopyTestCount $bytes
    if {[string length $error]} {
	set fcopyTestDone 1
    } elseif {[eof $in]} {
	set fcopyTestDone 0
    } else {
	# Delay next fcopy to wait for size>0 input bytes
	after 100 [list fcopy $in $out -size 1000 \
		-command [namespace code [list doFcopy $in $out]]]
    }
}
test io-53.7 {CopyData: Flooding fcopy from pipe} {stdio fcopy} {
    variable fcopyTestDone
    file delete $path(pipe)
    catch {unset fcopyTestDone}
    set fcopyTestCount 0
    set f1 [open $path(pipe) w]
    puts $f1 {
	# Write  10 bytes / 10 msec
	proc Write {count} {
	    puts -nonewline "1234567890"
	    if {[incr count -1]} {
		after 10 [list Write $count]
	    } else {
		set ::ready 1
	    }
	}
	fconfigure stdout -buffering none
	Write 345 ;# 3450 bytes ~3.45 sec
	vwait ready
	exit 0
    }
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
		fcopy $b $a -command [list geof $b]
		puts stderr 2COPY
	    }
	    puts stderr ...
	}
	puts stderr SRV
	set l {}
	set srv [socket -server new 9999]

	puts stderr WAITING
	fileevent stdin readable bye
	puts OK
	vwait forever
    }
    # wait for OK from server.
    gets $pipe
    # Now the two clients.
    proc ::done {sock} {
	if {[eof $sock]} { close $sock ; return }
	lappend ::forever [gets $sock]
	return
    }
    set a [socket 127.0.0.1 9999]
    set b [socket 127.0.0.1 9999]
    fconfigure $a -translation binary -buffering none
    fconfigure $b -translation binary -buffering none
    fileevent  $a readable [list ::done $a]
    fileevent  $b readable [list ::done $b]
} -constraints {stdio fcopy} -body {
    # Now pass data through the server in both directions.
    set ::forever {}







|
>


|



|






|
|







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
		fcopy $b $a -command [list geof $b]
		puts stderr 2COPY
	    }
	    puts stderr ...
	}
	puts stderr SRV
	set l {}
	set srv [socket -server new -myaddr 127.0.0.1 0]
        set port [lindex [fconfigure $srv -sockname] 2]
	puts stderr WAITING
	fileevent stdin readable bye
	puts "OK $port"
	vwait forever
    }
    # wait for OK from server.
    lassign [gets $pipe] ok port
    # Now the two clients.
    proc ::done {sock} {
	if {[eof $sock]} { close $sock ; return }
	lappend ::forever [gets $sock]
	return
    }
    set a [socket 127.0.0.1 $port]
    set b [socket 127.0.0.1 $port]
    fconfigure $a -translation binary -buffering none
    fconfigure $b -translation binary -buffering none
    fileevent  $a readable [list ::done $a]
    fileevent  $b readable [list ::done $b]
} -constraints {stdio fcopy} -body {
    # Now pass data through the server in both directions.
    set ::forever {}
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
    set done
} -cleanup {
    close $outChan
    close $inChan
    removeFile out
    removeFile in
} -result {40 bytes copied}
test io-53.12 {CopyData: foreground short reads, aka bug 3096275} {stdio unix fcopy} {
    file delete $path(pipe)
    set f1 [open $path(pipe) w]
    puts -nonewline $f1 {
	fconfigure stdin -translation binary -blocking 0
	fconfigure stdout -buffering none -translation binary
	fcopy stdin stdout
    }
    close $f1
    set f1 [open "|[list [interpreter] $path(pipe)]" r+]
    fconfigure $f1 -translation binary -buffering none
    puts -nonewline $f1 A
    after 2000 {set ::done timeout}
    fileevent $f1 readable {set ::done ok}
    vwait ::done
    set ch [read $f1 1]
    close $f1
    list $::done $ch
} {ok A}


























test io-53.13 {TclCopyChannel: read error reporting} -setup {
    proc driver {cmd args} {
        variable buffer
        variable index
        set chan [lindex $args 0]
        switch -- $cmd {
            initialize {
                return {initialize finalize watch read}
            }
            finalize {
                return
            }
            watch {}
            read {
		error FAIL
            }
        }
    }
    set outFile [makeFile {} out]
} -body {
    set in [chan create read [namespace which driver]]
    chan configure $in -translation binary
    set out [open $outFile wb]
    chan copy $in $out
} -cleanup {
    catch {close $in}
    catch {close $out}
    removeFile out
    rename driver {}
} -result {error reading "*": *} -returnCodes error -match glob
test io-53.14 {TclCopyChannel: write error reporting} -setup {
    proc driver {cmd args} {
        variable buffer
        variable index
        set chan [lindex $args 0]
        switch -- $cmd {
            initialize {
                return {initialize finalize watch write}
            }
            finalize {
                return
            }
            watch {}
            write {
                error FAIL
            }
        }
    }
    set inFile [makeFile {aaa} in]
} -body {
    set in [open $inFile rb]
    set out [chan create write [namespace which driver]]
    chan configure $out -translation binary
    chan copy $in $out
} -cleanup {
    catch {close $in}
    catch {close $out}
    removeFile in
    rename driver {}
} -result {error writing "*": *} -returnCodes error -match glob
test io-53.15 {[ed29c4da21] DoRead: fblocked seen as error} -setup {
    proc driver {cmd args} {
        variable buffer
        variable index
        variable blocked
        set chan [lindex $args 0]
        switch -- $cmd {
            initialize {
                set index($chan) 0
                set buffer($chan) [encoding convertto utf-8 \
                        [string repeat a 100]]
                set blocked($chan) 1
                return {initialize finalize watch read}
            }
            finalize {
                unset index($chan) buffer($chan) blocked($chan)
                return
            }
            watch {}
            read {
                if {$blocked($chan)} {
                    set blocked($chan) [expr {!$blocked($chan)}]
                    return -code error EAGAIN
                }
                set n [lindex $args 1]
                set new [expr {$index($chan) + $n}]
                set result [string range $buffer($chan) $index($chan) $new-1]
                set index($chan) $new
                return $result
            }
        }
    }
    set c [chan create read [namespace which driver]]
    chan configure $c -encoding utf-8
    set out [makeFile {} out]
    set outChan [open $out w]
    chan configure $outChan -encoding utf-8
} -body {
    chan copy $c $outChan
} -cleanup {
    close $outChan
    close $c
    removeFile out
} -result 100
test io-53.16 {[ed29c4da21] MBRead: fblocked seen as error} -setup {
    proc driver {cmd args} {
        variable buffer
        variable index
        variable blocked
        set chan [lindex $args 0]
        switch -- $cmd {
            initialize {
                set index($chan) 0
                set buffer($chan) [encoding convertto utf-8 \
                        [string repeat a 100]]
                set blocked($chan) 1
                return {initialize finalize watch read}
            }
            finalize {
                unset index($chan) buffer($chan) blocked($chan)
                return
            }
            watch {}
            read {
                if {$blocked($chan)} {
                    set blocked($chan) [expr {!$blocked($chan)}]
                    return -code error EAGAIN
                }
                set n [lindex $args 1]
                set new [expr {$index($chan) + $n}]
                set result [string range $buffer($chan) $index($chan) $new-1]
                set index($chan) $new
                return $result
            }
        }
    }
    set c [chan create read [namespace which driver]]
    chan configure $c -encoding utf-8 -translation lf
    set out [makeFile {} out]
    set outChan [open $out w]
    chan configure $outChan -encoding utf-8 -translation lf
} -body {
    chan copy $c $outChan
} -cleanup {
    close $outChan
    close $c
    removeFile out
} -result 100
test io-53.17 {[7c187a3773] MBWrite: proper inQueueTail handling} -setup {
    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 \
                        line\n[string repeat a 100]line\n]
                return {initialize finalize watch read}
            }
            finalize {
                unset index($chan) buffer($chan)
                return
            }
            watch {}
            read {
                set n [lindex $args 1]
                set new [expr {$index($chan) + $n}]
                set result [string range $buffer($chan) $index($chan) $new-1]
                set index($chan) $new
                return $result
            }
        }
    }
    set c [chan create read [namespace which driver]]
    chan configure $c -encoding utf-8 -translation lf -buffersize 107
    set out [makeFile {} out]
    set outChan [open $out w]
    chan configure $outChan -encoding utf-8 -translation lf
} -body {







|


















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


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

|
|












|


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















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















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















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







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
    set done
} -cleanup {
    close $outChan
    close $inChan
    removeFile out
    removeFile in
} -result {40 bytes copied}
test io-53.12.0 {CopyData: foreground short reads, aka bug 3096275} {stdio unix fcopy} {
    file delete $path(pipe)
    set f1 [open $path(pipe) w]
    puts -nonewline $f1 {
	fconfigure stdin -translation binary -blocking 0
	fconfigure stdout -buffering none -translation binary
	fcopy stdin stdout
    }
    close $f1
    set f1 [open "|[list [interpreter] $path(pipe)]" r+]
    fconfigure $f1 -translation binary -buffering none
    puts -nonewline $f1 A
    after 2000 {set ::done timeout}
    fileevent $f1 readable {set ::done ok}
    vwait ::done
    set ch [read $f1 1]
    close $f1
    list $::done $ch
} {ok A}
test io-53.12.1 {
    Issue 9ca87e6286262a62.
    CopyData: foreground short reads via ReadChars().
    Related to report 3096275 for ReadBytes().

    Prior to the fix this test waited forever for read() to return.
} {stdio unix fcopy} {
    file delete $path(output)
    set f1 [open $path(output) w]
    puts -nonewline $f1 {
	chan configure stdin -encoding iso8859-1 -translation lf -buffering none
	fcopy stdin stdout
    }
    close $f1
    set f1 [open "|[list [info nameofexecutable] $path(output)]" r+]
    try {
	chan configure $f1 -encoding utf-8  -buffering none
	puts -nonewline $f1 A
	set ch [read $f1 1]
    } finally {
	if {$f1 in [chan names]} {
	    close $f1
	}
    }
    lindex $ch
} A
test io-53.13 {TclCopyChannel: read error reporting} -setup {
    proc driver {cmd args} {
	variable buffer
	variable index
	set chan [lindex $args 0]
	switch -- $cmd {
	    initialize {
		return {initialize finalize watch read}
	    }
	    finalize {
		return
	    }
	    watch {}
	    read {
		error FAIL
	    }
	}
    }
    set outFile [makeFile {} out]
} -body {
    set in [chan create read [namespace which driver]]
    chan configure $in -translation binary
    set out [open $outFile wb]
    chan copy $in $out
} -cleanup {
    catch {close $in}
    catch {close $out}
    removeFile out
    rename driver {}
} -result {error reading "rc*": *} -returnCodes error -match glob
test io-53.14 {TclCopyChannel: write error reporting} -setup {
    proc driver {cmd args} {
	variable buffer
	variable index
	set chan [lindex $args 0]
	switch -- $cmd {
	    initialize {
		return {initialize finalize watch write}
	    }
	    finalize {
		return
	    }
	    watch {}
	    write {
		error FAIL
	    }
	}
    }
    set inFile [makeFile {aaa} in]
} -body {
    set in [open $inFile rb]
    set out [chan create write [namespace which driver]]
    chan configure $out -translation binary
    chan copy $in $out
} -cleanup {
    catch {close $in}
    catch {close $out}
    removeFile in
    rename driver {}
} -result {error writing "*": *} -returnCodes error -match glob
test io-53.15 {[ed29c4da21] DoRead: fblocked seen as error} -setup {
    proc driver {cmd args} {
	variable buffer
	variable index
	variable blocked
	set chan [lindex $args 0]
	switch -- $cmd {
	    initialize {
		set index($chan) 0
		set buffer($chan) [encoding convertto utf-8 \
			[string repeat a 100]]
		set blocked($chan) 1
		return {initialize finalize watch read}
	    }
	    finalize {
		unset index($chan) buffer($chan) blocked($chan)
		return
	    }
	    watch {}
	    read {
		if {$blocked($chan)} {
		    set blocked($chan) [expr {!$blocked($chan)}]
		    return -code error EAGAIN
		}
		set n [lindex $args 1]
		set new [expr {$index($chan) + $n}]
		set result [string range $buffer($chan) $index($chan) $new-1]
		set index($chan) $new
		return $result
	    }
	}
    }
    set c [chan create read [namespace which driver]]
    chan configure $c -encoding utf-8
    set out [makeFile {} out]
    set outChan [open $out w]
    chan configure $outChan -encoding utf-8
} -body {
    chan copy $c $outChan
} -cleanup {
    close $outChan
    close $c
    removeFile out
} -result 100
test io-53.16 {[ed29c4da21] MBRead: fblocked seen as error} -setup {
    proc driver {cmd args} {
	variable buffer
	variable index
	variable blocked
	set chan [lindex $args 0]
	switch -- $cmd {
	    initialize {
		set index($chan) 0
		set buffer($chan) [encoding convertto utf-8 \
			[string repeat a 100]]
		set blocked($chan) 1
		return {initialize finalize watch read}
	    }
	    finalize {
		unset index($chan) buffer($chan) blocked($chan)
		return
	    }
	    watch {}
	    read {
		if {$blocked($chan)} {
		    set blocked($chan) [expr {!$blocked($chan)}]
		    return -code error EAGAIN
		}
		set n [lindex $args 1]
		set new [expr {$index($chan) + $n}]
		set result [string range $buffer($chan) $index($chan) $new-1]
		set index($chan) $new
		return $result
	    }
	}
    }
    set c [chan create read [namespace which driver]]
    chan configure $c -encoding utf-8 -translation lf
    set out [makeFile {} out]
    set outChan [open $out w]
    chan configure $outChan -encoding utf-8 -translation lf
} -body {
    chan copy $c $outChan
} -cleanup {
    close $outChan
    close $c
    removeFile out
} -result 100
test io-53.17 {[7c187a3773] MBWrite: proper inQueueTail handling} -setup {
    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 \
			line\n[string repeat a 100]line\n]
		return {initialize finalize watch read}
	    }
	    finalize {
		unset index($chan) buffer($chan)
		return
	    }
	    watch {}
	    read {
		set n [lindex $args 1]
		set new [expr {$index($chan) + $n}]
		set result [string range $buffer($chan) $index($chan) $new-1]
		set index($chan) $new
		return $result
	    }
	}
    }
    set c [chan create read [namespace which driver]]
    chan configure $c -encoding utf-8 -translation lf -buffersize 107
    set out [makeFile {} out]
    set outChan [open $out w]
    chan configure $outChan -encoding utf-8 -translation lf
} -body {
8586
8587
8588
8589
8590
8591
8592
8593
8594
8595
8596
8597
8598
8599
8600
    variable x ""
    set result ""
    vwait [namespace which -variable x]

    # cut of the remainder of the error stack, especially the filename
    set result [lreplace $result 3 3 [lindex [split [lindex $result 3] \n] 0]]
    list $x $result
} {1 {gets ABC catch {error writing "stdout": illegal byte sequence}}}

test io-61.1 {Reset eof state after changing the eof char} -setup {
    set datafile [makeFile {} eofchar]
    set f [open $datafile w]
    fconfigure $f -translation binary
    puts -nonewline $f [string repeat "Ho hum\n" 11]
    puts $f =







|







8824
8825
8826
8827
8828
8829
8830
8831
8832
8833
8834
8835
8836
8837
8838
    variable x ""
    set result ""
    vwait [namespace which -variable x]

    # cut of the remainder of the error stack, especially the filename
    set result [lreplace $result 3 3 [lindex [split [lindex $result 3] \n] 0]]
    list $x $result
} {1 {gets ABC catch {error writing "stdout": invalid or incomplete multibyte or wide character}}}

test io-61.1 {Reset eof state after changing the eof char} -setup {
    set datafile [makeFile {} eofchar]
    set f [open $datafile w]
    fconfigure $f -translation binary
    puts -nonewline $f [string repeat "Ho hum\n" 11]
    puts $f =
8616
8617
8618
8619
8620
8621
8622
8623
8624
8625
8626
8627
8628
8629
8630
    close $f
    set res
} -cleanup {
    removeFile eofchar
} -result {77 = 23431}


# Test the cutting and splicing of channels, this is incidentially the
# attach/detach facility of package Thread, but __without any
# safeguards__. It can also be used to emulate transfer of channels
# between threads, and is used for that here.

test io-70.0 {Cutting & Splicing channels} {testchannel} {
    set f [makeFile {... dummy ...} cutsplice]
    set c [open $f r]







|







8854
8855
8856
8857
8858
8859
8860
8861
8862
8863
8864
8865
8866
8867
8868
    close $f
    set res
} -cleanup {
    removeFile eofchar
} -result {77 = 23431}


# Test the cutting and splicing of channels, this is incidentally the
# attach/detach facility of package Thread, but __without any
# safeguards__. It can also be used to emulate transfer of channels
# between threads, and is used for that here.

test io-70.0 {Cutting & Splicing channels} {testchannel} {
    set f [makeFile {... dummy ...} cutsplice]
    set c [open $f r]
8920
8921
8922
8923
8924
8925
8926
8927
8928
8929
8930
8931
8932
8933
8934
    set rfd [open $fn r]
    set wfd [open $fn a]
    chan configure $wfd -buffering none -translation binary
    chan configure $rfd -buffersize 5 -encoding utf-8
    read $rfd
} -body {
    set result [eof $rfd]
    puts -nonewline $wfd "more\xC2\xA0data"
    lappend result [eof $rfd]
    lappend result [read $rfd]
    lappend result [eof $rfd]
} -cleanup {
    close $wfd
    close $rfd
    removeFile io-73.5







|







9158
9159
9160
9161
9162
9163
9164
9165
9166
9167
9168
9169
9170
9171
9172
    set rfd [open $fn r]
    set wfd [open $fn a]
    chan configure $wfd -buffering none -translation binary
    chan configure $rfd -buffersize 5 -encoding utf-8
    read $rfd
} -body {
    set result [eof $rfd]
    puts -nonewline $wfd more\xC2\xA0data
    lappend result [eof $rfd]
    lappend result [read $rfd]
    lappend result [eof $rfd]
} -cleanup {
    close $wfd
    close $rfd
    removeFile io-73.5
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
    read [teststringobj get 2]
} -cleanup {
    interp delete child
    testobj freeallvars
    removeFile io-74.1
} -returnCodes error -match glob -result {can not find channel named "*"}

test io-75.1 {multibyte encoding error read results in raw bytes (-nocomplainencoding 1)} -setup {
    set fn [makeFile {} io-75.1]
    set f [open $fn w+]
    fconfigure $f -encoding binary
    # In UTF-8, a byte 0xCx starts a multibyte sequence and must be followed
    # by a byte > 0x7F. This is violated to get an invalid sequence.
    puts -nonewline $f "A\xC0\x40"
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -nocomplainencoding 1 -buffering none
} -body {
    set d [read $f]
    binary scan $d H* hd
    set hd
} -cleanup {
    close $f
    removeFile io-75.1
} -result "41c040"

test io-75.2 {unrepresentable character write passes and is replaced by ? (-nocomplainencoding 1)} -setup {
    set fn [makeFile {} io-75.2]
    set f [open $fn w+]
    fconfigure $f -encoding iso8859-1 -nocomplainencoding 1
} -body {
    puts -nonewline $f "A\u2022"
    flush $f
    seek $f 0
    read $f
} -cleanup {
    close $f
    removeFile io-75.2
} -result "A?"

# Incomplete sequence test.
# This error may IMHO only be detected with the close.
# But the read already returns the incomplete sequence.
test io-75.3 {incomplete multibyte encoding read is ignored (-nocomplainencoding 1)} -setup {
    set fn [makeFile {} io-75.3]
    set f [open $fn w+]
    fconfigure $f -encoding binary
    puts -nonewline $f "A\xC0"
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none -nocomplainencoding 1
} -body {
    set d [read $f]
    close $f
    binary scan $d H* hd
    set hd
} -cleanup {

    removeFile io-75.3
} -result "41c0"

# As utf-8 has a special treatment in multi-byte decoding, also test another
# one.
test io-75.4 {shiftjis encoding error read results in raw bytes (-nocomplainencoding 1)} -setup {
    set fn [makeFile {} io-75.4]
    set f [open $fn w+]
    fconfigure $f -encoding binary
    # In shiftjis, \x81 starts a two-byte sequence.
    # But 2nd byte \xFF is not allowed
    puts -nonewline $f "A\x81\xFFA"
    flush $f
    seek $f 0
    fconfigure $f -encoding shiftjis -buffering none -eofchar "" -translation lf -nocomplainencoding 1
} -body {
    set d [read $f]
    binary scan $d H* hd
    set hd
} -cleanup {
    close $f
    removeFile io-75.4
} -result "4181ff41"

test io-75.5 {incomplete shiftjis encoding read is ignored (-nocomplainencoding 1)} -setup {
    set fn [makeFile {} io-75.5]
    set f [open $fn w+]
    fconfigure $f -encoding binary
    # \x81 announces a two byte sequence.
    puts -nonewline $f "A\x81"
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none -eofchar "" -translation lf -nocomplainencoding 1
} -body {
    set d [read $f]
    close $f
    binary scan $d H* hd
    set hd
} -cleanup {

    removeFile io-75.5
} -result "4181"

test io-75.6 {multibyte encoding error read results in raw bytes} -setup {
    set fn [makeFile {} io-75.6]
    set f [open $fn w+]
    fconfigure $f -encoding binary
    # In UTF-8, a byte 0xCx starts a multibyte sequence and must be followed
    # by a byte > 0x7F. This is violated to get an invalid sequence.
    puts -nonewline $f "A\xC0\x40"
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none

} -constraints knownBug -body {
    set d [read $f]
    binary scan $d H* hd
    set hd
} -cleanup {
    close $f
    removeFile io-75.6











































} -result "41"
# The current result cuts at the invalid sequence. IMHO, there should be an
























# error thrown or the whole sequence should be returned as byte (compat mode).





















test io-75.7 {unrepresentable character write passes and is replaced by ?} -setup {
    set fn [makeFile {} io-75.7]
    set f [open $fn w+]
    fconfigure $f -encoding iso8859-1
} -body {
    catch {puts -nonewline $f "A\u2022"} msg
    flush $f
    seek $f 0
    list [read $f] $msg
} -cleanup {
    close $f
    removeFile io-75.7
} -match glob -result [list {A} {error writing "*": illegal byte sequence}]


# Incomplete sequence test.
# This error may IMHO only be detected with the close.
# But the read already returns the incomplete sequence.
test io-75.8 {incomplete multibyte encoding read is ignored} -setup {



    set fn [makeFile {} io-75.8]
    set f [open $fn w+]
    fconfigure $f -encoding binary
    puts -nonewline $f "A\xC0"
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none
} -body {




    set d [read $f]
    close $f
    binary scan $d H* hd

    set hd
} -cleanup {

    removeFile io-75.8
} -result "41c0"



# The current result returns the orphan byte as byte.
# This may be expected due to special utf-8 handling.

# As utf-8 has a special treatment in multi-byte decoding, also test another
# one.
test io-75.9 {shiftjis encoding error read results in raw bytes} -setup {
    set fn [makeFile {} io-75.9]
    set f [open $fn w+]
    fconfigure $f -encoding binary
    # In shiftjis, \x81 starts a two-byte sequence.
    # But 2nd byte \xFF is not allowed
    puts -nonewline $f "A\x81\xFFA"
    flush $f
    seek $f 0
    fconfigure $f -encoding shiftjis -buffering none -eofchar "" -translation lf

} -constraints knownBug -body {
    set d [read $f]
    binary scan $d H* hd
    set hd
} -cleanup {
    close $f
    removeFile io-75.9
} -result "41"
# The current result cuts at the invalid sequence. IMHO, there should be an
# error thrown or the whole sequence should be returned as byte (compat mode).

test io-75.10 {incomplete shiftjis encoding read is ignored} -setup {




    set fn [makeFile {} io-75.10]
    set f [open $fn w+]
    fconfigure $f -encoding binary



























    # \x81 announces a two byte sequence.
    puts -nonewline $f "A\x81"
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none -eofchar "" -translation lf

} -body {
    set d [read $f]
    close $f
    binary scan $d H* hd
    set hd
} -cleanup {

    removeFile io-75.10


} -result "4181"


























































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



test io-76.0 {channel modes} -setup {
    set datafile [makeFile {some characters} dummy]







|





|


|







|

|


|

|






|




|






|


<



>

|



|





|


|







|

|



<
|


|


<



>

|

|



|
<
|


|
>
|
<
<
|



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

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

|







|
|
>

|
<
<
|
>
>
>
|


|




>
>
>
>

<

>
|

>
|
|
>
>
>





|
|




|


|
>
|


|


|
|
|
<

|
>
>
>
>
|


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


|
>


<

|

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







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
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
    read [teststringobj get 2]
} -cleanup {
    interp delete child
    testobj freeallvars
    removeFile io-74.1
} -returnCodes error -match glob -result {can not find channel named "*"}

test io-75.1 {multibyte encoding error read results in raw bytes (-profile tcl8)} -setup {
    set fn [makeFile {} io-75.1]
    set f [open $fn w+]
    fconfigure $f -encoding binary
    # In UTF-8, a byte 0xCx starts a multibyte sequence and must be followed
    # by a byte > 0x7F. This is violated to get an invalid sequence.
    puts -nonewline $f A\xC0\x40
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -profile tcl8 -buffering none
} -body {
    set d [read $f]
    binary scan $d H* hd
    set hd
} -cleanup {
    close $f
    removeFile io-75.1
} -result 41c040

test io-75.2 {unrepresentable character write passes and is replaced by ? (-profile tcl8)} -setup {
    set fn [makeFile {} io-75.2]
    set f [open $fn w+]
    fconfigure $f -encoding iso8859-1 -profile tcl8
} -body {
    puts -nonewline $f A\u2022
    flush $f
    seek $f 0
    read $f
} -cleanup {
    close $f
    removeFile io-75.2
} -result A?

# Incomplete sequence test.
# This error may IMHO only be detected with the close.
# But the read already returns the incomplete sequence.
test io-75.3 {incomplete multibyte encoding read is ignored (-profile tcl8)} -setup {
    set fn [makeFile {} io-75.3]
    set f [open $fn w+]
    fconfigure $f -encoding binary
    puts -nonewline $f "A\xC0"
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none -profile tcl8
} -body {
    set d [read $f]

    binary scan $d H* hd
    set hd
} -cleanup {
    close $f
    removeFile io-75.3
} -result 41c0

# As utf-8 has a special treatment in multi-byte decoding, also test another
# one.
test io-75.4 {shiftjis encoding error read results in raw bytes (-profile tcl8)} -setup {
    set fn [makeFile {} io-75.4]
    set f [open $fn w+]
    fconfigure $f -encoding binary
    # In shiftjis, \x81 starts a two-byte sequence.
    # But 2nd byte \xFF is not allowed
    puts -nonewline $f A\x81\xFFA
    flush $f
    seek $f 0
    fconfigure $f -encoding shiftjis -buffering none -eofchar "" -translation lf -profile tcl8
} -body {
    set d [read $f]
    binary scan $d H* hd
    set hd
} -cleanup {
    close $f
    removeFile io-75.4
} -result 4181ff41

test io-75.5 {invalid utf-8 encoding read is ignored (-profile tcl8)} -setup {
    set fn [makeFile {} io-75.5]
    set f [open $fn w+]
    fconfigure $f -encoding binary

    puts -nonewline $f A\x81
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none -eofchar "" -translation lf -profile tcl8
} -body {
    set d [read $f]

    binary scan $d H* hd
    set hd
} -cleanup {
    close $f
    removeFile io-75.5
} -result 4181

test io-75.6 {invalid utf-8 encoding, gets is not ignored (-profile strict)} -setup {
    set fn [makeFile {} io-75.6]
    set f [open $fn w+]
    fconfigure $f -encoding binary
    # \x81 is an incomplete byte sequence in utf-8

    puts -nonewline $f A\x81
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none -eofchar {} \
	    -translation lf -profile strict
} -body {


    gets $f
} -cleanup {
    close $f
    removeFile io-75.6
} -match glob -returnCodes 1 -result {error reading "file*":\
	invalid or incomplete multibyte or wide character}

test io-75.7 {
    invalid utf-8 encoding gets is not ignored (-profile strict)
} -setup {
    set fn [makeFile {} io-75.7]
    set f [open $fn w+]
    fconfigure $f -encoding binary
    # \x81 is invalid in utf-8
    puts -nonewline $f A\x81
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none -eofchar {} -translation lf \
	    -profile strict
} -body {
    list [catch {read $f} msg] $msg
} -cleanup {
    close $f
    removeFile io-75.7
} -match glob -result {1 {error reading "file*":\
    invalid or incomplete multibyte or wide character}}

test io-75.8 {invalid utf-8 encoding eof handling (-profile strict)} -setup {
    set fn [makeFile {} io-75.8]
    set f [open $fn w+]
    fconfigure $f -encoding binary
    # \x81 is invalid in utf-8, but since \x1A comes first, -eofchar takes
    # precedence.
    puts -nonewline $f A\x1A\x81
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none -eofchar \x1A \
	-translation lf -profile strict
} -body {
    set d [read $f]
    binary scan $d H* hd
    lappend hd [eof $f]
    lappend hd [read $f]
    close $f
    set hd
} -cleanup {
    removeFile io-75.8
} -result {41 1 {}}

test io-75.8.eoflater {invalid utf-8 encoding eof handling (-profile strict)} -setup {
    set fn [makeFile {} io-75.8]
    set f [open $fn w+]
    # This also configures the channel encoding profile as strict.
    fconfigure $f -encoding binary
    # \x81 is invalid in utf-8. -eofchar is not detected, because it comes later.
    puts -nonewline $f A\x81\x81\x1A
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none -eofchar \x1A \
	-translation lf -profile strict
} -body {
    set res [list [catch {read $f} cres] [eof $f]]
    chan configure $f -encoding iso8859-1
    lappend res [read $f 1]
    chan configure $f -encoding utf-8
    catch {read $f 1} cres
    lappend res $cres
    close $f
    set res
} -cleanup {
    removeFile io-75.8
} -match glob -result "1 0 \x81 {error reading \"*\":\
    invalid or incomplete multibyte or wide character}"


test io-strict-multibyte-eof {
    incomplete utf-8 sequence immediately prior to eof character

    See issue 25cdcb7e8fb381fb
} -setup {
    set res {}
    set chan [file tempfile];
    fconfigure $chan -encoding binary
    puts -nonewline $chan \x81\x1A
    flush $chan
    seek $chan 0
    chan configure $chan -encoding utf-8 -profile strict
} -body {
    list [catch {read $chan 1} cres] $cres
} -cleanup {
    close $chan
    unset res
} -match glob -result {1 {error reading "*":\
    invalid or incomplete multibyte or wide character}}

test io-75.9 {unrepresentable character write passes and is replaced by ?} -setup {
    set fn [makeFile {} io-75.9]
    set f [open $fn w+]
    fconfigure $f -encoding iso8859-1 -profile strict
} -body {
    catch {puts -nonewline $f "A\u2022"} msg
    flush $f
    seek $f 0
    list [read $f] $msg
} -cleanup {
    close $f
    removeFile io-75.9
} -match glob -result [list {A} {error writing "*":\
    invalid or incomplete multibyte or wide character}]

test io-75.10 {


    incomplete multibyte encoding read is not ignored because "binary" sets
    profile to strict
} -setup {
    set res {}
    set fn [makeFile {} io-75.10]
    set f [open $fn w+]
    fconfigure $f -encoding binary
    puts -nonewline $f A\xC0
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none
} -body {
    catch {read $f} errmsg
    lappend res $errmsg
    seek $f 0
    chan configure $f -profile tcl8
    set d [read $f]

    binary scan $d H* hd
    lappend res $hd
    return $res
} -cleanup {
    close $f
    removeFile io-75.10
    unset result
} -match glob -result {{error reading "file*":\
    invalid or incomplete multibyte or wide character} 41c0}

# The current result returns the orphan byte as byte.
# This may be expected due to special utf-8 handling.

# As utf-8 has a special treatment in multi-byte decoding, also test another
# one.
test io-75.11 {shiftjis encoding error read results in raw bytes} -setup {
    set fn [makeFile {} io-75.11]
    set f [open $fn w+]
    fconfigure $f -encoding binary
    # In shiftjis, \x81 starts a two-byte sequence.
    # But 2nd byte \xFF is not allowed
    puts -nonewline $f A\x81\xFFA
    flush $f
    seek $f 0
    fconfigure $f -encoding shiftjis -blocking 0 -eofchar {} -translation lf \
	-profile strict
} -body {
    set d [read $f]
    binary scan $d H* hd
    lappend hd [catch {set d [read $f]} msg] $msg
} -cleanup {
    close $f
    removeFile io-75.11
} -match glob -result {41 1 {error reading "file*":\
    invalid or incomplete multibyte or wide character}}


test io-75.12 {
    invalid utf-8 encoding read is not ignored because setting the encoding to
    "binary" also set the profile to strict
} -setup {
    set res {}
    set fn [makeFile {} io-75.12]
    set f [open $fn w+]
    fconfigure $f -encoding binary
    puts -nonewline $f A\x81
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none -eofchar {} -translation lf
} -body {
    catch {read $f} errmsg
    lappend res $errmsg
    chan configure $f -profile tcl8
    seek $f 0
    set d [read $f]
    binary scan $d H* hd
    lappend res $hd
    return $res
} -cleanup {
    close $f
    removeFile io-75.12
    unset res
} -match glob -result {{error reading "file*":\
    invalid or incomplete multibyte or wide character} 4181}
test io-75.13 {
    In nonblocking mode when there is an encoding error the data that has been
    successfully read so far is returned first and then the error is returned
    on the next call to [read].
} -setup {
    set fn [makeFile {} io-75.13]
    set f [open $fn w+]
    fconfigure $f -encoding binary
    # \x81 is invalid in utf-8
    puts -nonewline $f A\x81
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -blocking 0 -eofchar {} -translation lf \
	-profile strict
} -body {
    set d [read $f]

    binary scan $d H* hd
    lappend hd [catch {read $f} msg] $msg
} -cleanup {
    close $f
    removeFile io-75.13
} -match glob -result {41 1 {error reading "file*":\
    invalid or incomplete multibyte or wide character}}

test io-75.14 {
	[gets] succesfully returns lines prior to error

	invalid utf-8 encoding [gets] continues in non-strict mode after error
} -setup {
    set chan [file tempfile]
    fconfigure $chan -encoding binary
    # \xC0\n is an invalid utf-8 sequence
    puts -nonewline $chan a\nb\nc\xC0\nd\n
    flush $chan
    seek $chan 0
    fconfigure $chan -encoding utf-8 -buffering none -eofchar {} \
	-translation auto -profile strict
} -body {
    lappend res [gets $chan]
    lappend res [gets $chan]
    lappend res [catch {gets $chan} cres] $cres
    chan configure $chan -profile tcl8
    lappend res [gets $chan]
    lappend res [gets $chan]
    close $chan
    return $res
} -match glob -result {a b 1 {error reading "*":\
    invalid or incomplete multibyte or wide character} cÀ d}

test io-75.15 {
    invalid utf-8 encoding strict
    gets does not hang
    gets succeeds for the first two lines
} -setup {
    set res {}
    set chan [file tempfile]
    fconfigure $chan -encoding binary
    # \xC0\x40 is an invalid utf-8 sequence
    puts $chan hello\nAB\nCD\xC0\x40EF\nGHI
	seek $chan 0
} -body {
    #Now try to read it with [gets]
    fconfigure $chan -encoding utf-8 -profile strict
    lappend res [gets $chan]
    lappend res [gets $chan]
    lappend res [catch {gets $chan} cres] $cres
    lappend res [catch {gets $chan} cres] $cres
	chan configure $chan -translation binary
	set data [read $chan 4]
	foreach char [split $data {}] {
		scan $char %c ord
		lappend res [format %x $ord]
	}
    fconfigure $chan -encoding utf-8 -profile strict -translation auto
	lappend res [gets $chan]
	lappend res [gets $chan]
    return $res
} -cleanup {
    close $chan
} -match glob -result {hello AB 1 {error reading "*": invalid or incomplete multibyte or wide character}\
    1 {error reading "*": invalid or incomplete multibyte or wide character} 43 44 c0 40 EF GHI}

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



test io-76.0 {channel modes} -setup {
    set datafile [makeFile {some characters} dummy]
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
    set datafile [makeFile {some characters} dummy]
    set f [open $datafile r]
} -constraints testchannel -body {
    testchannel mremove-rd $f
} -returnCodes error -cleanup {
    close $f
    removeFile dummy
} -match glob -result {Tcl_RemoveChannelMode error: Bad mode, would make channel inacessible. Channel: "*"}


test io-76.5 {channel mode dropping} -setup {
    set datafile [makeFile {some characters} dummy]
    set f [open $datafile w]
} -constraints testchannel -body {
    testchannel mremove-rd $f
    list [testchannel mode $f] [testchannel maxmode $f]
} -cleanup {
    close $f
    removeFile dummy
} -result {{{} write} {{} write}}

test io-76.6 {channel mode dropping} -setup {
    set datafile [makeFile {some characters} dummy]
    set f [open $datafile w]
} -constraints testchannel -body {
    testchannel mremove-wr $f
} -returnCodes error -cleanup {
    close $f
    removeFile dummy
} -match glob -result {Tcl_RemoveChannelMode error: Bad mode, would make channel inacessible. Channel: "*"}


test io-76.7 {channel mode dropping} -setup {
    set datafile [makeFile {some characters} dummy]
    set f [open $datafile r+]
} -constraints testchannel -body {
    testchannel mremove-rd $f
    list [testchannel mode $f] [testchannel maxmode $f]







|
>




















|
>







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
    set datafile [makeFile {some characters} dummy]
    set f [open $datafile r]
} -constraints testchannel -body {
    testchannel mremove-rd $f
} -returnCodes error -cleanup {
    close $f
    removeFile dummy
} -match glob -result {Tcl_RemoveChannelMode error:\
    Bad mode, would make channel inacessible. Channel: "*"}

test io-76.5 {channel mode dropping} -setup {
    set datafile [makeFile {some characters} dummy]
    set f [open $datafile w]
} -constraints testchannel -body {
    testchannel mremove-rd $f
    list [testchannel mode $f] [testchannel maxmode $f]
} -cleanup {
    close $f
    removeFile dummy
} -result {{{} write} {{} write}}

test io-76.6 {channel mode dropping} -setup {
    set datafile [makeFile {some characters} dummy]
    set f [open $datafile w]
} -constraints testchannel -body {
    testchannel mremove-wr $f
} -returnCodes error -cleanup {
    close $f
    removeFile dummy
} -match glob -result {Tcl_RemoveChannelMode error:\
    Bad mode, would make channel inacessible. Channel: "*"}

test io-76.7 {channel mode dropping} -setup {
    set datafile [makeFile {some characters} dummy]
    set f [open $datafile r+]
} -constraints testchannel -body {
    testchannel mremove-rd $f
    list [testchannel mode $f] [testchannel maxmode $f]
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
    set f [open $datafile r+]
} -constraints testchannel -body {
    testchannel mremove-wr $f
    testchannel mremove-rd $f
} -returnCodes error -cleanup {
    close $f
    removeFile dummy
} -match glob -result {Tcl_RemoveChannelMode error: Bad mode, would make channel inacessible. Channel: "*"}


test io-76.10 {channel mode dropping} -setup {
    set datafile [makeFile {some characters} dummy]
    set f [open $datafile r+]
} -constraints testchannel -body {
    testchannel mremove-rd $f
    testchannel mremove-wr $f
} -returnCodes error -cleanup {
    close $f
    removeFile dummy
} -match glob -result {Tcl_RemoveChannelMode error: Bad mode, would make channel inacessible. Channel: "*"}


# cleanup
foreach file [list fooBar longfile script script2 output test1 pipe my_script \
	test2 test3 cat stdout kyrillic.txt utf8-fcopy.txt utf8-rp.txt] {
    removeFile $file
}
cleanupTests
}
namespace delete ::tcl::test::io
return







|
>










|
>










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
    set f [open $datafile r+]
} -constraints testchannel -body {
    testchannel mremove-wr $f
    testchannel mremove-rd $f
} -returnCodes error -cleanup {
    close $f
    removeFile dummy
} -match glob -result {Tcl_RemoveChannelMode error:\
    Bad mode, would make channel inacessible. Channel: "*"}

test io-76.10 {channel mode dropping} -setup {
    set datafile [makeFile {some characters} dummy]
    set f [open $datafile r+]
} -constraints testchannel -body {
    testchannel mremove-rd $f
    testchannel mremove-wr $f
} -returnCodes error -cleanup {
    close $f
    removeFile dummy
} -match glob -result {Tcl_RemoveChannelMode error:\
    Bad mode, would make channel inacessible. Channel: "*"}

# cleanup
foreach file [list fooBar longfile script script2 output test1 pipe my_script \
	test2 test3 cat stdout kyrillic.txt utf8-fcopy.txt utf8-rp.txt] {
    removeFile $file
}
cleanupTests
}
namespace delete ::tcl::test::io
return

Changes to tests/ioCmd.test.

13
14
15
16
17
18
19

20
21
22
23
24
25
26
27
28
29
30
31
32
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}


::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]

package require tcltests

# Custom constraints used in this file
testConstraint testchannel	[llength [info commands testchannel]]

#----------------------------------------------------------------------

test iocmd-1.1 {puts command} {
   list [catch {puts} msg] $msg







>




<
<







13
14
15
16
17
18
19
20
21
22
23
24


25
26
27
28
29
30
31
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}
source [file join [file dirname [info script]] tcltests.tcl]

::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]



# Custom constraints used in this file
testConstraint testchannel	[llength [info commands testchannel]]

#----------------------------------------------------------------------

test iocmd-1.1 {puts command} {
   list [catch {puts} msg] $msg
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
    chan close $chan write
} -cleanup {
    close $chan
} -returnCodes error -result "Half-close of write-side not possible, side not opened or already closed"

proc expectedOpts {got extra} {
    set basicOpts {
	-blocking -buffering -buffersize -encoding -eofchar -translation
    }
    set opts [list {*}$basicOpts {*}$extra]
    lset opts end [string cat "or " [lindex $opts end]]
    return [format {bad option "%s": should be one of %s} $got [join $opts ", "]]
}
test iocmd-8.1 {fconfigure command} -returnCodes error -body {
    fconfigure







|







203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
    chan close $chan write
} -cleanup {
    close $chan
} -returnCodes error -result "Half-close of write-side not possible, side not opened or already closed"

proc expectedOpts {got extra} {
    set basicOpts {
	-blocking -buffering -buffersize -encoding -eofchar -profile -translation
    }
    set opts [list {*}$basicOpts {*}$extra]
    lset opts end [string cat "or " [lindex $opts end]]
    return [format {bad option "%s": should be one of %s} $got [join $opts ", "]]
}
test iocmd-8.1 {fconfigure command} -returnCodes error -body {
    fconfigure
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
test iocmd-8.4 {fconfigure command} -setup {
    file delete $path(test1)
    set f1 [open $path(test1) w]
} -body {
    fconfigure $f1 froboz
} -returnCodes error -cleanup {
    close $f1
} -result [expectedOpts "froboz" {}]
test iocmd-8.5 {fconfigure command} -returnCodes error -body {
    fconfigure stdin -buffering froboz
} -result {bad value for -buffering: must be one of full, line, or none}
test iocmd-8.6 {fconfigure command} -returnCodes error -body {
    fconfigure stdin -translation froboz
} -result {bad value for -translation: must be one of auto, binary, cr, lf, crlf, or platform}
test iocmd-8.7 {fconfigure command} -setup {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    fconfigure $f1 -translation lf -eofchar {} -encoding utf-16
    fconfigure $f1
} -cleanup {
    catch {close $f1}
} -result {-blocking 1 -buffering full -buffersize 4096 -encoding utf-16 -eofchar {} -nocomplainencoding 0 -strictencoding 0 -translation lf}
test iocmd-8.8 {fconfigure command} -setup {
    file delete $path(test1)
    set x {}
} -body {
    set f1 [open $path(test1) w]
    fconfigure $f1 -translation lf -buffering line -buffersize 3030 \
		-eofchar {} -encoding utf-16
    lappend x [fconfigure $f1 -buffering]
    lappend x [fconfigure $f1]
} -cleanup {
    catch {close $f1}
} -result {line {-blocking 1 -buffering line -buffersize 3030 -encoding utf-16 -eofchar {} -nocomplainencoding 0 -strictencoding 0 -translation lf}}
test iocmd-8.9 {fconfigure command} -setup {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    fconfigure $f1 -translation binary -buffering none -buffersize 4040 \
		-eofchar {} -encoding binary
    fconfigure $f1
} -cleanup {
    catch {close $f1}
} -result {-blocking 1 -buffering none -buffersize 4040 -encoding binary -eofchar {} -nocomplainencoding 0 -strictencoding 0 -translation lf}
test iocmd-8.10 {fconfigure command} -returnCodes error -body {
    fconfigure a b
} -result {can not find channel named "a"}
set path(fconfigure.dummy) [makeFile {} fconfigure.dummy]
test iocmd-8.11 {fconfigure command} -body {
    set chan [open $path(fconfigure.dummy) r]
    fconfigure $chan -froboz blarfo







|










|



|






|




|





|



|







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
test iocmd-8.4 {fconfigure command} -setup {
    file delete $path(test1)
    set f1 [open $path(test1) w]
} -body {
    fconfigure $f1 froboz
} -returnCodes error -cleanup {
    close $f1
} -result [expectedOpts "froboz" -stat]
test iocmd-8.5 {fconfigure command} -returnCodes error -body {
    fconfigure stdin -buffering froboz
} -result {bad value for -buffering: must be one of full, line, or none}
test iocmd-8.6 {fconfigure command} -returnCodes error -body {
    fconfigure stdin -translation froboz
} -result {bad value for -translation: must be one of auto, binary, cr, lf, crlf, or platform}
test iocmd-8.7 {fconfigure command} -setup {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    fconfigure $f1 -translation lf -eofchar {} -encoding utf-16 -profile tcl8
    fconfigure $f1
} -cleanup {
    catch {close $f1}
} -result {-blocking 1 -buffering full -buffersize 4096 -encoding utf-16 -eofchar {} -profile tcl8 -translation lf}
test iocmd-8.8 {fconfigure command} -setup {
    file delete $path(test1)
    set x {}
} -body {
    set f1 [open $path(test1) w]
    fconfigure $f1 -translation lf -buffering line -buffersize 3030 \
		-eofchar {} -encoding utf-16 -profile tcl8
    lappend x [fconfigure $f1 -buffering]
    lappend x [fconfigure $f1]
} -cleanup {
    catch {close $f1}
} -result {line {-blocking 1 -buffering line -buffersize 3030 -encoding utf-16 -eofchar {} -profile tcl8 -translation lf}}
test iocmd-8.9 {fconfigure command} -setup {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    fconfigure $f1 -translation binary -buffering none -buffersize 4040 \
		-eofchar {} -encoding binary -profile tcl8
    fconfigure $f1
} -cleanup {
    catch {close $f1}
} -result {-blocking 1 -buffering none -buffersize 4040 -encoding iso8859-1 -eofchar {} -profile tcl8 -translation lf}
test iocmd-8.10 {fconfigure command} -returnCodes error -body {
    fconfigure a b
} -result {can not find channel named "a"}
set path(fconfigure.dummy) [makeFile {} fconfigure.dummy]
test iocmd-8.11 {fconfigure command} -body {
    set chan [open $path(fconfigure.dummy) r]
    fconfigure $chan -froboz blarfo
366
367
368
369
370
371
372




373
374
375
376
377
378
379
    set console stdin
} -body {
    fconfigure $console -blah blih
} -returnCodes error -result [expectedOpts "-blah" {-inputmode}]
# TODO: Test parsing of serial channel options (nonPortable, since requires an
# open channel to work with).





test iocmd-9.1 {eof command} {
    list [catch {eof} msg] $msg $::errorCode
} {1 {wrong # args: should be "eof channelId"} {TCL WRONGARGS}}
test iocmd-9.2 {eof command} {
    list [catch {eof a b} msg] $msg $::errorCode
} {1 {wrong # args: should be "eof channelId"} {TCL WRONGARGS}}
test iocmd-9.3 {eof command} {







>
>
>
>







365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
    set console stdin
} -body {
    fconfigure $console -blah blih
} -returnCodes error -result [expectedOpts "-blah" {-inputmode}]
# TODO: Test parsing of serial channel options (nonPortable, since requires an
# open channel to work with).

test iocmd-8.23 {fconfigure -profile badprofile} -body {
    fconfigure stdin -profile froboz
} -returnCodes error -result {bad profile name "froboz": must be replace, strict, or tcl8}

test iocmd-9.1 {eof command} {
    list [catch {eof} msg] $msg $::errorCode
} {1 {wrong # args: should be "eof channelId"} {TCL WRONGARGS}}
test iocmd-9.2 {eof command} {
    list [catch {eof a b} msg] $msg $::errorCode
} {1 {wrong # args: should be "eof channelId"} {TCL WRONGARGS}}
test iocmd-9.3 {eof command} {
488
489
490
491
492
493
494
495

496






497
498
499
500
501
502
503
504
    close $f
    set f [open $path(test1) r]
    fconfigure $f -translation binary
    set result [string length [read $f]]
    close $f
    set result
} 5
test iocmd-12.11 {POSIX open access modes: BINARY} {

    set f [open $path(test1) {WRONLY BINARY TRUNC}]






    puts $f Ɉ		;# gets truncated to H
    close $f
    set f [open $path(test1) r]
    fconfigure $f -translation binary
    set result [read -nonewline $f]
    close $f
    set result
} H







|
>

>
>
>
>
>
>
|







491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
    close $f
    set f [open $path(test1) r]
    fconfigure $f -translation binary
    set result [string length [read $f]]
    close $f
    set result
} 5
test iocmd-12.11 {POSIX open access modes: BINARY} -body {
    after 100
    set f [open $path(test1) {WRONLY BINARY TRUNC}]
    puts $f Ɉ		;# throws an exception
} -cleanup {
    close $f
} -returnCodes 1 -match glob -result {error writing "*": invalid or incomplete multibyte or wide character}
test iocmd-12.12 {POSIX open access modes: BINARY} {
    set f [open $path(test1) {WRONLY BINARY TRUNC}]
    puts $f H
    close $f
    set f [open $path(test1) r]
    fconfigure $f -translation binary
    set result [read -nonewline $f]
    close $f
    set result
} H
578
579
580
581
582
583
584
585





















586
587
588
589
590
591
592
    set fid [open $f rb]
    append d [read $fid]
    close $fid
    return $d
} -cleanup {
    removeFile $f
} -result 341234x6























test iocmd-14.1 {file id parsing errors} {
    list [catch {eof gorp} msg] $msg $::errorCode
} {1 {can not find channel named "gorp"} {TCL LOOKUP CHANNEL gorp}}
test iocmd-14.2 {file id parsing errors} {
    list [catch {eof filex} msg] $msg
} {1 {can not find channel named "filex"}}







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







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
    set fid [open $f rb]
    append d [read $fid]
    close $fid
    return $d
} -cleanup {
    removeFile $f
} -result 341234x6
test ioCmd-13.12 {open file produces something that has fconfigure -stat} -setup {
    set f [makeFile {} iocmd13_12]
    set result {}
} -body {
    set fd [open $f wb]
    set result [dict get [fconfigure $fd -stat] type]
    fconfigure $fd -buffering none
    puts -nonewline $fd abc
    # Three ways of getting the size; all should agree!
    lappend result [tell $fd] [file size $f] \
	[dict get [fconfigure $fd -stat] size]
    puts -nonewline $fd def
    lappend result [tell $fd] [file size $f] \
	[dict get [fconfigure $fd -stat] size]
    puts -nonewline $fd ghi
    lappend result [tell $fd] [file size $f] \
	[dict get [fconfigure $fd -stat] size]
    close $fd
    return $result
} -cleanup {
    removeFile $f
} -result {file 3 3 3 6 6 6 9 9 9}

test iocmd-14.1 {file id parsing errors} {
    list [catch {eof gorp} msg] $msg $::errorCode
} {1 {can not find channel named "gorp"} {TCL LOOKUP CHANNEL gorp}}
test iocmd-14.2 {file id parsing errors} {
    list [catch {eof filex} msg] $msg
} {1 {can not find channel named "filex"}}
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
    set msg
} {wrong # args: should be "chan subcommand ?arg ...?"}
test iocmd-20.1 {chan, unknown method} -body {
    chan foo
} -returnCodes error -match glob -result {unknown or ambiguous subcommand "foo": must be *}

# --- --- --- --------- --------- ---------
# chan create, and method "initalize"

test iocmd-21.0 {chan create, wrong#args, not enough} {
    catch {chan create} msg
    set msg
} {wrong # args: should be "chan create mode cmdprefix"}
test iocmd-21.1 {chan create, wrong#args, too many} {
    catch {chan create a b c} msg
    set msg
} {wrong # args: should be "chan create mode cmdprefix"}
test iocmd-21.2 {chan create, invalid r/w mode, empty} {
    proc foo {} {}
    catch {chan create {} foo} msg

    rename foo {}
    set msg
} {bad mode list: is empty}
test iocmd-21.3 {chan create, invalid r/w mode, bad string} {
    proc foo {} {}
    catch {chan create {c} foo} msg
    rename foo {}
    set msg
} {bad mode "c": must be read or write}
test iocmd-21.4 {chan create, bad handler, not a list} {







|









|
|
|
>

|
<







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
    set msg
} {wrong # args: should be "chan subcommand ?arg ...?"}
test iocmd-20.1 {chan, unknown method} -body {
    chan foo
} -returnCodes error -match glob -result {unknown or ambiguous subcommand "foo": must be *}

# --- --- --- --------- --------- ---------
# chan create, and method "initialize"

test iocmd-21.0 {chan create, wrong#args, not enough} {
    catch {chan create} msg
    set msg
} {wrong # args: should be "chan create mode cmdprefix"}
test iocmd-21.1 {chan create, wrong#args, too many} {
    catch {chan create a b c} msg
    set msg
} {wrong # args: should be "chan create mode cmdprefix"}
test iocmd-21.2 {chan create, r/w mode empty} {
    proc foo {cmd args} { return {initialize finalize watch} }
    set chan [chan create {} foo]
    close $chan
    rename foo {}
} {}

test iocmd-21.3 {chan create, invalid r/w mode, bad string} {
    proc foo {} {}
    catch {chan create {c} foo} msg
    rename foo {}
    set msg
} {bad mode "c": must be read or write}
test iocmd-21.4 {chan create, bad handler, not a list} {
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
    }
    set c [chan create {r w} foo]
    note [read $c 10]
    close $c
    rename foo {}
    set res
} -result {{read rc* 4096} {read rc* 4096} snarfsnarf}
test iocmd-23.2 {chan read, bad data return, to much} -match glob -body {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	return [string repeat snarf 1000]
    }
    set c [chan create {r w} foo]
    note [catch {read $c 2} msg]; note $msg







|







1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
    }
    set c [chan create {r w} foo]
    note [read $c 10]
    close $c
    rename foo {}
    set res
} -result {{read rc* 4096} {read rc* 4096} snarfsnarf}
test iocmd-23.2 {chan read, bad data return, too much} -match glob -body {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	return [string repeat snarf 1000]
    }
    set c [chan create {r w} foo]
    note [catch {read $c 2} msg]; note $msg
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
} -result {{write rc* ABC} {watch rc* write} {}}

# --- === *** ###########################
# method cgetall

test iocmd-25.1 {chan configure, cgetall, standard options} -match glob -body {
    set res {}
    proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
    set c [chan create {r w} foo]
    note [fconfigure $c]
    close $c
    rename foo {}
    set res
} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {} -nocomplainencoding 0 -strictencoding 0 -translation {auto *}}}
test iocmd-25.2 {chan configure, cgetall, no options} -match glob -body {
    set res {}
    proc foo {args} {oninit cget cgetall; onfinal; track; return ""}
    set c [chan create {r w} foo]
    note [fconfigure $c]
    close $c
    rename foo {}
    set res
} -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {} -nocomplainencoding 0 -strictencoding 0 -translation {auto *}}}
test iocmd-25.3 {chan configure, cgetall, regular result} -match glob -body {
    set res {}
    proc foo {args} {
	oninit cget cgetall; onfinal; track
	return "-bar foo -snarf x"
    }
    set c [chan create {r w} foo]
    note [fconfigure $c]
    close $c
    rename foo {}
    set res
} -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {} -nocomplainencoding 0 -strictencoding 0 -translation {auto *} -bar foo -snarf x}}
test iocmd-25.4 {chan configure, cgetall, bad result, list of uneven length} -match glob -body {
    set res {}
    proc foo {args} {
	oninit cget cgetall; onfinal; track
	return "-bar"
    }
    set c [chan create {r w} foo]







|





|


|





|


|

|






|







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
} -result {{write rc* ABC} {watch rc* write} {}}

# --- === *** ###########################
# method cgetall

test iocmd-25.1 {chan configure, cgetall, standard options} -match glob -body {
    set res {}
    proc foo args {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
    set c [chan create {r w} foo]
    note [fconfigure $c]
    close $c
    rename foo {}
    set res
} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {} -profile * -translation {auto *}}}
test iocmd-25.2 {chan configure, cgetall, no options} -match glob -body {
    set res {}
    proc foo args {oninit cget cgetall; onfinal; track; return ""}
    set c [chan create {r w} foo]
    note [fconfigure $c]
    close $c
    rename foo {}
    set res
} -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {} -profile * -translation {auto *}}}
test iocmd-25.3 {chan configure, cgetall, regular result} -match glob -body {
    set res {}
    proc foo args {
	oninit cget cgetall; onfinal; track
	return {-bar foo -snarf x}
    }
    set c [chan create {r w} foo]
    note [fconfigure $c]
    close $c
    rename foo {}
    set res
} -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {} -profile * -translation {auto *} -bar foo -snarf x}}
test iocmd-25.4 {chan configure, cgetall, bad result, list of uneven length} -match glob -body {
    set res {}
    proc foo {args} {
	oninit cget cgetall; onfinal; track
	return "-bar"
    }
    set c [chan create {r w} foo]
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
	note [read $c 10]
	close $c
	notes
    } c]
    rename foo {}
    set res
} -constraints {testchannel thread} -result {{read rc* 4096} {read rc* 4096} snarfsnarf}
test iocmd.tf-23.2 {chan read, bad data return, to much} -match glob -body {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	return [string repeat snarf 1000]
    }
    set c [chan create {r w} foo]
    notes [inthread $c {







|







2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
	note [read $c 10]
	close $c
	notes
    } c]
    rename foo {}
    set res
} -constraints {testchannel thread} -result {{read rc* 4096} {read rc* 4096} snarfsnarf}
test iocmd.tf-23.2 {chan read, bad data return, too much} -match glob -body {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	return [string repeat snarf 1000]
    }
    set c [chan create {r w} foo]
    notes [inthread $c {

Changes to tests/ioTrans.test.

110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
    chan
} -result {wrong # args: should be "chan subcommand ?arg ...?"}
test iortrans-1.1 {chan, unknown method} -returnCodes error -body {
    chan foo
} -match glob -result {unknown or ambiguous subcommand "foo": must be*}

# --- --- --- --------- --------- ---------
# chan push, and method "initalize"

test iortrans-2.0 {chan push, wrong#args, not enough} -returnCodes error -body {
    chan push
} -result {wrong # args: should be "chan push channel cmdprefix"}
test iortrans-2.1 {chan push, wrong#args, too many} -returnCodes error -body {
    chan push a b c
} -result {wrong # args: should be "chan push channel cmdprefix"}







|







110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
    chan
} -result {wrong # args: should be "chan subcommand ?arg ...?"}
test iortrans-1.1 {chan, unknown method} -returnCodes error -body {
    chan foo
} -match glob -result {unknown or ambiguous subcommand "foo": must be*}

# --- --- --- --------- --------- ---------
# chan push, and method "initialize"

test iortrans-2.0 {chan push, wrong#args, not enough} -returnCodes error -body {
    chan push
} -result {wrong # args: should be "chan push channel cmdprefix"}
test iortrans-2.1 {chan push, wrong#args, too many} -returnCodes error -body {
    chan push a b c
} -result {wrong # args: should be "chan push channel cmdprefix"}
629
630
631
632
633
634
635























































636
637
638
639
640
641
642
                if {[string length $result] == 0} {
                    driver finalize $chan
                }
                return $result
            }
        }
    }
























































# Channel read transform that is just the identity - pass all through
    proc idxform {cmd handle args} {
      switch -- $cmd {
        initialize {
            return {initialize finalize read}
        }







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







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
                if {[string length $result] == 0} {
                    driver finalize $chan
                }
                return $result
            }
        }
    }



namespace eval reflector {
    proc initialize {_ chan mode} {
	return {initialize finalize watch read}
    }


    proc finalize {_ chan} {
	foreach id [after info] {
	    after cancel $id
	}
	namespace delete $_
    }


    proc read {_ chan count} {
	namespace upvar $_ source source
	set res [string range $source 0 $count-1]
	set source [string range $source $count end]
	return $res
    }


    proc watch {_ chan events} {
	after 0 [list chan postevent $chan read]
	return read
    }

    namespace ensemble create -parameters _
    namespace export *
}




namespace eval inputfilter {
    proc initialize {chan mode} {
	return {initialize finalize read}
    }

    proc read {chan buffer} {
	return $buffer
    }

    proc finalize chan {
	namespace delete $chan
    }

    namespace ensemble create
    namespace export *
}



# Channel read transform that is just the identity - pass all through
    proc idxform {cmd handle args} {
      switch -- $cmd {
        initialize {
            return {initialize finalize read}
        }
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
#
## The id numbers refer to the original test without thread forwarding, and
## gaps due to tests not applicable to forwarding are left to keep this
## association.

# ### ### ### ######### ######### #########
## Helper command. Runs a script in a separate thread and returns the result.
## A channel is transfered into the thread as well, and a list of configuation
## variables

proc inthread {chan script args} {
    # Test thread.
    set tid [thread::create -preserved]
    thread::send $tid {load {} Tcltest}








|







1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
#
## The id numbers refer to the original test without thread forwarding, and
## gaps due to tests not applicable to forwarding are left to keep this
## association.

# ### ### ### ######### ######### #########
## Helper command. Runs a script in a separate thread and returns the result.
## A channel is transferred into the thread as well, and a list of configuration
## variables

proc inthread {chan script args} {
    # Test thread.
    set tid [thread::create -preserved]
    thread::send $tid {load {} Tcltest}

1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
    set c [chan push [tempchan] foo]
    lappend res {*}[inthread $c {
	# Flush, no writing
	seek $c 2
	# The close flushes again, this modifies the file!
	lappend notes | [close $c] |
	# NOTE: The flush generated by the close is recorded immediately, the
	# other note's here are defered until after the thread is done. This
	# changes the order of the result a bit from the non-threaded case
	# (The first | moves one to the right). This is an artifact of the
	# 'inthread' framework, not of the transformation itself.
	notes
    } c]
    lappend res [tempview]
} -cleanup {







|







2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
    set c [chan push [tempchan] foo]
    lappend res {*}[inthread $c {
	# Flush, no writing
	seek $c 2
	# The close flushes again, this modifies the file!
	lappend notes | [close $c] |
	# NOTE: The flush generated by the close is recorded immediately, the
	# other note's here are deferred until after the thread is done. This
	# changes the order of the result a bit from the non-threaded case
	# (The first | moves one to the right). This is an artifact of the
	# 'inthread' framework, not of the transformation itself.
	notes
    } c]
    lappend res [tempview]
} -cleanup {
2085
2086
2087
2088
2089
2090
2091
2092


2093






























2094
2095
    vwait ::res
    set res
} -cleanup {
    thread::send $tidb tempdone
    thread::release $tidb
} -result {Owner lost}

# ### ### ### ######### ######### #########

































cleanupTests
return







|
>
>

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


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
    vwait ::res
    set res
} -cleanup {
    thread::send $tidb tempdone
    thread::release $tidb
} -result {Owner lost}


test iortrans-ea69b0258a9833cb {
    Crash when using a channel transformation on TCP client socket

    "line two" does not make it into result.  This issue should probably be
    addressed, but it is outside the scope of this test.
} -setup {
    set res {}
    set read 0
} -body {
    namespace eval reflector1 {
	variable source "line one\nline two"
	interp alias {} [namespace current]::dispatch {} [
	    namespace parent]::reflector [namespace current]
    }
    set chan [chan create read [namespace which reflector1::dispatch]]
    chan configure $chan -blocking 0
    chan push $chan inputfilter
    chan event $chan read [list ::apply [list chan {
	variable res
	variable read
	set gets [gets $chan]
	append res $gets
	incr read
    } [namespace current]] $chan]
    vwait [namespace current]::read
    chan pop $chan
    vwait [namespace current]::read
    return $res
} -cleanup {
    catch {unset read}
    close $chan
} -result {line one}

cleanupTests
return

Changes to tests/iogt.test.

545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
delete/write {} *ignored*}
test iogt-2.3 {basic I/O, mixed trail} {testchannel unix} {
    set fin [open $path(dummy) r]
    set fout [open $path(dummyout) w]
    set trail [list]
    audit_flow trail -attach $fin
    audit_flow trail -attach $fout
    fconfigure $fin -buffersize 20
    fconfigure $fout -buffersize 10
    fcopy $fin $fout
    close $fin
    close $fout
    join $trail \n
} {create/read {} *ignored*
create/write {} *ignored*
query/maxRead {} -1







|
|







545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
delete/write {} *ignored*}
test iogt-2.3 {basic I/O, mixed trail} {testchannel unix} {
    set fin [open $path(dummy) r]
    set fout [open $path(dummyout) w]
    set trail [list]
    audit_flow trail -attach $fin
    audit_flow trail -attach $fout
    fconfigure $fin -buffersize 20 -profile tcl8
    fconfigure $fout -buffersize 10 -profile tcl8
    fcopy $fin $fout
    close $fin
    close $fout
    join $trail \n
} {create/read {} *ignored*
create/write {} *ignored*
query/maxRead {} -1
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
    set f [open $path(dummy) r]
    # contents of dummy = "abcdefghi..."
    read $f 3;		# skip behind "abc"
    constx -attach $f
    # expect to get "xxx" from the transform because of unread "def" input to
    # transform which returns "xxx".
    #
    # Actually the IO layer pre-read the whole file and will read "def"
    # directly from the buffer without bothering to consult the newly stacked
    # transformation. This is wrong.
    read $f 3
} -cleanup {
    close $f
} -result {xxx}
test iogt-6.1 {Push back and up} -constraints {testchannel knownBug} -body {







|







839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
    set f [open $path(dummy) r]
    # contents of dummy = "abcdefghi..."
    read $f 3;		# skip behind "abc"
    constx -attach $f
    # expect to get "xxx" from the transform because of unread "def" input to
    # transform which returns "xxx".
    #
    # Actually the IO layer preread the whole file and will read "def"
    # directly from the buffer without bothering to consult the newly stacked
    # transformation. This is wrong.
    read $f 3
} -cleanup {
    close $f
} -result {xxx}
test iogt-6.1 {Push back and up} -constraints {testchannel knownBug} -body {

Changes to tests/link.test.

65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
    set uchar 161
    set short 8000
    set ushort 40000
    set uint 0xc001babe
    set long 34543
    set ulong 567890
    set float 1.0987654321
    set uwide 357357357357
    concat [testlink get] | $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide
} -result {465 -10.5 1 abcdef 135135 79 161 8000 40000 -1073628482 34543 567890 1.0987653732299805 357357357357 | 0o0721 -10.5 true abcdef 135135 79 161 8000 40000 0xc001babe 34543 567890 1.0987654321 357357357357}
test link-2.2 {writing bad values into variables} -setup {
    testlink delete
} -constraints {testlink} -body {
    testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
    list [catch {set int 09a} msg] $msg $int
} -result {1 {can't set "int": variable must have integer value} 43}







|

|







65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
    set uchar 161
    set short 8000
    set ushort 40000
    set uint 0xc001babe
    set long 34543
    set ulong 567890
    set float 1.0987654321
    set uwide 12345678901234567890
    concat [testlink get] | $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide
} -result {465 -10.5 1 abcdef 135135 79 161 8000 40000 -1073628482 34543 567890 1.0987653732299805 12345678901234567890 | 0o0721 -10.5 true abcdef 135135 79 161 8000 40000 0xc001babe 34543 567890 1.0987654321 12345678901234567890}
test link-2.2 {writing bad values into variables} -setup {
    testlink delete
} -constraints {testlink} -body {
    testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
    list [catch {set int 09a} msg] $msg $int
} -result {1 {can't set "int": variable must have integer value} 43}
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
    proc x args {
	global x int real bool string wide
	lappend x $args $int $real $bool $string $wide
    }
    set x {}
    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
    testlink set 14 -2.0 0 xyzzy 995511 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
    trace var int w x
    testlink update 32 4.0 3 abcd 113355 65 251 30001 60001 0xbabebeef 12322 32124 3.125 12312312340
    trace vdelete int w x
    return $x
} {{int {} w} 32 -2.0 0 xyzzy 995511}
test link-8.2 {Tcl_UpdateLinkedVar procedure} {testlink} {
    proc x args {
	global x int real bool string wide
	lappend x $args $int $real $bool $string $wide
    }
    set x {}
    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
    testlink set 14 -2.0 0 xyzzy 995511 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
    testlink delete
    trace var int w x
    testlink update 32 4.0 6 abcd 113355 65 251 30001 60001 0xbabebeef 12322 32124 3.125 12312312340
    trace vdelete int w x
    return $x
} {}
test link-8.3 {Tcl_UpdateLinkedVar procedure, read-only variable} {testlink} {
    testlink create 0 0 0 0 0 0 0 0 0 0 0 0 0 0
    list [catch {
	testlink update 47 {} {} {} {} {} {} {} {} {} {} {} {} {}
    } msg] $msg $int







|

|

|









|

|







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
    proc x args {
	global x int real bool string wide
	lappend x $args $int $real $bool $string $wide
    }
    set x {}
    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
    testlink set 14 -2.0 0 xyzzy 995511 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
    trace add var int write x
    testlink update 32 4.0 3 abcd 113355 65 251 30001 60001 0xbabebeef 12322 32124 3.125 12312312340
    trace remove var int write x
    return $x
} {{int {} write} 32 -2.0 0 xyzzy 995511}
test link-8.2 {Tcl_UpdateLinkedVar procedure} {testlink} {
    proc x args {
	global x int real bool string wide
	lappend x $args $int $real $bool $string $wide
    }
    set x {}
    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
    testlink set 14 -2.0 0 xyzzy 995511 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
    testlink delete
    trace add var int write x
    testlink update 32 4.0 6 abcd 113355 65 251 30001 60001 0xbabebeef 12322 32124 3.125 12312312340
    trace remove var int write x
    return $x
} {}
test link-8.3 {Tcl_UpdateLinkedVar procedure, read-only variable} {testlink} {
    testlink create 0 0 0 0 0 0 0 0 0 0 0 0 0 0
    list [catch {
	testlink update 47 {} {} {} {} {} {} {} {} {} {} {} {} {}
    } msg] $msg $int

Changes to tests/listObj.test.

18
19
20
21
22
23
24



25
26
27
28
29
30
31

::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testobj [llength [info commands testobj]]
testConstraint memory [llength [info commands memory]]




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

test listobj-2.1 {Tcl_SetListObj, use in lappend} {







>
>
>







18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34

::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testobj [llength [info commands testobj]]
testConstraint memory [llength [info commands memory]]

set INT_MAX 0x7fffffff; # Assumes sizeof(int) == 4
set SIZE_MAX [expr {(1 << (8*$::tcl_platform(pointerSize) - 1)) - 1}]

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

test listobj-2.1 {Tcl_SetListObj, use in lappend} {
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
    testlistobj get 1
} {f c d e}
test listobj-10.3 {Tcl_ListObjReplace with negative count value} testobj {
    testlistobj set 1 a b c d e
    testlistobj replace 1 1 -1 f
    testlistobj get 1
} {a f b c d e}
test listobj-10.4 {Tcl_ListObjReplace with UINT_MAX-1 count value} testobj {
    testlistobj set 1 a b c d e
    testlistobj replace 1 1 0xFFFFFFFE f
    testlistobj get 1
} {a f}
test listobj-10.5 {Tcl_ListObjReplace with SIZE_MAX-1 count value} testobj {
    testlistobj set 1 a b c d e
    testlistobj replace 1 1 -2 f
    testlistobj get 1
} {a f}

test listobj-11.1 {Bug 3598580: Tcl_ListObjReplace refcount management} testobj {
    testobj bug3598580
} 123








|

|




|







205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
    testlistobj get 1
} {f c d e}
test listobj-10.3 {Tcl_ListObjReplace with negative count value} testobj {
    testlistobj set 1 a b c d e
    testlistobj replace 1 1 -1 f
    testlistobj get 1
} {a f b c d e}
test listobj-10.4 {Tcl_ListObjReplace with $SIZE_MAX count value} testobj {
    testlistobj set 1 a b c d e
    testlistobj replace 1 1 $SIZE_MAX f
    testlistobj get 1
} {a f}
test listobj-10.5 {Tcl_ListObjReplace with SIZE_MAX-1 count value} testobj {
    testlistobj set 1 a b c d e
    testlistobj replace 1 1 [expr {$SIZE_MAX -1}] f
    testlistobj get 1
} {a f}

test listobj-11.1 {Bug 3598580: Tcl_ListObjReplace refcount management} testobj {
    testobj bug3598580
} 123

Changes to tests/listRep.test.

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
test listrep-1.2 {
    Inserts at back of unshared list with no free space should allocate all
    space at back -- linsert version
} -constraints testlistrep -body {
    set l [linsert [freeSpaceNone] $end 99]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 6 7 99} 0 9]

test listrep-1.2.1 {
    Inserts at back of unshared list with no free space should allocate all
    space at back -- lset version
} -constraints testlistrep -body {
    set l [freeSpaceNone]
    lset l $end+1 99
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 6 7 99} 0 9]

test listrep-1.2.2 {
    Inserts at back of unshared list with no free space should allocate all
    space at back -- lappend version
} -constraints testlistrep -body {
    set l [freeSpaceNone]
    lappend l 99
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 6 7 99} 0 9]

test listrep-1.3 {
    Inserts in middle of unshared list with no free space should reallocate with
    equal free space at front and back - linsert version
} -constraints testlistrep -body {
    set l [linsert [freeSpaceNone] $four 99]
    validate $l







|









|









|







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
test listrep-1.2 {
    Inserts at back of unshared list with no free space should allocate all
    space at back -- linsert version
} -constraints testlistrep -body {
    set l [linsert [freeSpaceNone] $end 99]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 6 7 99} 0 4]

test listrep-1.2.1 {
    Inserts at back of unshared list with no free space should allocate all
    space at back -- lset version
} -constraints testlistrep -body {
    set l [freeSpaceNone]
    lset l $end+1 99
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 6 7 99} 0 4]

test listrep-1.2.2 {
    Inserts at back of unshared list with no free space should allocate all
    space at back -- lappend version
} -constraints testlistrep -body {
    set l [freeSpaceNone]
    lappend l 99
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 6 7 99} 0 4]

test listrep-1.3 {
    Inserts in middle of unshared list with no free space should reallocate with
    equal free space at front and back - linsert version
} -constraints testlistrep -body {
    set l [linsert [freeSpaceNone] $four 99]
    validate $l
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
} -body {
    lrange {    1 2   3 4   } $zero $end
} -result {1 2 3 4}

test listrep-1.11 {
    Append elements to large unshared list is optimized as lappend
    so no free space in front - lreplace version
} -body {
    # Note $end, not end else byte code compiler short-cuts
    set l [lreplace [freeSpaceNone 1000] $end+1 $end+1 1000]
    validate $l
    list $l [leadSpace $l] [expr {[tailSpace $l] > 0}] [hasSpan $l]
} -result [list [irange 0 1000] 0 1 0]

test listrep-1.11.1 {
    Append elements to large unshared list is optimized as lappend
    so no free space in front - linsert version
} -body {
    # Note $end, not end else byte code compiler short-cuts
    set l [linsert [freeSpaceNone 1000] $end+1 1000]
    validate $l
    list $l [leadSpace $l] [expr {[tailSpace $l] > 0}] [hasSpan $l]
} -result [list [irange 0 1000] 0 1 0]

test listrep-1.11.2 {
    Append elements to large unshared list leaves no free space in front
    - lappend version
} -body {
    # Note $end, not end else byte code compiler short-cuts
    set l [freeSpaceNone 1000]
    lappend l 1000 1001
    validate $l
    list $l [leadSpace $l] [expr {[tailSpace $l] > 0}] [hasSpan $l]
} -result [list [irange 0 1001] 0 1 0]


test listrep-1.12 {
    Replacement of elements at front with same number elements in unshared list
    is in-place - lreplace version
} -body {
    set l [lreplace [freeSpaceNone] $zero $one 10 11]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {10 11 2 3 4 5 6 7} 0 0]

test listrep-1.12.1 {
    Replacement of elements at front with same number elements in unshared list
    is in-place - lset version
} -body {
    set l [freeSpaceNone]
    lset l 0 -1
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {-1 1 2 3 4 5 6 7} 0 0]

test listrep-1.13 {
    Replacement of elements at front with fewer elements in unshared list
    results in a spanned list with space only in front
} -body {
    set l [lreplace [freeSpaceNone] $zero $four 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {10 5 6 7} 4 0]

test listrep-1.14 {
    Replacement of elements at front with more elements in unshared list
    results in a reallocated spanned list with space at front and back
} -body {
    set l [lreplace [freeSpaceNone] $zero $one 10 11 12]
    validate $l
    list $l [spaceEqual $l]
} -result [list {10 11 12 2 3 4 5 6 7} 1]

test listrep-1.15 {
    Replacement of elements in middle with same number elements in unshared list
    is in-place - lreplace version
} -body {
    set l [lreplace [freeSpaceNone] $one $two 10 11]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 10 11 3 4 5 6 7} 0 0]

test listrep-1.15.1 {
    Replacement of elements in middle with same number elements in unshared list
    is in-place - lset version
} -body {
    set l [freeSpaceNone]
    lset l $two -1
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 -1 3 4 5 6 7} 0 0]

test listrep-1.16 {
    Replacement of elements in front half with fewer elements in unshared list
    results in a spanned list with space only in front since smaller segment moved
} -body {
    set l [lreplace [freeSpaceNone] $one $four 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 10 5 6 7} 3 0]

test listrep-1.17 {
    Replacement of elements in back half with fewer elements in unshared list
    results in a spanned list with space only at back
} -body {
    set l [lreplace [freeSpaceNone] end-$four end-$one 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 10 7} 0 3]

test listrep-1.18 {
    Replacement of elements in middle more elements in unshared list
    results in a reallocated spanned list with space at front and back
} -body {
    set l [lreplace [freeSpaceNone] $one $two 10 11 12]
    validate $l
    list $l [spaceEqual $l]
} -result [list {0 10 11 12 3 4 5 6 7} 1]

test listrep-1.19 {
    Replacement of elements at back with same number elements in unshared list
    is in-place - lreplace version
} -body {
    set l [lreplace [freeSpaceNone] $end-1 $end 10 11]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 10 11} 0 0]

test listrep-1.19.1 {
    Replacement of elements at back with same number elements in unshared list
    is in-place - lset version
} -body {
    set l [freeSpaceNone]
    lset l $end 10
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 6 10} 0 0]

test listrep-1.20 {
    Replacement of elements at back with fewer elements in unshared list
    is in-place with space only at the back
} -body {
    set l [lreplace [freeSpaceNone] $end-2 $end 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 10} 0 2]

test listrep-1.21 {
    Replacement of elements at back with more elements in unshared list
    allocates new representation with equal space at front and back
} -body {
    set l [lreplace [freeSpaceNone] $end-1 $end 10 11 12]
    validate $l
    list $l [spaceEqual $l]
} -result [list {0 1 2 3 4 5 10 11 12} 1]

#
# listrep-2.* tests all operate on shared list reps with no free space. Note the







|









|









|











|








|









|








|








|








|









|








|








|








|








|









|








|







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
} -body {
    lrange {    1 2   3 4   } $zero $end
} -result {1 2 3 4}

test listrep-1.11 {
    Append elements to large unshared list is optimized as lappend
    so no free space in front - lreplace version
} -constraints testlistrep -body {
    # Note $end, not end else byte code compiler short-cuts
    set l [lreplace [freeSpaceNone 1000] $end+1 $end+1 1000]
    validate $l
    list $l [leadSpace $l] [expr {[tailSpace $l] > 0}] [hasSpan $l]
} -result [list [irange 0 1000] 0 1 0]

test listrep-1.11.1 {
    Append elements to large unshared list is optimized as lappend
    so no free space in front - linsert version
} -constraints testlistrep -body {
    # Note $end, not end else byte code compiler short-cuts
    set l [linsert [freeSpaceNone 1000] $end+1 1000]
    validate $l
    list $l [leadSpace $l] [expr {[tailSpace $l] > 0}] [hasSpan $l]
} -result [list [irange 0 1000] 0 1 0]

test listrep-1.11.2 {
    Append elements to large unshared list leaves no free space in front
    - lappend version
} -constraints testlistrep -body {
    # Note $end, not end else byte code compiler short-cuts
    set l [freeSpaceNone 1000]
    lappend l 1000 1001
    validate $l
    list $l [leadSpace $l] [expr {[tailSpace $l] > 0}] [hasSpan $l]
} -result [list [irange 0 1001] 0 1 0]


test listrep-1.12 {
    Replacement of elements at front with same number elements in unshared list
    is in-place - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceNone] $zero $one 10 11]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {10 11 2 3 4 5 6 7} 0 0]

test listrep-1.12.1 {
    Replacement of elements at front with same number elements in unshared list
    is in-place - lset version
} -constraints testlistrep -body {
    set l [freeSpaceNone]
    lset l 0 -1
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {-1 1 2 3 4 5 6 7} 0 0]

test listrep-1.13 {
    Replacement of elements at front with fewer elements in unshared list
    results in a spanned list with space only in front
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceNone] $zero $four 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {10 5 6 7} 4 0]

test listrep-1.14 {
    Replacement of elements at front with more elements in unshared list
    results in a reallocated spanned list with space at front and back
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceNone] $zero $one 10 11 12]
    validate $l
    list $l [spaceEqual $l]
} -result [list {10 11 12 2 3 4 5 6 7} 1]

test listrep-1.15 {
    Replacement of elements in middle with same number elements in unshared list
    is in-place - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceNone] $one $two 10 11]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 10 11 3 4 5 6 7} 0 0]

test listrep-1.15.1 {
    Replacement of elements in middle with same number elements in unshared list
    is in-place - lset version
} -constraints testlistrep -body {
    set l [freeSpaceNone]
    lset l $two -1
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 -1 3 4 5 6 7} 0 0]

test listrep-1.16 {
    Replacement of elements in front half with fewer elements in unshared list
    results in a spanned list with space only in front since smaller segment moved
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceNone] $one $four 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 10 5 6 7} 3 0]

test listrep-1.17 {
    Replacement of elements in back half with fewer elements in unshared list
    results in a spanned list with space only at back
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceNone] end-$four end-$one 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 10 7} 0 3]

test listrep-1.18 {
    Replacement of elements in middle more elements in unshared list
    results in a reallocated spanned list with space at front and back
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceNone] $one $two 10 11 12]
    validate $l
    list $l [spaceEqual $l]
} -result [list {0 10 11 12 3 4 5 6 7} 1]

test listrep-1.19 {
    Replacement of elements at back with same number elements in unshared list
    is in-place - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceNone] $end-1 $end 10 11]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 10 11} 0 0]

test listrep-1.19.1 {
    Replacement of elements at back with same number elements in unshared list
    is in-place - lset version
} -constraints testlistrep -body {
    set l [freeSpaceNone]
    lset l $end 10
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 6 10} 0 0]

test listrep-1.20 {
    Replacement of elements at back with fewer elements in unshared list
    is in-place with space only at the back
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceNone] $end-2 $end 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 10} 0 2]

test listrep-1.21 {
    Replacement of elements at back with more elements in unshared list
    allocates new representation with equal space at front and back
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceNone] $end-1 $end 10 11 12]
    validate $l
    list $l [spaceEqual $l]
} -result [list {0 1 2 3 4 5 10 11 12} 1]

#
# listrep-2.* tests all operate on shared list reps with no free space. Note the
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
test listrep-3.3 {
    Inserts in front of unshared spanned list with insufficient total freespace
    should reallocate with equal free space - linsert version
} -constraints testlistrep -body {
    set l [linsert [freeSpaceBoth 8 1 1] $zero -3 -2 -1]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list [irange -3 7] 6 5 1]

test listrep-3.3.1 {
    Inserts in front of unshared spanned list with insufficient total freespace
    should reallocate with equal free space - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth 8 1 1] $zero -1 -3 -2 -1]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list [irange -3 7] 6 5 1]

test listrep-3.4 {
    Inserts at back of unshared spanned list with room at back should not
    reallocate - linsert version
} -constraints testlistrep -body {
    set l [linsert [freeSpaceBoth] $end 8]
    validate $l







|








|







1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
test listrep-3.3 {
    Inserts in front of unshared spanned list with insufficient total freespace
    should reallocate with equal free space - linsert version
} -constraints testlistrep -body {
    set l [linsert [freeSpaceBoth 8 1 1] $zero -3 -2 -1]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list [irange -3 7] 3 2 1]

test listrep-3.3.1 {
    Inserts in front of unshared spanned list with insufficient total freespace
    should reallocate with equal free space - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth 8 1 1] $zero -1 -3 -2 -1]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list [irange -3 7] 3 2 1]

test listrep-3.4 {
    Inserts at back of unshared spanned list with room at back should not
    reallocate - linsert version
} -constraints testlistrep -body {
    set l [linsert [freeSpaceBoth] $end 8]
    validate $l
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
    Inserts in back of unshared spanned list with insufficient total freespace
    should reallocate with all *additional* space at back. Note this differs
    from the insert in front case because here we realloc(). - linsert version
} -constraints testlistrep -body {
    set l [linsert [freeSpaceBoth 8 1 1] $end 8 9 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list [irange 0 10] 1 10 1]

test listrep-3.6.1 {
    Inserts in back of unshared spanned list with insufficient total freespace
    should reallocate with all *additional* space at back. Note this differs
    from the insert in front case because here we realloc() - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth 8 1 1] $end+1 $end+1 8 9 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list [irange 0 10] 1 10 1]

test listrep-3.6.2 {
    Inserts in back of unshared spanned list with insufficient total freespace
    should reallocate with all *additional* space at back. Note this differs
    from the insert in front case because here we realloc() - lappend version
} -constraints testlistrep -body {
    set l [freeSpaceBoth 8 1 1]
    lappend l 8 9 10
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list [irange 0 10] 1 10 1]

test listrep-3.6.3 {
    Inserts in back of unshared spanned list with insufficient total freespace
    should reallocate with all *additional* space at back. Note this differs
    from the insert in front case because here we realloc() - lset version
} -constraints testlistrep -body {
    set l [freeSpaceNone]
    lset l $end+1 8
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list [irange 0 8] 0 9 1]

test listrep-3.7 {
    Inserts in front half of unshared spanned list with room in front should not
    reallocate and should move front segment
} -constraints testlistrep -body {
    set l [linsert [freeSpaceBoth] $one -2 -1]
    validate $l







|









|










|










|







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
    Inserts in back of unshared spanned list with insufficient total freespace
    should reallocate with all *additional* space at back. Note this differs
    from the insert in front case because here we realloc(). - linsert version
} -constraints testlistrep -body {
    set l [linsert [freeSpaceBoth 8 1 1] $end 8 9 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list [irange 0 10] 1 4 1]

test listrep-3.6.1 {
    Inserts in back of unshared spanned list with insufficient total freespace
    should reallocate with all *additional* space at back. Note this differs
    from the insert in front case because here we realloc() - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth 8 1 1] $end+1 $end+1 8 9 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list [irange 0 10] 1 4 1]

test listrep-3.6.2 {
    Inserts in back of unshared spanned list with insufficient total freespace
    should reallocate with all *additional* space at back. Note this differs
    from the insert in front case because here we realloc() - lappend version
} -constraints testlistrep -body {
    set l [freeSpaceBoth 8 1 1]
    lappend l 8 9 10
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list [irange 0 10] 1 4 1]

test listrep-3.6.3 {
    Inserts in back of unshared spanned list with insufficient total freespace
    should reallocate with all *additional* space at back. Note this differs
    from the insert in front case because here we realloc() - lset version
} -constraints testlistrep -body {
    set l [freeSpaceNone]
    lset l $end+1 8
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list [irange 0 8] 0 4 1]

test listrep-3.7 {
    Inserts in front half of unshared spanned list with room in front should not
    reallocate and should move front segment
} -constraints testlistrep -body {
    set l [linsert [freeSpaceBoth] $one -2 -1]
    validate $l
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
test listrep-3.10 {
    Inserts in front half of unshared spanned list with insufficient total space.
    Note use of realloc() means new space will be at the back - linsert version
} -constraints testlistrep -body {
    set l [linsert [freeSpaceBoth 8 1 1] $one -3 -2 -1]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list {0 -3 -2 -1 1 2 3 4 5 6 7} 1 10 1]

test listrep-3.10.1 {
    Inserts in front half of unshared spanned list with insufficient total space.
    Note use of realloc() means new space will be at the back - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth 8 1 1] $one -1 -3 -2 -1]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list {0 -3 -2 -1 1 2 3 4 5 6 7} 1 10 1]

test listrep-3.11 {
    Inserts in back half of unshared spanned list with room in back should not
    reallocate and should move back segment - linsert version
} -constraints testlistrep -body {
    set l [linsert [freeSpaceBoth] $end-$one 8 9]
    validate $l







|








|







1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
test listrep-3.10 {
    Inserts in front half of unshared spanned list with insufficient total space.
    Note use of realloc() means new space will be at the back - linsert version
} -constraints testlistrep -body {
    set l [linsert [freeSpaceBoth 8 1 1] $one -3 -2 -1]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list {0 -3 -2 -1 1 2 3 4 5 6 7} 1 4 1]

test listrep-3.10.1 {
    Inserts in front half of unshared spanned list with insufficient total space.
    Note use of realloc() means new space will be at the back - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth 8 1 1] $one -1 -3 -2 -1]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list {0 -3 -2 -1 1 2 3 4 5 6 7} 1 4 1]

test listrep-3.11 {
    Inserts in back half of unshared spanned list with room in back should not
    reallocate and should move back segment - linsert version
} -constraints testlistrep -body {
    set l [linsert [freeSpaceBoth] $end-$one 8 9]
    validate $l
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
    Inserts in back half of unshared spanned list with insufficient
    total space. Note use of realloc() means new space will be at the
    back - linsert version
} -constraints testlistrep -body {
    set l [linsert [freeSpaceBoth 8 1 1] $end-$one 8 9 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list {0 1 2 3 4 5 6 8 9 10 7} 1 10 1]

test listrep-3.14.1 {
    Inserts in back half of unshared spanned list with insufficient
    total space. Note use of realloc() means new space will be at the
    back - lrepalce version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth 8 1 1] $end -1 8 9 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list {0 1 2 3 4 5 6 8 9 10 7} 1 10 1]

test listrep-3.15 {
    Deletes from front of small unshared span list results in elements
    moved up front and span removal - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth] $zero $zero]
    validate $l







|









|







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
    Inserts in back half of unshared spanned list with insufficient
    total space. Note use of realloc() means new space will be at the
    back - linsert version
} -constraints testlistrep -body {
    set l [linsert [freeSpaceBoth 8 1 1] $end-$one 8 9 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list {0 1 2 3 4 5 6 8 9 10 7} 1 4 1]

test listrep-3.14.1 {
    Inserts in back half of unshared spanned list with insufficient
    total space. Note use of realloc() means new space will be at the
    back - lrepalce version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth 8 1 1] $end -1 8 9 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list {0 1 2 3 4 5 6 8 9 10 7} 1 4 1]

test listrep-3.15 {
    Deletes from front of small unshared span list results in elements
    moved up front and span removal - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth] $zero $zero]
    validate $l
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
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [hasSpan $l 10 998]
} -result [list [list {*}[irange 0 996] 999] 10 12 1]

test listrep-3.23 {
    Replacement of elements at front with same number elements in unshared
    spanned list is in-place - lreplace version
} -body {
    set l [lreplace [freeSpaceBoth] $zero $one 10 11]
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {10 11 2 3 4 5 6 7} 3 3]

test listrep-3.23.1 {
    Replacement of elements at front with same number elements in unshared
    spanned list is in-place - lset version
} -body {
    set l [freeSpaceBoth]
    lset l $zero 10
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {10 1 2 3 4 5 6 7} 3 3]

test listrep-3.24 {
    Replacement of elements at front with fewer elements in unshared
    spanned list expands leading space - lreplace version
} -body {
    set l [lreplace [freeSpaceBoth] $zero $four 10]
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {10 5 6 7} 7 3]

test listrep-3.25 {
    Replacement of elements at front with more elements in unshared
    spanned list with sufficient leading space shrinks leading space
} -body {
    set l [lreplace [freeSpaceBoth] $zero $one 10 11 12]
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {10 11 12 2 3 4 5 6 7} 2 3]

test listrep-3.26 {
    Replacement of elements at front with more elements in unshared
    spanned list with insufficient leading space but sufficient total







|







|








|







|







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
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [hasSpan $l 10 998]
} -result [list [list {*}[irange 0 996] 999] 10 12 1]

test listrep-3.23 {
    Replacement of elements at front with same number elements in unshared
    spanned list is in-place - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth] $zero $one 10 11]
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {10 11 2 3 4 5 6 7} 3 3]

test listrep-3.23.1 {
    Replacement of elements at front with same number elements in unshared
    spanned list is in-place - lset version
} -constraints testlistrep -body {
    set l [freeSpaceBoth]
    lset l $zero 10
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {10 1 2 3 4 5 6 7} 3 3]

test listrep-3.24 {
    Replacement of elements at front with fewer elements in unshared
    spanned list expands leading space - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth] $zero $four 10]
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {10 5 6 7} 7 3]

test listrep-3.25 {
    Replacement of elements at front with more elements in unshared
    spanned list with sufficient leading space shrinks leading space
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth] $zero $one 10 11 12]
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {10 11 12 2 3 4 5 6 7} 2 3]

test listrep-3.26 {
    Replacement of elements at front with more elements in unshared
    spanned list with insufficient leading space but sufficient total
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
test listrep-3.27 {
    Replacement of elements at front in unshared spanned list with insufficient
    total freespace should reallocate with equal free space
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth 8 1 1] $zero $one 10 11 12 13 14]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list {10 11 12 13 14 2 3 4 5 6 7} 6 5 1]

test listrep-3.28 {
    Replacement of elements at back with same number of elements in unshared
    spanned list is in-place - lreplace version
} -body {
    set l [lreplace [freeSpaceBoth] $end-1 $end 10 11]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 10 11} 3 3]

test listrep-3.28.1 {
    Replacement of elements at back with same number of elements in unshared
    spanned list is in-place - lset version
} -body {
    set l [freeSpaceBoth]
    lset l $end 10
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 6 10} 3 3]

test listrep-3.29 {
    Replacement of elements at back with fewer elements in unshared
    spanned list expands tail space
} -body {
    set l [lreplace [freeSpaceBoth] $end-2 $end 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 10} 3 5]

test listrep-3.30 {
    Replacement of elements at back with more elements in unshared
    spanned list with sufficient tail space shrinks tailspace
} -body {
    set l [lreplace [freeSpaceBoth] $end-1 $end 10 11 12]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 10 11 12} 3 2]

test listrep-3.31 {
    Replacement of elements at back with more elements in unshared spanned list
    with insufficient tail space but enough total free space moves up the span
} -body {
    set l [lreplace [freeSpaceBoth 8 2 2] $end-1 $end 10 11 12 13 14]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 10 11 12 13 14} 0 1]

test listrep-3.32 {
    Replacement of elements at back with more elements in unshared spanned list
    with insufficient total space reallocates with more room in the tail because
    of realloc()
} -body {
    set l [lreplace [freeSpaceBoth 8 1 1] $end-1 $end 10 11 12 13 14]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 10 11 12 13 14} 1 10]

test listrep-3.33 {
    Replacement of elements in the middle in an unshared spanned list with
    the same number of elements - lreplace version
} -body {
    set l [lreplace [freeSpaceBoth] $two $four 10 11 12]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 10 11 12 5 6 7} 3 3]

test listrep-3.33.1 {
    Replacement of elements in the middle in an unshared spanned list with
    the same number of elements - lset version
} -body {
    set l [freeSpaceBoth]
    lset l $two 10
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 10 3 4 5 6 7} 3 3]

test listrep-3.34 {
    Replacement of elements in an unshared spanned list with fewer elements
    in the front half moves the front (smaller) segment
} -body {
    set l [lreplace [freeSpaceBoth] $two $four 10 11]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 10 11 5 6 7} 4 3]

test listrep-3.35 {
    Replacement of elements in an unshared spanned list with fewer elements
    in the back half moves the tail (smaller) segment
} -body {
    set l [lreplace [freeSpaceBoth] $end-2 $end-1 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 10 7} 3 4]

test listrep-3.36 {
    Replacement of elements in an unshared spanned list with more elements
    when both front and back have room should move the smaller segment
    (front case)
} -body {
    set l [lreplace [freeSpaceBoth] $one $two 8 9 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 8 9 10 3 4 5 6 7} 2 3]

test listrep-3.37 {
    Replacement of elements in an unshared spanned list with more elements
    when both front and back have room should move the smaller segment
    (back case)
} -body {
    set l [lreplace [freeSpaceBoth] $end-2 $end-1 8 9 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 8 9 10 7} 3 2]

test listrep-3.38 {
    Replacement of elements in an unshared spanned list with more elements
    when only front has room
} -body {
    set l [lreplace [freeSpaceBoth 8 3 1] $end-1 $end-1 8 9 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 8 9 10 7} 1 1]

test listrep-3.39 {
    Replacement of elements in an unshared spanned list with more elements
    when only back has room
} -body {
    set l [lreplace [freeSpaceBoth 8 1 3] $one $one 8 9 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 8 9 10 2 3 4 5 6 7} 1 1]

test listrep-3.40 {
    Replacement of elements in an unshared spanned list with more elements
    when neither send has enough room by itself
} -body {
    set l [lreplace [freeSpaceBoth] $one $one 8 9 10 11 12]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 8 9 10 11 12 2 3 4 5 6 7} 1 1]

test listrep-3.41 {
    Replacement of elements in an unshared spanned list with more elements
    when there is not enough free space results in new allocation. The back
    end has more space because of realloc()
} -body {
    set l [lreplace [freeSpaceBoth 8 1 1] $one $one 8 9 10 11 12]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 8 9 10 11 12 2 3 4 5 6 7} 1 11]

#
# 4.* - tests on shared spanned lists

test listrep-4.1 {
    Inserts in front of shared spanned list with used elements in lead space
    creates new list rep with more lead than tail space - linsert version







|




|








|









|








|








|









|



|




|








|









|








|









|









|








|








|








|









|



|







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
test listrep-3.27 {
    Replacement of elements at front in unshared spanned list with insufficient
    total freespace should reallocate with equal free space
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth 8 1 1] $zero $one 10 11 12 13 14]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list {10 11 12 13 14 2 3 4 5 6 7} 3 2 1]

test listrep-3.28 {
    Replacement of elements at back with same number of elements in unshared
    spanned list is in-place - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth] $end-1 $end 10 11]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 10 11} 3 3]

test listrep-3.28.1 {
    Replacement of elements at back with same number of elements in unshared
    spanned list is in-place - lset version
} -constraints testlistrep -body {
    set l [freeSpaceBoth]
    lset l $end 10
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 6 10} 3 3]

test listrep-3.29 {
    Replacement of elements at back with fewer elements in unshared
    spanned list expands tail space
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth] $end-2 $end 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 10} 3 5]

test listrep-3.30 {
    Replacement of elements at back with more elements in unshared
    spanned list with sufficient tail space shrinks tailspace
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth] $end-1 $end 10 11 12]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 10 11 12} 3 2]

test listrep-3.31 {
    Replacement of elements at back with more elements in unshared spanned list
    with insufficient tail space but enough total free space moves up the span
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth 8 2 2] $end-1 $end 10 11 12 13 14]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 10 11 12 13 14} 0 1]

test listrep-3.32 {
    Replacement of elements at back with more elements in unshared spanned list
    with insufficient total space reallocates with more room in the tail because
    of realloc()
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth 8 1 1] $end-1 $end 10 11 12 13 14]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 10 11 12 13 14} 1 4]

test listrep-3.33 {
    Replacement of elements in the middle in an unshared spanned list with
    the same number of elements - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth] $two $four 10 11 12]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 10 11 12 5 6 7} 3 3]

test listrep-3.33.1 {
    Replacement of elements in the middle in an unshared spanned list with
    the same number of elements - lset version
} -constraints testlistrep -body {
    set l [freeSpaceBoth]
    lset l $two 10
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 10 3 4 5 6 7} 3 3]

test listrep-3.34 {
    Replacement of elements in an unshared spanned list with fewer elements
    in the front half moves the front (smaller) segment
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth] $two $four 10 11]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 10 11 5 6 7} 4 3]

test listrep-3.35 {
    Replacement of elements in an unshared spanned list with fewer elements
    in the back half moves the tail (smaller) segment
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth] $end-2 $end-1 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 10 7} 3 4]

test listrep-3.36 {
    Replacement of elements in an unshared spanned list with more elements
    when both front and back have room should move the smaller segment
    (front case)
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth] $one $two 8 9 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 8 9 10 3 4 5 6 7} 2 3]

test listrep-3.37 {
    Replacement of elements in an unshared spanned list with more elements
    when both front and back have room should move the smaller segment
    (back case)
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth] $end-2 $end-1 8 9 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 8 9 10 7} 3 2]

test listrep-3.38 {
    Replacement of elements in an unshared spanned list with more elements
    when only front has room
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth 8 3 1] $end-1 $end-1 8 9 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 8 9 10 7} 1 1]

test listrep-3.39 {
    Replacement of elements in an unshared spanned list with more elements
    when only back has room
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth 8 1 3] $one $one 8 9 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 8 9 10 2 3 4 5 6 7} 1 1]

test listrep-3.40 {
    Replacement of elements in an unshared spanned list with more elements
    when neither send has enough room by itself
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth] $one $one 8 9 10 11 12]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 8 9 10 11 12 2 3 4 5 6 7} 1 1]

test listrep-3.41 {
    Replacement of elements in an unshared spanned list with more elements
    when there is not enough free space results in new allocation. The back
    end has more space because of realloc()
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth 8 1 1] $one $one 8 9 10 11 12]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 8 9 10 11 12 2 3 4 5 6 7} 1 5]

#
# 4.* - tests on shared spanned lists

test listrep-4.1 {
    Inserts in front of shared spanned list with used elements in lead space
    creates new list rep with more lead than tail space - linsert version

Changes to tests/lsearch.test.

684
685
686
687
688
689
690



691
692
693
694
695
696
697
} -result 4
test lsearch-28.8 {lsearch -sorted with -stride} -body {
    lsearch -sorted -stride 2 -index 1 -subindices {3 5 8 7 2 9} 9
} -result 5
test lsearch-28.9 {lsearch -sorted with -stride} -body {
    lsearch -sorted -stride 2 -index 1 -subindices -inline {3 5 8 7 2 9} 9
} -result 9





# cleanup
catch {unset res}
catch {unset increasingIntegers}
catch {unset decreasingIntegers}
catch {unset increasingDoubles}







>
>
>







684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
} -result 4
test lsearch-28.8 {lsearch -sorted with -stride} -body {
    lsearch -sorted -stride 2 -index 1 -subindices {3 5 8 7 2 9} 9
} -result 5
test lsearch-28.9 {lsearch -sorted with -stride} -body {
    lsearch -sorted -stride 2 -index 1 -subindices -inline {3 5 8 7 2 9} 9
} -result 9
test lsearch-28.10 {lsearch -sorted with -stride} -body {
    lsearch -sorted -stride 4294967296 -index 1 -subindices -inline {3 5 8 7 2 9} 9
} -returnCodes 1 -result {list size must be a multiple of the stride length}


# cleanup
catch {unset res}
catch {unset increasingIntegers}
catch {unset decreasingIntegers}
catch {unset increasingDoubles}

Changes to tests/lseq.test.

13
14
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
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

testConstraint arithSeriesDouble 1
testConstraint arithSeriesShimmer 1
testConstraint arithSeriesShimmerOk 1




## Arg errors
test lseq-1.1 {error cases} -body {
    lseq
} \
    -returnCodes 1 \
    -result {wrong # args: should be "lseq n ??op? n ??by? n??"}


test lseq-1.2 {step magnitude} {
    lseq 10 .. 1 by -2 ;# or this could be an error - or not
} {10 8 6 4 2}

test lseq-1.3 {synergy between int and double} {
    set rl [lseq 25. to 5. by -5]
    set il [lseq 25  to 5  by -5]
    lmap r $rl i $il { if {$r ne "" && $i ne ""} {expr {int($r) == $i}} else {list $r $i} }


} {1 1 1 1 1}

test lseq-1.4 {integer decreasing} {
    lseq 10 .. 1
} {10 9 8 7 6 5 4 3 2 1}

test lseq-1.5 {integer increasing} {
    lseq 1 .. 10







>
>
>

|











|



>
>
|







13
14
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
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

testConstraint arithSeriesDouble 1
testConstraint arithSeriesShimmer 1
testConstraint arithSeriesShimmerOk 1
testConstraint knownBug 0
testConstraint has64BitLengths [expr {$tcl_platform(pointerSize) == 8}]
testConstraint has32BitLengths [expr {$tcl_platform(pointerSize) == 4}]

# Arg errors
test lseq-1.1 {error cases} -body {
    lseq
} \
    -returnCodes 1 \
    -result {wrong # args: should be "lseq n ??op? n ??by? n??"}


test lseq-1.2 {step magnitude} {
    lseq 10 .. 1 by -2 ;# or this could be an error - or not
} {10 8 6 4 2}

test lseq-1.3 {synergy between int and double} -body {
    set rl [lseq 25. to 5. by -5]
    set il [lseq 25  to 5  by -5]
    lmap r $rl i $il { if {$r ne "" && $i ne ""} {expr {int($r) == $i}} else {list $r $i} }
} -cleanup {
    unset rl il
} -result {1 1 1 1 1}

test lseq-1.4 {integer decreasing} {
    lseq 10 .. 1
} {10 9 8 7 6 5 4 3 2 1}

test lseq-1.5 {integer increasing} {
    lseq 1 .. 10
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
	[lseq -10 1 -3] \
	[lseq 10 -1 -4] \
	[lseq -10 -1 3] \
	[lseq 10 1 -5]

} {{-10 -8 -6 -4 -2} {} {} {10 6 2} {-10 -7 -4 -1} {10 5}}

test lseq-3.1 {experiement} {
    set ans {}
    foreach factor [lseq 2.0 10.0] {
	set start 1
	set end 10
	for {set step 1} {$step < 1e8} {} {
	    set l [lseq $start to $end by $step]
	    if {[llength $l] != 10} {
		lappend ans $factor $step [llength $l] $l
	    }
	    set step [expr {$step * $factor}]
	    set end [expr {$end * $factor}]
	}
    }
    if {$ans eq {}} {
	set ans OK
    }
    unset factor
    unset l
    set ans


} {OK}

test lseq-3.2 {error case} -body {
    lseq foo
} -returnCodes 1 -result {bad operation "foo": must be .., to, count, or by}

test lseq-3.3 {error case} -body {
    lseq 10 foo
} -returnCodes 1 -result {bad operation "foo": must be .., to, count, or by}

test lseq-3.4 {error case} -body {
    lseq 25 or 6
} -returnCodes 1 -result {bad operation "or": must be .., to, count, or by}

test lseq-3.5 {simple count and step arguments} {
    set s [lseq 25 by 6]
    list $s length=[llength $s]


} {{0 6 12 18 24 30 36 42 48 54 60 66 72 78 84 90 96 102 108 114 120 126 132 138 144} length=25}

test lseq-3.6 {error case} -body {
    lseq 1 7 or 3
} -returnCodes 1  -result {bad operation "or": must be .., to, count, or by}

test lseq-3.7 {lmap lseq} {
    lmap x [lseq 5] { expr {$x * $x} }
} {0 1 4 9 16}

test lseq-3.8 {lrange lseq} {
    set r [lrange [lseq 1 100] 10 20]
    set empty [lrange [lseq 1 100] 20 10]
    list $r $empty [lindex [tcl::unsupported::representation $r] 3]


} {{11 12 13 14 15 16 17 18 19 20 21} {} arithseries}

test lseq-3.9 {lassign lseq} arithSeriesShimmer {
    set r [lseq 15]
    set r2 [lassign $r a b]
    list [lindex [tcl::unsupported::representation $r] 3] $a $b \
	[lindex [tcl::unsupported::representation $r2] 3]
} {arithseries 0 1 arithseries}

test lseq-3.10 {lsearch lseq must shimmer?} arithSeriesShimmer {
    set r [lseq 15 0]
    set a [lsearch $r 9]
    list [lindex [tcl::unsupported::representation $r] 3] $a
} {arithseries 6}

test lseq-3.11 {lreverse lseq} {
    set r [lseq 15 0]
    set a [lreverse $r]
    join [list \
	      [lindex [tcl::unsupported::representation $r] 3] \
	      $r \
	      [lindex [tcl::unsupported::representation $a] 3] \
	      $a] \n
} {arithseries
15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0
arithseries
0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15}

test lseq-3.12 {in operator} {
    set r [lseq 9]
    set i [expr {7 in $r}]
    set j [expr {10 ni $r}]
    set k [expr {-1 in $r}]
    set l [expr {4 ni $r}]
    list $i $j $k $l [lindex [tcl::unsupported::representation $r] 3]


} {1 1 0 0 arithseries}

test lseq-3.13 {lmap lseq shimmer} arithSeriesShimmer {
    set r [lseq 15]
    set rep-before [lindex [tcl::unsupported::representation $r] 3]
    set m [lmap i $r { expr {$i * 7} }]
    set rep-after [lindex [tcl::unsupported::representation $r] 3]
    set rep-m [lindex [tcl::unsupported::representation $m] 3]
    list $r ${rep-before} ${rep-after} ${rep-m} $m


} {{0 1 2 3 4 5 6 7 8 9 10 11 12 13 14} arithseries arithseries list {0 7 14 21 28 35 42 49 56 63 70 77 84 91 98}}

test lseq-3.14 {array for shimmer} arithSeriesShimmerOk {
    array set testarray {a Test for This great Function}
    set vars [lseq 2]
    set vars-rep [lindex [tcl::unsupported::representation $vars] 3]
    array for $vars testarray {
	lappend keys $0
	lappend vals $1
    }
    # Since hash order is not guaranteed, have to validate content ignoring order
    set valk [lmap k $keys {expr {$k in {a for great}}}]
    set valv [lmap v $vals {expr {$v in {Test This Function}}}]
    set vars-after [lindex [tcl::unsupported::representation $vars] 3]
    list ${vars-rep} $valk $valv ${vars-after}


} {arithseries {1 1 1} {1 1 1} arithseries}

test lseq-3.15 {join for shimmer} arithSeriesShimmer {
    set r [lseq 3]
    set rep-before [lindex [tcl::unsupported::representation $r] 3]
    set str [join $r :]
    set rep-after [lindex [tcl::unsupported::representation $r] 3]
    list ${rep-before} $str ${rep-after}


} {arithseries 0:1:2 arithseries}

test lseq-3.16 {error case} -body {
    lseq 16 to
} -returnCodes 1 -result {missing "to" value.}

test lseq-3.17 {error case} -body {
    lseq 17 to 13 by







|
















<
<

>
>
|













|


>
>
|





|

|

|



>
>
|

|




|

|



|

|







|




|






>
>
|

|






>
>
|

|












>
>
|

|





>
>
|







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
	[lseq -10 1 -3] \
	[lseq 10 -1 -4] \
	[lseq -10 -1 3] \
	[lseq 10 1 -5]

} {{-10 -8 -6 -4 -2} {} {} {10 6 2} {-10 -7 -4 -1} {10 5}}

test lseq-3.1 {experiement} -body {
    set ans {}
    foreach factor [lseq 2.0 10.0] {
	set start 1
	set end 10
	for {set step 1} {$step < 1e8} {} {
	    set l [lseq $start to $end by $step]
	    if {[llength $l] != 10} {
		lappend ans $factor $step [llength $l] $l
	    }
	    set step [expr {$step * $factor}]
	    set end [expr {$end * $factor}]
	}
    }
    if {$ans eq {}} {
	set ans OK
    }


    set ans
} -cleanup {
    unset ans step end start factor l
} -result {OK}

test lseq-3.2 {error case} -body {
    lseq foo
} -returnCodes 1 -result {bad operation "foo": must be .., to, count, or by}

test lseq-3.3 {error case} -body {
    lseq 10 foo
} -returnCodes 1 -result {bad operation "foo": must be .., to, count, or by}

test lseq-3.4 {error case} -body {
    lseq 25 or 6
} -returnCodes 1 -result {bad operation "or": must be .., to, count, or by}

test lseq-3.5 {simple count and step arguments} -body {
    set s [lseq 25 by 6]
    list $s length=[llength $s]
} -cleanup {
    unset s
} -result {{0 6 12 18 24 30 36 42 48 54 60 66 72 78 84 90 96 102 108 114 120 126 132 138 144} length=25}

test lseq-3.6 {error case} -body {
    lseq 1 7 or 3
} -returnCodes 1  -result {bad operation "or": must be .., to, count, or by}

test lseq-3.7 {lmap lseq} -body {
    lmap x [lseq 5] { expr {$x * $x} }
} -cleanup {unset x} -result {0 1 4 9 16}

test lseq-3.8 {lrange lseq} -body {
    set r [lrange [lseq 1 100] 10 20]
    set empty [lrange [lseq 1 100] 20 10]
    list $r $empty [lindex [tcl::unsupported::representation $r] 3]
} -cleanup {
    unset r empty
} -result {{11 12 13 14 15 16 17 18 19 20 21} {} arithseries}

test lseq-3.9 {lassign lseq} -constraints arithSeriesShimmer -body {
    set r [lseq 15]
    set r2 [lassign $r a b]
    list [lindex [tcl::unsupported::representation $r] 3] $a $b \
	[lindex [tcl::unsupported::representation $r2] 3]
} -cleanup {unset r r2 a b} -result {arithseries 0 1 arithseries}

test lseq-3.10 {lsearch lseq must shimmer?} -constraints arithSeriesShimmer -body {
    set r [lseq 15 0]
    set a [lsearch $r 9]
    list [lindex [tcl::unsupported::representation $r] 3] $a
} -cleanup {unset r a} -result {arithseries 6}

test lseq-3.11 {lreverse lseq} -body {
    set r [lseq 15 0]
    set a [lreverse $r]
    join [list \
	      [lindex [tcl::unsupported::representation $r] 3] \
	      $r \
	      [lindex [tcl::unsupported::representation $a] 3] \
	      $a] \n
} -cleanup {unset r a} -result {arithseries
15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0
arithseries
0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15}

test lseq-3.12 {in operator} -body {
    set r [lseq 9]
    set i [expr {7 in $r}]
    set j [expr {10 ni $r}]
    set k [expr {-1 in $r}]
    set l [expr {4 ni $r}]
    list $i $j $k $l [lindex [tcl::unsupported::representation $r] 3]
} -cleanup {
    unset r i j k l
} -result {1 1 0 0 arithseries}

test lseq-3.13 {lmap lseq shimmer} -constraints arithSeriesShimmer -body {
    set r [lseq 15]
    set rep-before [lindex [tcl::unsupported::representation $r] 3]
    set m [lmap i $r { expr {$i * 7} }]
    set rep-after [lindex [tcl::unsupported::representation $r] 3]
    set rep-m [lindex [tcl::unsupported::representation $m] 3]
    list $r ${rep-before} ${rep-after} ${rep-m} $m
} -cleanup {
    unset r rep-before m rep-after rep-m
} -result {{0 1 2 3 4 5 6 7 8 9 10 11 12 13 14} arithseries arithseries list {0 7 14 21 28 35 42 49 56 63 70 77 84 91 98}}

test lseq-3.14 {array for shimmer} -constraints arithSeriesShimmerOk -body {
    array set testarray {a Test for This great Function}
    set vars [lseq 2]
    set vars-rep [lindex [tcl::unsupported::representation $vars] 3]
    array for $vars testarray {
	lappend keys $0
	lappend vals $1
    }
    # Since hash order is not guaranteed, have to validate content ignoring order
    set valk [lmap k $keys {expr {$k in {a for great}}}]
    set valv [lmap v $vals {expr {$v in {Test This Function}}}]
    set vars-after [lindex [tcl::unsupported::representation $vars] 3]
    list ${vars-rep} $valk $valv ${vars-after}
} -cleanup {
    unset testarray vars vars-rep 0 valk k  valv v vars-after
} -result {arithseries {1 1 1} {1 1 1} arithseries}

test lseq-3.15 {join for shimmer} -constraints arithSeriesShimmer -body {
    set r [lseq 3]
    set rep-before [lindex [tcl::unsupported::representation $r] 3]
    set str [join $r :]
    set rep-after [lindex [tcl::unsupported::representation $r] 3]
    list ${rep-before} $str ${rep-after}
} -cleanup {
    unset r rep-before str rep-after
} -result {arithseries 0:1:2 arithseries}

test lseq-3.16 {error case} -body {
    lseq 16 to
} -returnCodes 1 -result {missing "to" value.}

test lseq-3.17 {error case} -body {
    lseq 17 to 13 by
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
    llength [lseq 1 to 1 1]
} {1}

test lseq-3.25 {edge case} {
    llength [lseq 1 to 1 by 1]
} {1}

test lseq-3.26 {lsort shimmer} arithSeriesShimmer {
    set r [lseq 15 0]
    set rep-before [lindex [tcl::unsupported::representation $r] 3]
    set lexical_sort [lsort $r]
    set rep-after [lindex [tcl::unsupported::representation $r] 3]
    list ${rep-before} $lexical_sort ${rep-after}


} {arithseries {0 1 10 11 12 13 14 15 2 3 4 5 6 7 8 9} arithseries}

test lseq-3.27 {lreplace shimmer} -constraints arithSeriesShimmer -body {
    set r [lseq 15 0]
    set rep-before [lindex [tcl::unsupported::representation $r] 3]
    set lexical_sort [lreplace $r 3 5 A B C]
    set rep-after [lindex [tcl::unsupported::representation $r] 3]
    list ${rep-before} $lexical_sort ${rep-after}
} -cleanup {
    unset r
    unset rep-before
    unset lexical_sort
    unset rep-after
} -result {arithseries {15 14 13 A B C 9 8 7 6 5 4 3 2 1 0} arithseries}

test lseq-3.28 {lreverse bug in ArithSeries} {} {
    set r [lseq -5 17 3]
    set rr [lreverse $r]
    list $r $rr [string equal $r [lreverse $rr]]


} {{-5 -2 1 4 7 10 13 16} {16 13 10 7 4 1 -2 -5} 1}

test lseq-3.29 {edge case: negative count} {
    lseq -15
} {}

test lseq-3.30 {lreverse with double values} arithSeriesDouble {
    set r [lseq 3.5 18.5 1.5]
    set a [lreverse $r]
    join [list \
	      [lindex [tcl::unsupported::representation $r] 3] \
	      $r \
	      [lindex [tcl::unsupported::representation $a] 3] \
	      $a] \n


} {arithseries
3.5 5.0 6.5 8.0 9.5 11.0 12.5 14.0 15.5 17.0 18.5
arithseries
18.5 17.0 15.5 14.0 12.5 11.0 9.5 8.0 6.5 5.0 3.5}

test lseq-3.31 {lreverse inplace with doubles} arithSeriesDouble {
    lreverse [lseq 1.1 29.9 0.3]

} {29.9 29.599999999999998 29.299999999999997 29.0 28.7 28.4 28.099999999999998 27.799999999999997 27.5 27.2 26.9 26.599999999999998 26.299999999999997 26.0 25.7 25.4 25.099999999999998 24.799999999999997 24.5 24.2 23.9 23.599999999999998 23.299999999999997 23.0 22.7 22.4 22.099999999999998 21.799999999999997 21.5 21.2 20.9 20.6 20.299999999999997 20.0 19.7 19.4 19.1 18.799999999999997 18.5 18.2 17.9 17.6 17.299999999999997 17.0 16.7 16.4 16.1 15.799999999999999 15.5 15.2 14.899999999999999 14.6 14.299999999999999 14.0 13.7 13.399999999999999 13.099999999999998 12.8 12.5 12.2 11.899999999999999 11.599999999999998 11.3 11.0 10.7 10.399999999999999 10.099999999999998 9.8 9.5 9.2 8.899999999999999 8.599999999999998 8.3 8.0 7.699999999999999 7.399999999999999 7.099999999999998 6.800000000000001 6.5 6.199999999999999 5.899999999999999 5.599999999999998 5.300000000000001 5.0 4.699999999999999 4.399999999999999 4.099999999999998 3.8000000000000007 3.5 3.1999999999999993 2.8999999999999986 2.599999999999998 2.3000000000000007 2.0 1.6999999999999993 1.3999999999999986 1.1000000000000014}































test lseq-4.1 {end expressions} {
    set start 7
    lseq $start $start+11
} {7 8 9 10 11 12 13 14 15 16 17 18}

test lseq-4.2 {start expressions} {
    set base [clock seconds]
    set tl [lseq $base-60 $base 10]
    lmap t $tl {expr {$t - $base + 60}}
} {0 10 20 30 40 50 60}

##	lseq 1 to 10 by -2
##	# -> lseq: invalid step = -2 with a = 1 and b = 10

test lseq-4.3 {TIP examples} {
    set examples {# Examples from TIP-629
	# --- Begin ---
	lseq 10 .. 1
	# -> 10 9 8 7 6 5 4 3 2 1
	lseq 1 .. 10
	# -> 1 2 3 4 5 6 7 8 9 10
	lseq 10 .. 1 by 2







|





>
>
|














|



>
>
|





|







>
>
|




|

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


|

|



|




|







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
    llength [lseq 1 to 1 1]
} {1}

test lseq-3.25 {edge case} {
    llength [lseq 1 to 1 by 1]
} {1}

test lseq-3.26 {lsort shimmer} -constraints arithSeriesShimmer -body {
    set r [lseq 15 0]
    set rep-before [lindex [tcl::unsupported::representation $r] 3]
    set lexical_sort [lsort $r]
    set rep-after [lindex [tcl::unsupported::representation $r] 3]
    list ${rep-before} $lexical_sort ${rep-after}
} -cleanup {
    unset r rep-before lexical_sort rep-after
} -result {arithseries {0 1 10 11 12 13 14 15 2 3 4 5 6 7 8 9} arithseries}

test lseq-3.27 {lreplace shimmer} -constraints arithSeriesShimmer -body {
    set r [lseq 15 0]
    set rep-before [lindex [tcl::unsupported::representation $r] 3]
    set lexical_sort [lreplace $r 3 5 A B C]
    set rep-after [lindex [tcl::unsupported::representation $r] 3]
    list ${rep-before} $lexical_sort ${rep-after}
} -cleanup {
    unset r
    unset rep-before
    unset lexical_sort
    unset rep-after
} -result {arithseries {15 14 13 A B C 9 8 7 6 5 4 3 2 1 0} arithseries}

test lseq-3.28 {lreverse bug in ArithSeries} -body {
    set r [lseq -5 17 3]
    set rr [lreverse $r]
    list $r $rr [string equal $r [lreverse $rr]]
} -cleanup {
    unset r rr
} -result {{-5 -2 1 4 7 10 13 16} {16 13 10 7 4 1 -2 -5} 1}

test lseq-3.29 {edge case: negative count} {
    lseq -15
} {}

test lseq-3.30 {lreverse with double values} -constraints arithSeriesDouble -body {
    set r [lseq 3.5 18.5 1.5]
    set a [lreverse $r]
    join [list \
	      [lindex [tcl::unsupported::representation $r] 3] \
	      $r \
	      [lindex [tcl::unsupported::representation $a] 3] \
	      $a] \n
} -cleanup {
    unset r a
} -result {arithseries
3.5 5.0 6.5 8.0 9.5 11.0 12.5 14.0 15.5 17.0 18.5
arithseries
18.5 17.0 15.5 14.0 12.5 11.0 9.5 8.0 6.5 5.0 3.5}

test lseq-3.31 {lreverse inplace with doubles} {arithSeriesDouble} {
    lreverse [lseq 1.1 29.9 0.3]
} {29.9 29.6 29.3 29.0 28.7 28.4 28.1 27.8 27.5 27.2 26.9 26.6 26.3 26.0 25.7 25.4 25.1 24.8 24.5 24.2 23.9 23.6 23.3 23.0 22.7 22.4 22.1 21.8 21.5 21.2 20.9 20.6 20.3 20.0 19.7 19.4 19.1 18.8 18.5 18.2 17.9 17.6 17.3 17.0 16.7 16.4 16.1 15.8 15.5 15.2 14.9 14.6 14.3 14.0 13.7 13.4 13.1 12.8 12.5 12.2 11.9 11.6 11.3 11.0 10.7 10.4 10.1 9.8 9.5 9.2 8.9 8.6 8.3 8.0 7.7 7.4 7.1 6.8 6.5 6.2 5.9 5.6 5.3 5.0 4.7 4.4 4.1 3.8 3.5 3.2 2.9 2.6 2.3 2.0 1.7 1.4 1.1}

# lsearch -
#  -- should not shimmer lseq  list
#  -- should not leak lseq elements
test lseq-3.32 {lsearch nested lists of lseq} arithSeriesShimmer {
    set srchlist {}
    for {set i 5} {$i < 25} {incr i} {
	lappend srchlist [lseq $i count 7 by 3]
    }
    set a [lsearch -all -inline -index 1 $srchlist 23]
    set b [lmap i $a {lindex [tcl::unsupported::representation $i] 3}]
    list [lindex [tcl::unsupported::representation $a] 3] $a $b \
        [lindex [tcl::unsupported::representation [lindex $srchlist 15]] 3]
} {list {{20 23 26 29 32 35 38}} arithseries arithseries}


# lsearch -
#  -- should not shimmer lseq  list
#  -- should not leak lseq elements
test lseq-3.32 {lsearch nested lists of lseq} -constraints arithSeriesShimmer -body {
    set srchlist {}
    for {set i 5} {$i < 25} {incr i} {
	lappend srchlist [lseq $i count 7 by 3]
    }
    set a [lsearch -all -inline -index 1 $srchlist 23]
    set b [lmap i $a {lindex [tcl::unsupported::representation $i] 3}]
    list [lindex [tcl::unsupported::representation $a] 3] $a $b \
        [lindex [tcl::unsupported::representation [lindex $srchlist 15]] 3]
} -cleanup {
    unset srchlist i a b
} -result {list {{20 23 26 29 32 35 38}} arithseries arithseries}

test lseq-4.1 {end expressions} -body {
    set start 7
    lseq $start $start+11
} -cleanup {unset start} -result {7 8 9 10 11 12 13 14 15 16 17 18}

test lseq-4.2 {start expressions} -body {
    set base [clock seconds]
    set tl [lseq $base-60 $base 10]
    lmap t $tl {expr {$t - $base + 60}}
} -cleanup {unset base tl t} -result {0 10 20 30 40 50 60}

##	lseq 1 to 10 by -2
##	# -> lseq: invalid step = -2 with a = 1 and b = 10

test lseq-4.3 {TIP examples} -body {
    set examples {# Examples from TIP-629
	# --- Begin ---
	lseq 10 .. 1
	# -> 10 9 8 7 6 5 4 3 2 1
	lseq 1 .. 10
	# -> 1 2 3 4 5 6 7 8 9 10
	lseq 10 .. 1 by 2
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
	lseq 5 5
	# -> 5
	lseq 5 5 2
	# -> 5
	lseq 5 5 -2
	# -> 5
    }

    foreach {cmd expect} [split $examples \n] {
	if {[string trim $cmd] ne ""} {
	    set cmd [string trimleft $cmd]
	    if {[string match {\#*} $cmd]} continue
	    set status [catch $cmd ans]
	    lappend res $ans
	    if {[regexp {\# -> (.*)$} $expect -> expected]} {
		if {$expected ne $ans} {
		    lappend res [list Mismatch: $cmd -> $ans ne $expected]
		}
	    }
	}
    }
    set res


} {{10 9 8 7 6 5 4 3 2 1} {1 2 3 4 5 6 7 8 9 10} {} {10 8 6 4 2} {5.0 6.0 7.0 8.0 9.0 10.0 11.0 12.0 13.0 14.0 15.0} {5.0 10.0 15.0 20.0 25.0} {} {25.0 20.0 15.0 10.0 5.0} {1 3 5 7 9} {25.0 20.0 15.0 10.0 5.0 0.0 -5.0 -10.0 -15.0 -20.0 -25.0} 5 5 5}

#
# Ticket 9933cc4d88697f05976accebd31c1e3ba6efe9c6 - lseq corner case
test lseq-4.4 {lseq corner case} -body {



















    set tcmd {
	set res {}
	set s [catch {lindex [lseq 10 100] 0} e]
	lappend res $s $e
	set s [catch {lindex [lseq 10 9223372036854775000] 0} e]
	lappend res $s $e
	set s [catch {llength [lseq 10 9223372036854775000]} e]
	lappend res $s $e
	set s [catch {lindex [lseq 10 2147483647] 0} e]
	lappend res $s $e
	set s [catch {llength [lseq 10 2147483647]} e]
	lappend res $s $e
    }
    eval $tcmd
} -cleanup {
    unset res
} -result {0 10 0 10 0 9223372036854774991 0 10 0 2147483638}

# Ticket 99e834bf33 - lseq, lindex end off by one

test lseq-4.5 {lindex off by one} -body {
    lappend res [eval {lindex [lseq 1 4] end}]
    lappend res [eval {lindex [lseq 1 4] end-1}]
} -cleanup {







|














>
>
|



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















|
|







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
	lseq 5 5
	# -> 5
	lseq 5 5 2
	# -> 5
	lseq 5 5 -2
	# -> 5
    }
    set res {}
    foreach {cmd expect} [split $examples \n] {
	if {[string trim $cmd] ne ""} {
	    set cmd [string trimleft $cmd]
	    if {[string match {\#*} $cmd]} continue
	    set status [catch $cmd ans]
	    lappend res $ans
	    if {[regexp {\# -> (.*)$} $expect -> expected]} {
		if {$expected ne $ans} {
		    lappend res [list Mismatch: $cmd -> $ans ne $expected]
		}
	    }
	}
    }
    set res
} -cleanup {
    unset res cmd status ans expect expected examples
} -result {{10 9 8 7 6 5 4 3 2 1} {1 2 3 4 5 6 7 8 9 10} {} {10 8 6 4 2} {5.0 6.0 7.0 8.0 9.0 10.0 11.0 12.0 13.0 14.0 15.0} {5.0 10.0 15.0 20.0 25.0} {} {25.0 20.0 15.0 10.0 5.0} {1 3 5 7 9} {25.0 20.0 15.0 10.0 5.0 0.0 -5.0 -10.0 -15.0 -20.0 -25.0} 5 5 5}

#
# Ticket 9933cc4d88697f05976accebd31c1e3ba6efe9c6 - lseq corner case
test lseq-4.4 {lseq corner case} -constraints has64BitLengths -body {
    set tcmd {
	set res {}
	set s [catch {lindex [lseq 10 100] 0} e]
	lappend res $s $e
	set s [catch {lindex [lseq 10 9223372036854775000] 0} e]
	lappend res $s $e
	set s [catch {llength [lseq 10 9223372036854775000]} e]
	lappend res $s $e
	set s [catch {lindex [lseq 10 2147483647] 0} e]
	lappend res $s $e
	set s [catch {llength [lseq 10 2147483647]} e]
	lappend res $s $e
    }
    eval $tcmd
} -cleanup {
    unset res s e tcmd
} -result {0 10 0 10 0 9223372036854774991 0 10 0 2147483638}

test lseq-4.4.32 {lseq corner case} -constraints has32BitLengths -body {
    set tcmd {
	set res {}
	set s [catch {lindex [lseq 10 100] 0} e]
	lappend res $s $e
	set s [catch {lindex [lseq 10 9223372036854775000] 0} e]
	lappend res $s $e
	set s [catch {llength [lseq 10 9223372036854775000]} e]
	lappend res $s $e
	set s [catch {lindex [lseq 10 2147483647] 0} e]
	lappend res $s $e
	set s [catch {llength [lseq 10 2147483647]} e]
	lappend res $s $e
    }
    eval $tcmd
} -cleanup {
    unset res s e tcmd
} -result {0 10 1 {max length of a Tcl list exceeded} 1 {max length of a Tcl list exceeded} 0 10 0 2147483638}

# Ticket 99e834bf33 - lseq, lindex end off by one

test lseq-4.5 {lindex off by one} -body {
    lappend res [eval {lindex [lseq 1 4] end}]
    lappend res [eval {lindex [lseq 1 4] end-1}]
} -cleanup {
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
    set i 4
    set c [lindex $l $i]
    set d [$cmd $l $i]
    set e [lindex [lseq 2 10] $i]
    set f [$cmd [lseq 2 10] $i]
    list $c $d $e $f
} -cleanup {
    unset l
    unset e
} -result [lrepeat 4 6]

test lseq-4.7 {empty list} {
    list [lseq 0] [join [lseq 0] {}] [join [lseq 1] {}]
} {{} {} 0}

test lseq-4.8 {error case lrange} -body {
    lrange [lseq 1 5] fred ginger
} -returnCodes 1 \

    -result {bad index "fred": must be integer?[+-]integer? or end?[+-]integer?}

test lseq-4.9 {error case lrange} -body {
    set fred 7
    set ginger 8
    lrange [lseq 1 10] $fred $ginger
} -result {8 9}

test lseq-4.10 {lset shimmer} -body {
    set l [lseq 15]
    lappend res $l [lindex [tcl::unsupported::representation $l] 3]
    lset l 3 25
    lappend res $l [lindex [tcl::unsupported::representation $l] 3]
} -result {{0 1 2 3 4 5 6 7 8 9 10 11 12 13 14} arithseries {0 1 2 25 4 5 6 7 8 9 10 11 12 13 14} list}


# Panic when using variable value?
test lseq-4.10 {panic using variable index} {
    set i 0
    lindex [lseq 10] $i

} {0}




















































































# cleanup
::tcltest::cleanupTests

return

# Local Variables:
# mode: tcl
# End:







|
<








|
>
|

|
|
|
|
<
|
<
<
<
|
<
<
|


|


>
|
>
>
>

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









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
    set i 4
    set c [lindex $l $i]
    set d [$cmd $l $i]
    set e [lindex [lseq 2 10] $i]
    set f [$cmd [lseq 2 10] $i]
    list $c $d $e $f
} -cleanup {
    unset l cmd i c d e f

} -result [lrepeat 4 6]

test lseq-4.7 {empty list} {
    list [lseq 0] [join [lseq 0] {}] [join [lseq 1] {}]
} {{} {} 0}

test lseq-4.8 {error case lrange} -body {
    lrange [lseq 1 5] fred ginger
} -cleanup {
    unset -nocomplain fred ginger
} -returnCodes 1 -result {bad index "fred": must be integer?[+-]integer? or end?[+-]integer?}

test lseq-4.9 {lrange empty/partial sets} -body {
    set res {}
    foreach {fred ginger} {7 8 4 9 0 15 9 9 4 2} {
        lappend res [lrange [lseq 1 5] $fred $ginger]

    }



    set res


} -cleanup {unset res fred ginger} -result {{} 5 {1 2 3 4 5} {} {}}

# Panic when using variable value?
test lseq-4.10 {panic using variable index} -body {
    set i 0
    lindex [lseq 10] $i
} -cleanup {unset i} -result {0}

test lseq-4.11 {bug lseq / lindex discrepancies} -body {
    lindex [lseq 0x7fffffff] 0x80000000
} -result {}

test lseq-4.12 {bug lseq} -constraints has64BitLengths -body {
    llength [lseq 0x100000000]
} -result {4294967296}

test lseq-4.12.32 {bug lseq} -constraints has32BitLengths -body {
    llength [lseq 0x100000000]
} -returnCodes 1 -result {max length of a Tcl list exceeded}

test lseq-4.13 {bug lseq} -constraints knownBug -body {
    set l [lseq 0x7fffffffffffffff]
    list \
    [llength $l] \
    [lindex $l end] \
        [lindex $l 9223372036854775800]
} -cleanup {unset l} -result {9223372036854775807 9223372036854775806 9223372036854775800}


test lseq-4.14 {bug lseq - inconsistent rounding} {
    # using a non-integer increment, [lseq] rounding seems to be not consistent:
    lseq 4 40 0.1
} {4.0 4.1 4.2 4.3 4.4 4.5 4.6 4.7 4.8 4.9 5.0 5.1 5.2 5.3 5.4 5.5 5.6 5.7 5.8 5.9 6.0 6.1 6.2 6.3 6.4 6.5 6.6 6.7 6.8 6.9 7.0 7.1 7.2 7.3 7.4 7.5 7.6 7.7 7.8 7.9 8.0 8.1 8.2 8.3 8.4 8.5 8.6 8.7 8.8 8.9 9.0 9.1 9.2 9.3 9.4 9.5 9.6 9.7 9.8 9.9 10.0 10.1 10.2 10.3 10.4 10.5 10.6 10.7 10.8 10.9 11.0 11.1 11.2 11.3 11.4 11.5 11.6 11.7 11.8 11.9 12.0 12.1 12.2 12.3 12.4 12.5 12.6 12.7 12.8 12.9 13.0 13.1 13.2 13.3 13.4 13.5 13.6 13.7 13.8 13.9 14.0 14.1 14.2 14.3 14.4 14.5 14.6 14.7 14.8 14.9 15.0 15.1 15.2 15.3 15.4 15.5 15.6 15.7 15.8 15.9 16.0 16.1 16.2 16.3 16.4 16.5 16.6 16.7 16.8 16.9 17.0 17.1 17.2 17.3 17.4 17.5 17.6 17.7 17.8 17.9 18.0 18.1 18.2 18.3 18.4 18.5 18.6 18.7 18.8 18.9 19.0 19.1 19.2 19.3 19.4 19.5 19.6 19.7 19.8 19.9 20.0 20.1 20.2 20.3 20.4 20.5 20.6 20.7 20.8 20.9 21.0 21.1 21.2 21.3 21.4 21.5 21.6 21.7 21.8 21.9 22.0 22.1 22.2 22.3 22.4 22.5 22.6 22.7 22.8 22.9 23.0 23.1 23.2 23.3 23.4 23.5 23.6 23.7 23.8 23.9 24.0 24.1 24.2 24.3 24.4 24.5 24.6 24.7 24.8 24.9 25.0 25.1 25.2 25.3 25.4 25.5 25.6 25.7 25.8 25.9 26.0 26.1 26.2 26.3 26.4 26.5 26.6 26.7 26.8 26.9 27.0 27.1 27.2 27.3 27.4 27.5 27.6 27.7 27.8 27.9 28.0 28.1 28.2 28.3 28.4 28.5 28.6 28.7 28.8 28.9 29.0 29.1 29.2 29.3 29.4 29.5 29.6 29.7 29.8 29.9 30.0 30.1 30.2 30.3 30.4 30.5 30.6 30.7 30.8 30.9 31.0 31.1 31.2 31.3 31.4 31.5 31.6 31.7 31.8 31.9 32.0 32.1 32.2 32.3 32.4 32.5 32.6 32.7 32.8 32.9 33.0 33.1 33.2 33.3 33.4 33.5 33.6 33.7 33.8 33.9 34.0 34.1 34.2 34.3 34.4 34.5 34.6 34.7 34.8 34.9 35.0 35.1 35.2 35.3 35.4 35.5 35.6 35.7 35.8 35.9 36.0 36.1 36.2 36.3 36.4 36.5 36.6 36.7 36.8 36.9 37.0 37.1 37.2 37.3 37.4 37.5 37.6 37.7 37.8 37.9 38.0 38.1 38.2 38.3 38.4 38.5 38.6 38.7 38.8 38.9 39.0 39.1 39.2 39.3 39.4 39.5 39.6 39.7 39.8 39.9 40.0}

test lseq-4.15 {bug lseq - inconsistent rounding} {
    # using a non-integer increment, [lseq] rounding seems to be not consistent:
    lseq 6 40 0.1
} {6.0 6.1 6.2 6.3 6.4 6.5 6.6 6.7 6.8 6.9 7.0 7.1 7.2 7.3 7.4 7.5 7.6 7.7 7.8 7.9 8.0 8.1 8.2 8.3 8.4 8.5 8.6 8.7 8.8 8.9 9.0 9.1 9.2 9.3 9.4 9.5 9.6 9.7 9.8 9.9 10.0 10.1 10.2 10.3 10.4 10.5 10.6 10.7 10.8 10.9 11.0 11.1 11.2 11.3 11.4 11.5 11.6 11.7 11.8 11.9 12.0 12.1 12.2 12.3 12.4 12.5 12.6 12.7 12.8 12.9 13.0 13.1 13.2 13.3 13.4 13.5 13.6 13.7 13.8 13.9 14.0 14.1 14.2 14.3 14.4 14.5 14.6 14.7 14.8 14.9 15.0 15.1 15.2 15.3 15.4 15.5 15.6 15.7 15.8 15.9 16.0 16.1 16.2 16.3 16.4 16.5 16.6 16.7 16.8 16.9 17.0 17.1 17.2 17.3 17.4 17.5 17.6 17.7 17.8 17.9 18.0 18.1 18.2 18.3 18.4 18.5 18.6 18.7 18.8 18.9 19.0 19.1 19.2 19.3 19.4 19.5 19.6 19.7 19.8 19.9 20.0 20.1 20.2 20.3 20.4 20.5 20.6 20.7 20.8 20.9 21.0 21.1 21.2 21.3 21.4 21.5 21.6 21.7 21.8 21.9 22.0 22.1 22.2 22.3 22.4 22.5 22.6 22.7 22.8 22.9 23.0 23.1 23.2 23.3 23.4 23.5 23.6 23.7 23.8 23.9 24.0 24.1 24.2 24.3 24.4 24.5 24.6 24.7 24.8 24.9 25.0 25.1 25.2 25.3 25.4 25.5 25.6 25.7 25.8 25.9 26.0 26.1 26.2 26.3 26.4 26.5 26.6 26.7 26.8 26.9 27.0 27.1 27.2 27.3 27.4 27.5 27.6 27.7 27.8 27.9 28.0 28.1 28.2 28.3 28.4 28.5 28.6 28.7 28.8 28.9 29.0 29.1 29.2 29.3 29.4 29.5 29.6 29.7 29.8 29.9 30.0 30.1 30.2 30.3 30.4 30.5 30.6 30.7 30.8 30.9 31.0 31.1 31.2 31.3 31.4 31.5 31.6 31.7 31.8 31.9 32.0 32.1 32.2 32.3 32.4 32.5 32.6 32.7 32.8 32.9 33.0 33.1 33.2 33.3 33.4 33.5 33.6 33.7 33.8 33.9 34.0 34.1 34.2 34.3 34.4 34.5 34.6 34.7 34.8 34.9 35.0 35.1 35.2 35.3 35.4 35.5 35.6 35.7 35.8 35.9 36.0 36.1 36.2 36.3 36.4 36.5 36.6 36.7 36.8 36.9 37.0 37.1 37.2 37.3 37.4 37.5 37.6 37.7 37.8 37.9 38.0 38.1 38.2 38.3 38.4 38.5 38.6 38.7 38.8 38.9 39.0 39.1 39.2 39.3 39.4 39.5 39.6 39.7 39.8 39.9 40.0}

test lseq-4.16 {bug lseq - inconsistent rounding} {
    # using a non-integer increment, [lseq] rounding seems to be not consistent:
    set res {}
    lappend res [lseq 4.07 6 0.1]
    lappend res [lseq 4.03 4.208 0.013]
} {{4.07 4.17 4.27 4.37 4.47 4.57 4.67 4.77 4.87 4.97 5.07 5.17 5.27 5.37 5.47 5.57 5.67 5.77 5.87 5.97} {4.03 4.043 4.056 4.069 4.082 4.095 4.108 4.121 4.134 4.147 4.16 4.173 4.186 4.199}}

# Test abstract list in a concat
#  -- lseq list should not shimmer
#  -- lseq elements should not leak
test lseq-4.17 {concat shimmer} -body {
    set rng [lseq 8 15 2]
    set pre [list A b C]
    set pst [list x Y z]
    list [concat $pre $rng $pst] \
         [lindex [tcl::unsupported::representation $pre] 3] \
         [lindex [tcl::unsupported::representation $rng] 3] \
         [lindex [tcl::unsupported::representation $pst] 3]
} -cleanup {unset rng pre pst} -result  {{A b C 8 10 12 14 x Y z} list arithseries list}

test lseq-4.18 {concat shimmer} -body {
    set rng [lseq 8 15 2]
    set pre [list A b C]
    set pst [list x Y z]
    list [concat $rng $pre $pst] \
         [lindex [tcl::unsupported::representation $rng] 3] \
         [lindex [tcl::unsupported::representation $pre] 3] \
         [lindex [tcl::unsupported::representation $pst] 3]
} -cleanup {unset rng pre pst} -result {{8 10 12 14 A b C x Y z} arithseries list list}

# Test lseq elements as var names
test lseq-4.19 {varnames} -body {
    set plist {}
    foreach v {auto_execok auto_load auto_qualify} {
	lappend plist proc $v [info args $v] [info body $v]
    }
    set res {}
    set varlist [lseq 1 to 4]
    foreach $varlist $plist {
	lappend res $2 [llength $3]
    }
    lappend res [lindex [tcl::unsupported::representation $varlist] 3]
} -cleanup {
    unset {*}$varlist res varlist v plist
} -result {auto_execok 1 auto_load 2 auto_qualify 2 arithseries}

test lseq-convertToList {does not result in a memory error} -body {
	trace add variable var1 write [list ::apply [list args {
		error {this is an error}
	} [namespace current]]]
	list [catch {set var1 [lindex [lreplace [lseq 1 2] 1 1 hello] 0]} cres] $cres
} -cleanup {unset var1 cres} -result {1 {can't set "var1": this is an error}}

# cleanup
::tcltest::cleanupTests

return

# Local Variables:
# mode: tcl
# End:

Changes to tests/mathop.test.

18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
# A namespace to test that operators are exported and that they
# work when imported
namespace eval ::testmathop2 {
    namespace import ::tcl::mathop::*
}

# Helper to test math ops.
# Test different invokation variants and see that they do the same thing.
# Byte compiled / non byte compiled version
# Shared / unshared arguments
# Original / imported
proc TestOp {op args} {
    set results {}

    # Non byte compiled version, shared args







|







18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
# A namespace to test that operators are exported and that they
# work when imported
namespace eval ::testmathop2 {
    namespace import ::tcl::mathop::*
}

# Helper to test math ops.
# Test different invocation variants and see that they do the same thing.
# Byte compiled / non byte compiled version
# Shared / unshared arguments
# Original / imported
proc TestOp {op args} {
    set results {}

    # Non byte compiled version, shared args

Changes to tests/msgcat.test.

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
    }
    set bgerrorsaved [interp bgerror {}]
    interp bgerror {} [namespace code callbackproc]

    variable locale
    if {![info exist locale]} { set locale [mclocale] }

	test msgcat-14.1 {invokation loadcmd} -setup {
	    mcforgetpackage
    	    mclocale $locale
	    mclocale ""
	    mcloadedlocales clear
	    set resultvariable ""
	} -cleanup {
	    mcforgetpackage
	} -body {
	    mcpackageconfig set loadcmd [namespace code callbackproc]
	    mclocale foo_bar
	    lsort $resultvariable
	} -result {foo foo_bar}

	test msgcat-14.2 {invokation failed in loadcmd} -setup {
	    mcforgetpackage
    	    mclocale $locale
	    mclocale ""
	    mcloadedlocales clear
	} -cleanup {
	    mcforgetpackage
	    after cancel set [namespace current]::resultvariable timeout
	} -body {
	    mcpackageconfig set loadcmd [namespace code callbackfailproc]
	    mclocale foo_bar
	    # let the bgerror run
	    after 100 set [namespace current]::resultvariable timeout
	    vwait [namespace current]::resultvariable
	    lassign $resultvariable err errdict
	    list $err [dict get $errdict -code]
	} -result {fail 1}

	test msgcat-14.3 {invokation changecmd} -setup {
	    mcforgetpackage
    	    mclocale $locale
	    mclocale ""
	    set resultvariable ""
	} -cleanup {
	    mcforgetpackage
	} -body {
	    mcpackageconfig set changecmd [namespace code callbackproc]
	    mclocale foo_bar
	    set resultvariable
	} -result {foo_bar foo {}}

	test msgcat-14.4 {invokation unknowncmd} -setup {
	    mcforgetpackage
    	    mclocale $locale
	    mclocale ""
	    mcloadedlocales clear
	    set resultvariable ""
	} -cleanup {
	    mcforgetpackage







|













|

















|












|







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
    }
    set bgerrorsaved [interp bgerror {}]
    interp bgerror {} [namespace code callbackproc]

    variable locale
    if {![info exist locale]} { set locale [mclocale] }

	test msgcat-14.1 {invocation loadcmd} -setup {
	    mcforgetpackage
    	    mclocale $locale
	    mclocale ""
	    mcloadedlocales clear
	    set resultvariable ""
	} -cleanup {
	    mcforgetpackage
	} -body {
	    mcpackageconfig set loadcmd [namespace code callbackproc]
	    mclocale foo_bar
	    lsort $resultvariable
	} -result {foo foo_bar}

	test msgcat-14.2 {invocation failed in loadcmd} -setup {
	    mcforgetpackage
    	    mclocale $locale
	    mclocale ""
	    mcloadedlocales clear
	} -cleanup {
	    mcforgetpackage
	    after cancel set [namespace current]::resultvariable timeout
	} -body {
	    mcpackageconfig set loadcmd [namespace code callbackfailproc]
	    mclocale foo_bar
	    # let the bgerror run
	    after 100 set [namespace current]::resultvariable timeout
	    vwait [namespace current]::resultvariable
	    lassign $resultvariable err errdict
	    list $err [dict get $errdict -code]
	} -result {fail 1}

	test msgcat-14.3 {invocation changecmd} -setup {
	    mcforgetpackage
    	    mclocale $locale
	    mclocale ""
	    set resultvariable ""
	} -cleanup {
	    mcforgetpackage
	} -body {
	    mcpackageconfig set changecmd [namespace code callbackproc]
	    mclocale foo_bar
	    set resultvariable
	} -result {foo_bar foo {}}

	test msgcat-14.4 {invocation unknowncmd} -setup {
	    mcforgetpackage
    	    mclocale $locale
	    mclocale ""
	    mcloadedlocales clear
	    set resultvariable ""
	} -cleanup {
	    mcforgetpackage

Changes to tests/namespace-old.test.

631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
            variable x ""
        }
        variable status ""
        proc monitor {name1 name2 op} {
            variable status
            lappend status "$op: $name1"
        }
        trace variable foo::x rwu [namespace code monitor]
    }
    set test_ns_trace::foo::x "yes!"
    set test_ns_trace::foo::x
    unset test_ns_trace::foo::x
    namespace eval test_ns_trace { set status }
} {{w: test_ns_trace::foo::x} {r: test_ns_trace::foo::x} {u: test_ns_trace::foo::x}}

# -----------------------------------------------------------------------
# TEST: imported commands
# -----------------------------------------------------------------------
test namespace-old-9.1 {empty "namespace export" list} {
    list [catch "namespace export" msg] $msg
} {0 {}}







|





|







631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
            variable x ""
        }
        variable status ""
        proc monitor {name1 name2 op} {
            variable status
            lappend status "$op: $name1"
        }
        trace add variable foo::x {read write unset} [namespace code monitor]
    }
    set test_ns_trace::foo::x "yes!"
    set test_ns_trace::foo::x
    unset test_ns_trace::foo::x
    namespace eval test_ns_trace { set status }
} {{write: test_ns_trace::foo::x} {read: test_ns_trace::foo::x} {unset: test_ns_trace::foo::x}}

# -----------------------------------------------------------------------
# TEST: imported commands
# -----------------------------------------------------------------------
test namespace-old-9.1 {empty "namespace export" list} {
    list [catch "namespace export" msg] $msg
} {0 {}}

Changes to tests/oo.test.

372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
	foreach initial $initials {
	    lappend x [info object class $initial]
	}
	return $x
    }] {lsort [lsearch -all -not -inline $x *::delegate]}
} -cleanup {
    interp delete $fresh
} -result {{} {::oo::Slot ::oo::abstract ::oo::class ::oo::object ::oo::singleton} {::oo::define::filter ::oo::define::mixin ::oo::define::superclass ::oo::define::variable ::oo::objdefine::filter ::oo::objdefine::mixin ::oo::objdefine::variable} {::oo::Slot ::oo::class} {::oo::abstract ::oo::singleton} {} {} {} {} {} ::oo::object ::oo::object ::oo::class ::oo::class ::oo::class}

test oo-2.1 {basic test of OO functionality: constructor} -setup {
    # This is a bit complex because it needs to run in a sub-interp as
    # we're modifying the root object class's constructor
    interp create subinterp
    subinterp eval {
	package require tcl::oo







|







372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
	foreach initial $initials {
	    lappend x [info object class $initial]
	}
	return $x
    }] {lsort [lsearch -all -not -inline $x *::delegate]}
} -cleanup {
    interp delete $fresh
} -result {{} {::oo::Slot ::oo::abstract ::oo::class ::oo::configurable ::oo::configuresupport::configurable ::oo::object ::oo::singleton} {::oo::configuresupport::objreadableproperties ::oo::configuresupport::objwritableproperties ::oo::configuresupport::readableproperties ::oo::configuresupport::writableproperties ::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::configuresupport::configurable} {::oo::abstract ::oo::configurable ::oo::singleton} {} {} {} {} {} ::oo::object ::oo::object ::oo::class ::oo::class ::oo::class}

test oo-2.1 {basic test of OO functionality: constructor} -setup {
    # This is a bit complex because it needs to run in a sub-interp as
    # we're modifying the root object class's constructor
    interp create subinterp
    subinterp eval {
	package require tcl::oo
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
    while executing
\"info object\""
test oo-16.2 {OO: object introspection} -body {
    info object class NOTANOBJECT
} -returnCodes 1 -result {NOTANOBJECT does not refer to an object}
test oo-16.3 {OO: object introspection} -body {
    info object gorp oo::object
} -returnCodes 1 -result {unknown or ambiguous subcommand "gorp": must be call, class, creationid, definition, filters, forward, isa, methods, methodtype, mixins, namespace, variables, or vars}
test oo-16.4 {OO: object introspection} -setup {
    oo::class create meta { superclass oo::class }
    [meta create instance1] create instance2
} -body {
    list [list [info object class oo::object] \
	      [info object class oo::class] \
	      [info object class meta] \







|







2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
    while executing
\"info object\""
test oo-16.2 {OO: object introspection} -body {
    info object class NOTANOBJECT
} -returnCodes 1 -result {NOTANOBJECT does not refer to an object}
test oo-16.3 {OO: object introspection} -body {
    info object gorp oo::object
} -returnCodes 1 -result {unknown or ambiguous subcommand "gorp": must be call, class, creationid, definition, filters, forward, isa, methods, methodtype, mixins, namespace, properties, variables, or vars}
test oo-16.4 {OO: object introspection} -setup {
    oo::class create meta { superclass oo::class }
    [meta create instance1] create instance2
} -body {
    list [list [info object class oo::object] \
	      [info object class oo::class] \
	      [info object class meta] \
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
} -body {
    info class superclass foo
} -returnCodes 1 -cleanup {
    foo destroy
} -result {"foo" is not a class}
test oo-17.4 {OO: class introspection} -body {
    info class gorp oo::object
} -returnCodes 1 -result {unknown or ambiguous subcommand "gorp": must be call, constructor, definition, definitionnamespace, destructor, filters, forward, instances, methods, methodtype, mixins, subclasses, superclasses, or variables}
test oo-17.5 {OO: class introspection} -setup {
    oo::class create testClass
} -body {
    testClass create foo
    testClass create bar
    testClass create spong
    lsort [info class instances testClass]







|







2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
} -body {
    info class superclass foo
} -returnCodes 1 -cleanup {
    foo destroy
} -result {"foo" is not a class}
test oo-17.4 {OO: class introspection} -body {
    info class gorp oo::object
} -returnCodes 1 -result {unknown or ambiguous subcommand "gorp": must be call, constructor, definition, definitionnamespace, destructor, filters, forward, instances, methods, methodtype, mixins, properties, subclasses, superclasses, or variables}
test oo-17.5 {OO: class introspection} -setup {
    oo::class create testClass
} -body {
    testClass create foo
    testClass create bar
    testClass create spong
    lsort [info class instances testClass]
4193
4194
4195
4196
4197
4198
4199
4200
4201
4202
4203
4204
4205
4206
4207
    set s [SampleSlot new]
}] -body {
    # Method names beginning with "-" are special to slots
    $s -grill q
} -returnCodes error -cleanup [SampleSlotCleanup {
    rename $s {}
}] -result \
    {unknown method "-grill": must be -append, -clear, -prepend, -remove, -set, contents or ops}

test oo-34.1 {TIP 380: slots - presence} -setup {
    set obj [oo::object new]
    set result {}
} -body {
    oo::define oo::object {
	::lappend ::result [::info object class filter]







|







4193
4194
4195
4196
4197
4198
4199
4200
4201
4202
4203
4204
4205
4206
4207
    set s [SampleSlot new]
}] -body {
    # Method names beginning with "-" are special to slots
    $s -grill q
} -returnCodes error -cleanup [SampleSlotCleanup {
    rename $s {}
}] -result \
    {unknown method "-grill": must be -append, -appendifnew, -clear, -prepend, -remove, -set, contents or ops}

test oo-34.1 {TIP 380: slots - presence} -setup {
    set obj [oo::object new]
    set result {}
} -body {
    oo::define oo::object {
	::lappend ::result [::info object class filter]
4216
4217
4218
4219
4220
4221
4222
4223
4224
4225
4226
4227
4228
4229
4230
4231
4232
4233
4234
4235
4236
4237
4238
4239
4240
4241
4242
4243
4244
4245
4246
4247
4248
4249
4250
4251
4252
4253
4254
4255
    }
    return $result
} -cleanup {
    $obj destroy
} -result {::oo::Slot ::oo::Slot ::oo::Slot ::oo::Slot ::oo::Slot ::oo::Slot ::oo::Slot}
test oo-34.2 {TIP 380: slots - presence} {
    lsort [info class instances oo::Slot]
} {::oo::define::filter ::oo::define::mixin ::oo::define::superclass ::oo::define::variable ::oo::objdefine::filter ::oo::objdefine::mixin ::oo::objdefine::variable}
proc getMethods obj {
    list [lsort [info object methods $obj -all]] \
	[lsort [info object methods $obj -private]]
}
test oo-34.3 {TIP 380: slots - presence} {
    getMethods oo::define::filter
} {{-append -clear -prepend -remove -set} {Get Set}}
test oo-34.4 {TIP 380: slots - presence} {
    getMethods oo::define::mixin
} {{-append -clear -prepend -remove -set} {--default-operation Get Resolve Set}}
test oo-34.5 {TIP 380: slots - presence} {
    getMethods oo::define::superclass
} {{-append -clear -prepend -remove -set} {--default-operation Get Resolve Set}}
test oo-34.6 {TIP 380: slots - presence} {
    getMethods oo::define::variable
} {{-append -clear -prepend -remove -set} {Get Set}}
test oo-34.7 {TIP 380: slots - presence} {
    getMethods oo::objdefine::filter
} {{-append -clear -prepend -remove -set} {Get Set}}
test oo-34.8 {TIP 380: slots - presence} {
    getMethods oo::objdefine::mixin
} {{-append -clear -prepend -remove -set} {--default-operation Get Resolve Set}}
test oo-34.9 {TIP 380: slots - presence} {
    getMethods oo::objdefine::variable
} {{-append -clear -prepend -remove -set} {Get Set}}
test oo-34.10 {TIP 516: slots - resolution} -setup {
    oo::class create parent
    set result {}
    oo::class create 516a { superclass parent }
    oo::class create 516b { superclass parent }
    oo::class create 516c { superclass parent }
    namespace eval 516test {







|






|


|


|


|


|


|


|







4216
4217
4218
4219
4220
4221
4222
4223
4224
4225
4226
4227
4228
4229
4230
4231
4232
4233
4234
4235
4236
4237
4238
4239
4240
4241
4242
4243
4244
4245
4246
4247
4248
4249
4250
4251
4252
4253
4254
4255
    }
    return $result
} -cleanup {
    $obj destroy
} -result {::oo::Slot ::oo::Slot ::oo::Slot ::oo::Slot ::oo::Slot ::oo::Slot ::oo::Slot}
test oo-34.2 {TIP 380: slots - presence} {
    lsort [info class instances oo::Slot]
} {::oo::configuresupport::objreadableproperties ::oo::configuresupport::objwritableproperties ::oo::configuresupport::readableproperties ::oo::configuresupport::writableproperties ::oo::define::filter ::oo::define::mixin ::oo::define::superclass ::oo::define::variable ::oo::objdefine::filter ::oo::objdefine::mixin ::oo::objdefine::variable}
proc getMethods obj {
    list [lsort [info object methods $obj -all]] \
	[lsort [info object methods $obj -private]]
}
test oo-34.3 {TIP 380: slots - presence} {
    getMethods oo::define::filter
} {{-append -appendifnew -clear -prepend -remove -set} {Get Set}}
test oo-34.4 {TIP 380: slots - presence} {
    getMethods oo::define::mixin
} {{-append -appendifnew -clear -prepend -remove -set} {--default-operation Get Resolve Set}}
test oo-34.5 {TIP 380: slots - presence} {
    getMethods oo::define::superclass
} {{-append -appendifnew -clear -prepend -remove -set} {--default-operation Get Resolve Set}}
test oo-34.6 {TIP 380: slots - presence} {
    getMethods oo::define::variable
} {{-append -appendifnew -clear -prepend -remove -set} {Get Set}}
test oo-34.7 {TIP 380: slots - presence} {
    getMethods oo::objdefine::filter
} {{-append -appendifnew -clear -prepend -remove -set} {Get Set}}
test oo-34.8 {TIP 380: slots - presence} {
    getMethods oo::objdefine::mixin
} {{-append -appendifnew -clear -prepend -remove -set} {--default-operation Get Resolve Set}}
test oo-34.9 {TIP 380: slots - presence} {
    getMethods oo::objdefine::variable
} {{-append -appendifnew -clear -prepend -remove -set} {Get Set}}
test oo-34.10 {TIP 516: slots - resolution} -setup {
    oo::class create parent
    set result {}
    oo::class create 516a { superclass parent }
    oo::class create 516b { superclass parent }
    oo::class create 516c { superclass parent }
    namespace eval 516test {

Changes to tests/ooNext2.test.

122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
	}
    }
    oo::class create C {
	superclass A B
	variable result
	constructor {p q r} {
	    lappend result ==C== p=$p,q=$q,r=$r
	    # Route arguments to superclasses, in non-trival pattern
	    nextto B $q
	    nextto A $p $r
	}
	method result {} {return $result}
    }
    [C new x y z] result
} -cleanup {







|







122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
	}
    }
    oo::class create C {
	superclass A B
	variable result
	constructor {p q r} {
	    lappend result ==C== p=$p,q=$q,r=$r
	    # Route arguments to superclasses, in non-trivial pattern
	    nextto B $q
	    nextto A $p $r
	}
	method result {} {return $result}
    }
    [C new x y z] result
} -cleanup {

Added tests/ooProp.test.











































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
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
# This file contains a collection of tests for Tcl's built-in object system,
# specifically the parts that support configurable properties on objects.
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright © 2019-2020 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require tcl::oo 1.0.3
package require tcltest 2
if {"::tcltest" in [namespace children]} {
    namespace import -force ::tcltest::*
}

test ooProp-1.1 {TIP 558: properties: core support} -setup {
    oo::class create parent
    unset -nocomplain result
    set result {}
} -body {
    oo::class create c {superclass parent}
    lappend result [info class properties c] [info class properties c -writable]
    oo::define c ::oo::configuresupport::readableproperties -set a b c
    lappend result [info class properties c] [info class properties c -writable]
    oo::define c ::oo::configuresupport::readableproperties -set f e d
    lappend result [info class properties c] [info class properties c -writable]
    oo::define c ::oo::configuresupport::readableproperties -set a a a
    lappend result [info class properties c] [info class properties c -writable]
    oo::define c ::oo::configuresupport::readableproperties -set
    lappend result [info class properties c] [info class properties c -writable]
} -cleanup {
    parent destroy
} -result {{} {} {a b c} {} {d e f} {} a {} {} {}}
test ooProp-1.2 {TIP 558: properties: core support} -setup {
    oo::class create parent
    unset -nocomplain result
    set result {}
} -body {
    oo::class create c {superclass parent}
    lappend result [info class properties c -all] [info class properties c -writable -all]
    oo::define c ::oo::configuresupport::readableproperties -set a b c
    lappend result [info class properties c -all] [info class properties c -writable -all]
    oo::define c ::oo::configuresupport::readableproperties -set f e d
    lappend result [info class properties c -all] [info class properties c -writable -all]
    oo::define c ::oo::configuresupport::readableproperties -set a a a
    lappend result [info class properties c -all] [info class properties c -writable -all]
    oo::define c ::oo::configuresupport::readableproperties -set
    lappend result [info class properties c -all] [info class properties c -writable -all]
} -cleanup {
    parent destroy
} -result {{} {} {a b c} {} {d e f} {} a {} {} {}}
test ooProp-1.3 {TIP 558: properties: core support} -setup {
    oo::class create parent
    unset -nocomplain result
    set result {}
} -body {
    oo::class create c {superclass parent}
    lappend result [info class properties c] [info class properties c -writable]
    oo::define c ::oo::configuresupport::writableproperties -set a b c
    lappend result [info class properties c] [info class properties c -writable]
    oo::define c ::oo::configuresupport::writableproperties -set f e d
    lappend result [info class properties c] [info class properties c -writable]
    oo::define c ::oo::configuresupport::writableproperties -set a a a
    lappend result [info class properties c] [info class properties c -writable]
    oo::define c ::oo::configuresupport::writableproperties -set
    lappend result [info class properties c] [info class properties c -writable]
} -cleanup {
    parent destroy
} -result {{} {} {} {a b c} {} {d e f} {} a {} {}}
test ooProp-1.4 {TIP 558: properties: core support} -setup {
    oo::class create parent
    unset -nocomplain result
    set result {}
} -body {
    oo::class create c {superclass parent}
    lappend result [info class properties c -all] [info class properties c -writable -all]
    oo::define c ::oo::configuresupport::writableproperties -set a b c
    lappend result [info class properties c -all] [info class properties c -writable -all]
    oo::define c ::oo::configuresupport::writableproperties -set f e d
    lappend result [info class properties c -all] [info class properties c -writable -all]
    oo::define c ::oo::configuresupport::writableproperties -set a a a
    lappend result [info class properties c -all] [info class properties c -writable -all]
    oo::define c ::oo::configuresupport::writableproperties -set
    lappend result [info class properties c -all] [info class properties c -writable -all]
} -cleanup {
    parent destroy
} -result {{} {} {} {a b c} {} {d e f} {} a {} {}}
test ooProp-1.5 {TIP 558: properties: core support} -setup {
    oo::class create parent
    unset -nocomplain result
    set result {}
} -body {
    oo::class create c {superclass parent}
    oo::class create d {superclass c}
    lappend result [info class properties d -all] [info class properties d -writable -all]
    oo::define c ::oo::configuresupport::readableproperties -set a b c
    oo::define d ::oo::configuresupport::readableproperties -set x y z
    lappend result [info class properties d -all] [info class properties d -writable -all]
    oo::define c ::oo::configuresupport::readableproperties -set f e d
    oo::define d ::oo::configuresupport::readableproperties -set r p q
    lappend result [info class properties d -all] [info class properties d -writable -all]
    oo::define c ::oo::configuresupport::readableproperties -set a a h
    oo::define d ::oo::configuresupport::readableproperties -set g h g
    lappend result [info class properties d -all] [info class properties d -writable -all]
    oo::define c ::oo::configuresupport::readableproperties -set
    lappend result [info class properties d -all] [info class properties d -writable -all]
    oo::define d ::oo::configuresupport::readableproperties -set
    lappend result [info class properties d -all] [info class properties d -writable -all]
} -cleanup {
    parent destroy
} -result {{} {} {a b c x y z} {} {d e f p q r} {} {a g h} {} {g h} {} {} {}}
test ooProp-1.6 {TIP 558: properties: core support} -setup {
    oo::class create parent
    unset -nocomplain result
    set result {}
} -body {
    oo::class create c {superclass parent}
    oo::class create d {superclass c}
    lappend result [info class properties d -all] [info class properties d -writable -all]
    oo::define c ::oo::configuresupport::writableproperties -set a b c
    oo::define d ::oo::configuresupport::writableproperties -set x y z
    lappend result [info class properties d -all] [info class properties d -writable -all]
    oo::define c ::oo::configuresupport::writableproperties -set f e d
    oo::define d ::oo::configuresupport::writableproperties -set r p q
    lappend result [info class properties d -all] [info class properties d -writable -all]
    oo::define c ::oo::configuresupport::writableproperties -set a a h
    oo::define d ::oo::configuresupport::writableproperties -set g h g
    lappend result [info class properties d -all] [info class properties d -writable -all]
    oo::define c ::oo::configuresupport::writableproperties -set
    lappend result [info class properties d -all] [info class properties d -writable -all]
    oo::define d ::oo::configuresupport::writableproperties -set
    lappend result [info class properties d -all] [info class properties d -writable -all]
} -cleanup {
    parent destroy
} -result {{} {} {} {a b c x y z} {} {d e f p q r} {} {a g h} {} {g h} {} {}}
test ooProp-1.7 {TIP 558: properties: core support} -setup {
    oo::class create parent
    unset -nocomplain result
    set result {}
} -body {
    oo::class create c {superclass parent}
    c create o
    lappend result [info object properties o] [info object properties o -writable]
    oo::objdefine o ::oo::configuresupport::objreadableproperties -set a b c
    lappend result [info object properties o] [info object properties o -writable]
    oo::objdefine o ::oo::configuresupport::objreadableproperties -set f e d
    lappend result [info object properties o] [info object properties o -writable]
    oo::objdefine o ::oo::configuresupport::objreadableproperties -set a a h
    lappend result [info object properties o] [info object properties o -writable]
    oo::objdefine o ::oo::configuresupport::objreadableproperties -set
    lappend result [info object properties o] [info object properties o -writable]
} -cleanup {
    parent destroy
} -result {{} {} {a b c} {} {d e f} {} {a h} {} {} {}}
test ooProp-1.8 {TIP 558: properties: core support} -setup {
    oo::class create parent
    unset -nocomplain result
    set result {}
} -body {
    oo::class create c {superclass parent}
    c create o
    lappend result [info object properties o] [info object properties o -writable]
    oo::objdefine o ::oo::configuresupport::objwritableproperties -set a b c
    lappend result [info object properties o] [info object properties o -writable]
    oo::objdefine o ::oo::configuresupport::objwritableproperties -set f e d
    lappend result [info object properties o] [info object properties o -writable]
    oo::objdefine o ::oo::configuresupport::objwritableproperties -set a a h
    lappend result [info object properties o] [info object properties o -writable]
    oo::objdefine o ::oo::configuresupport::objwritableproperties -set
    lappend result [info object properties o] [info object properties o -writable]
} -cleanup {
    parent destroy
} -result {{} {} {} {a b c} {} {d e f} {} {a h} {} {}}
test ooProp-1.9 {TIP 558: properties: core support} -setup {
    oo::class create parent
    unset -nocomplain result
    set result {}
} -body {
    oo::class create c {superclass parent}
    oo::class create d {superclass c}
    d create o
    lappend result [info object properties o -all] [info object properties o -writable -all]
    oo::define c ::oo::configuresupport::readableproperties -set a b
    oo::define d ::oo::configuresupport::readableproperties -set c d
    oo::objdefine o ::oo::configuresupport::objreadableproperties -set e f
    lappend result [info object properties o -all] [info object properties o -writable -all]
    oo::objdefine o ::oo::configuresupport::objreadableproperties -set f e d b e
    lappend result [info object properties o -all] [info object properties o -writable -all]
} -cleanup {
    parent destroy
} -result {{} {} {a b c d e f} {} {a b c d e f} {}}
test ooProp-1.10 {TIP 558: properties: core support} -setup {
    oo::class create parent
    unset -nocomplain result
    set result {}
} -body {
    oo::class create c {superclass parent}
    oo::class create d {superclass c}
    d create o
    lappend result [info object properties o -all] [info object properties o -writable -all]
    oo::define c ::oo::configuresupport::writableproperties -set a b
    oo::define d ::oo::configuresupport::writableproperties -set c d
    oo::objdefine o ::oo::configuresupport::objwritableproperties -set e f
    lappend result [info object properties o -all] [info object properties o -writable -all]
    oo::objdefine o ::oo::configuresupport::objwritableproperties -set f e d b e
    lappend result [info object properties o -all] [info object properties o -writable -all]
} -cleanup {
    parent destroy
} -result {{} {} {} {a b c d e f} {} {a b c d e f}}
test ooProp-1.11 {TIP 558: properties: core support cache} -setup {
    oo::class create parent
    unset -nocomplain result
} -body {
    oo::class create m {
	superclass parent
	::oo::configuresupport::readableproperties -set a
	::oo::configuresupport::writableproperties -set c
    }
    oo::class create c {
	superclass parent
	::oo::configuresupport::readableproperties -set b
	::oo::configuresupport::writableproperties -set d
    }
    c create o
    lappend result [info object properties o -all -readable] \
	[info object properties o -all -writable]
    oo::objdefine o mixin m
    lappend result [info object properties o -all -readable] \
	[info object properties o -all -writable]
} -cleanup {
    parent destroy
} -result {b d {a b} {c d}}

test ooProp-2.1 {TIP 558: properties: configurable class system} -setup {
    oo::class create parent
    unset -nocomplain result
    set result {}
} -body {
    oo::configurable create Point {
	superclass parent
	property x y
        constructor args {
            my configure -x 0 -y 0 {*}$args
        }
        variable x y
        method report {} {
            lappend ::result "x=$x, y=$y"
        }
    }
    set pt [Point new -x 3]
    $pt report
    $pt configure -y 4
    $pt report
    lappend result [$pt configure -x],[$pt configure -y] [$pt configure]
} -cleanup {
    parent destroy
} -result {{x=3, y=0} {x=3, y=4} 3,4 {-x 3 -y 4}}
test ooProp-2.2 {TIP 558: properties: configurable class system} -setup {
    oo::class create parent
} -body {
    oo::configurable create Point {
	superclass parent
	property x y
        constructor args {
            my configure -x 0 -y 0 {*}$args
        }
    }
    oo::configurable create 3DPoint {
	superclass Point
	property z
	constructor args {
	    next -z 0 {*}$args
	}
    }
    set pt [3DPoint new -x 3 -y 4 -z 5]
    list [$pt configure -x],[$pt configure -y],[$pt configure -z] \
	[$pt configure]
} -cleanup {
    parent destroy
} -result {3,4,5 {-x 3 -y 4 -z 5}}
test ooProp-2.3 {TIP 558: properties: configurable class system} -setup {
    oo::class create parent
} -body {
    oo::configurable create Point {
	superclass parent
	property x y
        constructor args {
            my configure -x 0 -y 0 {*}$args
        }
    }
    set pt [Point new -x 3 -y 4]
    oo::objdefine $pt property z
    $pt configure -z 5
    list [$pt configure -x],[$pt configure -y],[$pt configure -z] \
	[$pt configure]
} -cleanup {
    parent destroy
} -result {3,4,5 {-x 3 -y 4 -z 5}}
test ooProp-2.4 {TIP 558: properties: configurable class system} -setup {
    oo::class create parent
} -body {
    oo::configurable create Point {
	superclass parent
	property x y
        constructor args {
            my configure -x 0 -y 0 {*}$args
        }
    }
    [Point new] configure gorp
} -returnCodes error -cleanup {
    parent destroy
} -result {bad property "gorp": must be -x or -y}
test ooProp-2.5 {TIP 558: properties: configurable class system} -setup {
    oo::class create parent
} -body {
    oo::configurable create Point {
	superclass parent
	property x y
        constructor args {
            my configure -x 0 -y 0 {*}$args
        }
    }
    oo::configurable create 3DPoint {
	superclass Point
	property z
	constructor args {
	    next -z 0 {*}$args
	}
    }
    [3DPoint new] configure gorp
} -returnCodes error -cleanup {
    parent destroy
} -result {bad property "gorp": must be -x, -y, or -z}
test ooProp-2.6 {TIP 558: properties: configurable class system} -setup {
    oo::class create parent
} -body {
    oo::configurable create Point {
	superclass parent
	property x y
        constructor args {
            my configure -x 0 -y 0 {*}$args
        }
    }
    [Point create p] configure -x 1 -y
} -returnCodes error -cleanup {
    parent destroy
} -result {wrong # args: should be "::p configure ?-option value ...?"}
test ooProp-2.7 {TIP 558: properties: configurable class system} -setup {
    oo::class create parent
    unset -nocomplain msg
} -body {
    oo::configurable create Point {
	superclass parent
	property x y -kind writable
        constructor args {
            my configure -x 0 -y 0 {*}$args
        }
    }
    Point create p
    list [p configure -y ok] [catch {p configure -y} msg] $msg
} -cleanup {
    parent destroy
} -result {{} 1 {property "-y" is write only}}
test ooProp-2.8 {TIP 558: properties: configurable class system} -setup {
    oo::class create parent
    unset -nocomplain msg
} -body {
    oo::configurable create Point {
	superclass parent
	property x y -kind readable
        constructor args {
            my configure -x 0 {*}$args
	    variable y 123
        }
    }
    Point create p
    list [p configure] [p configure -y] [catch {p configure -y foo} msg] $msg
} -cleanup {
    parent destroy
} -result {{-x 0 -y 123} 123 1 {property "-y" is read only}}

test ooProp-3.1 {TIP 558: properties: declaration semantics} -setup {
    oo::class create parent
    unset -nocomplain result
    set result {}
} -body {
    oo::configurable create Point {superclass parent}
    oo::define Point {
	variable xyz
	property x -get {
	    global result
	    lappend result "get"
	    return [lrepeat 3 $xyz]
	} -set {
	    global result
	    lappend result [list set $value]
	    set xyz [expr {$value * 3}]
	}
    }
    Point create pt
    pt configure -x 5
    lappend result >[pt configure -x]<
} -cleanup {
    parent destroy
} -result {{set 5} get {>15 15 15<}}
test ooProp-3.2 {TIP 558: properties: declaration semantics} -setup {
    oo::class create parent
    unset -nocomplain result
    set result {}
} -body {
    oo::configurable create Point {superclass parent}
    oo::define Point {
	variable xyz
	property x -get {
	    global result
	    lappend result "get"
	    return [lrepeat 3 $xyz]
	} -set {
	    global result
	    lappend result [list set $value]
	    set xyz [expr {$value * 3}]
	} y -kind readable -get {return $xyz}
    }
    Point create pt
    pt configure -x 5
    lappend result >[pt configure -x]< [pt configure -y]
} -cleanup {
    parent destroy
} -result {{set 5} get {>15 15 15<} 15}
test ooProp-3.3 {TIP 558: properties: declaration semantics} -setup {
    oo::class create parent
} -body {
    oo::configurable create Point {superclass parent}
    oo::define Point {
	variable xyz
	property -x -get {return $xyz}
    }
} -returnCodes error -cleanup {
    parent destroy
} -result {bad property name "-x": must not begin with -}
test ooProp-3.4 {TIP 558: properties: declaration semantics} -setup {
    oo::class create parent
} -body {
    oo::configurable create Point {superclass parent}
    oo::define Point {
	property "x y"
    }
} -returnCodes error -cleanup {
    parent destroy
} -result {bad property name "x y": must be a simple word}
test ooProp-3.5 {TIP 558: properties: declaration semantics} -setup {
    oo::class create parent
} -body {
    oo::configurable create Point {superclass parent}
    oo::define Point {
	property ::x
    }
} -returnCodes error -cleanup {
    parent destroy
} -result {bad property name "::x": must not contain namespace separators}
test ooProp-3.6 {TIP 558: properties: declaration semantics} -setup {
    oo::class create parent
} -body {
    oo::configurable create Point {superclass parent}
    oo::define Point {
	property x(
    }
} -returnCodes error -cleanup {
    parent destroy
} -result {bad property name "x(": must not contain parentheses}
test ooProp-3.7 {TIP 558: properties: declaration semantics} -setup {
    oo::class create parent
} -body {
    oo::configurable create Point {superclass parent}
    oo::define Point {
	property x)
    }
} -returnCodes error -cleanup {
    parent destroy
} -result {bad property name "x)": must not contain parentheses}
test ooProp-3.8 {TIP 558: properties: declaration semantics} -setup {
    oo::class create parent
} -body {
    oo::configurable create Point {superclass parent}
    oo::define Point {
	property x -get
    }
} -returnCodes error -cleanup {
    parent destroy
} -result {missing body to go with -get option}
test ooProp-3.9 {TIP 558: properties: declaration semantics} -setup {
    oo::class create parent
} -body {
    oo::configurable create Point {superclass parent}
    oo::define Point {
	property x -set
    }
} -returnCodes error -cleanup {
    parent destroy
} -result {missing body to go with -set option}
test ooProp-3.10 {TIP 558: properties: declaration semantics} -setup {
    oo::class create parent
} -body {
    oo::configurable create Point {superclass parent}
    oo::define Point {
	property x -kind
    }
} -returnCodes error -cleanup {
    parent destroy
} -result {missing kind value to go with -kind option}
test ooProp-3.11 {TIP 558: properties: declaration semantics} -setup {
    oo::class create parent
} -body {
    oo::configurable create Point {superclass parent}
    oo::define Point {
	property x -get {} -set
    }
} -returnCodes error -cleanup {
    parent destroy
} -result {missing body to go with -set option}
test ooProp-3.12 {TIP 558: properties: declaration semantics} -setup {
    oo::class create parent
} -body {
    oo::configurable create Point {
	superclass parent
	property x -get {} -get {return ok}
    }
    [Point new] configure -x
} -cleanup {
    parent destroy
} -result ok
test ooProp-3.13 {TIP 558: properties: declaration semantics} -setup {
    oo::class create parent
} -body {
    oo::configurable create Point {
	superclass parent
	property x -kind gorp
    }
} -returnCodes error -cleanup {
    parent destroy
} -result {bad kind "gorp": must be readable, readwrite, or writable}
test ooProp-3.14 {TIP 558: properties: declaration semantics} -setup {
    oo::class create parent
} -body {
    oo::configurable create Point {
	superclass parent
	property x -k reada -g {return ok}
    }
    [Point new] configure -x
} -cleanup {
    parent destroy
} -result ok
test ooProp-3.15 {TIP 558: properties: declaration semantics} -setup {
    oo::class create parent
} -body {
    oo::configurable create Point {
	superclass parent
	property {*}{
	    x -kind writable
	    y -get {return ok}
	}
    }
    [Point new] configure -y
} -cleanup {
    parent destroy
} -result ok
test ooProp-3.16 {TIP 558: properties: declaration semantics} -setup {
    oo::class create parent
    unset -nocomplain msg
} -body {
    oo::configurable create Point {
	superclass parent
	variable xy
	property x -kind readable -get {return $xy}
	property x -kind writable -set {set xy $value}
    }
    Point create pt
    list [catch {
	pt configure -x ok
    } msg] $msg [catch {
	pt configure -x
    } msg] $msg [catch {
	pt configure -y 1
    } msg] $msg
} -cleanup {
    parent destroy
} -result {0 {} 1 {property "-x" is write only} 1 {bad property "-y": must be -x}}
test ooProp-3.17 {TIP 558: properties: declaration semantics} -setup {
    oo::class create parent
} -body {
    oo::configurable create Point {
	superclass parent
	property x -get {return -code break}
    }
    while 1 {
	[Point new] configure -x
	break
    }
} -returnCodes error -cleanup {
    parent destroy
} -result {property getter for -x did a break}
test ooProp-3.18 {TIP 558: properties: declaration semantics} -setup {
    oo::class create parent
} -body {
    oo::configurable create Point {
	superclass parent
	property x -get {return -code break}
    }
    while 1 {
	[Point new] configure
	break
    }
} -returnCodes error -cleanup {
    parent destroy
} -result {property getter for -x did a break}
test ooProp-3.19 {TIP 558: properties: declaration semantics} -setup {
    oo::class create parent
} -body {
    oo::configurable create Point {
	superclass parent
	property x -get {error "boo"}
    }
    while 1 {
	[Point new] configure -x
	break
    }
} -returnCodes error -cleanup {
    parent destroy
} -result boo
test ooProp-3.20 {TIP 558: properties: declaration semantics} -setup {
    oo::class create parent
} -body {
    oo::configurable create Point {
	superclass parent
	property x -get {error "boo"}
    }
    while 1 {
	[Point new] configure
	break
    }
} -returnCodes error -cleanup {
    parent destroy
} -result boo
test ooProp-3.21 {TIP 558: properties: declaration semantics} -setup {
    oo::class create parent
} -body {
    oo::configurable create Point {
	superclass parent
	property x -get {return -code continue}
    }
    while 1 {
	[Point new] configure -x
	break
    }
} -returnCodes error -cleanup {
    parent destroy
} -result {property getter for -x did a continue}
test ooProp-3.22 {TIP 558: properties: declaration semantics} -setup {
    oo::class create parent
} -body {
    oo::configurable create Point {
	superclass parent
	property x -get {return -level 2 ok}
    }
    apply {{} {
	[Point new] configure
	return bad
    }}
} -cleanup {
    parent destroy
} -result ok
test ooProp-3.23 {TIP 558: properties: declaration semantics} -setup {
    oo::class create parent
} -body {
    oo::configurable create Point {
	superclass parent
	property x -get {return -level 2 ok}
    }
    apply {{} {
	[Point new] configure -x
	return bad
    }}
} -cleanup {
    parent destroy
} -result ok
test ooProp-3.24 {TIP 558: properties: declaration semantics} -setup {
    oo::class create parent
} -body {
    oo::configurable create Point {
	superclass parent
	property x -set {return -code break}
    }
    while 1 {
	[Point new] configure -x gorp
	break
    }
} -returnCodes error -cleanup {
    parent destroy
} -result {property setter for -x did a break}
test ooProp-3.25 {TIP 558: properties: declaration semantics} -setup {
    oo::class create parent
} -body {
    oo::configurable create Point {
	superclass parent
	property x -set {return -code continue}
    }
    while 1 {
	[Point new] configure -x gorp
	break
    }
} -returnCodes error -cleanup {
    parent destroy
} -result {property setter for -x did a continue}
test ooProp-3.26 {TIP 558: properties: declaration semantics} -setup {
    oo::class create parent
} -body {
    oo::configurable create Point {
	superclass parent
	property x -set {error "boo"}
    }
    while 1 {
	[Point new] configure -x gorp
	break
    }
} -returnCodes error -cleanup {
    parent destroy
} -result boo
test ooProp-3.27 {TIP 558: properties: declaration semantics} -setup {
    oo::class create parent
} -body {
    oo::configurable create Point {
	superclass parent
	property x -set {return -level 2 ok}
    }
    apply {{} {
	[Point new] configure -x gorp
	return bad
    }}
} -cleanup {
    parent destroy
} -result ok
test ooProp-3.28 {TIP 558: properties: declaration semantics} -setup {
    oo::class create parent
} -body {
    oo::configurable create Point {
	superclass parent
	private property var
    }
    Point create pt
    pt configure -var ok
    pt configure -var
} -cleanup {
    parent destroy
} -result ok

test ooProp-4.1 {TIP 558: properties: error details} -setup {
    oo::class create parent
    unset -nocomplain msg opt
} -body {
    oo::configurable create Point {superclass parent}
    list [catch {oo::define Point {property -x}} msg opt] \
	[dict get $opt -errorinfo] [dict get $opt -errorcode]
} -cleanup {
    parent destroy
} -result {1 {bad property name "-x": must not begin with -
    while executing
"property -x"
    (in definition script for class "::Point" line 1)
    invoked from within
"oo::define Point {property -x}"} {TCLOO PROPERTY_FORMAT}}
test ooProp-4.2 {TIP 558: properties: error details} -setup {
    oo::class create parent
    unset -nocomplain msg opt
} -body {
    oo::configurable create Point {superclass parent}
    list [catch {oo::define Point {property x -get}} msg opt] \
	[dict get $opt -errorinfo] [dict get $opt -errorcode]
} -cleanup {
    parent destroy
} -result {1 {missing body to go with -get option
    while executing
"property x -get"
    (in definition script for class "::Point" line 1)
    invoked from within
"oo::define Point {property x -get}"} {TCL WRONGARGS}}
test ooProp-4.3 {TIP 558: properties: error details} -setup {
    oo::class create parent
    unset -nocomplain msg opt
} -body {
    oo::configurable create Point {superclass parent}
    list [catch {oo::define Point {property x -set}} msg opt] \
	[dict get $opt -errorinfo] [dict get $opt -errorcode]
} -cleanup {
    parent destroy
} -result {1 {missing body to go with -set option
    while executing
"property x -set"
    (in definition script for class "::Point" line 1)
    invoked from within
"oo::define Point {property x -set}"} {TCL WRONGARGS}}
test ooProp-4.4 {TIP 558: properties: error details} -setup {
    oo::class create parent
    unset -nocomplain msg opt
} -body {
    oo::configurable create Point {superclass parent}
    list [catch {oo::define Point {property x -kind}} msg opt] \
	[dict get $opt -errorinfo] [dict get $opt -errorcode]
} -cleanup {
    parent destroy
} -result {1 {missing kind value to go with -kind option
    while executing
"property x -kind"
    (in definition script for class "::Point" line 1)
    invoked from within
"oo::define Point {property x -kind}"} {TCL WRONGARGS}}
test ooProp-4.5 {TIP 558: properties: error details} -setup {
    oo::class create parent
    unset -nocomplain msg opt
} -body {
    oo::configurable create Point {superclass parent}
    list [catch {oo::define Point {property x -kind gorp}} msg opt] \
	[dict get $opt -errorinfo] [dict get $opt -errorcode]
} -cleanup {
    parent destroy
} -result {1 {bad kind "gorp": must be readable, readwrite, or writable
    while executing
"property x -kind gorp"
    (in definition script for class "::Point" line 1)
    invoked from within
"oo::define Point {property x -kind gorp}"} {TCL LOOKUP INDEX kind gorp}}
test ooProp-4.6 {TIP 558: properties: error details} -setup {
    oo::class create parent
    unset -nocomplain msg opt
} -body {
    oo::configurable create Point {superclass parent}
    list [catch {oo::define Point {property x -gorp}} msg opt] \
	[dict get $opt -errorinfo] [dict get $opt -errorcode]
} -cleanup {
    parent destroy
} -result {1 {bad option "-gorp": must be -get, -kind, or -set
    while executing
"property x -gorp"
    (in definition script for class "::Point" line 1)
    invoked from within
"oo::define Point {property x -gorp}"} {TCL LOOKUP INDEX option -gorp}}
test ooProp-4.7 {TIP 558: properties: error details} -setup {
    oo::class create parent
    unset -nocomplain msg opt
} -body {
    oo::configurable create Point {
	superclass parent
	property x
    }
    Point create pt
    list [catch {pt configure -gorp} msg opt] \
	[dict get $opt -errorinfo] [dict get $opt -errorcode]
} -cleanup {
    parent destroy
} -result {1 {bad property "-gorp": must be -x
    while executing
"pt configure -gorp"} {TCL LOOKUP INDEX property -gorp}}
test ooProp-4.8 {TIP 558: properties: error details} -setup {
    oo::class create parent
    unset -nocomplain msg opt
} -body {
    oo::configurable create Point {
	superclass parent
	property x
    }
    Point create pt
    list [catch {pt configure -gorp blarg} msg opt] \
	[dict get $opt -errorinfo] [dict get $opt -errorcode]
} -cleanup {
    parent destroy
} -result {1 {bad property "-gorp": must be -x
    while executing
"pt configure -gorp blarg"} {TCL LOOKUP INDEX property -gorp}}

cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/ooUtil.test.

425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
    set x [pqr new]
    set y [pqr create ::y]
    lappend codes [$x foo] [$x bar] $y
} -cleanup {
    parent destroy
} -result {1 1 1 123 456 ::y}

test ooUtil-6.1 {TIP 478: classvarable} -setup {
    oo::class create parent
} -body {
    oo::class create xyz {
	superclass parent
	initialise {
	    variable x 1 y 2
	}







|







425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
    set x [pqr new]
    set y [pqr create ::y]
    lappend codes [$x foo] [$x bar] $y
} -cleanup {
    parent destroy
} -result {1 1 1 123 456 ::y}

test ooUtil-6.1 {TIP 478: classvariable} -setup {
    oo::class create parent
} -body {
    oo::class create xyz {
	superclass parent
	initialise {
	    variable x 1 y 2
	}
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
    set result [list [$p c] [$q c]]
    $p a
    $q b
    lappend result [[xyz new] c]
} -cleanup {
    parent destroy
} -result {{1 2} {1 2} {2 3}}
test ooUtil-6.2 {TIP 478: classvarable error case} -setup {
    oo::class create parent
} -body {
    oo::class create xyz {
	superclass parent
	method a {} {
	    classvariable x(1)
	    incr x(1)
	}
    }
    set p [xyz new]
    set q [xyz new]
    list [$p a] [$q a]
} -returnCodes error -cleanup {
    parent destroy
} -result {bad variable name "x(1)": can't create a scalar variable that looks like an array element}
test ooUtil-6.3 {TIP 478: classvarable error case} -setup {
    oo::class create parent
} -body {
    oo::class create xyz {
	superclass parent
	method a {} {
	    classvariable ::x
	    incr x







|















|







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
    set result [list [$p c] [$q c]]
    $p a
    $q b
    lappend result [[xyz new] c]
} -cleanup {
    parent destroy
} -result {{1 2} {1 2} {2 3}}
test ooUtil-6.2 {TIP 478: classvariable error case} -setup {
    oo::class create parent
} -body {
    oo::class create xyz {
	superclass parent
	method a {} {
	    classvariable x(1)
	    incr x(1)
	}
    }
    set p [xyz new]
    set q [xyz new]
    list [$p a] [$q a]
} -returnCodes error -cleanup {
    parent destroy
} -result {bad variable name "x(1)": can't create a scalar variable that looks like an array element}
test ooUtil-6.3 {TIP 478: classvariable error case} -setup {
    oo::class create parent
} -body {
    oo::class create xyz {
	superclass parent
	method a {} {
	    classvariable ::x
	    incr x

Changes to tests/pkgMkIndex.test.

486
487
488
489
490
491
492
493
494
495
496
497
498
499
500

removeFile [file join pkg pkg5.tcl]
removeFile [file join pkg pkg2_a.tcl]
removeFile [file join pkg pkg2_b.tcl]

makeFile {
#  This package requires circ2, and circ2 requires circ3, which in turn
#  requires circ1.  In case of cirularities, pkg_mkIndex should give up when
#  it gets stuck.
package require circ2 1.0
package provide circ1 1.0
namespace eval circ1 {
    namespace export c1-1 c1-2 c1-3 c1-4
}
proc circ1::c1-1 { num } {







|







486
487
488
489
490
491
492
493
494
495
496
497
498
499
500

removeFile [file join pkg pkg5.tcl]
removeFile [file join pkg pkg2_a.tcl]
removeFile [file join pkg pkg2_b.tcl]

makeFile {
#  This package requires circ2, and circ2 requires circ3, which in turn
#  requires circ1.  In case of circularities, pkg_mkIndex should give up when
#  it gets stuck.
package require circ2 1.0
package provide circ1 1.0
namespace eval circ1 {
    namespace export c1-1 c1-2 c1-3 c1-4
}
proc circ1::c1-1 { num } {
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664

test pkgMkIndex-12.1 {same name procs in different namespace} {
    pkgtest::runIndex -lazy $fullPkgPath samename.tcl
} {0 {{football:1.0 {tclPkgSetup {samename.tcl source {::college::team ::pro::team}}}}}}

removeFile [file join pkg samename.tcl]

# Proc names with embedded spaces are properly listed (ie, correct number of
# braces) in result
makeFile {
package provide spacename 1.0
proc {a b} {} {}
proc {c d} {} {}
} [file join pkg spacename.tcl]








|







650
651
652
653
654
655
656
657
658
659
660
661
662
663
664

test pkgMkIndex-12.1 {same name procs in different namespace} {
    pkgtest::runIndex -lazy $fullPkgPath samename.tcl
} {0 {{football:1.0 {tclPkgSetup {samename.tcl source {::college::team ::pro::team}}}}}}

removeFile [file join pkg samename.tcl]

# Proc names with embedded spaces are properly listed (i.e. correct number of
# braces) in result
makeFile {
package provide spacename 1.0
proc {a b} {} {}
proc {c d} {} {}
} [file join pkg spacename.tcl]

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
32
# The file tests the tcl_platform variable and platform package.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright © 1999 Scriptics Corporation
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require tcltest 2.5


namespace eval ::tcl::test::platform {
    namespace import ::tcltest::testConstraint
    namespace import ::tcltest::test
    namespace import ::tcltest::cleanupTests

    # This is not how [variable] works. See TIP 276.
    #variable ::tcl_platform
    namespace upvar :: tcl_platform tcl_platform

::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]
package require tcltests

testConstraint testCPUID [llength [info commands testcpuid]]
testConstraint testlongsize [llength [info commands testlongsize]]

test platform-1.0 {tcl_platform(engine)} {
  set tcl_platform(engine)
} {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
# The file tests the tcl_platform variable and platform package.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright © 1999 Scriptics Corporation
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require tcltest 2.5
source [file join [file dirname [info script]] tcltests.tcl]

namespace eval ::tcl::test::platform {
    namespace import ::tcltest::testConstraint
    namespace import ::tcltest::test
    namespace import ::tcltest::cleanupTests

    # This is not how [variable] works. See TIP 276.
    #variable ::tcl_platform
    namespace upvar :: tcl_platform tcl_platform

::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]


testConstraint testCPUID [llength [info commands testcpuid]]
testConstraint testlongsize [llength [info commands testlongsize]]

test platform-1.0 {tcl_platform(engine)} {
  set tcl_platform(engine)
} {Tcl}

Changes to tests/proc-old.test.

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
    do {global a; do {global a; unset a}; set a(z) 22}
    list [catch {array names a} msg] $msg
} {0 z}
test proc-old-3.7 {local and global arrays} {
    proc t1 {args} {global info; set info 1}
    catch {unset a}
    set info {}
    do {global a; trace var a(1) w t1}
    set a(1) 44
    set info
} 1
test proc-old-3.8 {local and global arrays} {
    proc t1 {args} {global info; set info 1}
    catch {unset a}
    trace var a(1) w t1
    set info {}
    do {global a; trace vdelete a(1) w t1}
    set a(1) 44
    set info
} {}
test proc-old-3.9 {local and global arrays} {
    proc t1 {args} {global info; set info 1}
    catch {unset a}
    trace var a(1) w t1
    do {global a; trace vinfo a(1)}
} {{w t1}}
catch {unset a}

test proc-old-30.1 {arguments and defaults} {
    proc tproc {x y z} {
	return [list $x $y $z]
    }
    tproc 11 12 13







|






|

|






|
|
|







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
    do {global a; do {global a; unset a}; set a(z) 22}
    list [catch {array names a} msg] $msg
} {0 z}
test proc-old-3.7 {local and global arrays} {
    proc t1 {args} {global info; set info 1}
    catch {unset a}
    set info {}
    do {global a; trace add var a(1) write t1}
    set a(1) 44
    set info
} 1
test proc-old-3.8 {local and global arrays} {
    proc t1 {args} {global info; set info 1}
    catch {unset a}
    trace add var a(1) write t1
    set info {}
    do {global a; trace remove var a(1) write t1}
    set a(1) 44
    set info
} {}
test proc-old-3.9 {local and global arrays} {
    proc t1 {args} {global info; set info 1}
    catch {unset a}
    trace add var a(1) write t1
    do {global a; trace info var a(1)}
} {{write t1}}
catch {unset a}

test proc-old-30.1 {arguments and defaults} {
    proc tproc {x y z} {
	return [list $x $y $z]
    }
    tproc 11 12 13
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
test proc-old-5.16 {error conditions} {
    proc foo args {
	global fooMsg
	set fooMsg "foo was called: $args"
    }
    proc tproc {} {
	set x 44
	trace var x u foo
	while {$x < 100} {
	    error "Nested error"
	}
    }
    set fooMsg "foo not called"
    list [catch tproc msg] $msg $::errorInfo $fooMsg
} {1 {Nested error} {Nested error
    while executing
"error "Nested error""
    (procedure "tproc" line 5)
    invoked from within
"tproc"} {foo was called: x {} u}}

# The tests below will really only be useful when run under Purify or
# some other system that can detect accesses to freed memory...

test proc-old-6.1 {procedure that redefines itself} {
    proc tproc {} {
	proc tproc {} {







|











|







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
test proc-old-5.16 {error conditions} {
    proc foo args {
	global fooMsg
	set fooMsg "foo was called: $args"
    }
    proc tproc {} {
	set x 44
	trace add var x unset foo
	while {$x < 100} {
	    error "Nested error"
	}
    }
    set fooMsg "foo not called"
    list [catch tproc msg] $msg $::errorInfo $fooMsg
} {1 {Nested error} {Nested error
    while executing
"error "Nested error""
    (procedure "tproc" line 5)
    invoked from within
"tproc"} {foo was called: x {} unset}}

# The tests below will really only be useful when run under Purify or
# some other system that can detect accesses to freed memory...

test proc-old-6.1 {procedure that redefines itself} {
    proc tproc {} {
	proc tproc {} {

Changes to tests/regexp.test.

13
14
15
16
17
18
19
20
21
22
23
24
25
26
27

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

unset -nocomplain foo
package require tcltests
testConstraint exec [llength [info commands exec]]

# Used for constraining memory leak tests
testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {
    proc memtest script {
	set end [lindex [split [memory info] \n] 3 3]







|







13
14
15
16
17
18
19
20
21
22
23
24
25
26
27

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

unset -nocomplain foo
source [file join [file dirname [info script]] tcltests.tcl]
testConstraint exec [llength [info commands exec]]

# Used for constraining memory leak tests
testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {
    proc memtest script {
	set end [lindex [split [memory info] \n] 3 3]

Changes to tests/registry.test.

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
    namespace import -force ::tcltest::*
}

testConstraint reg 0
if {[testConstraint win]} {
    if {![catch {
	    ::tcltest::loadTestedCommands
	    set ::regver [package require registry 1.3.6]
	}]} {
	testConstraint reg 1
    }
}
testConstraint notWine [expr {![info exists ::env(CI_USING_WINE)]}]

# determine the current locale
testConstraint english [expr {
    [llength [info commands testlocale]]
    && [string match "English*" [testlocale all ""]]
}]

test registry-1.0 {check if we are testing the right dll} {win reg} {
    set ::regver
} {1.3.6}
test registry-1.1 {argument parsing for registry command} {win reg} {
    list [catch {registry} msg] $msg
} {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}}
test registry-1.1a {argument parsing for registry command} {win reg} {
    list [catch {registry -32bit} msg] $msg
} {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}}
test registry-1.1b {argument parsing for registry command} {win reg} {







|














|







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
    namespace import -force ::tcltest::*
}

testConstraint reg 0
if {[testConstraint win]} {
    if {![catch {
	    ::tcltest::loadTestedCommands
	    set ::regver [package require registry 1.3.7]
	}]} {
	testConstraint reg 1
    }
}
testConstraint notWine [expr {![info exists ::env(CI_USING_WINE)]}]

# determine the current locale
testConstraint english [expr {
    [llength [info commands testlocale]]
    && [string match "English*" [testlocale all ""]]
}]

test registry-1.0 {check if we are testing the right dll} {win reg} {
    set ::regver
} {1.3.7}
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
15
16
17
18
19
# This file contains Tcl code to implement a remote server that can be
# used during testing of Tcl socket code. This server is used by some
# of the tests in socket.test.
#
# Source this file in the remote server you are using to test Tcl against.
#
# Copyright © 1995-1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Initialize message delimitor

# Initialize command array
catch {unset command}
set command(0) ""
set callerSocket ""

# Detect whether we should print out connection messages etc.











|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
# This file contains Tcl code to implement a remote server that can be
# used during testing of Tcl socket code. This server is used by some
# of the tests in socket.test.
#
# Source this file in the remote server you are using to test Tcl against.
#
# Copyright © 1995-1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Initialize message delimiter

# Initialize command array
catch {unset command}
set command(0) ""
set callerSocket ""

# Detect whether we should print out connection messages etc.

Changes to tests/resolver.test.

199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
# The test resolver-3.1* test bad interactions of resolvers on the "global"
# (per interp) literal pools. A resolver might resolve a cmd literal depending
# on a context differently, whereas the cmd literal sharing assumed that the
# namespace containing the literal solely determines the resolved cmd (and is
# resolver-agnostic).
#
# In order to make the test cases for the per-interpreter cmd literal pool
# reproducable and to minimize interactions between test cases, we use a child
# interpreter per test-case.
#
#
# Testing resolver in namespace-based context "ctx1"
#
test resolver-3.1a {
    interp command resolver,







|







199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
# The test resolver-3.1* test bad interactions of resolvers on the "global"
# (per interp) literal pools. A resolver might resolve a cmd literal depending
# on a context differently, whereas the cmd literal sharing assumed that the
# namespace containing the literal solely determines the resolved cmd (and is
# resolver-agnostic).
#
# In order to make the test cases for the per-interpreter cmd literal pool
# reproducible and to minimize interactions between test cases, we use a child
# interpreter per test-case.
#
#
# Testing resolver in namespace-based context "ctx1"
#
test resolver-3.1a {
    interp command resolver,

Changes to tests/safe-stock.test.

93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
    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}

testConstraint AutoSyncDefined 1

# high level general test
test safe-stock-7.1 {tests that everything works at high level with conventional AutoPathSync, use pkg opt} -setup {
    set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]







|
|







93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
    set listOut {}
    foreach element $listIn {
        lappend listOut [string map $map $element]
    }
    lsort $listOut
}

# Force actual loading of the safe package because we use unexported (and
# thus unautoindexed) APIs in this test result arguments:
catch {safe::interpConfigure}

testConstraint AutoSyncDefined 1

# high level general test
test safe-stock-7.1 {tests that everything works at high level with conventional AutoPathSync, use pkg opt} -setup {
    set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]

Changes to tests/safe.test.

52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
    set listOut {}
    foreach element $listIn {
        lappend listOut [string map $map $element]
    }
    lsort $listOut
}

# Force actual loading of the safe package because we use un-exported (and
# thus un-autoindexed) APIs in this test result arguments:
catch {safe::interpConfigure}

# testing that nested and statics do what is advertised (we use a static
# package - tcl::test - but it might be absent if we're in standard tclsh)

testConstraint tcl::test [expr {![catch {package require tcl::test}]}]
testConstraint AutoSyncDefined 1







|
|







52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
    set listOut {}
    foreach element $listIn {
        lappend listOut [string map $map $element]
    }
    lsort $listOut
}

# Force actual loading of the safe package because we use unexported (and
# thus unautoindexed) APIs in this test result arguments:
catch {safe::interpConfigure}

# testing that nested and statics do what is advertised (we use a static
# package - tcl::test - but it might be absent if we're in standard tclsh)

testConstraint tcl::test [expr {![catch {package require tcl::test}]}]
testConstraint AutoSyncDefined 1
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
} -result foobar
test safe-11.7 {testing safe encoding} -setup {
    set i [safe::interpCreate]
} -body {
    interp eval $i encoding convertfrom
} -returnCodes error -cleanup {
    safe::interpDelete $i
} -result {wrong # args: should be "encoding convertfrom ?-nocomplain? ?-strict? ?-failindex var? ?encoding? data"}
test safe-11.7.1 {testing safe encoding} -setup {
    set i [safe::interpCreate]
} -body {
    catch {interp eval $i encoding convertfrom} m o
    dict get $o -errorinfo
} -match glob -cleanup {
    unset -nocomplain m o
    safe::interpDelete $i
} -result {wrong # args: should be "encoding convertfrom ?-nocomplain? ?-strict? ?-failindex var? ?encoding? data"
    while executing
"encoding convertfrom"
    invoked from within
"encoding convertfrom"
    invoked from within
"interp eval $i encoding convertfrom"}
test safe-11.8 {testing safe encoding} -setup {
    set i [safe::interpCreate]
} -body {
    interp eval $i encoding convertto
} -returnCodes error -cleanup {
    safe::interpDelete $i
} -result {wrong # args: should be "encoding convertto ?-nocomplain? ?-strict? ?-failindex var? ?encoding? data"}
test safe-11.8.1 {testing safe encoding} -setup {
    set i [safe::interpCreate]
} -body {
    catch {interp eval $i encoding convertto} m o
    dict get $o -errorinfo
} -match glob -cleanup {
    unset -nocomplain m o
    safe::interpDelete $i
} -result {wrong # args: should be "encoding convertto ?-nocomplain? ?-strict? ?-failindex var? ?encoding? data"
    while executing
"encoding convertto"
    invoked from within
"encoding convertto"
    invoked from within
"interp eval $i encoding convertto"}








|








|












|








|







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
} -result foobar
test safe-11.7 {testing safe encoding} -setup {
    set i [safe::interpCreate]
} -body {
    interp eval $i encoding convertfrom
} -returnCodes error -cleanup {
    safe::interpDelete $i
} -result {wrong # args: should be "encoding convertfrom ?-profile profile? ?-failindex var? encoding data" or "encoding convertfrom data"}
test safe-11.7.1 {testing safe encoding} -setup {
    set i [safe::interpCreate]
} -body {
    catch {interp eval $i encoding convertfrom} m o
    dict get $o -errorinfo
} -match glob -cleanup {
    unset -nocomplain m o
    safe::interpDelete $i
} -result {wrong # args: should be "encoding convertfrom ?-profile profile? ?-failindex var? encoding data" or "encoding convertfrom data"
    while executing
"encoding convertfrom"
    invoked from within
"encoding convertfrom"
    invoked from within
"interp eval $i encoding convertfrom"}
test safe-11.8 {testing safe encoding} -setup {
    set i [safe::interpCreate]
} -body {
    interp eval $i encoding convertto
} -returnCodes error -cleanup {
    safe::interpDelete $i
} -result {wrong # args: should be "encoding convertto ?-profile profile? ?-failindex var? encoding data" or "encoding convertto data"}
test safe-11.8.1 {testing safe encoding} -setup {
    set i [safe::interpCreate]
} -body {
    catch {interp eval $i encoding convertto} m o
    dict get $o -errorinfo
} -match glob -cleanup {
    unset -nocomplain m o
    safe::interpDelete $i
} -result {wrong # args: should be "encoding convertto ?-profile profile? ?-failindex var? encoding data" or "encoding convertto data"
    while executing
"encoding convertto"
    invoked from within
"encoding convertto"
    invoked from within
"interp eval $i encoding convertto"}

Changes to tests/scan.test.

504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
} -result {4 12 34 56 78}
test scan-5.10 {integer scanning} -setup {
    set a {}; set b {}; set c {}; set d {}
} -body {
    list [scan "1 2 " "%hd %d %d %d" a b c d] $a $b $c $d
} -result {2 1 2 {} {}}
#
# The behavior for scaning intergers larger than MAX_INT is not defined by the
# ANSI spec.  Some implementations wrap the input (-16) some return MAX_INT.
#
test scan-5.11 {integer scanning} -constraints {nonPortable} -setup {
    set a {}; set b {}
} -body {
    list [scan "4294967280 4294967280" "%u %d" a b] $a \
	    [expr {$b == -16 || $b == 0x7fffffff}]







|







504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
} -result {4 12 34 56 78}
test scan-5.10 {integer scanning} -setup {
    set a {}; set b {}; set c {}; set d {}
} -body {
    list [scan "1 2 " "%hd %d %d %d" a b c d] $a $b $c $d
} -result {2 1 2 {} {}}
#
# The behavior for scanning integers larger than MAX_INT is not defined by the
# ANSI spec.  Some implementations wrap the input (-16) some return MAX_INT.
#
test scan-5.11 {integer scanning} -constraints {nonPortable} -setup {
    set a {}; set b {}
} -body {
    list [scan "4294967280 4294967280" "%u %d" a b] $a \
	    [expr {$b == -16 || $b == 0x7fffffff}]
854
855
856
857
858
859
860






861
862
863
864
865
866
867
test scan-13.7 {Tcl_ScanObjCmd, inline XPG case lots of arguments} {
    scan "10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160 170 180 190 200" {%20$d %18$d %17$d %16$d %15$d %14$d %13$d %12$d %11$d %10$d %9$d %8$d %7$d %6$d %5$d %4$d %3$d %2$d %1$d}
} {190 180 170 160 150 140 130 120 110 100 90 80 70 60 50 40 30 20 {} 10}
test scan-13.8 {Tcl_ScanObjCmd, inline XPG case lots of arguments} {
    set msg [scan "10 20 30" {%100$d %5$d %200$d}]
    list [llength $msg] [lindex $msg 99] [lindex $msg 4] [lindex $msg 199]
} {200 10 20 30}







# scan infinities - not working

test scan-14.1 {positive infinity} {
    scan Inf %g d
    return $d
} Inf







>
>
>
>
>
>







854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
test scan-13.7 {Tcl_ScanObjCmd, inline XPG case lots of arguments} {
    scan "10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160 170 180 190 200" {%20$d %18$d %17$d %16$d %15$d %14$d %13$d %12$d %11$d %10$d %9$d %8$d %7$d %6$d %5$d %4$d %3$d %2$d %1$d}
} {190 180 170 160 150 140 130 120 110 100 90 80 70 60 50 40 30 20 {} 10}
test scan-13.8 {Tcl_ScanObjCmd, inline XPG case lots of arguments} {
    set msg [scan "10 20 30" {%100$d %5$d %200$d}]
    list [llength $msg] [lindex $msg 99] [lindex $msg 4] [lindex $msg 199]
} {200 10 20 30}
test scan-13.9 {Tcl_ScanObjCmd, inline XPG case limit error} -body {
    # Note this applies to 64-bit builds as well so long as max number of
    # command line arguments allowed for scan command is INT_MAX
    scan abc {%2147483648$s}
} -result {"%n$" argument index out of range} -returnCodes error


# scan infinities - not working

test scan-14.1 {positive infinity} {
    scan Inf %g d
    return $d
} Inf

Changes to tests/set-old.test.

165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
    list [catch {set a} msg] $msg
} {1 {can't read "a": variable is array}}

# Errors and other special cases in writing variables

test set-old-6.1 {creating array during write} {
    catch {unset a}
    trace var a rwu ignore
    list [catch {set a(14) 186} msg] $msg [array names a]
} {0 186 14}
test set-old-6.2 {errors in writing variables} {
    catch {unset a}
    set a xxx
    list [catch {set a(14) 186} msg] $msg
} {1 {can't set "a(14)": variable isn't array}}







|







165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
    list [catch {set a} msg] $msg
} {1 {can't read "a": variable is array}}

# Errors and other special cases in writing variables

test set-old-6.1 {creating array during write} {
    catch {unset a}
    trace add var a {read write unset} ignore
    list [catch {set a(14) 186} msg] $msg [array names a]
} {0 186 14}
test set-old-6.2 {errors in writing variables} {
    catch {unset a}
    set a xxx
    list [catch {set a(14) 186} msg] $msg
} {1 {can't set "a(14)": variable isn't array}}
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
    set a(22) 3
    set {a(long name)} {}
    lsort [array get a]
} {{} 22 3 {long name}}
test set-old-8.19 {array command, get option (unset variable)} {
    catch {unset a}
    set a(x) 3
    trace var a(y) w ignore
    array get a
} {x 3}
test set-old-8.20 {array command, get option, with pattern} {
    catch {unset a}
    set a(x1) 3
    set a(x2) 4
    set a(x3) 5







|







403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
    set a(22) 3
    set {a(long name)} {}
    lsort [array get a]
} {{} 22 3 {long name}}
test set-old-8.19 {array command, get option (unset variable)} {
    catch {unset a}
    set a(x) 3
    trace add var a(y) write ignore
    array get a
} {x 3}
test set-old-8.20 {array command, get option, with pattern} {
    catch {unset a}
    set a(x1) 3
    set a(x2) 4
    set a(x3) 5
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
    catch {unset a}
    set a(22) 3; set a(Textual_name) 44; set "a(name with spaces)" xxx
    list [catch {lsort [array names a]} msg] $msg
} {0 {22 Textual_name {name with spaces}}}
test set-old-8.25 {array command, names option} {
    catch {unset a}
    set a(22) 3; set a(33) 44;
    trace var a(xxx) w ignore
    list [catch {lsort [array names a]} msg] $msg
} {0 {22 33}}
test set-old-8.26 {array command, names option} {
    catch {unset a}
    set a(22) 3; set a(33) 44;
    trace var a(xxx) w ignore
    set a(xxx) value
    list [catch {lsort [array names a]} msg] $msg
} {0 {22 33 xxx}}
test set-old-8.27 {array command, names option} {
    catch {unset a}
    set a(axy) 3
    set a(bxy) 44







|





|







441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
    catch {unset a}
    set a(22) 3; set a(Textual_name) 44; set "a(name with spaces)" xxx
    list [catch {lsort [array names a]} msg] $msg
} {0 {22 Textual_name {name with spaces}}}
test set-old-8.25 {array command, names option} {
    catch {unset a}
    set a(22) 3; set a(33) 44;
    trace add var a(xxx) write ignore
    list [catch {lsort [array names a]} msg] $msg
} {0 {22 33}}
test set-old-8.26 {array command, names option} {
    catch {unset a}
    set a(22) 3; set a(33) 44;
    trace add var a(xxx) write ignore
    set a(xxx) value
    list [catch {lsort [array names a]} msg] $msg
} {0 {22 33 xxx}}
test set-old-8.27 {array command, names option} {
    catch {unset a}
    set a(axy) 3
    set a(bxy) 44
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
    set a(22) 3; set a(xx) 44; set a(y) xxx
    unset a(22) a(y) a(xx)
    list [catch {array size a} msg] $msg
} {0 0}
test set-old-8.44 {array command, size option} {
    catch {unset a}
    set a(22) 3;
    trace var a(33) rwu ignore
    list [catch {array size a} msg] $msg
} {0 1}
test set-old-8.45 {array command, size option, array doesn't exist yet but has compiler-allocated procedure slot} {
    proc foo {x} {
        if {$x==1} {
            return [array size a]
        }







|







575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
    set a(22) 3; set a(xx) 44; set a(y) xxx
    unset a(22) a(y) a(xx)
    list [catch {array size a} msg] $msg
} {0 0}
test set-old-8.44 {array command, size option} {
    catch {unset a}
    set a(22) 3;
    trace add var a(33) {read write unset} ignore
    list [catch {array size a} msg] $msg
} {0 1}
test set-old-8.45 {array command, size option, array doesn't exist yet but has compiler-allocated procedure slot} {
    proc foo {x} {
        if {$x==1} {
            return [array size a]
        }
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
	    [catch {array next a $y} msg2] $msg2
} {0 a 0 a}
test set-old-9.10 {array enumeration: searches automatically stopped} {
    catch {unset a}
    set a(a) 1
    set x [array startsearch a]
    set y [array startsearch a]
    trace var a(b) r {}
    list [catch {array next a $x} msg] $msg \
	    [catch {array next a $y} msg2] $msg2
} {1 {couldn't find search "s-1-a"} 1 {couldn't find search "s-2-a"}}
test set-old-9.11 {array enumeration: searches automatically stopped} {
    catch {unset a}
    set a(a) 1
    set x [array startsearch a]
    set y [array startsearch a]
    trace var a(a) r {}
    list [catch {array next a $x} msg] $msg \
	    [catch {array next a $y} msg2] $msg2
} {0 a 0 a}
test set-old-9.12 {array enumeration with traced undefined elements} {
    catch {unset a}
    set a(a) 1
    trace var a(b) r {}
    set x [array startsearch a]
    lsort [list [array next a $x] [array next a $x]]
} {{} a}

test set-old-10.1 {array enumeration errors} {
    list [catch {array start} msg] $msg
} {1 {wrong # args: should be "array startsearch arrayName"}}







|








|






|







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
	    [catch {array next a $y} msg2] $msg2
} {0 a 0 a}
test set-old-9.10 {array enumeration: searches automatically stopped} {
    catch {unset a}
    set a(a) 1
    set x [array startsearch a]
    set y [array startsearch a]
    trace add var a(b) read {}
    list [catch {array next a $x} msg] $msg \
	    [catch {array next a $y} msg2] $msg2
} {1 {couldn't find search "s-1-a"} 1 {couldn't find search "s-2-a"}}
test set-old-9.11 {array enumeration: searches automatically stopped} {
    catch {unset a}
    set a(a) 1
    set x [array startsearch a]
    set y [array startsearch a]
    trace add var a(a) read {}
    list [catch {array next a $x} msg] $msg \
	    [catch {array next a $y} msg2] $msg2
} {0 a 0 a}
test set-old-9.12 {array enumeration with traced undefined elements} {
    catch {unset a}
    set a(a) 1
    trace add var a(b) read {}
    set x [array startsearch a]
    lsort [list [array next a $x] [array next a $x]]
} {{} a}

test set-old-10.1 {array enumeration errors} {
    list [catch {array start} msg] $msg
} {1 {wrong # args: should be "array startsearch arrayName"}}

Changes to tests/set.test.

259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
    list [catch {set a(18)} msg] $msg
} -result {1 {can't read "a(18)": no such element in array}}
test set-2.4 {set command: runtime error, readonly variable} -setup {
    unset -nocomplain x
} -body {
    proc readonly args {error "variable is read-only"}
    set x 123
    trace var x w readonly
    list [catch {set x 1} msg] $msg $::errorInfo
} -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only
    while executing
*
"set x 1"}}
test set-2.5 {set command: runtime error, basic array operations} -setup {
    unset -nocomplain a







|







259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
    list [catch {set a(18)} msg] $msg
} -result {1 {can't read "a(18)": no such element in array}}
test set-2.4 {set command: runtime error, readonly variable} -setup {
    unset -nocomplain x
} -body {
    proc readonly args {error "variable is read-only"}
    set x 123
    trace add var x write readonly
    list [catch {set x 1} msg] $msg $::errorInfo
} -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only
    while executing
*
"set x 1"}}
test set-2.5 {set command: runtime error, basic array operations} -setup {
    unset -nocomplain a
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
    $z a(6) 44
    list [catch {$z a(18)} msg] $msg
} -result {1 {can't read "a(18)": no such element in array}}
test set-4.4 {uncompiled set command: runtime error, readonly variable} -body {
    set z set
    proc readonly args {error "variable is read-only"}
    $z x 123
    trace var x w readonly
    list [catch {$z x 1} msg] $msg $::errorInfo
} -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only
    while executing
*
"$z x 1"}}
test set-4.5 {uncompiled set command: runtime error, basic array operations} -setup {
    unset -nocomplain a







|







517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
    $z a(6) 44
    list [catch {$z a(18)} msg] $msg
} -result {1 {can't read "a(18)": no such element in array}}
test set-4.4 {uncompiled set command: runtime error, readonly variable} -body {
    set z set
    proc readonly args {error "variable is read-only"}
    $z x 123
    trace add var x write readonly
    list [catch {$z x 1} msg] $msg $::errorInfo
} -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only
    while executing
*
"$z x 1"}}
test set-4.5 {uncompiled set command: runtime error, basic array operations} -setup {
    unset -nocomplain a

Changes to tests/socket.test.

123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
puts $s2 test1; gets $s1
puts $s2 test2; gets $s1
close $s1; close $s2
set t2 [clock milliseconds]
set lat1 [expr {($t2-$t1)*2}]; # doubled as a safety margin

# Test the latency of failed connection attempts over the loopback
# interface. They can take more than a second under Windowos and requres
# additional [after]s in some tests that are not needed on systems that fail
# immediately.
set t1 [clock milliseconds]
catch {socket 127.0.0.1 [randport]}
set t2 [clock milliseconds]
set lat2 [expr {($t2-$t1)*3}]








|







123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
puts $s2 test1; gets $s1
puts $s2 test2; gets $s1
close $s1; close $s2
set t2 [clock milliseconds]
set lat1 [expr {($t2-$t1)*2}]; # doubled as a safety margin

# Test the latency of failed connection attempts over the loopback
# interface. They can take more than a second under Windows and requires
# additional [after]s in some tests that are not needed on systems that fail
# immediately.
set t1 [clock milliseconds]
catch {socket 127.0.0.1 [randport]}
set t2 [clock milliseconds]
set lat2 [expr {($t2-$t1)*3}]

1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
} -result {3 1 0}
test socket_$af-7.3 {testing socket specific options} -constraints [list socket supported_$af] -body {
    set s [socket -server accept -myaddr $localhost 0]
    set l [fconfigure $s]
    close $s
    update
    llength $l
} -result 22
test socket_$af-7.4 {testing socket specific options} -constraints [list socket supported_$af] -setup {
    set timer [after 10000 "set x timed_out"]
    set l ""
} -body {
    set s [socket -server accept -myaddr $localhost 0]
    proc accept {s a p} {
	global x







|







1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
} -result {3 1 0}
test socket_$af-7.3 {testing socket specific options} -constraints [list socket supported_$af] -body {
    set s [socket -server accept -myaddr $localhost 0]
    set l [fconfigure $s]
    close $s
    update
    llength $l
} -result 20
test socket_$af-7.4 {testing socket specific options} -constraints [list socket supported_$af] -setup {
    set timer [after 10000 "set x timed_out"]
    set l ""
} -body {
    set s [socket -server accept -myaddr $localhost 0]
    proc accept {s a p} {
	global x
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
  try {
    set ::count 0
    set ::testmode $testmode
    set port 0
    set srvsock {}
    # if binding on port 0 is not possible (system related, blocked on ISPs etc):
    if {[catch {close [socket -async $::localhost $port]}]} {
      # simplest server on random port (immediatelly closing a connect):
      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
      }
    }







|







1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
  try {
    set ::count 0
    set ::testmode $testmode
    set port 0
    set srvsock {}
    # if binding on port 0 is not possible (system related, blocked on ISPs etc):
    if {[catch {close [socket -async $::localhost $port]}]} {
      # simplest server on random port (immediately closing a connect):
      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
      }
    }
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
          }} $fd]
        };#
        thread::detach $fd
        thread::send -async $::parent [list transf_parent $fd {*}$args]
      }
      iteration first
    }
    # parent proc commiting transfer attempt (attach) and checking acquire was successful:
    proc transf_parent {fd args} {
      tcltest::DebugPuts 2 "** trma / $::count ** $args **"
      thread::attach $fd
      if {"parent-close" in $::testmode} {;# to test close during connect
        set ::count $::count
        close $fd
        return







|







1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
          }} $fd]
        };#
        thread::detach $fd
        thread::send -async $::parent [list transf_parent $fd {*}$args]
      }
      iteration first
    }
    # parent proc committing transfer attempt (attach) and checking acquire was successful:
    proc transf_parent {fd args} {
      tcltest::DebugPuts 2 "** trma / $::count ** $args **"
      thread::attach $fd
      if {"parent-close" in $::testmode} {;# to test close during connect
        set ::count $::count
        close $fd
        return
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
    -constraints {socket} \
    -body {
        set sock [socket -async localhost [randport]]
        catch {gets $sock} x
        list $x [fconfigure $sock -error] [fconfigure $sock -error]
    } -cleanup {
        close $sock
    } -match glob -result {{error reading "sock*": socket is not connected} {connection refused} {}}
test socket-14.8.0 {pending [socket -async] and nonblocking [gets], server is IPv4} \
    -constraints {socket supported_inet localhost_v4} \
    -setup {
        makeFile {
            fileevent stdin readable exit
            set server [socket -server accept -myaddr 127.0.0.1 0]
            proc accept {s h p} {puts $s ok; close $s; set ::x 1}







|







2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
    -constraints {socket} \
    -body {
        set sock [socket -async localhost [randport]]
        catch {gets $sock} x
        list $x [fconfigure $sock -error] [fconfigure $sock -error]
    } -cleanup {
        close $sock
    } -match glob -result {{error reading "sock*": transport endpoint is not connected} {connection refused} {}}
test socket-14.8.0 {pending [socket -async] and nonblocking [gets], server is IPv4} \
    -constraints {socket supported_inet localhost_v4} \
    -setup {
        makeFile {
            fileevent stdin readable exit
            set server [socket -server accept -myaddr 127.0.0.1 0]
            proc accept {s h p} {puts $s ok; close $s; set ::x 1}
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
        for {set i 0} {$i < 50} {incr i } {
            if {[catch {gets $sock} x] || $x ne "" || ![fblocked $sock]} break
            after 200
        }
        list $x [fconfigure $sock -error] [fconfigure $sock -error]
    } -cleanup {
        close $sock
    } -match glob -result {{error reading "sock*": socket is not connected} {connection refused} {}}
test socket-14.9.0 {pending [socket -async] and blocking [puts], server is IPv4} \
    -constraints {socket supported_inet localhost_v4} \
    -setup {
        makeFile {
            fileevent stdin readable exit
            set server [socket -server accept -myaddr 127.0.0.1 0]
            proc accept {s h p} {set ::x $s}







|







2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
        for {set i 0} {$i < 50} {incr i } {
            if {[catch {gets $sock} x] || $x ne "" || ![fblocked $sock]} break
            after 200
        }
        list $x [fconfigure $sock -error] [fconfigure $sock -error]
    } -cleanup {
        close $sock
    } -match glob -result {{error reading "sock*": transport endpoint is not connected} {connection refused} {}}
test socket-14.9.0 {pending [socket -async] and blocking [puts], server is IPv4} \
    -constraints {socket supported_inet localhost_v4} \
    -setup {
        makeFile {
            fileevent stdin readable exit
            set server [socket -server accept -myaddr 127.0.0.1 0]
            proc accept {s h p} {set ::x $s}
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
        puts $sock ok
        fileevent $sock writable {set x 1}
        vwait x
        close $sock
    } -cleanup {
        catch {close $sock}
        unset x
    } -result {socket is not connected} -returnCodes 1
test socket-14.11.1 {pending [socket -async] and nonblocking [puts], no listener, flush} \
    -constraints {socket testsocket_testflags} \
    -body {
        set sock [socket -async localhost [randport]]
        # Set the socket in async test mode.
        # The async connect will not be continued on the following fconfigure
        # and puts/flush. Thus, the connect will fail after them.
        testsocket testflags $sock 1
        fconfigure $sock -blocking 0
        puts $sock ok
        flush $sock
        testsocket testflags $sock 0
        fileevent $sock writable {set x 1}
        vwait x
        close $sock
    } -cleanup {
        catch {close $sock}
        catch {unset x}
    } -result {socket is not connected} -returnCodes 1
test socket-14.12 {[socket -async] background progress triggered by [fconfigure -error]} \
    -constraints {socket} \
    -body {
        set s [socket -async localhost [randport]]
        for {set i 0} {$i < 50} {incr i} {
            set x [fconfigure $s -error]
            if {$x != ""} break







|


















|







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
        puts $sock ok
        fileevent $sock writable {set x 1}
        vwait x
        close $sock
    } -cleanup {
        catch {close $sock}
        unset x
    } -result {transport endpoint is not connected} -returnCodes 1
test socket-14.11.1 {pending [socket -async] and nonblocking [puts], no listener, flush} \
    -constraints {socket testsocket_testflags} \
    -body {
        set sock [socket -async localhost [randport]]
        # Set the socket in async test mode.
        # The async connect will not be continued on the following fconfigure
        # and puts/flush. Thus, the connect will fail after them.
        testsocket testflags $sock 1
        fconfigure $sock -blocking 0
        puts $sock ok
        flush $sock
        testsocket testflags $sock 0
        fileevent $sock writable {set x 1}
        vwait x
        close $sock
    } -cleanup {
        catch {close $sock}
        catch {unset x}
    } -result {transport endpoint is not connected} -returnCodes 1
test socket-14.12 {[socket -async] background progress triggered by [fconfigure -error]} \
    -constraints {socket} \
    -body {
        set s [socket -async localhost [randport]]
        for {set i 0} {$i < 50} {incr i} {
            set x [fconfigure $s -error]
            if {$x != ""} break
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457

test socket-14.13 {testing writable event when quick failure} \
    -constraints {socket win supported_inet notWine} \
    -body {
    # Test for bug 336441ed59 where a quick background fail was ignored

    # Test only for windows as socket -async 255.255.255.255 fails
    # directly on unix

    # The following connect should fail very quickly
    set a1 [after 2000 {set x timeout}]
    set s [socket -async 255.255.255.255 43434]
    fileevent $s writable {set x writable}
    vwait x
    set x







|







2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457

test socket-14.13 {testing writable event when quick failure} \
    -constraints {socket win supported_inet notWine} \
    -body {
    # Test for bug 336441ed59 where a quick background fail was ignored

    # Test only for windows as socket -async 255.255.255.255 fails
    # directly on Unix

    # The following connect should fail very quickly
    set a1 [after 2000 {set x timeout}]
    set s [socket -async 255.255.255.255 43434]
    fileevent $s writable {set x writable}
    vwait x
    set x

Changes to tests/string.test.

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
if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]

package require tcltests

# Helper commands to test various optimizations, code paths, and special cases.
proc makeByteArray {s} {binary format a* $s}
proc makeUnicode {s} {lindex [regexp -inline .* $s] 0}
proc makeList {args} {return $args}
proc makeShared {s} {uplevel 1 [list lappend copy $s]; return $s}

# Some tests require the testobj command

testConstraint testobj [expr {[info commands testobj] ne {}}]
testConstraint testindexobj [expr {[info commands testindexobj] ne {}}]
testConstraint testevalex [expr {[info commands testevalex] ne {}}]
testConstraint utf32 [expr {[string length \U010000] == 1}]
testConstraint testbytestring   [llength [info commands testbytestring]]
testConstraint utf32 [expr {[testConstraint fullutf]
		&& [string length [format %c 0x10000]] == 1}]

# Used for constraining memory leak tests
testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {







>
|












|







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
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]]
source [file join [file dirname [info script]] tcltests.tcl]


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

# Some tests require the testobj command

testConstraint testobj [expr {[info commands testobj] ne {}}]
testConstraint testindexobj [expr {[info commands testindexobj] ne {}}]
testConstraint testevalex [expr {[info commands testevalex] ne {}}]
testConstraint fullutf [expr {[format %c 0x010000] ne "\uFFFD"}]
testConstraint testbytestring   [llength [info commands testbytestring]]
testConstraint utf32 [expr {[testConstraint fullutf]
		&& [string length [format %c 0x10000]] == 1}]

# Used for constraining memory leak tests
testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
test string-2.11.2.$noComp {string compare, unicode} {
    run {string compare Ü ü}
} -1
test string-2.11.3.$noComp {string compare, unicode} {
    run {string compare ÜÜÜüü ÜÜÜÜÜ}
} 1
test string-2.12.$noComp {string compare, high bit} {
    # This test will fail if the underlying comparison
    # is using signed chars instead of unsigned chars.
    # (like SunOS's default memcmp thus the compat/memcmp.c)
    run {string compare "\x80" "@"}
    # Nb this tests works also in utf-8 space because \x80 is
    # translated into a 2 or more bytelength but whose first byte has
    # the high bit set.
} 1







|







131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
test string-2.11.2.$noComp {string compare, unicode} {
    run {string compare Ü ü}
} -1
test string-2.11.3.$noComp {string compare, unicode} {
    run {string compare ÜÜÜüü ÜÜÜÜÜ}
} 1
test string-2.12.$noComp {string compare, high bit} {
    # This test fails 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
    # translated into a 2 or more bytelength but whose first byte has
    # the high bit set.
} 1
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
} 0
test string-2.26.$noComp {string compare -nocase, null strings} {
    run {string compare -nocase "" foo}
} -1
test string-2.27.$noComp {string compare -nocase, null strings} {
    run {string compare -nocase foo ""}
} 1
test string-2.28.$noComp {string compare with length, unequal strings} {
    run {string compare -length 2 abc abde}
} 0
test string-2.29.$noComp {string compare with length, unequal strings} {
    run {string compare -length 2 ab abde}
} 0
test string-2.30.$noComp {string compare with NUL character vs. other ASCII} {
    # Be careful here, since UTF-8 rep comparison with memcmp() of
    # these puts chars in the wrong order
    run {string compare \x00 \x01}
} -1







|


|







195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
} 0
test string-2.26.$noComp {string compare -nocase, null strings} {
    run {string compare -nocase "" foo}
} -1
test string-2.27.$noComp {string compare -nocase, null strings} {
    run {string compare -nocase foo ""}
} 1
test string-2.28.$noComp {string compare with length, unequal strings, partial first string} {
    run {string compare -length 2 abc abde}
} 0
test string-2.29.$noComp {string compare with length, unequal strings 2, full first string} {
    run {string compare -length 2 ab abde}
} 0
test string-2.30.$noComp {string compare with NUL character vs. other ASCII} {
    # Be careful here, since UTF-8 rep comparison with memcmp() of
    # these puts chars in the wrong order
    run {string compare \x00 \x01}
} -1
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
test string-3.18.$noComp {string equal, unicode} {
    run {string equal Ü ü}
} 0
test string-3.19.$noComp {string equal, unicode} {
    run {string equal ÜÜÜüü ÜÜÜÜÜ}
} 0
test string-3.20.$noComp {string equal, high bit} {
    # This test will fail if the underlying comparison
    # is using signed chars instead of unsigned chars.
    # (like SunOS's default memcmp thus the compat/memcmp.c)
    run {string equal "\x80" "@"}
    # Nb this tests works also in utf8 space because \x80 is
    # translated into a 2 or more bytelength but whose first byte has
    # the high bit set.
} 0







|







286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
test string-3.18.$noComp {string equal, unicode} {
    run {string equal Ü ü}
} 0
test string-3.19.$noComp {string equal, unicode} {
    run {string equal ÜÜÜüü ÜÜÜÜÜ}
} 0
test string-3.20.$noComp {string equal, high bit} {
    # This test fails 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
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
test string-29.11.$noComp {string cat, efficiency} -body {
    tcl::unsupported::representation \
	[run {string cat [list x] [encoding convertto utf-8 {}]}]
} -match glob -result {*no string representation}
test string-29.12.$noComp {string cat, efficiency} -body {
    tcl::unsupported::representation \
	[run {string cat [encoding convertto utf-8 {}] [list x]}]
} -match glob -result {*, string representation "x"}
test string-29.13.$noComp {string cat, efficiency} -body {
    tcl::unsupported::representation [run {string cat \
	[encoding convertto utf-8 {}] [encoding convertto utf-8 {}] [list x]}]
} -match glob -result {*, string representation "x"}
test string-29.14.$noComp {string cat, efficiency} -setup {
    set e [encoding convertto utf-8 {}]
} -cleanup {
    unset e
} -body {
    tcl::unsupported::representation [run {string cat $e $e [list x]}]
} -match glob -result {*no string representation}







|



|







2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
test string-29.11.$noComp {string cat, efficiency} -body {
    tcl::unsupported::representation \
	[run {string cat [list x] [encoding convertto utf-8 {}]}]
} -match glob -result {*no string representation}
test string-29.12.$noComp {string cat, efficiency} -body {
    tcl::unsupported::representation \
	[run {string cat [encoding convertto utf-8 {}] [list x]}]
} -match glob -result {*, no string representation}
test string-29.13.$noComp {string cat, efficiency} -body {
    tcl::unsupported::representation [run {string cat \
	[encoding convertto utf-8 {}] [encoding convertto utf-8 {}] [list x]}]
} -match glob -result {*, no string representation}
test string-29.14.$noComp {string cat, efficiency} -setup {
    set e [encoding convertto utf-8 {}]
} -cleanup {
    unset e
} -body {
    tcl::unsupported::representation [run {string cat $e $e [list x]}]
} -match glob -result {*no string representation}

Changes to tests/stringObj.test.

27
28
29
30
31
32
33



34
35
36
37
38
39
40

test stringObj-1.1 {string type registration} testobj {
    set t [testobj types]
    set first [string first "string" $t]
    set result [expr {$first >= 0}]
} 1




test stringObj-2.1 {Tcl_NewStringObj} testobj {
    set result ""
    lappend result [testobj freeallvars]
    lappend result [teststringobj set 1 abcd]
    lappend result [testobj type 1]
    lappend result [testobj refcount 1]
} {{} abcd string 2}







>
>
>







27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43

test stringObj-1.1 {string type registration} testobj {
    set t [testobj types]
    set first [string first "string" $t]
    set result [expr {$first >= 0}]
} 1

set INT_MAX 0x7fffffff; # Assumes sizeof(int) == 4
set SIZE_MAX [expr {(1 << (8*$::tcl_platform(pointerSize) - 1)) - 1}]

test stringObj-2.1 {Tcl_NewStringObj} testobj {
    set result ""
    lappend result [testobj freeallvars]
    lappend result [teststringobj set 1 abcd]
    lappend result [testobj type 1]
    lappend result [testobj refcount 1]
} {{} abcd string 2}
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
    list [teststringobj length 1] [teststringobj length2 1] \
	    [teststringobj get 1]
} {3 4 tes}
test stringObj-4.2 {Tcl_SetObjLength procedure, string gets longer} testobj {
    testobj freeallvars
    teststringobj set 1 abcdef
    teststringobj setlength 1 10
    list [teststringobj length 1] [teststringobj length2 1]
} {10 10}
test stringObj-4.3 {Tcl_SetObjLength procedure, string gets longer} testobj {
    testobj freeallvars
    teststringobj set 1 abcdef
    teststringobj append 1 xyzq -1
    list [teststringobj length 1] [teststringobj length2 1] \
	    [teststringobj get 1]
} {10 20 abcdefxyzq}
test stringObj-4.4 {Tcl_SetObjLength procedure, "expty string", length 0} testobj {
    testobj freeallvars
    testobj newobj 1
    teststringobj setlength 1 0
    list [teststringobj length2 1] [teststringobj get 1]
} {0 {}}

test stringObj-5.1 {Tcl_AppendToObj procedure, type conversion} testobj {







|
|






|
|







66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
    list [teststringobj length 1] [teststringobj length2 1] \
	    [teststringobj get 1]
} {3 4 tes}
test stringObj-4.2 {Tcl_SetObjLength procedure, string gets longer} testobj {
    testobj freeallvars
    teststringobj set 1 abcdef
    teststringobj setlength 1 10
    teststringobj length 1
} 10
test stringObj-4.3 {Tcl_SetObjLength procedure, string gets longer} testobj {
    testobj freeallvars
    teststringobj set 1 abcdef
    teststringobj append 1 xyzq -1
    list [teststringobj length 1] [teststringobj length2 1] \
	    [teststringobj get 1]
} {10 15 abcdefxyzq}
test stringObj-4.4 {Tcl_SetObjLength procedure, "empty string", length 0} testobj {
    testobj freeallvars
    testobj newobj 1
    teststringobj setlength 1 0
    list [teststringobj length2 1] [teststringobj get 1]
} {0 {}}

test stringObj-5.1 {Tcl_AppendToObj procedure, type conversion} testobj {
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
    set result {}
    teststringobj append 1 1234567890123 -1
    lappend result [teststringobj length 1] [teststringobj length2 1]
    teststringobj setlength 1 10
    teststringobj append 1 abcdef -1
    lappend result [teststringobj length 1] [teststringobj length2 1] \
	    [teststringobj get 1]
} {15 15 16 32 xy12345678abcdef}

test stringObj-6.1 {Tcl_AppendStringsToObj procedure, type conversion} testobj {
    testobj freeallvars
    teststringobj set2 1 [list a b]
    teststringobj appendstrings 1 xyz { 1234 } foo
    teststringobj get 1
} {a bxyz 1234 foo}







|







107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
    set result {}
    teststringobj append 1 1234567890123 -1
    lappend result [teststringobj length 1] [teststringobj length2 1]
    teststringobj setlength 1 10
    teststringobj append 1 abcdef -1
    lappend result [teststringobj length 1] [teststringobj length2 1] \
	    [teststringobj get 1]
} {15 15 16 24 xy12345678abcdef}

test stringObj-6.1 {Tcl_AppendStringsToObj procedure, type conversion} testobj {
    testobj freeallvars
    teststringobj set2 1 [list a b]
    teststringobj appendstrings 1 xyz { 1234 } foo
    teststringobj get 1
} {a bxyz 1234 foo}
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
    list [teststringobj length 1] [teststringobj get 1]
} {15 {abc 123 abcdefg}}
test stringObj-6.5 {Tcl_AppendStringsToObj procedure, don't double space if initial string empty} testobj {
    testobj freeallvars
    testobj newobj 1
    teststringobj appendstrings 1 123 abcdefg
    list [teststringobj length 1] [teststringobj length2 1] [teststringobj get 1]
} {10 20 123abcdefg}
test stringObj-6.6 {Tcl_AppendStringsToObj procedure, space reallocation} testobj {
    testobj freeallvars
    teststringobj set 1 abc
    teststringobj setlength 1 10
    teststringobj setlength 1 2
    teststringobj appendstrings 1 34567890
    list [teststringobj length 1] [teststringobj length2 1] \
	    [teststringobj get 1]
} {10 10 ab34567890}
test stringObj-6.7 {Tcl_AppendStringsToObj procedure, space reallocation} testobj {
    testobj freeallvars
    teststringobj set 1 abc
    teststringobj setlength 1 10
    teststringobj setlength 1 2
    teststringobj appendstrings 1 34567890x
    list [teststringobj length 1] [teststringobj length2 1] \
	    [teststringobj get 1]
} {11 22 ab34567890x}
test stringObj-6.8 {Tcl_AppendStringsToObj procedure, object totally empty} testobj {
    testobj freeallvars
    testobj newobj 1
    teststringobj appendstrings 1 {}
    list [teststringobj length2 1] [teststringobj get 1]
} {0 {}}
test stringObj-6.9 {Tcl_AppendStringToObj, pure unicode} testobj {
    testobj freeallvars
    teststringobj set2 1 [string replace abc 1 1 d]
    teststringobj appendstrings 1 foo bar soom
    teststringobj get 1
} adcfoobarsoom

test stringObj-7.1 {SetStringFromAny procedure} testobj {
    testobj freeallvars
    teststringobj set2 1 [list a b]
    teststringobj append 1 x -1
    list [teststringobj length 1] [teststringobj length2 1] \
	    [teststringobj get 1]
} {4 8 {a bx}}
test stringObj-7.2 {SetStringFromAny procedure, null object} testobj {
    testobj freeallvars
    testobj newobj 1
    teststringobj appendstrings 1 {}
    list [teststringobj length 1] [teststringobj length2 1] \
	    [teststringobj get 1]
} {0 0 {}}







|

















|



















|







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
    list [teststringobj length 1] [teststringobj get 1]
} {15 {abc 123 abcdefg}}
test stringObj-6.5 {Tcl_AppendStringsToObj procedure, don't double space if initial string empty} testobj {
    testobj freeallvars
    testobj newobj 1
    teststringobj appendstrings 1 123 abcdefg
    list [teststringobj length 1] [teststringobj length2 1] [teststringobj get 1]
} {10 15 123abcdefg}
test stringObj-6.6 {Tcl_AppendStringsToObj procedure, space reallocation} testobj {
    testobj freeallvars
    teststringobj set 1 abc
    teststringobj setlength 1 10
    teststringobj setlength 1 2
    teststringobj appendstrings 1 34567890
    list [teststringobj length 1] [teststringobj length2 1] \
	    [teststringobj get 1]
} {10 10 ab34567890}
test stringObj-6.7 {Tcl_AppendStringsToObj procedure, space reallocation} testobj {
    testobj freeallvars
    teststringobj set 1 abc
    teststringobj setlength 1 10
    teststringobj setlength 1 2
    teststringobj appendstrings 1 34567890x
    list [teststringobj length 1] [teststringobj length2 1] \
	    [teststringobj get 1]
} {11 17 ab34567890x}
test stringObj-6.8 {Tcl_AppendStringsToObj procedure, object totally empty} testobj {
    testobj freeallvars
    testobj newobj 1
    teststringobj appendstrings 1 {}
    list [teststringobj length2 1] [teststringobj get 1]
} {0 {}}
test stringObj-6.9 {Tcl_AppendStringToObj, pure unicode} testobj {
    testobj freeallvars
    teststringobj set2 1 [string replace abc 1 1 d]
    teststringobj appendstrings 1 foo bar soom
    teststringobj get 1
} adcfoobarsoom

test stringObj-7.1 {SetStringFromAny procedure} testobj {
    testobj freeallvars
    teststringobj set2 1 [list a b]
    teststringobj append 1 x -1
    list [teststringobj length 1] [teststringobj length2 1] \
	    [teststringobj get 1]
} {4 6 {a bx}}
test stringObj-7.2 {SetStringFromAny procedure, null object} testobj {
    testobj freeallvars
    testobj newobj 1
    teststringobj appendstrings 1 {}
    list [teststringobj length 1] [teststringobj length2 1] \
	    [teststringobj get 1]
} {0 0 {}}
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
    teststringobj set 1 {}
    teststringobj append 1 abcde -1
    testobj duplicate 1 2
    list [teststringobj length 1] [teststringobj length2 1] \
	    [teststringobj maxchars 1] [teststringobj get 1] \
	    [teststringobj length 2] [teststringobj length2 2] \
	    [teststringobj maxchars 2] [teststringobj get 2]
} {5 10 0 abcde 5 5 0 abcde}
test stringObj-8.2 {DupUnicodeInternalRep, mixed width chars} testobj {
    set x abc\xEF\xBF\xAEghi
    string length $x
    set y $x
    list [testobj objtype $x] [testobj objtype $y] [append x "\xAE\xBF\xEF"] \
	    [set y] [testobj objtype $x] [testobj objtype $y]
} "string string abc\xEF\xBF\xAEghi\xAE\xBF\xEF abc\xEF\xBF\xAEghi string string"







|







204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
    teststringobj set 1 {}
    teststringobj append 1 abcde -1
    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 8 0 abcde 5 5 0 abcde}
test stringObj-8.2 {DupUnicodeInternalRep, mixed width chars} testobj {
    set x abc\xEF\xBF\xAEghi
    string length $x
    set y $x
    list [testobj objtype $x] [testobj objtype $y] [append x "\xAE\xBF\xEF"] \
	    [set y] [testobj objtype $x] [testobj objtype $y]
} "string string abc\xEF\xBF\xAEghi\xAE\xBF\xEF abc\xEF\xBF\xAEghi string string"
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
    string length $x
    list [testobj objtype $x] [testobj objtype $y] [append x $y] \
	    [set y] [testobj objtype $x] [testobj objtype $y]
} "string int abc\xEF\xBF\xAEghi9 9 string int"
test stringObj-9.11 {TclAppendObjToObj, mixed src & 1-byte dest index check} testobj {
    # bug 2678, in <=8.2.0, the second obj (the one to append) in
    # Tcl_AppendObjToObj was not correctly checked to see if it was all one
    # byte chars, so a unicode string would be added as one byte chars.
    set x abcdef
    set len [string length $x]
    set y a\xFCb\xE5c\xEF
    set len [string length $y]
    append x $y
    string length $x
    set q {}







|







314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
    string length $x
    list [testobj objtype $x] [testobj objtype $y] [append x $y] \
	    [set y] [testobj objtype $x] [testobj objtype $y]
} "string int abc\xEF\xBF\xAEghi9 9 string int"
test stringObj-9.11 {TclAppendObjToObj, mixed src & 1-byte dest index check} testobj {
    # bug 2678, in <=8.2.0, the second obj (the one to append) in
    # Tcl_AppendObjToObj was not correctly checked to see if it was all one
    # byte chars, so a Unicode string would be added as one byte chars.
    set x abcdef
    set len [string length $x]
    set y a\xFCb\xE5c\xEF
    set len [string length $y]
    append x $y
    string length $x
    set q {}
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
    list [string length $a] [string length $a]
} {6 6}
test stringObj-13.4 {Tcl_GetCharLength with mixed width chars} testobj {
    string length "\xAE"
} 1
test stringObj-13.5 {Tcl_GetCharLength with mixed width chars} testobj {
    # string length "○○"
    # Use \uXXXX notation below instead of hardcoding the values, otherwise
    # the test will fail in multibyte locales.
    string length "\xEF\xBF\xAE\xEF\xBF\xAE"
} 6
test stringObj-13.6 {Tcl_GetCharLength with mixed width chars} testobj {
    # set a "ïa¿b®cï¿d®"
    # Use \uXXXX notation below instead of hardcoding the values, otherwise
    # the test will fail in multibyte locales.
    set a "\xEFa\xBFb\xAEc\xEF\xBFd\xAE"
    list [string length $a] [string length $a]
} {10 10}
test stringObj-13.7 {Tcl_GetCharLength with identity nulls} {testobj testbytestring} {
    # SF bug #684699
    string length [testbytestring \x00]







|





|







407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
    list [string length $a] [string length $a]
} {6 6}
test stringObj-13.4 {Tcl_GetCharLength with mixed width chars} testobj {
    string length "\xAE"
} 1
test stringObj-13.5 {Tcl_GetCharLength with mixed width chars} testobj {
    # string length "○○"
    # Use \uXXXX notation below instead of hard-coding the values, otherwise
    # the test will fail in multibyte locales.
    string length "\xEF\xBF\xAE\xEF\xBF\xAE"
} 6
test stringObj-13.6 {Tcl_GetCharLength with mixed width chars} testobj {
    # set a "ïa¿b®cï¿d®"
    # Use \uXXXX notation below instead of hard-coding the values, otherwise
    # the test will fail in multibyte locales.
    set a "\xEFa\xBFb\xAEc\xEF\xBFd\xAE"
    list [string length $a] [string length $a]
} {10 10}
test stringObj-13.7 {Tcl_GetCharLength with identity nulls} {testobj testbytestring} {
    # SF bug #684699
    string length [testbytestring \x00]
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
    teststringobj range 1 -1 -1
} abcde
test stringObj-16.6 {Tcl_GetRange: old anomaly} testobj {
    # Older implementations could return "cde"
    teststringobj set 1 abcde
    teststringobj range 1 2 0
} {}
test stringObj-16.7 {Tcl_GetRange: first = UINT_MAX-1} testobj {
    teststringobj set 1 abcde
    teststringobj range 1 0xFFFFFFFE 3
} {}
test stringObj-16.8 {Tcl_GetRange: first = SIZE_MAX-1} testobj {
    teststringobj set 1 abcde
    teststringobj range 1 -2 3
} {}
test stringObj-16.9 {Tcl_GetRange: last = UINT_MAX-1} testobj {
    teststringobj set 1 abcde
    teststringobj range 1 1 0xFFFFFFFE
} bcde
test stringObj-16.10 {Tcl_GetRange: last = SIZE_MAX-1} testobj {
    teststringobj set 1 abcde
    teststringobj range 1 1 -2
} bcde
test stringObj-16.11 {Tcl_GetRange: first = last = UINT_MAX-1} testobj {
    teststringobj set 1 abcde
    teststringobj range 1 0xFFFFFFFE 0xFFFFFFFE
} {}
test stringObj-16.12 {Tcl_GetRange: first = last = SIZE_MAX-1} testobj {
    teststringobj set 1 abcde

    teststringobj range 1 -2 -2
} {}

if {[testConstraint testobj]} {
    testobj freeallvars
}

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:







|

|



|

|

|



|

|

|



>
|













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
    teststringobj range 1 -1 -1
} abcde
test stringObj-16.6 {Tcl_GetRange: old anomaly} testobj {
    # Older implementations could return "cde"
    teststringobj set 1 abcde
    teststringobj range 1 2 0
} {}
test stringObj-16.7 {Tcl_GetRange: first = INT_MAX-1} testobj {
    teststringobj set 1 abcde
    teststringobj range 1 [expr {$INT_MAX-1}] 3
} {}
test stringObj-16.8 {Tcl_GetRange: first = SIZE_MAX-1} testobj {
    teststringobj set 1 abcde
    teststringobj range 1 [expr {$SIZE_MAX - 1}] 3
} {}
test stringObj-16.9 {Tcl_GetRange: last = INT_MAX-1} testobj {
    teststringobj set 1 abcde
    teststringobj range 1 1 [expr {$INT_MAX-1}]
} bcde
test stringObj-16.10 {Tcl_GetRange: last = SIZE_MAX-1} testobj {
    teststringobj set 1 abcde
    teststringobj range 1 1 [expr {$SIZE_MAX - 1}]
} bcde
test stringObj-16.11 {Tcl_GetRange: first = last = INT_MAX-1} testobj {
    teststringobj set 1 abcde
    teststringobj range 1 [expr {$INT_MAX-1}] [expr {$INT_MAX-1}]
} {}
test stringObj-16.12 {Tcl_GetRange: first = last = SIZE_MAX-1} testobj {
    teststringobj set 1 abcde
    set i [expr {$SIZE_MAX - 1}]
    teststringobj range 1 $i $i
} {}

if {[testConstraint testobj]} {
    testobj freeallvars
}

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/tailcall.test.

703
704
705
706
707
708
709







710
711
712
713
714
715
716
	proc p args {
	    tailcall [namespace current] {*}$args
	}
	namespace delete [namespace current]
	p
    }
} -returnCodes 1 -result {namespace "::ns" not found}








# cleanup
::tcltest::cleanupTests

# Local Variables:
# mode: tcl
# End:







>
>
>
>
>
>
>







703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
	proc p args {
	    tailcall [namespace current] {*}$args
	}
	namespace delete [namespace current]
	p
    }
} -returnCodes 1 -result {namespace "::ns" not found}

test tailcall-bug-784befb0ba {tailcall crash with 254 args} -body {
    proc tccrash args {llength $args}
    # Must be EXACTLY 254 for crash
    proc p {} [list tailcall tccrash {*}[lrepeat 254 x]]
    p
} -result 254

# cleanup
::tcltest::cleanupTests

# Local Variables:
# mode: tcl
# End:

Changes to tests/tcltest.test.

18
19
20
21
22
23
24



25
26
27
28
29
30
31
#

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}




namespace eval ::tcltest::test {

namespace import ::tcltest::*

makeFile {
    package require tcltest 2.5
    namespace import ::tcltest::test







>
>
>







18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
#

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

# File permissions broken on wsl without some "exotic" wsl configuration
testConstraint notWsl [expr {[llength [array names ::env *WSL*]] == 0}]

namespace eval ::tcltest::test {

namespace import ::tcltest::*

makeFile {
    package require tcltest 2.5
    namespace import ::tcltest::test
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
#	set ::tcltest::constraintsSpecified $constraintlist
#	unset ::tcltest::testConstraints(tcltestFakeConstraint1)
#	unset ::tcltest::testConstraints(tcltestFakeConstraint2)
#    }
#}

test tcltest-5.5 {InitConstraints: list of built-in constraints} \
	-constraints {!singleTestInterp} \
	-setup {tcltest::InitConstraints} \
	-body { lsort [array names ::tcltest::testConstraints] } \
	-result [lsort {
    95 98 asyncPipeClose eformat emptyTest exec hasIsoLocale interactive
    knownBug mac macCrash macOnly macOrPc macOrUnix macOrWin nonBlockFiles
    nonPortable notRoot nt pc pcCrash pcOnly root singleTestInterp socket
    stdio tempNotMac tempNotPc tempNotUnix tempNotWin unix unixCrash unixExecs







|







305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
#	set ::tcltest::constraintsSpecified $constraintlist
#	unset ::tcltest::testConstraints(tcltestFakeConstraint1)
#	unset ::tcltest::testConstraints(tcltestFakeConstraint2)
#    }
#}

test tcltest-5.5 {InitConstraints: list of built-in constraints} \
	-constraints {!singleTestInterp notWsl} \
	-setup {tcltest::InitConstraints} \
	-body { lsort [array names ::tcltest::testConstraints] } \
	-result [lsort {
    95 98 asyncPipeClose eformat emptyTest exec hasIsoLocale interactive
    knownBug mac macCrash macOnly macOrPc macOrUnix macOrWin nonBlockFiles
    nonPortable notRoot nt pc pcCrash pcOnly root singleTestInterp socket
    stdio tempNotMac tempNotPc tempNotUnix tempNotWin unix unixCrash unixExecs
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
    -body {
	child msg $a -tmpdir $tdiaf
	return $msg
    }
    -result {*not a directory*}
    -match glob
}
# Test non-writeable directories, non-readable directories with directory flags
set notReadableDir [file join [temporaryDirectory] notreadable]
set notWriteableDir [file join [temporaryDirectory] notwriteable]
makeDirectory notreadable
makeDirectory notwriteable

switch -- $::tcl_platform(platform) {
    unix {
	file attributes $notReadableDir -permissions 0o333
	file attributes $notWriteableDir -permissions 0o555
    }
    default {
	# note in FAT/NTFS we won't be able to protect directory with read-only attribute...
	catch {file attributes $notWriteableDir -readonly 1}
	catch {testchmod 0 $notWriteableDir}
    }
}
test tcltest-8.3 {tcltest a.tcl -tmpdir notReadableDir} {
    -constraints {unix notRoot}
    -body {
	child msg $a -tmpdir $notReadableDir
	return $msg
    }
    -result {*not readable*}
    -match glob
}
# This constraint doesn't go at the top of the file so that it doesn't
# interfere with tcltest-5.5
testConstraint notFAT [expr {
       ![regexp {^(FAT\d*|NTFS)$} [lindex [file system $notWriteableDir] 1]]
    || $::tcl_platform(platform) eq "unix" || [llength [info commands testchmod]]
}]
# FAT/NTFS permissions are fairly hopeless; ignore this test if that FS is used
test tcltest-8.4 {tcltest a.tcl -tmpdir notWriteableDir} {
    -constraints {unixOrWin notRoot notFAT}
    -body {
	child msg $a -tmpdir $notWriteableDir
	return $msg
    }
    -result {*not writeable*}
    -match glob
}
test tcltest-8.5 {tcltest a.tcl -tmpdir normaldirectory} {
    -constraints unixOrWin
    -body {
	child msg $a -tmpdir $normaldirectory
	# The join is necessary because the message can be split on multiple







|

|

|




|



|
|



|










|



|
|

|


|







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
    -body {
	child msg $a -tmpdir $tdiaf
	return $msg
    }
    -result {*not a directory*}
    -match glob
}
# Test non-writable directories, non-readable directories with directory flags
set notReadableDir [file join [temporaryDirectory] notreadable]
set notWritableDir [file join [temporaryDirectory] notwritable]
makeDirectory notreadable
makeDirectory notwritable

switch -- $::tcl_platform(platform) {
    unix {
	file attributes $notReadableDir -permissions 0o333
	file attributes $notWritableDir -permissions 0o555
    }
    default {
	# note in FAT/NTFS we won't be able to protect directory with read-only attribute...
	catch {file attributes $notWritableDir -readonly 1}
	catch {testchmod 0o444 $notWritableDir}
    }
}
test tcltest-8.3 {tcltest a.tcl -tmpdir notReadableDir} {
    -constraints {unix notRoot notWsl}
    -body {
	child msg $a -tmpdir $notReadableDir
	return $msg
    }
    -result {*not readable*}
    -match glob
}
# This constraint doesn't go at the top of the file so that it doesn't
# interfere with tcltest-5.5
testConstraint notFAT [expr {
       ![regexp {^(FAT\d*|NTFS)$} [lindex [file system $notWritableDir] 1]]
    || $::tcl_platform(platform) eq "unix" || [llength [info commands testchmod]]
}]
# FAT/NTFS permissions are fairly hopeless; ignore this test if that FS is used
test tcltest-8.4 {tcltest a.tcl -tmpdir notWritableDir} {
    -constraints {unixOrWin notRoot notFAT notWsl}
    -body {
	child msg $a -tmpdir $notWritableDir
	return $msg
    }
    -result {*not writable*}
    -match glob
}
test tcltest-8.5 {tcltest a.tcl -tmpdir normaldirectory} {
    -constraints unixOrWin
    -body {
	child msg $a -tmpdir $normaldirectory
	# The join is necessary because the message can be split on multiple
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
	child msg $a -testdir $tdiaf
	return $msg
    }
    -match glob
    -result {*not a directory*}
}
test tcltest-8.12 {tcltest a.tcl -testdir notReadableDir} {
    -constraints {unix notRoot}
    -body {
	child msg $a -testdir $notReadableDir
	return $msg
    }
    -match glob
    -result {*not readable*}
}







|







645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
	child msg $a -testdir $tdiaf
	return $msg
    }
    -match glob
    -result {*not a directory*}
}
test tcltest-8.12 {tcltest a.tcl -testdir notReadableDir} {
    -constraints {unix notRoot notWsl}
    -body {
	child msg $a -testdir $notReadableDir
	return $msg
    }
    -match glob
    -result {*not readable*}
}
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
}

# clean up from directory testing

switch -- $::tcl_platform(platform) {
    unix {
	file attributes $notReadableDir -permissions 0o777
	file attributes $notWriteableDir -permissions 0o777
    }
    default {
	catch {testchmod 0o777 $notWriteableDir}
	catch {file attributes $notWriteableDir -readonly 0}
    }
}

file delete -force -- $notReadableDir $notWriteableDir
removeFile a.tcl
removeFile thisdirectoryisafile
removeDirectory normaldirectory

# -file, -notfile, [matchFiles], [skipFiles]
test tcltest-9.1 {-file d*.tcl} -constraints {unixOrWin} -setup {
    set old [testsDirectory]







|


|
|



|







717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
}

# clean up from directory testing

switch -- $::tcl_platform(platform) {
    unix {
	file attributes $notReadableDir -permissions 0o777
	file attributes $notWritableDir -permissions 0o777
    }
    default {
	catch {testchmod 0o777 $notWritableDir}
	catch {file attributes $notWritableDir -readonly 0}
    }
}

file delete -force -- $notReadableDir $notWritableDir
removeFile a.tcl
removeFile thisdirectoryisafile
removeDirectory normaldirectory

# -file, -notfile, [matchFiles], [skipFiles]
test tcltest-9.1 {-file d*.tcl} -constraints {unixOrWin} -setup {
    set old [testsDirectory]

Changes to tests/tcltests.tcl.

1
2



3
4
5
6
7
8
9
#! /usr/bin/env tclsh




package require tcltest 2.5
namespace import ::tcltest::*
testConstraint exec [llength [info commands exec]]
testConstraint deprecated [expr {![tcl::build-info no-deprecate]}]
testConstraint debug [tcl::build-info debug]
testConstraint purify [tcl::build-info purify]
testConstraint debugpurify [


>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
#! /usr/bin/env tclsh

# Don't overwrite tcltests facilities already present
if {[package provide tcltests] ne {}} return

package require tcltest 2.5
namespace import ::tcltest::*
testConstraint exec [llength [info commands exec]]
testConstraint deprecated [expr {![tcl::build-info no-deprecate]}]
testConstraint debug [tcl::build-info debug]
testConstraint purify [tcl::build-info purify]
testConstraint debugpurify [
26
27
28
29
30
31
32












33
34
35
36
37
38
39
	    interp alias {} [namespace current]::tempdir {} [
		namespace current]::tempdir_alternate
	} else {
	    interp alias {} [namespace current]::tempdir {} ::tcl::file::tempdir
	}
    }














    proc tempdir_alternate {} {
	close [file tempfile tempfile]
	set tmpdir [file dirname $tempfile]
	set execname [info nameofexecutable]
	regsub -all {[^[:alpha:][:digit:]]} $execname _ execname
	for {set i 0} {$i < 10000} {incr i} {







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







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
	    interp alias {} [namespace current]::tempdir {} [
		namespace current]::tempdir_alternate
	} else {
	    interp alias {} [namespace current]::tempdir {} ::tcl::file::tempdir
	}
    }


    # Stolen from dict.test
    proc scriptmemcheck script {
	set end [lindex [split [memory info] \n] 3 3]
	for {set i 0} {$i < 5} {incr i} {
	    uplevel 1 $script
	    set tmp $end
	    set end [lindex [split [memory info] \n] 3 3]
	}
	expr {$end - $tmp}
    }


    proc tempdir_alternate {} {
	close [file tempfile tempfile]
	set tmpdir [file dirname $tempfile]
	set execname [info nameofexecutable]
	regsub -all {[^[:alpha:][:digit:]]} $execname _ execname
	for {set i 0} {$i < 10000} {incr i} {

Changes to tests/thread.test.

15
16
17
18
19
20
21



22
23
24
25
26
27
28
29
30
31
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

#  when thread::release is used, -wait is passed in order allow the thread to
#  be fully finalized, which avoids valgrind "still reachable" reports.




::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]
package require tcltests

# Some tests require the testthread command

testConstraint testthread [expr {[info commands testthread] ne {}}]


set threadSuperKillScript {







>
>
>


<







15
16
17
18
19
20
21
22
23
24
25
26

27
28
29
30
31
32
33
    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.

package require tcltest 2.5
source [file join [file dirname [info script]] tcltests.tcl]

::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]


# Some tests require the testthread command

testConstraint testthread [expr {[info commands testthread] ne {}}]


set threadSuperKillScript {

Changes to tests/trace.test.

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
test trace-0.0 {memory corruption in trace (Tcl Bug 484339)} {
    # You may need Purify or Electric Fence to reliably
    # see this one fail.
    unset -nocomplain z
    trace add variable z array {set z(foo) 1 ;#}
    set res "names: [array names z]"
    unset -nocomplain ::z
    trace variable ::z w {unset ::z; error "memory corruption";#}
    list [catch {set ::z 1} msg] $msg
} {1 {can't set "::z": memory corruption}}

# Read-tracing on variables

test trace-1.1 {trace variable reads} {
    unset -nocomplain x
    set info {}
    trace add variable x read traceScalar
    list [catch {set x} msg] $msg $info
} {1 {can't read "x": no such variable} {x {} read 1 {can't read "x": no such variable}}}
test trace-1.2 {trace variable reads} {
    unset -nocomplain x
    set x 123
    set info {}
    trace add variable x read traceScalar
    list [catch {set x} msg] $msg $info
} {0 123 {x {} read 0 123}}
test trace-1.3 {trace variable reads} {
    unset -nocomplain x
    set info {}
    trace add variable x read traceScalar
    set x 123
    set info
} {}
test trace-1.4 {trace array element reads} {







|





|





|






|







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
test trace-0.0 {memory corruption in trace (Tcl Bug 484339)} {
    # You may need Purify or Electric Fence to reliably
    # see this one fail.
    unset -nocomplain z
    trace add variable z array {set z(foo) 1 ;#}
    set res "names: [array names z]"
    unset -nocomplain ::z
    trace add variable ::z write {unset ::z; error "memory corruption";#}
    list [catch {set ::z 1} msg] $msg
} {1 {can't set "::z": memory corruption}}

# Read-tracing on variables

test trace-1.1 {trace add variable reads} {
    unset -nocomplain x
    set info {}
    trace add variable x read traceScalar
    list [catch {set x} msg] $msg $info
} {1 {can't read "x": no such variable} {x {} read 1 {can't read "x": no such variable}}}
test trace-1.2 {trace add variable reads} {
    unset -nocomplain x
    set x 123
    set info {}
    trace add variable x read traceScalar
    list [catch {set x} msg] $msg $info
} {0 123 {x {} read 0 123}}
test trace-1.3 {trace add variable reads} {
    unset -nocomplain x
    set info {}
    trace add variable x read traceScalar
    set x 123
    set info
} {}
test trace-1.4 {trace array element reads} {
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
test trace-1.9 {trace reads on whole arrays} {
    unset -nocomplain x
    set x(2) zzz
    set info {}
    trace add variable x read traceArray
    list [catch {set x(2)} msg] $msg $info
} {0 zzz {x 2 read 0 zzz}}
test trace-1.10 {trace variable reads} {
    unset -nocomplain x
    set x 444
    set info {}
    trace add variable x read traceScalar
    unset x
    set info
} {}
test trace-1.11 {read traces that modify the array structure} {
    unset -nocomplain x
    set x(bar) 0
    trace variable x r {set x(foo) 1 ;#}
    trace variable x r {unset -nocomplain x(bar) ;#}
    array get x
} {}
test trace-1.12 {read traces that modify the array structure} {
    unset -nocomplain x
    set x(bar) 0
    trace variable x r {unset -nocomplain x(bar) ;#}
    trace variable x r {set x(foo) 1 ;#}
    array get x
} {}
test trace-1.13 {read traces that modify the array structure} {
    unset -nocomplain x
    set x(bar) 0
    trace variable x r {set x(foo) 1 ;#}
    trace variable x r {unset -nocomplain x;#}
    list [catch {array get x} res] $res
} {1 {can't read "x(bar)": no such variable}}
test trace-1.14 {read traces that modify the array structure} {
    unset -nocomplain x
    set x(bar) 0
    trace variable x r {unset -nocomplain x;#}
    trace variable x r {set x(foo) 1 ;#}
    list [catch {array get x} res] $res
} {1 {can't read "x(bar)": no such variable}}

# Basic write-tracing on variables

test trace-2.1 {trace variable writes} {
    unset -nocomplain x
    set info {}
    trace add variable x write traceScalar
    set x 123
    set info
} {x {} write 0 123}
test trace-2.2 {trace writes to array elements} {
    unset -nocomplain x
    set info {}
    trace add variable x(33) write traceArray
    set x(33) 444
    set info
} {x 33 write 0 444}
test trace-2.3 {trace writes on whole arrays} {
    unset -nocomplain x
    set info {}
    trace add variable x write traceArray
    set x(abc) qq
    set info
} {x abc write 0 qq}
test trace-2.4 {trace variable writes} {
    unset -nocomplain x
    set x 1234
    set info {}
    trace add variable x write traceScalar
    set x
    set info
} {}
test trace-2.5 {trace variable writes} {
    unset -nocomplain x
    set x 1234
    set info {}
    trace add variable x write traceScalar
    unset x
    set info
} {}
test trace-2.6 {trace variable writes on compiled local} {
    #
    # Check correct function of whole array traces on compiled local
    # arrays [Bug 1770591]. The corresponding function for read traces is
    # already indirectly tested in trace-1.7
    #
    unset -nocomplain x
    set info {}
    proc p {} {
	trace add variable x write traceArray
	set x(X) willy
    }
    p
    set info
} {x X write 0 willy}
test trace-2.7 {trace variable writes on errorInfo} -body {
   #
   # Check correct behaviour of write traces on errorInfo.
   # [Bug 1773040]
   trace add variable ::errorInfo write traceScalar
   catch {set dne}
   lrange [set info] 0 2
} -cleanup {
   # always remove trace on errorInfo otherwise further tests will fail
   unset ::errorInfo
} -result {::errorInfo {} write}



# append no longer triggers read traces when fetching the old values of
# variables before doing the append operation. However, lappend _does_
# still trigger these read traces. Also lappend triggers only one write
# trace: after appending all arguments to the list.

test trace-3.1 {trace variable read-modify-writes} {
    unset -nocomplain x
    set info {}
    trace add variable x read traceScalarAppend
    append x 123
    append x 456
    lappend x 789
    set info
} {x {} read 0 123456}
test trace-3.2 {trace variable read-modify-writes} {
    unset -nocomplain x
    set info {}
    trace add variable x {read write} traceScalarAppend
    append x 123
    lappend x 456
    set info
} {x {} write 0 123 x {} read 0 123 x {} write 0 {123 456}}

# Basic unset-tracing on variables

test trace-4.1 {trace variable unsets} {
    unset -nocomplain x
    set info {}
    trace add variable x unset traceScalar
    unset -nocomplain x
    set info
} {x {} unset 1 {can't read "x": no such variable}}
test trace-4.2 {variable mustn't exist during unset trace} {







|










|
|





|
|





|
|





|
|





|




















|







|







|














|


















|








|










|







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
test trace-1.9 {trace reads on whole arrays} {
    unset -nocomplain x
    set x(2) zzz
    set info {}
    trace add variable x read traceArray
    list [catch {set x(2)} msg] $msg $info
} {0 zzz {x 2 read 0 zzz}}
test trace-1.10 {trace add variable reads} {
    unset -nocomplain x
    set x 444
    set info {}
    trace add variable x read traceScalar
    unset x
    set info
} {}
test trace-1.11 {read traces that modify the array structure} {
    unset -nocomplain x
    set x(bar) 0
    trace add variable x read {set x(foo) 1 ;#}
    trace add variable x read {unset -nocomplain x(bar) ;#}
    array get x
} {}
test trace-1.12 {read traces that modify the array structure} {
    unset -nocomplain x
    set x(bar) 0
    trace add variable x read {unset -nocomplain x(bar) ;#}
    trace add variable x read {set x(foo) 1 ;#}
    array get x
} {}
test trace-1.13 {read traces that modify the array structure} {
    unset -nocomplain x
    set x(bar) 0
    trace add variable x read {set x(foo) 1 ;#}
    trace add variable x read {unset -nocomplain x;#}
    list [catch {array get x} res] $res
} {1 {can't read "x(bar)": no such variable}}
test trace-1.14 {read traces that modify the array structure} {
    unset -nocomplain x
    set x(bar) 0
    trace add variable x read {unset -nocomplain x;#}
    trace add variable x read {set x(foo) 1 ;#}
    list [catch {array get x} res] $res
} {1 {can't read "x(bar)": no such variable}}

# Basic write-tracing on variables

test trace-2.1 {trace add variable writes} {
    unset -nocomplain x
    set info {}
    trace add variable x write traceScalar
    set x 123
    set info
} {x {} write 0 123}
test trace-2.2 {trace writes to array elements} {
    unset -nocomplain x
    set info {}
    trace add variable x(33) write traceArray
    set x(33) 444
    set info
} {x 33 write 0 444}
test trace-2.3 {trace writes on whole arrays} {
    unset -nocomplain x
    set info {}
    trace add variable x write traceArray
    set x(abc) qq
    set info
} {x abc write 0 qq}
test trace-2.4 {trace add variable writes} {
    unset -nocomplain x
    set x 1234
    set info {}
    trace add variable x write traceScalar
    set x
    set info
} {}
test trace-2.5 {trace add variable writes} {
    unset -nocomplain x
    set x 1234
    set info {}
    trace add variable x write traceScalar
    unset x
    set info
} {}
test trace-2.6 {trace add variable writes on compiled local} {
    #
    # Check correct function of whole array traces on compiled local
    # arrays [Bug 1770591]. The corresponding function for read traces is
    # already indirectly tested in trace-1.7
    #
    unset -nocomplain x
    set info {}
    proc p {} {
	trace add variable x write traceArray
	set x(X) willy
    }
    p
    set info
} {x X write 0 willy}
test trace-2.7 {trace add variable writes on errorInfo} -body {
   #
   # Check correct behaviour of write traces on errorInfo.
   # [Bug 1773040]
   trace add variable ::errorInfo write traceScalar
   catch {set dne}
   lrange [set info] 0 2
} -cleanup {
   # always remove trace on errorInfo otherwise further tests will fail
   unset ::errorInfo
} -result {::errorInfo {} write}



# append no longer triggers read traces when fetching the old values of
# variables before doing the append operation. However, lappend _does_
# still trigger these read traces. Also lappend triggers only one write
# trace: after appending all arguments to the list.

test trace-3.1 {trace add variable read-modify-writes} {
    unset -nocomplain x
    set info {}
    trace add variable x read traceScalarAppend
    append x 123
    append x 456
    lappend x 789
    set info
} {x {} read 0 123456}
test trace-3.2 {trace add variable read-modify-writes} {
    unset -nocomplain x
    set info {}
    trace add variable x {read write} traceScalarAppend
    append x 123
    lappend x 456
    set info
} {x {} write 0 123 x {} read 0 123 x {} write 0 {123 456}}

# Basic unset-tracing on variables

test trace-4.1 {trace add variable unsets} {
    unset -nocomplain x
    set info {}
    trace add variable x unset traceScalar
    unset -nocomplain x
    set info
} {x {} unset 1 {can't read "x": no such variable}}
test trace-4.2 {variable mustn't exist during unset trace} {
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
    unset -nocomplain x
    trace add variable x array traceArray2
    set result [trace info variable x]
    set result
} [list [list array traceArray2]]
test trace-5.5 {array traces properly listed in trace information} {
    unset -nocomplain x
    trace variable x a traceArray2
    set result [trace vinfo x]
    set result
} [list [list a traceArray2]]
test trace-5.6 {array traces don't fire on scalar variables} {
    unset -nocomplain x
    set x foo
    trace add variable x array traceArray2
    set ::info {}
    catch {array set x {a 1}}
    set ::info







|
|

|







393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
    unset -nocomplain x
    trace add variable x array traceArray2
    set result [trace info variable x]
    set result
} [list [list array traceArray2]]
test trace-5.5 {array traces properly listed in trace information} {
    unset -nocomplain x
    trace add variable x array traceArray2
    set result [trace info variable x]
    set result
} [list [list array traceArray2]]
test trace-5.6 {array traces don't fire on scalar variables} {
    unset -nocomplain x
    set x foo
    trace add variable x array traceArray2
    set ::info {}
    catch {array set x {a 1}}
    set ::info
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
test trace-18.2 {namespace delete / trace vdelete combo} {
    namespace eval ::foo {
	variable x 123
    }
    proc p1 args {
	trace vdelete ::foo::x u p1
    }
    trace variable ::foo::x u p1
    namespace delete ::foo
    info exists ::foo::x
} 0
test trace-18.3 {namespace delete / trace vdelete combo, Bug \#1337229} {
    namespace eval ::ns {}
    trace add variable ::ns::var unset {unset ::ns::var ;#}
    namespace delete ::ns







|







1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
test trace-18.2 {namespace delete / trace vdelete combo} {
    namespace eval ::foo {
	variable x 123
    }
    proc p1 args {
	trace vdelete ::foo::x u p1
    }
    trace add variable ::foo::x unset p1
    namespace delete ::foo
    info exists ::foo::x
} 0
test trace-18.3 {namespace delete / trace vdelete combo, Bug \#1337229} {
    namespace eval ::ns {}
    trace add variable ::ns::var unset {unset ::ns::var ;#}
    namespace delete ::ns
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
    set result [trace info command foo]
    rename foo {}
    set result
} [list [list delete foo]]

test trace-33.1 {variable match with remove variable} {
    unset -nocomplain x
    trace variable x w foo
    trace remove variable x write foo
    llength [trace info variable x]
} 0

test trace-34.1 {Bug 1201035} {
    set ::x [list]
    proc foo {} {lappend ::x foo}







|







2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
    set result [trace info command foo]
    rename foo {}
    set result
} [list [list delete foo]]

test trace-33.1 {variable match with remove variable} {
    unset -nocomplain x
    trace add variable x write foo
    trace remove variable x write foo
    llength [trace info variable x]
} 0

test trace-34.1 {Bug 1201035} {
    set ::x [list]
    proc foo {} {lappend ::x foo}

Changes to tests/unixFCmd.test.

14
15
16
17
18
19
20


21
22
23
24
25
26
27
28
29
30
31
32
33
34
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testchmod [llength [info commands testchmod]]



# These tests really need to be run from a writable directory, which
# it is assumed [temporaryDirectory] is.
set oldcwd [pwd]
cd [temporaryDirectory]

# Several tests require need to match results against the unix username
set user {}
if {[testConstraint unix]} {
    catch {set user [exec whoami]}
    if {$user == ""} {
	catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user}
    }
    if {$user == ""} {







>
>






|







14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testchmod [llength [info commands testchmod]]
# File permissions broken on wsl without some "exotic" wsl configuration
testConstraint notWsl [expr {[llength [array names ::env *WSL*]] == 0}]

# These tests really need to be run from a writable directory, which
# it is assumed [temporaryDirectory] is.
set oldcwd [pwd]
cd [temporaryDirectory]

# Several tests require need to match results against the Unix username
set user {}
if {[testConstraint unix]} {
    catch {set user [exec whoami]}
    if {$user == ""} {
	catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user}
    }
    if {$user == ""} {
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
if {[testConstraint unix] && [testConstraint notRoot]} {
    testConstraint execMknod [expr {![catch {exec mknod tf1 p}]}]
    cleanup
}

test unixFCmd-1.1 {TclpRenameFile: EACCES} -setup {
    cleanup
} -constraints {unix notRoot} -body {
    file mkdir td1/td2/td3
    file attributes td1/td2 -permissions 0
    file rename td1/td2/td3 td2
} -returnCodes error -cleanup {
    file attributes td1/td2 -permissions 0o755
    cleanup
} -result {error renaming "td1/td2/td3": permission denied}
test unixFCmd-1.2 {TclpRenameFile: EEXIST} -setup {
    cleanup
} -constraints {unix notRoot} -body {
    file mkdir td1/td2
    file mkdir td2
    file rename td2 td1
} -returnCodes error -cleanup {
    cleanup
} -result {error renaming "td2" to "td1/td2": file already exists}
test unixFCmd-1.3 {TclpRenameFile: EINVAL} -setup {
    cleanup
} -constraints {unix notRoot} -body {
    file mkdir td1
    file rename td1 td1
} -returnCodes error -cleanup {
    cleanup







|















|







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
if {[testConstraint unix] && [testConstraint notRoot]} {
    testConstraint execMknod [expr {![catch {exec mknod tf1 p}]}]
    cleanup
}

test unixFCmd-1.1 {TclpRenameFile: EACCES} -setup {
    cleanup
} -constraints {unix notRoot notWsl} -body {
    file mkdir td1/td2/td3
    file attributes td1/td2 -permissions 0
    file rename td1/td2/td3 td2
} -returnCodes error -cleanup {
    file attributes td1/td2 -permissions 0o755
    cleanup
} -result {error renaming "td1/td2/td3": permission denied}
test unixFCmd-1.2 {TclpRenameFile: EEXIST} -setup {
    cleanup
} -constraints {unix notRoot} -body {
    file mkdir td1/td2
    file mkdir td2
    file rename td2 td1
} -returnCodes error -cleanup {
    cleanup
} -result {error renaming "td2" to "td1/td2": file exists}
test unixFCmd-1.3 {TclpRenameFile: EINVAL} -setup {
    cleanup
} -constraints {unix notRoot} -body {
    file mkdir td1
    file rename td1 td1
} -returnCodes error -cleanup {
    cleanup
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
    cleanup
} -result {error renaming "td2": no such file or directory}
test unixFCmd-1.6 {TclpRenameFile: ENOTDIR} {emptyTest unix notRoot} {
    # can't make it happen
} {}
test unixFCmd-1.7 {TclpRenameFile: EXDEV} -setup {
    cleanup
} -constraints {unix notRoot} -body {
    file mkdir foo/bar
    file attr foo -perm 0o40555
    file rename foo/bar /tmp
} -returnCodes error -cleanup {
    catch {file delete /tmp/bar}
    catch {file attr foo -perm 0o40777}
    catch {file delete -force foo}







|







133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
    cleanup
} -result {error renaming "td2": no such file or directory}
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 notWsl} -body {
    file mkdir foo/bar
    file attr foo -perm 0o40555
    file rename foo/bar /tmp
} -returnCodes error -cleanup {
    catch {file delete /tmp/bar}
    catch {file attr foo -perm 0o40777}
    catch {file delete -force foo}
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
    file copy tf1 tf2
    list [file type tf1] [file type tf2]
} -cleanup {
    cleanup
} -result {fifo fifo}
test unixFCmd-2.5 {TclpCopyFile: copy attributes} -setup {
    cleanup
} -constraints {unix notRoot} -body {
    close [open tf1 a]
    file attributes tf1 -permissions 0o472
    file copy tf1 tf2
    file attributes tf2 -permissions
} -cleanup {
    cleanup
} -result 0o472 ;# i.e. perms field of [exec ls -l tf2] is -r--rwx-w-







|







217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
    file copy tf1 tf2
    list [file type tf1] [file type tf2]
} -cleanup {
    cleanup
} -result {fifo fifo}
test unixFCmd-2.5 {TclpCopyFile: copy attributes} -setup {
    cleanup
} -constraints {unix notRoot notWsl} -body {
    close [open tf1 a]
    file attributes tf1 -permissions 0o472
    file copy tf1 tf2
    file attributes tf2 -permissions
} -cleanup {
    cleanup
} -result 0o472 ;# i.e. perms field of [exec ls -l tf2] is -r--rwx-w-
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
    catch {file delete -force -- foo.test}
} -constraints {unix notRoot} -returnCodes error -body {
    file attributes foo.test -owner foozzz
} -result {could not set owner for file "foo.test": user "foozzz" does not exist}

test unixFCmd-17.1 {SetPermissionsAttribute} -setup {
    catch {file delete -force -- foo.test}
} -constraints {unix notRoot} -body {
    close [open foo.test w]
    list [file attributes foo.test -permissions 0] \
	[file attributes foo.test -permissions]
} -cleanup {
    file delete -force -- foo.test
} -result {{} 00000}
test unixFCmd-17.2 {SetPermissionsAttribute} -setup {







|







332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
    catch {file delete -force -- foo.test}
} -constraints {unix notRoot} -returnCodes error -body {
    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 notWsl} -body {
    close [open foo.test w]
    list [file attributes foo.test -permissions 0] \
	[file attributes foo.test -permissions]
} -cleanup {
    file delete -force -- foo.test
} -result {{} 00000}
test unixFCmd-17.2 {SetPermissionsAttribute} -setup {
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
} -cleanup {
    file delete -force -- foo.test
} -returnCodes error -result {unknown permission string format "---rwx"}

close [open foo.test w]
set ::i 4
proc permcheck {testnum permList expected} {
    test $testnum {SetPermissionsAttribute} {unix notRoot} {
      set result {}
      foreach permstr $permList {
	file attributes foo.test -permissions $permstr
	lappend result [file attributes foo.test -permissions]
      }
      set result
    } $expected
}
permcheck unixFCmd-17.5   rwxrwxrwx	0o777
permcheck unixFCmd-17.6   r--r---w-	0o442
permcheck unixFCmd-17.7   {0 u+rwx,g+r u-w o+rwx} {00000 0o740 0o540 0o547}
permcheck unixFCmd-17.11  --x--x--x	0o111
permcheck unixFCmd-17.12  {0 a+rwx} {00000 0o777}
file delete -force -- foo.test

test unixFCmd-18.1 {Unix pwd} -constraints {unix notRoot nonPortable} -setup {
    set cd [pwd]
} -body {
    # This test is nonPortable because SunOS generates a weird error
    # message when the current directory isn't readable.
    set nd $cd/tstdir
    file mkdir $nd
    cd $nd
    file attributes $nd -permissions 0
    pwd
} -returnCodes error -cleanup {







|


















|







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
} -cleanup {
    file delete -force -- foo.test
} -returnCodes error -result {unknown permission string format "---rwx"}

close [open foo.test w]
set ::i 4
proc permcheck {testnum permList expected} {
    test $testnum {SetPermissionsAttribute} {unix notRoot notWsl} {
      set result {}
      foreach permstr $permList {
	file attributes foo.test -permissions $permstr
	lappend result [file attributes foo.test -permissions]
      }
      set result
    } $expected
}
permcheck unixFCmd-17.5   rwxrwxrwx	0o777
permcheck unixFCmd-17.6   r--r---w-	0o442
permcheck unixFCmd-17.7   {0 u+rwx,g+r u-w o+rwx} {00000 0o740 0o540 0o547}
permcheck unixFCmd-17.11  --x--x--x	0o111
permcheck unixFCmd-17.12  {0 a+rwx} {00000 0o777}
file delete -force -- foo.test

test unixFCmd-18.1 {Unix pwd} -constraints {unix notRoot nonPortable} -setup {
    set cd [pwd]
} -body {
    # This test is non-portable because SunOS generates a weird error
    # message when the current directory isn't readable.
    set nd $cd/tstdir
    file mkdir $nd
    cd $nd
    file attributes $nd -permissions 0
    pwd
} -returnCodes error -cleanup {

Changes to tests/unixForkEvent.test.

13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
    namespace import -force ::tcltest::*
}

testConstraint testfork [llength [info commands testfork]]

# Test if the notifier thread is well initialized in a forked interpreter
# by Tcl_InitNotifier
test unixforkevent-1.1 {fork and test writeable event} \
    -constraints {testfork nonPortable} \
    -body {
	set myFolder [makeDirectory unixtestfork]
	set pid [testfork]
	if {$pid == 0} {
	    # we are the forked process
	    set result initialized







|







13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
    namespace import -force ::tcltest::*
}

testConstraint testfork [llength [info commands testfork]]

# Test if the notifier thread is well initialized in a forked interpreter
# by Tcl_InitNotifier
test unixforkevent-1.1 {fork and test writable event} \
    -constraints {testfork nonPortable} \
    -body {
	set myFolder [makeDirectory unixtestfork]
	set pid [testfork]
	if {$pid == 0} {
	    # we are the forked process
	    set result initialized

Changes to tests/unixInit.test.

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
    close $f
    set enc
} -cleanup {
    unset -nocomplain env(LANG)
} -match regexp -result {^(iso8859-15?|utf-8)$}
test unixInit-3.2 {TclpSetInitialEncodings} -setup {
    catch {set oldlc_all $env(LC_ALL)}


} -constraints {unix stdio} -body {
    set env(LANG) japanese
    set env(LC_ALL) japanese
    set f [open "|[list [interpreter]]" w+]
    chan configure $f -buffering none
    puts $f {puts [encoding system]; exit}
    set enc [gets $f]
    close $f
    set validEncodings [list euc-jp]
    if {[string match HP-UX $tcl_platform(os)]} {
	# Some older HP-UX systems need us to accept this as valid Bug 453883
	# reports that newer HP-UX systems report euc-jp like everybody else.
	lappend validEncodings shiftjis
    }
    expr {$enc ni $validEncodings}
} -cleanup {
    unset -nocomplain env(LANG) env(LC_ALL)
    catch {set env(LC_ALL) $oldlc_all}

} -result 0

test unixInit-4.1 {TclpSetVariables} {unix} {
    # just make sure they exist
    set a [list $tcl_library $tcl_pkgPath $tcl_platform(os)]
    set a [list $tcl_platform(osVersion) $tcl_platform(machine)]
    set tcl_platform(platform)







>
>
|

















>







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
    close $f
    set enc
} -cleanup {
    unset -nocomplain env(LANG)
} -match regexp -result {^(iso8859-15?|utf-8)$}
test unixInit-3.2 {TclpSetInitialEncodings} -setup {
    catch {set oldlc_all $env(LC_ALL)}
    catch {set oldtcl_library $env(TCL_LIBRARY)}
    unset -nocomplain env(TCL_LIBRARY)
} -constraints {unix stdio knownBug} -body {
    set env(LANG) japanese
    set env(LC_ALL) japanese
    set f [open "|[list [interpreter]]" w+]
    chan configure $f -buffering none
    puts $f {puts [encoding system]; exit}
    set enc [gets $f]
    close $f
    set validEncodings [list euc-jp]
    if {[string match HP-UX $tcl_platform(os)]} {
	# Some older HP-UX systems need us to accept this as valid Bug 453883
	# reports that newer HP-UX systems report euc-jp like everybody else.
	lappend validEncodings shiftjis
    }
    expr {$enc ni $validEncodings}
} -cleanup {
    unset -nocomplain env(LANG) env(LC_ALL)
    catch {set env(LC_ALL) $oldlc_all}
    catch {set env(TCL_LIBRARY) $oldtcl_library}
} -result 0

test unixInit-4.1 {TclpSetVariables} {unix} {
    # just make sure they exist
    set a [list $tcl_library $tcl_pkgPath $tcl_platform(os)]
    set a [list $tcl_platform(osVersion) $tcl_platform(machine)]
    set tcl_platform(platform)

Changes to tests/upvar.test.

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
	set b bar
    }
    list [p1 14 15] $x1
} {{14 15 bar 33} foo}

proc tproc {args} {global x; set x [list $args [uplevel info vars]]}
test upvar-5.1 {traces involving upvars} {
    proc p1 {a b} {set c 22; set d 33; trace var c rw tproc; p2}
    proc p2 {} {upvar c x1; set x1 22}
    set x ---
    p1 foo bar
    set x
} {{x1 {} w} x1}
test upvar-5.2 {traces involving upvars} {
    proc p1 {a b} {set c 22; set d 33; trace var c rw tproc; p2}
    proc p2 {} {upvar c x1; set x1}
    set x ---
    p1 foo bar
    set x
} {{x1 {} r} x1}
test upvar-5.3 {traces involving upvars} {
    proc p1 {a b} {set c 22; set d 33; trace var c rwu tproc; p2}
    proc p2 {} {upvar c x1; unset x1}
    set x ---
    p1 foo bar
    set x
} {{x1 {} u} x1}
test upvar-5.4 {read trace on upvar array element} -body {
    proc p1 {a b} {
	array set foo {c 22 d 33}
	trace add variable foo {read write unset} tproc
	p2
	trace remove variable foo {read write unset} tproc
    }







|




|

|




|

|




|







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
	set b bar
    }
    list [p1 14 15] $x1
} {{14 15 bar 33} foo}

proc tproc {args} {global x; set x [list $args [uplevel info vars]]}
test upvar-5.1 {traces involving upvars} {
    proc p1 {a b} {set c 22; set d 33; trace add var c {read write} tproc; p2}
    proc p2 {} {upvar c x1; set x1 22}
    set x ---
    p1 foo bar
    set x
} {{x1 {} write} x1}
test upvar-5.2 {traces involving upvars} {
    proc p1 {a b} {set c 22; set d 33; trace add var c {read write} tproc; p2}
    proc p2 {} {upvar c x1; set x1}
    set x ---
    p1 foo bar
    set x
} {{x1 {} read} x1}
test upvar-5.3 {traces involving upvars} {
    proc p1 {a b} {set c 22; set d 33; trace add var c {read write unset} tproc; p2}
    proc p2 {} {upvar c x1; unset x1}
    set x ---
    p1 foo bar
    set x
} {{x1 {} unset} x1}
test upvar-5.4 {read trace on upvar array element} -body {
    proc p1 {a b} {
	array set foo {c 22 d 33}
	trace add variable foo {read write unset} tproc
	p2
	trace remove variable foo {read write unset} tproc
    }
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
    p1
} -result {can't upvar from variable to itself}
test upvar-8.6 {errors in upvar command} -returnCodes error -body {
    proc p1 {} {set a 33; upvar b a}
    p1
} -result {variable "a" already exists}
test upvar-8.7 {errors in upvar command} -returnCodes error -body {
    proc p1 {} {trace variable a w foo; upvar b a}
    p1
} -result {variable "a" has traces: can't use for upvar}
test upvar-8.8 {create nested array with upvar} -body {
    proc p1 {} {upvar x(a) b; set b(2) 44}
    catch {unset x}
    p1
} -returnCodes error -cleanup {







|







412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
    p1
} -result {can't upvar from variable to itself}
test upvar-8.6 {errors in upvar command} -returnCodes error -body {
    proc p1 {} {set a 33; upvar b a}
    p1
} -result {variable "a" already exists}
test upvar-8.7 {errors in upvar command} -returnCodes error -body {
    proc p1 {} {trace add variable a write foo; upvar b a}
    p1
} -result {variable "a" has traces: can't use for upvar}
test upvar-8.8 {create nested array with upvar} -body {
    proc p1 {} {upvar x(a) b; set b(2) 44}
    catch {unset x}
    p1
} -returnCodes error -cleanup {

Added tests/utfext.test.





















































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
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
# This file contains a collection of tests for Tcl_UtfToExternal and
# Tcl_UtfToExternal. Sourcing this file into Tcl runs the tests and generates
# errors. No output means no errors found.
#
# Copyright (c) 2023 Ashok P. Nadkarni
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint testencoding [llength [info commands testencoding]]

# Maps encoded bytes string to utf-8 equivalents, both in hex
# encoding utf-8 encdata
lappend utfExtMap {*}{
    ascii 414243 414243
}

# Simple test with basic flags
proc testbasic {direction enc hexin hexout {flags {start end}}} {
    if {$direction eq "toutf"} {
        set cmd Tcl_ExternalToUtf
    } else {
        set cmd Tcl_UtfToExternal
    }
    set in [binary decode hex $hexin]
    set out [binary decode hex $hexout]
    set dstlen 40 ;# Should be enough for all encoding tests

    # The C wrapper fills entire destination buffer with FF.
    # Anything beyond expected output should have FF's
    set filler [string repeat \xFF $dstlen]
    set result [string range "$out$filler" 0 $dstlen-1]
    test $cmd-$enc-$hexin-[join $flags -] "$cmd - $enc - $hexin - $flags" -body \
        [list testencoding $cmd $enc $in $flags {} $dstlen] \
        -result [list ok {} $result]
    foreach profile [encoding profiles] {
        set flags2 [linsert $flags end profile$profile]
        test $cmd-$enc-$hexin-[join $flags2 -] "$cmd - $enc - $hexin - $flags" -body \
            [list testencoding $cmd $enc $in $flags2 {} $dstlen] \
            -result [list ok {} $result]
    }
}

#
# Basic tests
foreach {enc utfhex hex} $utfExtMap {
    # Basic test - TCL_ENCODING_START|TCL_ENCODING_END
    # Note by default output should be terminated with \0
    testbasic toutf $enc $hex ${utfhex}00 {start end}
    testbasic fromutf $enc $utfhex ${hex}00 {start end}

    # Test TCL_ENCODING_NO_TERMINATE
    testbasic toutf $enc $hex $utfhex {start end noterminate}
    # knownBug - noterminate not obeyed by fromutf
    # testbasic fromutf $enc $utfhex $hex {start end noterminate}
}

# Test for insufficient space
test xx-bufferoverflow {buffer overflow Tcl_ExternalToUtf} -body {
    testencoding Tcl_UtfToExternal utf-16 A {start end} {} 1
} -result [list nospace {} \xFF]

# Another bug - char limit not obeyed
# % set cv 2
# % testencoding Tcl_ExternalToUtf utf-8 abcdefgh {start end noterminate charlimit} {} 20 rv wv cv
# nospace {} abcÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ

test TableToUtf-bug-5be203d6ca {Bug 5be203d6ca - truncated prefix in table encoding} -body {
    set src \x82\x4f\x82\x50\x82 
    lassign [testencoding Tcl_ExternalToUtf shiftjis $src {start} 0 16 srcRead dstWritten charsWritten] buf 
    set result [list [testencoding Tcl_ExternalToUtf shiftjis $src {start} 0 16 srcRead dstWritten charsWritten] $srcRead $dstWritten $charsWritten]
    lappend result {*}[list [testencoding Tcl_ExternalToUtf shiftjis [string range $src $srcRead end] {end} 0 10 srcRead dstWritten charsWritten] $srcRead $dstWritten $charsWritten]
} -result [list [list multibyte 0 \xEF\xBC\x90\xEF\xBC\x91\x00\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF] 4 6 2 [list ok 0 \xC2\x82\x00\xFF\xFF\xFF\xFF\xFF\xFF\xFF] 1 2 1]


::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/var.test.

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
    namespace eval test_ns_var {
        variable v 123
        variable info ""
        proc traceUnset {name1 name2 op} {
            variable info
            set info [concat $info [list $name1 $name2 $op]]
        }
        trace var v u [namespace code traceUnset]
    }
    list [unset test_ns_var::v] $test_ns_var::info
} -result {{} {test_ns_var::v {} u}}
test var-8.2 {TclDeleteNamespaceVars, "unset" traces on ns delete are called with fully-qualified var names} -setup {
    catch {namespace delete test_ns_var}
    catch {unset a}
} -body {
    set info ""
    namespace eval test_ns_var {
        variable v 123 1
        trace var v u ::traceUnset
    }
    proc traceUnset {name1 name2 op} {
	set ::info [concat $::info [list $name1 $name2 $op]]
    }
    list [namespace delete test_ns_var] $::info
} -result {{} {::test_ns_var::v {} u}}

test var-8.3 {TclDeleteNamespaceVars, mem leak} -constraints memory -setup {
    proc ::t {a i o} {
	set $a 321
    }
} -body {
    leaktest {
	namespace eval n {
	    variable v 123
	    trace variable v u ::t
	}
	namespace delete n
    }
} -cleanup {
    rename ::t {}
} -result 0








|


|







|





|









|







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
    namespace eval test_ns_var {
        variable v 123
        variable info ""
        proc traceUnset {name1 name2 op} {
            variable info
            set info [concat $info [list $name1 $name2 $op]]
        }
        trace add var v unset [namespace code traceUnset]
    }
    list [unset test_ns_var::v] $test_ns_var::info
} -result {{} {test_ns_var::v {} unset}}
test var-8.2 {TclDeleteNamespaceVars, "unset" traces on ns delete are called with fully-qualified var names} -setup {
    catch {namespace delete test_ns_var}
    catch {unset a}
} -body {
    set info ""
    namespace eval test_ns_var {
        variable v 123 1
        trace add var v unset ::traceUnset
    }
    proc traceUnset {name1 name2 op} {
	set ::info [concat $::info [list $name1 $name2 $op]]
    }
    list [namespace delete test_ns_var] $::info
} -result {{} {::test_ns_var::v {} unset}}

test var-8.3 {TclDeleteNamespaceVars, mem leak} -constraints memory -setup {
    proc ::t {a i o} {
	set $a 321
    }
} -body {
    leaktest {
	namespace eval n {
	    variable v 123
	    trace add variable v unset ::t
	}
	namespace delete n
    }
} -cleanup {
    rename ::t {}
} -result 0

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
} -result {1 {before set} 1 {can't set "arr": variable is array}}
test var-9.9 {behaviour of TclGetVar read trace success} -setup {
    catch {unset u}
    catch {unset v}
} -constraints testsetnoerr -body {
    proc resetvar {val name elem op} {upvar 1 $name v; set v $val}
    set u 10
    trace var u r [list resetvar 1]
    trace var v r [list resetvar 2]
    list \
	[testsetnoerr u] \
	[testseterr v]
} -result {{before get 1} {before get 2}}
test var-9.10 {behaviour of TclGetVar read trace error} testsetnoerr {
    proc writeonly args {error "write-only"}
    set v 456
    trace var v r writeonly
    list \
	[catch {testsetnoerr v} msg] $msg \
	[catch {testseterr v} msg] $msg
} {1 {before get} 1 {can't read "v": write-only}}
test var-9.11 {behaviour of TclSetVar write trace success} -setup {
    catch {unset u}
    catch {unset v}
} -constraints testsetnoerr -body {
    proc doubleval {name elem op} {upvar 1 $name v; set v [expr {2 * $v}]}
    set v 1
    trace var v w doubleval
    trace var u w doubleval
    list \
	[testsetnoerr u 2] \
	[testseterr v 3]
} -result {{before set 4} {before set 6}}
test var-9.12 {behaviour of TclSetVar write trace error} testsetnoerr {
    proc readonly args {error "read-only"}
    set v 456
    trace var v w readonly
    list \
	[catch {testsetnoerr v 2} msg] $msg $v \
	[catch {testseterr v 3} msg] $msg $v
} {1 {before set} 2 1 {can't set "v": read-only} 3}

test var-10.1 {can't nest arrays with array set} -setup {
   catch {unset arr}







|
|







|










|
|







|







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
} -result {1 {before set} 1 {can't set "arr": variable is array}}
test var-9.9 {behaviour of TclGetVar read trace success} -setup {
    catch {unset u}
    catch {unset v}
} -constraints testsetnoerr -body {
    proc resetvar {val name elem op} {upvar 1 $name v; set v $val}
    set u 10
    trace add var u read [list resetvar 1]
    trace add var v read [list resetvar 2]
    list \
	[testsetnoerr u] \
	[testseterr v]
} -result {{before get 1} {before get 2}}
test var-9.10 {behaviour of TclGetVar read trace error} testsetnoerr {
    proc writeonly args {error "write-only"}
    set v 456
    trace add var v read writeonly
    list \
	[catch {testsetnoerr v} msg] $msg \
	[catch {testseterr v} msg] $msg
} {1 {before get} 1 {can't read "v": write-only}}
test var-9.11 {behaviour of TclSetVar write trace success} -setup {
    catch {unset u}
    catch {unset v}
} -constraints testsetnoerr -body {
    proc doubleval {name elem op} {upvar 1 $name v; set v [expr {2 * $v}]}
    set v 1
    trace add var v write doubleval
    trace add var u write doubleval
    list \
	[testsetnoerr u 2] \
	[testseterr v 3]
} -result {{before set 4} {before set 6}}
test var-9.12 {behaviour of TclSetVar write trace error} testsetnoerr {
    proc readonly args {error "read-only"}
    set v 456
    trace add var v write readonly
    list \
	[catch {testsetnoerr v 2} msg] $msg $v \
	[catch {testseterr v 3} msg] $msg $v
} {1 {before set} 2 1 {can't set "v": read-only} 3}

test var-10.1 {can't nest arrays with array set} -setup {
   catch {unset arr}
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
} -body {
    proc foo {var ind op} {
	global t
	set foo bar
    }
    namespace eval :: {
	set t(1) 1
	trace variable t(1) u foo
	unset t
    }
    set x "If you see this, it worked"
} -result "If you see this, it worked"
test var-13.2 {unset array with search, bug 46a2410650} -body {
    apply {{} {
	array set a {aa 11 bb 22 cc 33 dd 44 ee 55 ff 66}







|







791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
} -body {
    proc foo {var ind op} {
	global t
	set foo bar
    }
    namespace eval :: {
	set t(1) 1
	trace add variable t(1) unset foo
	unset t
    }
    set x "If you see this, it worked"
} -result "If you see this, it worked"
test var-13.2 {unset array with search, bug 46a2410650} -body {
    apply {{} {
	array set a {aa 11 bb 22 cc 33 dd 44 ee 55 ff 66}

Changes to tests/winConsole.test.

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

## fconfigure get stdin

test console-fconfigure-get-1.0 {
    Console get stdin configuration
} -constraints {win interactive} -body {
    lsort [dict keys [fconfigure stdin]]
} -result {-blocking -buffering -buffersize -encoding -eofchar -inputmode -translation}

set testnum 0
foreach {opt result} {
    -blocking 1
    -buffering line
    -buffersize 4096
    -encoding utf-16
    -inputmode normal
    -translation auto
} {
    test console-fconfigure-get-1.[incr testnum] "Console get stdin option $opt" \
        -constraints {win interactive} -body {
        fconfigure stdin $opt
    } -result $result
}
test console-fconfigure-get-1.[incr testnum] {
    Console get stdin option -eofchar
} -constraints {win interactive} -body {
    fconfigure stdin -eofchar
} -result \x1a

test console-fconfigure-get-1.[incr testnum] {
    fconfigure -winsize
} -constraints {win interactive} -body {
    fconfigure stdin -winsize
} -result {bad option "-winsize": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, or -inputmode} -returnCodes error

## fconfigure get stdout/stderr
foreach chan {stdout stderr} major {2 3} {
    test console-fconfigure-get-$major.0 "Console get $chan configuration" -constraints {
        win interactive
    } -body {
        lsort [dict keys [fconfigure $chan]]
    } -result {-blocking -buffering -buffersize -encoding -eofchar -translation -winsize}
    set testnum 0
    foreach {opt result} {
        -blocking 1
        -buffersize 4096
        -encoding utf-16
        -translation crlf
    } {







|



















|





|







|







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

## fconfigure get stdin

test console-fconfigure-get-1.0 {
    Console get stdin configuration
} -constraints {win interactive} -body {
    lsort [dict keys [fconfigure stdin]]
} -result {-blocking -buffering -buffersize -encoding -eofchar -inputmode -profile -translation}

set testnum 0
foreach {opt result} {
    -blocking 1
    -buffering line
    -buffersize 4096
    -encoding utf-16
    -inputmode normal
    -translation auto
} {
    test console-fconfigure-get-1.[incr testnum] "Console get stdin option $opt" \
        -constraints {win interactive} -body {
        fconfigure stdin $opt
    } -result $result
}
test console-fconfigure-get-1.[incr testnum] {
    Console get stdin option -eofchar
} -constraints {win interactive} -body {
    fconfigure stdin -eofchar
} -result \x1A

test console-fconfigure-get-1.[incr testnum] {
    fconfigure -winsize
} -constraints {win interactive} -body {
    fconfigure stdin -winsize
} -result {bad option "-winsize": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -profile, -translation, or -inputmode} -returnCodes error

## fconfigure get stdout/stderr
foreach chan {stdout stderr} major {2 3} {
    test console-fconfigure-get-$major.0 "Console get $chan configuration" -constraints {
        win interactive
    } -body {
        lsort [dict keys [fconfigure $chan]]
    } -result {-blocking -buffering -buffersize -encoding -eofchar -profile -translation -winsize}
    set testnum 0
    foreach {opt result} {
        -blocking 1
        -buffersize 4096
        -encoding utf-16
        -translation crlf
    } {
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
        fconfigure $chan -buffering
    } -result [expr {$chan eq "stdout" ? "line" : "none"}]

    test console-fconfigure-get-$major.[incr testnum] {
        fconfigure -inputmode
    } -constraints {win interactive} -body {
        fconfigure $chan -inputmode
    } -result {bad option "-inputmode": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, or -winsize} -returnCodes error

}

## fconfigure set stdin

test console-fconfigure-set-1.0 {
    fconfigure -inputmode password







|







256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
        fconfigure $chan -buffering
    } -result [expr {$chan eq "stdout" ? "line" : "none"}]

    test console-fconfigure-get-$major.[incr testnum] {
        fconfigure -inputmode
    } -constraints {win interactive} -body {
        fconfigure $chan -inputmode
    } -result {bad option "-inputmode": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -profile, -translation, or -winsize} -returnCodes error

}

## fconfigure set stdin

test console-fconfigure-set-1.0 {
    fconfigure -inputmode password
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
    set result
} -result [list pass password 0 reset normal 1]

test console-fconfigure-set-1.3 {
    fconfigure stdin -winsize
} -constraints {win interactive} -body {
    fconfigure stdin -winsize {10 30}
} -result {bad option "-winsize": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, or -inputmode} -returnCodes error

## fconfigure set stdout,stderr

test console-fconfigure-set-2.0 {
    fconfigure stdout -winsize
} -constraints {win interactive} -body {
    fconfigure stdout -winsize {10 30}
} -result {bad option "-winsize": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, or -translation} -returnCodes error

test console-fconfigure-set-3.0 {
    fconfigure stderr -winsize
} -constraints {win interactive} -body {
    fconfigure stderr -winsize {10 30}
} -result {bad option "-winsize": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, or -translation} -returnCodes error

# Multiple threads

test console-thread-input-1.0 {Get input in thread} -constraints {
    win interactive haveThread
} -setup {
    set tid [thread::create]







|







|





|







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
    set result
} -result [list pass password 0 reset normal 1]

test console-fconfigure-set-1.3 {
    fconfigure stdin -winsize
} -constraints {win interactive} -body {
    fconfigure stdin -winsize {10 30}
} -result {bad option "-winsize": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -profile, -translation, or -inputmode} -returnCodes error

## fconfigure set stdout,stderr

test console-fconfigure-set-2.0 {
    fconfigure stdout -winsize
} -constraints {win interactive} -body {
    fconfigure stdout -winsize {10 30}
} -result {bad option "-winsize": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -profile, or -translation} -returnCodes error

test console-fconfigure-set-3.0 {
    fconfigure stderr -winsize
} -constraints {win interactive} -body {
    fconfigure stderr -winsize {10 30}
} -result {bad option "-winsize": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -profile, or -translation} -returnCodes error

# Multiple threads

test console-thread-input-1.0 {Get input in thread} -constraints {
    win interactive haveThread
} -setup {
    set tid [thread::create]

Changes to tests/winDde.test.

9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}
package require tcltests

testConstraint dde 0
if {[testConstraint win]} {
    if {![catch {
	    ::tcltest::loadTestedCommands
	    set ::ddever [package require dde 1.4.4]
	    set ::ddelib [info loaded {} Dde]}]} {
	testConstraint dde 1
    }
}
testConstraint notWine [expr {![info exists ::env(CI_USING_WINE)]}]









|





|







9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}
source [file join [file dirname [info script]] tcltests.tcl]

testConstraint dde 0
if {[testConstraint win]} {
    if {![catch {
	    ::tcltest::loadTestedCommands
	    set ::ddever [package require dde 1.4.5]
	    set ::ddelib [info loaded {} Dde]}]} {
	testConstraint dde 1
    }
}
testConstraint notWine [expr {![info exists ::env(CI_USING_WINE)]}]


101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
    gets $f line
    return $f
}

# -------------------------------------------------------------------------
test winDde-1.0 {check if we are testing the right dll} {win dde} {
    set ::ddever
} {1.4.4}

test winDde-1.1 {Settings the server's topic name} -constraints dde -body {
    list [dde servername foobar] [dde servername] [dde servername self]
} -result {foobar foobar self}

test winDde-2.1 {Checking for other services} -constraints dde -body {
    expr {[llength [dde services {} {}]] >= 0}







|







101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
    gets $f line
    return $f
}

# -------------------------------------------------------------------------
test winDde-1.0 {check if we are testing the right dll} {win dde} {
    set ::ddever
} {1.4.5}

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}
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
	-constraints dde -body {
    expr {[llength [dde services {} self]] >= 1}
} -result 1

# -------------------------------------------------------------------------

test winDde-3.1 {DDE execute locally} -constraints dde -body {
    set \xe1 ""
    dde execute TclEval self [list set \xe1 foo]
    set \xe1
} -result foo
test winDde-3.2 {DDE execute -async locally} -constraints dde -body {
    set \xe1 ""
    dde execute -async TclEval self [list set \xe1 foo]
    update
    set \xe1
} -result foo
test winDde-3.3 {DDE request locally} -constraints dde -body {
    set \xe1 ""
    dde execute TclEval self [list set \xe1 foo]
    dde request TclEval self \xe1
} -result foo
test winDde-3.4 {DDE eval locally} -constraints dde -body {
    set \xe1 ""
    dde eval self set \xe1 foo
} -result foo
test winDde-3.5 {DDE request locally} -constraints dde -body {
    set \xe1 ""
    dde execute TclEval self [list set \xe1 foo]
    dde request -binary TclEval self \xe1
} -result "foo\x00"
# Set variable a to A with diaeresis (unicode C4) by relying on the fact
# that utf-8 is sent (e.g. "c3 84" on the wire)
test winDde-3.6 {DDE request utf-8} -constraints dde -body {
    set \xe1 "not set"
    dde execute TclEval self "set \xe1 \xc4"
    scan [set \xe1] %c
} -result 196
# Set variable a to A with diaeresis (unicode C4) using binary execute
# and compose utf-8 (e.g. "c3 84" ) manualy
test winDde-3.7 {DDE request binary} -constraints {dde notWine} -body {
    set \xe1 "not set"
    dde execute -binary TclEval self [list set \xc3\xa1 \xc3\x84\x00]
    scan [set \xe1] %c
} -result 196
test winDde-3.8 {DDE poke locally} -constraints {dde debug} -body {
    set \xe1 ""
    dde poke TclEval self \xe1 \xc4
    dde request TclEval self \xe1
} -result \xc4
test winDde-3.9 {DDE poke -binary locally} -constraints {dde debug} -body {
    set \xe1 ""
    dde poke -binary TclEval self \xe1 \xc3\x84\x00
    dde request TclEval self \xe1
} -result \xc4

# -------------------------------------------------------------------------

test winDde-4.1 {DDE execute remotely} -constraints {dde stdio} -body {
    set \xe1 ""
    set name ch\xEDld-4.1
    set child [createChildProcess $name]
    dde execute TclEval $name [list set \xe1 foo]
    dde execute TclEval $name {set done 1}
    update
    set \xe1
} -result ""
test winDde-4.2 {DDE execute async remotely} -constraints {dde stdio} -body {
    set \xe1 ""
    set name ch\xEDld-4.2
    set child [createChildProcess $name]
    dde execute -async TclEval $name [list set \xe1 foo]
    update
    dde execute TclEval $name {set done 1}
    update
    set \xe1
} -result ""
test winDde-4.3 {DDE request remotely} -constraints {dde stdio} -body {
    set \xe1 ""
    set name ch\xEDld-4.3
    set child [createChildProcess $name]
    dde execute TclEval $name [list set \xe1 foo]
    set \xe1 [dde request TclEval $name \xe1]
    dde execute TclEval $name {set done 1}
    update
    set \xe1
} -result foo
test winDde-4.4 {DDE eval remotely} -constraints {dde stdio} -body {
    set \xe1 ""
    set name ch\xEDld-4.4
    set child [createChildProcess $name]
    set \xe1 [dde eval $name set \xe1 foo]
    dde execute TclEval $name {set done 1}
    update
    set \xe1
}  -result foo
test winDde-4.5 {DDE poke remotely} -constraints {dde debug stdio} -body {
    set \xe1 ""
    set name ch\xEDld-4.5
    set child [createChildProcess $name]
    dde poke TclEval $name \xe1 foo
    set \xe1 [dde request TclEval $name \xe1]
    dde execute TclEval $name {set done 1}
    update
    set \xe1
} -result foo

# -------------------------------------------------------------------------

test winDde-5.1 {check for bad arguments} -constraints dde -body {
    dde execute "" "" "" ""
} -returnCodes error -result {wrong # args: should be "dde execute ?-async? ?-binary? serviceName topicName value"}







|
|
|


|
|

|


|
|
|


|
|


|
|
|

|


|
|
|

|
|

|
|
|


|
|
|
|

|
|
|
|




|


|


|


|


|



|


|


|
|


|


|


|


|


|


|
|


|







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
	-constraints dde -body {
    expr {[llength [dde services {} self]] >= 1}
} -result 1

# -------------------------------------------------------------------------

test winDde-3.1 {DDE execute locally} -constraints dde -body {
    set \xE1 ""
    dde execute TclEval self [list set \xE1 foo]
    set \xE1
} -result foo
test winDde-3.2 {DDE execute -async locally} -constraints dde -body {
    set \xE1 ""
    dde execute -async TclEval self [list set \xE1 foo]
    update
    set \xE1
} -result foo
test winDde-3.3 {DDE request locally} -constraints dde -body {
    set \xE1 ""
    dde execute TclEval self [list set \xE1 foo]
    dde request TclEval self \xE1
} -result foo
test winDde-3.4 {DDE eval locally} -constraints dde -body {
    set \xE1 ""
    dde eval self set \xE1 foo
} -result foo
test winDde-3.5 {DDE request locally} -constraints dde -body {
    set \xE1 ""
    dde execute TclEval self [list set \xE1 foo]
    dde request -binary TclEval self \xE1
} -result "foo\x00"
# Set variable a to A with diaeresis (Unicode C4) by relying on the fact
# that utf-8 is sent (e.g. "c3 84" on the wire)
test winDde-3.6 {DDE request utf-8} -constraints dde -body {
    set \xE1 "not set"
    dde execute TclEval self "set \xE1 \xC4"
    scan [set \xE1] %c
} -result 196
# Set variable a to A with diaeresis (Unicode C4) using binary execute
# and compose utf-8 (e.g. "c3 84" ) manually
test winDde-3.7 {DDE request binary} -constraints {dde notWine} -body {
    set \xE1 "not set"
    dde execute -binary TclEval self [list set \xC3\xA1 \xC3\x84\x00]
    scan [set \xE1] %c
} -result 196
test winDde-3.8 {DDE poke locally} -constraints {dde debug} -body {
    set \xE1 ""
    dde poke TclEval self \xE1 \xC4
    dde request TclEval self \xE1
} -result \xC4
test winDde-3.9 {DDE poke -binary locally} -constraints {dde debug} -body {
    set \xE1 ""
    dde poke -binary TclEval self \xE1 \xC3\x84\x00
    dde request TclEval self \xE1
} -result \xC4

# -------------------------------------------------------------------------

test winDde-4.1 {DDE execute remotely} -constraints {dde stdio} -body {
    set \xE1 ""
    set name ch\xEDld-4.1
    set child [createChildProcess $name]
    dde execute TclEval $name [list set \xE1 foo]
    dde execute TclEval $name {set done 1}
    update
    set \xE1
} -result ""
test winDde-4.2 {DDE execute async remotely} -constraints {dde stdio} -body {
    set \xE1 ""
    set name ch\xEDld-4.2
    set child [createChildProcess $name]
    dde execute -async TclEval $name [list set \xE1 foo]
    update
    dde execute TclEval $name {set done 1}
    update
    set \xE1
} -result ""
test winDde-4.3 {DDE request remotely} -constraints {dde stdio} -body {
    set \xE1 ""
    set name ch\xEDld-4.3
    set child [createChildProcess $name]
    dde execute TclEval $name [list set \xE1 foo]
    set \xE1 [dde request TclEval $name \xE1]
    dde execute TclEval $name {set done 1}
    update
    set \xE1
} -result foo
test winDde-4.4 {DDE eval remotely} -constraints {dde stdio} -body {
    set \xE1 ""
    set name ch\xEDld-4.4
    set child [createChildProcess $name]
    set \xE1 [dde eval $name set \xE1 foo]
    dde execute TclEval $name {set done 1}
    update
    set \xE1
}  -result foo
test winDde-4.5 {DDE poke remotely} -constraints {dde debug stdio} -body {
    set \xE1 ""
    set name ch\xEDld-4.5
    set child [createChildProcess $name]
    dde poke TclEval $name \xE1 foo
    set \xE1 [dde request TclEval $name \xE1]
    dde execute TclEval $name {set done 1}
    update
    set \xE1
} -result foo

# -------------------------------------------------------------------------

test winDde-5.1 {check for bad arguments} -constraints dde -body {
    dde execute "" "" "" ""
} -returnCodes error -result {wrong # args: should be "dde execute ?-async? ?-binary? serviceName topicName value"}
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
} -cleanup {interp delete child} -result 1
test winDde-8.9 {Safe DDE check command evaluation} -constraints dde -setup {
    interp create -safe child
    child invokehidden load $::ddelib Dde
    child eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel \#0 $cmd]}}
    child invokehidden dde servername -handler DDEACCEPT child
} -body {
    dde eval child set \xe1 1
    child eval set \xe1
} -cleanup {interp delete child} -result 1
test winDde-8.10 {Safe DDE check command evaluation (2)} -constraints dde -setup {
    interp create -safe child
    child invokehidden load $::ddelib Dde
    child eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel \#0 $cmd]}}
    child invokehidden dde servername -handler DDEACCEPT child
} -body {







|
|







398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
} -cleanup {interp delete child} -result 1
test winDde-8.9 {Safe DDE check command evaluation} -constraints dde -setup {
    interp create -safe child
    child invokehidden load $::ddelib Dde
    child eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel \#0 $cmd]}}
    child invokehidden dde servername -handler DDEACCEPT child
} -body {
    dde eval child set \xE1 1
    child eval set \xE1
} -cleanup {interp delete child} -result 1
test winDde-8.10 {Safe DDE check command evaluation (2)} -constraints dde -setup {
    interp create -safe child
    child invokehidden load $::ddelib Dde
    child eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel \#0 $cmd]}}
    child invokehidden dde servername -handler DDEACCEPT child
} -body {

Changes to tests/winFCmd.test.

41
42
43
44
45
46
47
48


49
50
51
52

53
54
55
56




57
58
59
60
61
62
63
proc contents {file} {
    set f [open $file r]
    set r [read $f]
    close $f
    set r
}

proc cleanup {args} {


    foreach p ". $args" {
	set x ""
	catch {
	    set x [glob -directory $p tf* td*]

	}
	if {$x != ""} {
	    catch {file delete -force -- {*}$x}
	}




    }
}

# find a CD-ROM so we can test read-only filesystems.

proc findfile {dir} {
    foreach p [glob -nocomplain -type f -directory $dir *] {







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







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
proc contents {file} {
    set f [open $file r]
    set r [read $f]
    close $f
    set r
}

proc cleanupRecurse {args} {
    # Assumes no loops via links!
    # Need to change permissions BEFORE deletion
    testchmod 0o777 {*}$args

    foreach victim $args {
        if {[file isdirectory $victim]} {
            cleanupRecurse {*}[glob -nocomplain -directory $victim td* tf* Test*]
        }

        file delete -force $victim
    }
}
proc cleanup {args} {
    foreach p [list [pwd] {*}$args] {
        cleanupRecurse {*}[glob -nocomplain -directory $p tf* td*]
    }
}

# find a CD-ROM so we can test read-only filesystems.

proc findfile {dir} {
    foreach p [glob -nocomplain -type f -directory $dir *] {
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
append longname $longname
append longname $longname
append longname $longname

# Uses the "testfile" command instead of the "file" command.  The "file"
# command provides several layers of sanity checks on the arguments and
# it can be difficult to actually forward "insane" arguments to the
# low-level posix emulation layer.

test winFCmd-1.1 {TclpRenameFile: errno: EACCES} -body {
    testfile mv $cdfile $cdrom/dummy~~.fil
} -constraints {win cdrom testfile} -returnCodes error -result EACCES
test winFCmd-1.2 {TclpRenameFile: errno: EEXIST} -setup {
    cleanup
} -constraints {win testfile notInCIenv} -body {







|







119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
append longname $longname
append longname $longname
append longname $longname

# Uses the "testfile" command instead of the "file" command.  The "file"
# command provides several layers of sanity checks on the arguments and
# it can be difficult to actually forward "insane" arguments to the
# low-level Posix emulation layer.

test winFCmd-1.1 {TclpRenameFile: errno: EACCES} -body {
    testfile mv $cdfile $cdrom/dummy~~.fil
} -constraints {win cdrom testfile} -returnCodes error -result EACCES
test winFCmd-1.2 {TclpRenameFile: errno: EEXIST} -setup {
    cleanup
} -constraints {win testfile notInCIenv} -body {
241
242
243
244
245
246
247

248
249
250
251
252
253
254
255
256
} -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:/
} -returnCodes error -result EINVAL
test winFCmd-1.25 {TclpRenameFile: cross file systems} -setup {
    cleanup
} -constraints {win cdrom testfile} -body {
    file mkdir td1
    testfile mv td1 $cdrom/td1
} -returnCodes error -result EXDEV
test winFCmd-1.26 {TclpRenameFile: readonly fs} -setup {







>

|







246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
} -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 {
    # Error code depends on Windows version
    testfile mv / c:/
} -returnCodes error -result {^(EINVAL|ENOENT)$} -match regexp
test winFCmd-1.25 {TclpRenameFile: cross file systems} -setup {
    cleanup
} -constraints {win cdrom testfile} -body {
    file mkdir td1
    testfile mv td1 $cdrom/td1
} -returnCodes error -result EXDEV
test winFCmd-1.26 {TclpRenameFile: readonly fs} -setup {
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
    }
}

test winFCmd-1.38 {TclpRenameFile: check rename of conflicting inodes} -setup {
    cleanup
} -constraints {win winNonZeroInodes knownMsvcBug notInCIenv} -body {
    file mkdir td1
    foreach {a b} [MakeFiles td1] break
    file rename -force $a $b
    file exists $a
} -cleanup {
    cleanup
} -result {0}


test winFCmd-2.1 {TclpCopyFile: errno: EACCES} -setup {
    cleanup
} -constraints {win cdrom testfile} -body {
    testfile cp $cdfile $cdrom/dummy~~.fil
} -returnCodes error -result EACCES







|




|







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

test winFCmd-1.38 {TclpRenameFile: check rename of conflicting inodes} -setup {
    cleanup
} -constraints {win winNonZeroInodes knownMsvcBug notInCIenv} -body {
    file mkdir td1
    lassign [MakeFiles td1] a b
    file rename -force $a $b
    file exists $a
} -cleanup {
    cleanup
} -result 0


test winFCmd-2.1 {TclpCopyFile: errno: EACCES} -setup {
    cleanup
} -constraints {win cdrom testfile} -body {
    testfile cp $cdfile $cdrom/dummy~~.fil
} -returnCodes error -result EACCES
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
} -cleanup {
    cleanup
} -result {tf1 tf1}
test winFCmd-2.12 {TclpCopyFile: CopyFile succeeds} -setup {
    cleanup
} -constraints {win testfile} -body {
    createfile tf1 tf1
    testchmod 0 tf1
    testfile cp tf1 tf2
    list [contents tf2] [file writable tf2]
} -cleanup {
    catch {testchmod 0o666 tf1}
    cleanup
} -result {tf1 0}
test winFCmd-2.13 {TclpCopyFile: CopyFile fails} -setup {
    cleanup
} -constraints {win testfile} -body {
    createfile tf1
    file mkdir td1







|



|







452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
} -cleanup {
    cleanup
} -result {tf1 tf1}
test winFCmd-2.12 {TclpCopyFile: CopyFile succeeds} -setup {
    cleanup
} -constraints {win testfile} -body {
    createfile tf1 tf1
    file attribute tf1 -readonly 1
    testfile cp tf1 tf2
    list [contents tf2] [file writable tf2]
} -cleanup {
    testchmod 0o660 tf1
    cleanup
} -result {tf1 0}
test winFCmd-2.13 {TclpCopyFile: CopyFile fails} -setup {
    cleanup
} -constraints {win testfile} -body {
    createfile tf1
    file mkdir td1
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
    cleanup
} -returnCodes error -result EISDIR
test winFCmd-2.17 {TclpCopyFile: dst is readonly} -setup {
    cleanup
} -constraints {win testfile testchmod} -body {
    createfile tf1 tf1
    createfile tf2 tf2
    testchmod 0 tf2
    testfile cp tf1 tf2
    list [file writable tf2] [contents tf2]
} -cleanup {
    catch {testchmod 0o666 tf2}
    cleanup
} -result {1 tf1}

test winFCmd-3.1 {TclpDeleteFile: errno: EACCES} -body {
    testfile rm $cdfile $cdrom/dummy~~.fil
} -constraints {win cdrom testfile} -returnCodes error -result EACCES
test winFCmd-3.2 {TclpDeleteFile: errno: EISDIR} -setup {







|



<







498
499
500
501
502
503
504
505
506
507
508

509
510
511
512
513
514
515
    cleanup
} -returnCodes error -result EISDIR
test winFCmd-2.17 {TclpCopyFile: dst is readonly} -setup {
    cleanup
} -constraints {win testfile testchmod} -body {
    createfile tf1 tf1
    createfile tf2 tf2
    file attribute tf2 -readonly 1
    testfile cp tf1 tf2
    list [file writable tf2] [contents tf2]
} -cleanup {

    cleanup
} -result {1 tf1}

test winFCmd-3.1 {TclpDeleteFile: errno: EACCES} -body {
    testfile rm $cdfile $cdrom/dummy~~.fil
} -constraints {win cdrom testfile} -returnCodes error -result EACCES
test winFCmd-3.2 {TclpDeleteFile: errno: EISDIR} -setup {
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
    cleanup
} -constraints {win testfile testchmod} -body {
    set fd [open tf1 w]
    testchmod 0 tf1
    testfile rm tf1
} -cleanup {
    close $fd
    catch {testchmod 0o666 tf1}
    cleanup
} -returnCodes error -result EACCES

test winFCmd-4.1 {TclpCreateDirectory: errno: EACCES} -body {
    testfile mkdir $cdrom/dummy~~.dir
} -constraints {win cdrom testfile} -returnCodes error -result EACCES
test winFCmd-4.3 {TclpCreateDirectory: errno: EEXIST} -setup {







<







579
580
581
582
583
584
585

586
587
588
589
590
591
592
    cleanup
} -constraints {win testfile testchmod} -body {
    set fd [open tf1 w]
    testchmod 0 tf1
    testfile rm tf1
} -cleanup {
    close $fd

    cleanup
} -returnCodes error -result EACCES

test winFCmd-4.1 {TclpCreateDirectory: errno: EACCES} -body {
    testfile mkdir $cdrom/dummy~~.dir
} -constraints {win cdrom testfile} -returnCodes error -result EACCES
test winFCmd-4.3 {TclpCreateDirectory: errno: EEXIST} -setup {
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
    list [file type td1] [file type td2]
} -cleanup {
    cleanup
} -result {directory directory}

test winFCmd-6.1 {TclpRemoveDirectory: errno: EACCES} -setup {
    cleanup
} -constraints {win testfile testchmod knownMsvcBug notInCIenv} -body {



    file mkdir td1
    testchmod 0 td1

    testfile rmdir td1
    file exists td1
} -returnCodes error -cleanup {
    catch {testchmod 0o666 td1}
    cleanup
} -result {td1 EACCES}
# This next test has a very hokey way of matching...
test winFCmd-6.2 {TclpRemoveDirectory: errno: EEXIST} -setup {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1/td2
    list [catch {testfile rmdir td1} msg] [file tail $msg]
} -result {1 {td1 EEXIST}}
test winFCmd-6.3 {TclpRemoveDirectory: errno: EACCES} {win emptyTest} {
    # can't test this w/o removing everything on your hard disk first!
    # testfile rmdir /
} {}
# This next test has a very hokey way of matching...
test winFCmd-6.4 {TclpRemoveDirectory: errno: ENOENT} -setup {
    cleanup
} -constraints {win testfile} -body {







|
>
>
>
|
|
>
|
|

<

|







|







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
    list [file type td1] [file type td2]
} -cleanup {
    cleanup
} -result {directory directory}

test winFCmd-6.1 {TclpRemoveDirectory: errno: EACCES} -setup {
    cleanup
} -constraints {win testfile testchmod notInCIenv} -body {
    # Parent's FILE_DELETE_CHILD setting permits deletion of subdir
    # even when subdir DELETE mask is clear. So we need an intermediate
    # parent td0 with FILE_DELETE_CHILD turned off while allowing R/W.
    file mkdir td0/td1
    testchmod 0o777 td0
    testchmod 0 td0/td1
    testfile rmdir td0/td1
    file exists td0/td1
} -returnCodes error -cleanup {

    cleanup
} -result {td0/td1 EACCES}
# This next test has a very hokey way of matching...
test winFCmd-6.2 {TclpRemoveDirectory: errno: EEXIST} -setup {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1/td2
    list [catch {testfile rmdir td1} msg] [file tail $msg]
} -result {1 {td1 EEXIST}}
test winFCmd-6.3 {TclpRemoveDirectory: errno: EACCES} {win emptyTest trashSystem} {
    # can't test this w/o removing everything on your hard disk first!
    # testfile rmdir /
} {}
# This next test has a very hokey way of matching...
test winFCmd-6.4 {TclpRemoveDirectory: errno: ENOENT} -setup {
    cleanup
} -constraints {win testfile} -body {
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
# This next test has a very hokey way of matching...
test winFCmd-6.8 {TclpRemoveDirectory: RemoveDirectory fails} -setup {
    cleanup
} -constraints {win testfile} -body {
    createfile tf1
    list [catch {testfile rmdir tf1} msg] [file tail $msg]
} -result {1 {tf1 ENOTDIR}}
test winFCmd-6.9 {TclpRemoveDirectory: errno == EACCES} -setup {
    cleanup
} -constraints {win testfile testchmod knownMsvcBug notInCIenv} -body {
    file mkdir td1
    testchmod 0 td1
    testfile rmdir td1
    file exists td1
} -returnCodes error -cleanup {
    catch {testchmod 0o666 td1}
    cleanup
} -result {td1 EACCES}
test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} -setup {
    cleanup
} -constraints {win testfile notInCIenv} -body {
    testfile rmdir /
    # WinXP returns EEXIST, WinNT seems to return EACCES.  No policy
    # decision has been made as to which is correct.
} -returnCodes error -match regexp -result {^/ E(ACCES|EXIST)$}
test winFCmd-6.13 {TclpRemoveDirectory: write-protected} -setup {
    cleanup
} -constraints {win testfile testchmod knownMsvcBug notInCIenv} -body {



    file mkdir td1
    testchmod 0 td1

    testfile rmdir td1
    file exists td1
} -cleanup {
    catch {testchmod 0o666 td1}
    cleanup
} -returnCodes error -result {td1 EACCES}
# This next test has a very hokey way of matching...
test winFCmd-6.15 {TclpRemoveDirectory: !recursive} -setup {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1/td2
    list [catch {testfile rmdir td1} msg] [file tail $msg]
} -result {1 {td1 EEXIST}}







|
<
<
<
<
<
<
<
<
<
<









|
>
>
>
|
|
>
|
|

|

|







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
# This next test has a very hokey way of matching...
test winFCmd-6.8 {TclpRemoveDirectory: RemoveDirectory fails} -setup {
    cleanup
} -constraints {win testfile} -body {
    createfile tf1
    list [catch {testfile rmdir tf1} msg] [file tail $msg]
} -result {1 {tf1 ENOTDIR}}
# winFCmd-6.9 removed - was exact dup of winFCmd-6.1










test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} -setup {
    cleanup
} -constraints {win testfile notInCIenv} -body {
    testfile rmdir /
    # WinXP returns EEXIST, WinNT seems to return EACCES.  No policy
    # decision has been made as to which is correct.
} -returnCodes error -match regexp -result {^/ E(ACCES|EXIST)$}
test winFCmd-6.13 {TclpRemoveDirectory: write-protected} -setup {
    cleanup
} -constraints {win testfile testchmod notInCIenv} -body {
    # Parent's FILE_DELETE_CHILD setting permits deletion of subdir
    # even when subdir DELETE mask is clear. So we need an intermediate
    # parent td0 with FILE_DELETE_CHILD turned off while allowing R/W.
    file mkdir td0/td1
    testchmod 0o770 td0
    testchmod 0o444 td0/td1
    testfile rmdir td0/td1
    file exists td0/td1
} -cleanup {
    testchmod 0o770 td0/td1
    cleanup
} -returnCodes error -result {td0/td1 EACCES}
# This next test has a very hokey way of matching...
test winFCmd-6.15 {TclpRemoveDirectory: !recursive} -setup {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1/td2
    list [catch {testfile rmdir td1} msg] [file tail $msg]
} -result {1 {td1 EEXIST}}
787
788
789
790
791
792
793

794
795
796
797
798
799
800
801
802
803
804
805
    # can't make it happen
} {}
test winFCmd-7.11 {TraverseWinTree: call TraversalCopy: DOTREE_PRED} -setup {
    cleanup
} -constraints {win testfile testchmod} -body {
    file mkdir td1
    createfile td1/tf1 tf1

    testchmod 0 td1
    testfile cpdir td1 td2
    list [file exists td2] [file writable td2]
} -cleanup {
    catch {testchmod 0o666 td1}
    cleanup
} -result {1 1}
test winFCmd-7.12 {TraverseWinTree: call TraversalDelete: DOTREE_PRED} -setup {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    createfile td1/tf1 tf1







>
|



|







788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
    # can't make it happen
} {}
test winFCmd-7.11 {TraverseWinTree: call TraversalCopy: DOTREE_PRED} -setup {
    cleanup
} -constraints {win testfile testchmod} -body {
    file mkdir td1
    createfile td1/tf1 tf1
    testchmod 0o770 td1/tf1; # Else tf2 will have no ACL after td1 testchmod
    testchmod 0o400 td1
    testfile cpdir td1 td2
    list [file exists td2] [file writable td2]
} -cleanup {
    testchmod 0o660 td1
    cleanup
} -result {1 1}
test winFCmd-7.12 {TraverseWinTree: call TraversalDelete: DOTREE_PRED} -setup {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    createfile td1/tf1 tf1
858
859
860
861
862
863
864

865
866
867
868
869
870
871
872
873
874
875
876
    cleanup
} -result {td2/td2 td2/tf1 td2/tf2 td2/tf3 td2/tf4}
test winFCmd-7.19 {TraverseWinTree: call TraversalCopy: DOTREE_POSTD} -setup {
    cleanup
} -constraints {win testfile testchmod} -body {
    file mkdir td1
    createfile td1/tf1 tf1

    testchmod 0 td1
    testfile cpdir td1 td2
    list [file exists td2] [file writable td2]
} -cleanup {
    catch {testchmod 0o666 td1}
    cleanup
} -result {1 1}
test winFCmd-7.20 {TraverseWinTree: call TraversalDelete: DOTREE_POSTD} -setup {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    createfile td1/tf1 tf1







>
|



|







860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
    cleanup
} -result {td2/td2 td2/tf1 td2/tf2 td2/tf3 td2/tf4}
test winFCmd-7.19 {TraverseWinTree: call TraversalCopy: DOTREE_POSTD} -setup {
    cleanup
} -constraints {win testfile testchmod} -body {
    file mkdir td1
    createfile td1/tf1 tf1
    testchmod 0o770 td1/tf1; # Else tf2 will have no ACL after td1 testchmod
    testchmod 0o400 td1
    testfile cpdir td1 td2
    list [file exists td2] [file writable td2]
} -cleanup {
    testchmod 0o660 td1
    cleanup
} -result {1 1}
test winFCmd-7.20 {TraverseWinTree: call TraversalDelete: DOTREE_POSTD} -setup {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    createfile td1/tf1 tf1
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
    file mkdir td1
    testfile cpdir td1 td1
} -returnCodes error -result {td1 EEXIST}
test winFCmd-8.2 {TraversalCopy: DOTREE_PRED} -setup {
    cleanup
} -constraints {win testfile testchmod} -body {
    file mkdir td1/td2

    testchmod 0 td1
    testfile cpdir td1 td2
    list [file writable td1] [file writable td1/td2]
} -cleanup {
    catch {testchmod 0o666 td1}
    cleanup
} -result {0 1}
test winFCmd-8.3 {TraversalCopy: DOTREE_POSTD} -setup {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    testfile cpdir td1 td2
} -cleanup {
    cleanup
} -result {}

test winFCmd-9.1 {TraversalDelete: DOTREE_F} -setup {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    createfile td1/tf1
    testfile rmdir -force td1
} -result {}
test winFCmd-9.3 {TraversalDelete: DOTREE_PRED} -setup {
    cleanup
} -constraints {win testfile testchmod knownMsvcBug notInCIenv} -body {



    file mkdir td1/td2
    testchmod 0 td1

    testfile rmdir -force td1
    file exists td1
} -cleanup {
    catch {testchmod 0o666 td1}
    cleanup
} -returnCodes error -result {td1 EACCES}
test winFCmd-9.4 {TraversalDelete: DOTREE_POSTD} -setup {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1/td1/td3/td4/td5
    testfile rmdir -force td1
} -result {}








>
|



|




















|
>
>
>
|
|
>
|


|

|







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
    file mkdir td1
    testfile cpdir td1 td1
} -returnCodes error -result {td1 EEXIST}
test winFCmd-8.2 {TraversalCopy: DOTREE_PRED} -setup {
    cleanup
} -constraints {win testfile testchmod} -body {
    file mkdir td1/td2
    testchmod 0o770 td1/td2; # Else td2 will have no ACL after td1 testchmod
    testchmod 0o400 td1
    testfile cpdir td1 td2
    list [file writable td1] [file writable td1/td2]
} -cleanup {
    testchmod 0o660 td1
    cleanup
} -result {0 1}
test winFCmd-8.3 {TraversalCopy: DOTREE_POSTD} -setup {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    testfile cpdir td1 td2
} -cleanup {
    cleanup
} -result {}

test winFCmd-9.1 {TraversalDelete: DOTREE_F} -setup {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    createfile td1/tf1
    testfile rmdir -force td1
} -result {}
test winFCmd-9.3 {TraversalDelete: DOTREE_PRED} -setup {
    cleanup
} -constraints {win testfile testchmod notInCIenv} -body {
    # Parent's FILE_DELETE_CHILD setting permits deletion of subdir
    # even when subdir DELETE mask is clear. So we need an intermediate
    # parent td0 with FILE_DELETE_CHILD turned off while allowing R/W.
    file mkdir td0/td1/td2
    testchmod 0o770 td0
    testchmod 0o400 td0/td1
    testfile rmdir -force td0/td1
    file exists td1
} -cleanup {
    testchmod 0o770 td0/td1
    cleanup
} -returnCodes error -result {td0/td1 EACCES}
test winFCmd-9.4 {TraversalDelete: DOTREE_POSTD} -setup {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1/td1/td3/td4/td5
    testfile rmdir -force td1
} -result {}

1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
#		    puts $msg
#		}
#	    }
#	}
#    }
#}

# cleanup
cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:







<







1421
1422
1423
1424
1425
1426
1427

1428
1429
1430
1431
1432
1433
1434
#		    puts $msg
#		}
#	    }
#	}
#    }
#}


cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/winTime.test.

15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testwinclock [llength [info commands testwinclock]]
# Some things fail under all Continuous Integration systems for subtle reasons
# such as CI often running with elevated privileges in a container.
testConstraint notInCIenv   [expr {![info exists ::env(CI)]}]

# The next two tests will crash on Windows if the check for negative
# clock values is not done properly.

test winTime-1.1 {TclpGetDate} {win} {
    set ::env(TZ) JST-9
    set result [clock format -1 -format %Y]







<
<
<







15
16
17
18
19
20
21



22
23
24
25
26
27
28
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testwinclock [llength [info commands testwinclock]]




# 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]
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
    set result
} {1969}

# Next test tries to make sure that the Tcl clock stays in step
# with the Windows clock.  30 sec really isn't enough,
# but how much time does a tester have patience for?

test winTime-2.1 {Synchronization of Tcl and Windows clocks} {testwinclock notInCIenv} {
    # May fail due to OS/hardware discrepancies.  See:
    # http://support.microsoft.com/default.aspx?scid=kb;en-us;274323
    set failed {}
    set ok 1
    foreach start_sec [testwinclock] break
    while { 1 } {
	foreach { sys_sec sys_usec tcl_sec tcl_usec } [testwinclock] break







|







36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
    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 {
    # 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/zlib.test.

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
    set fd [open $file wb]
} -constraints zlib -body {
    list [fconfigure $fd] [zlib push compress $fd; fconfigure $fd] \
	[chan pop $fd; fconfigure $fd]
} -cleanup {
    catch {close $fd}
    removeFile $file
} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -nocomplainencoding 0 -strictencoding 0 -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -nocomplainencoding 0 -strictencoding 0 -translation lf -checksum 1 -dictionary {}} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -nocomplainencoding 0 -strictencoding 0 -translation lf}}
test zlib-8.7 {transformation and fconfigure} -setup {
    set file [makeFile {} test.gz]
    set fd [open $file wb]
} -constraints zlib -body {
    list [fconfigure $fd] [zlib push gzip $fd; fconfigure $fd] \
	[chan pop $fd; fconfigure $fd]
} -cleanup {
    catch {close $fd}
    removeFile $file
} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -nocomplainencoding 0 -strictencoding 0 -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -nocomplainencoding 0 -strictencoding 0 -translation lf -checksum 0} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -nocomplainencoding 0 -strictencoding 0 -translation lf}}
# Input is headers from fetching SPDY draft
# Dictionary is that which is proposed _in_ SPDY draft
set spdyHeaders "HTTP/1.0 200 OK\r\nContent-Type: text/html; charset=utf-8\r\nX-Robots-Tag: noarchive\r\nLast-Modified: Tue, 05 Jun 2012 02:43:25 GMT\r\nETag: \"1338864205129|#public|0|en|||0\"\r\nExpires: Tue, 05 Jun 2012 16:17:11 GMT\r\nDate: Tue, 05 Jun 2012 16:17:06 GMT\r\nCache-Control: public, max-age=5\r\nX-Content-Type-Options: nosniff\r\nX-XSS-Protection: 1; mode=block\r\nServer: GSE\r\n"
set spdyDict "optionsgetheadpostputdeletetraceacceptaccept-charsetaccept-encodingaccept-languageauthorizationexpectfromhostif-modified-sinceif-matchif-none-matchif-rangeif-unmodifiedsincemax-forwardsproxy-authorizationrangerefererteuser-agent100101200201202203204205206300301302303304305306307400401402403404405406407408409410411412413414415416417500501502503504505accept-rangesageetaglocationproxy-authenticatepublicretry-afterservervarywarningwww-authenticateallowcontent-basecontent-encodingcache-controlconnectiondatetrailertransfer-encodingupgradeviawarningcontent-languagecontent-lengthcontent-locationcontent-md5content-rangecontent-typeetagexpireslast-modifiedset-cookieMondayTuesdayWednesdayThursdayFridaySaturdaySundayJanFebMarAprMayJunJulAugSepOctNovDecchunkedtext/htmlimage/pngimage/jpgimage/gifapplication/xmlapplication/xhtmltext/plainpublicmax-agecharset=iso-8859-1utf-8gzipdeflateHTTP/1.1statusversionurl"
test zlib-8.8 {transformation and fconfigure} -setup {
    lassign [chan pipe] inSide outSide
} -constraints zlib -body {







|









|







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
    set fd [open $file wb]
} -constraints zlib -body {
    list [fconfigure $fd] [zlib push compress $fd; fconfigure $fd] \
	[chan pop $fd; fconfigure $fd]
} -cleanup {
    catch {close $fd}
    removeFile $file
} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding iso8859-1 -eofchar {} -profile strict -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding iso8859-1 -eofchar {} -profile strict -translation lf -checksum 1 -dictionary {}} {-blocking 1 -buffering full -buffersize 4096 -encoding iso8859-1 -eofchar {} -profile strict -translation lf}}
test zlib-8.7 {transformation and fconfigure} -setup {
    set file [makeFile {} test.gz]
    set fd [open $file wb]
} -constraints zlib -body {
    list [fconfigure $fd] [zlib push gzip $fd; fconfigure $fd] \
	[chan pop $fd; fconfigure $fd]
} -cleanup {
    catch {close $fd}
    removeFile $file
} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding iso8859-1 -eofchar {} -profile strict -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding iso8859-1 -eofchar {} -profile strict -translation lf -checksum 0} {-blocking 1 -buffering full -buffersize 4096 -encoding iso8859-1 -eofchar {} -profile strict -translation lf}}
# Input is headers from fetching SPDY draft
# Dictionary is that which is proposed _in_ SPDY draft
set spdyHeaders "HTTP/1.0 200 OK\r\nContent-Type: text/html; charset=utf-8\r\nX-Robots-Tag: noarchive\r\nLast-Modified: Tue, 05 Jun 2012 02:43:25 GMT\r\nETag: \"1338864205129|#public|0|en|||0\"\r\nExpires: Tue, 05 Jun 2012 16:17:11 GMT\r\nDate: Tue, 05 Jun 2012 16:17:06 GMT\r\nCache-Control: public, max-age=5\r\nX-Content-Type-Options: nosniff\r\nX-XSS-Protection: 1; mode=block\r\nServer: GSE\r\n"
set spdyDict "optionsgetheadpostputdeletetraceacceptaccept-charsetaccept-encodingaccept-languageauthorizationexpectfromhostif-modified-sinceif-matchif-none-matchif-rangeif-unmodifiedsincemax-forwardsproxy-authorizationrangerefererteuser-agent100101200201202203204205206300301302303304305306307400401402403404405406407408409410411412413414415416417500501502503504505accept-rangesageetaglocationproxy-authenticatepublicretry-afterservervarywarningwww-authenticateallowcontent-basecontent-encodingcache-controlconnectiondatetrailertransfer-encodingupgradeviawarningcontent-languagecontent-lengthcontent-locationcontent-md5content-rangecontent-typeetagexpireslast-modifiedset-cookieMondayTuesdayWednesdayThursdayFridaySaturdaySundayJanFebMarAprMayJunJulAugSepOctNovDecchunkedtext/htmlimage/pngimage/jpgimage/gifapplication/xmlapplication/xhtmltext/plainpublicmax-agecharset=iso-8859-1utf-8gzipdeflateHTTP/1.1statusversionurl"
test zlib-8.8 {transformation and fconfigure} -setup {
    lassign [chan pipe] inSide outSide
} -constraints zlib -body {
482
483
484
485
486
487
488
































489
490
491
492
493
494
495
    zlib push inflate $inSide -dictionary "one two"
    zlib push deflate $outSide -dictionary "one two"
    list [chan configure $inSide -dictionary] [chan configure $outSide -dictionary]
} -cleanup {
    catch {close $inSide}
    catch {close $outSide}
} -result {{one two} {one two}}

































test zlib-9.1 "check fcopy with push" -constraints zlib -setup {
    set sfile [makeFile {} testsrc.gz]
    set file [makeFile {} test.gz]
    set f [open $sfile wb]
    puts -nonewline $f [zlib gzip [string repeat a 81920]]
    close $f







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







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
    zlib push inflate $inSide -dictionary "one two"
    zlib push deflate $outSide -dictionary "one two"
    list [chan configure $inSide -dictionary] [chan configure $outSide -dictionary]
} -cleanup {
    catch {close $inSide}
    catch {close $outSide}
} -result {{one two} {one two}}
test zlib-8.19 {zlib transformation, bug f9eafc3886} -constraints zlib -setup {
    set file [makeFile {} test.gz]
} -body {
    set f [zlib push gzip [open $file w] -header [list comment [string repeat A 500]]]
} -cleanup {
    catch {close $f}
    removeFile $file
} -returnCodes 1 -result {Comment too large for zip}
test zlib-8.20 {zlib transformation, bug f9eafc3886} -constraints zlib -setup {
    set file [makeFile {} test.gz]
} -body {
    set f [zlib push gzip [open $file w] -header [list filename [string repeat A 5000]]]
} -cleanup {
    catch {close $f}
    removeFile $file
} -returnCodes 1 -result {Filename too large for zip}
test zlib-8.21 {zlib transformation, bug f9eafc3886} -constraints zlib -setup {
    set file [makeFile {} test.gz]
} -body {
    set f [zlib push gzip [open $file w] -header [list comment \u100]]
} -cleanup {
    catch {close $f}
    removeFile $file
} -returnCodes 1 -result {Comment contains characters > 0xFF}
test zlib-8.22 {zlib transformation, bug f9eafc3886} -constraints zlib -setup {
    set file [makeFile {} test.gz]
} -body {
    set f [zlib push gzip [open $file w] -header [list filename \u100]]
} -cleanup {
    catch {close $f}
    removeFile $file
} -returnCodes 1 -result {Filename contains characters > 0xFF}

test zlib-9.1 "check fcopy with push" -constraints zlib -setup {
    set sfile [makeFile {} testsrc.gz]
    set file [makeFile {} test.gz]
    set f [open $sfile wb]
    puts -nonewline $f [zlib gzip [string repeat a 81920]]
    close $f

Changes to tools/encoding/Makefile.

67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
	@for p in *.txt; do \
	    enc=`echo $$p | sed 's/\..*$$/\.enc/'`; \
	    echo $$enc; \
	    ./txt2enc -e 0 -u 1 $$p > $$enc; \
	done
	@echo
	@echo Compiling special versions of encoding files.
	@for p in ascii.txt; do \
	    enc=`echo $$p | sed 's/\..*$$/\.enc/'`; \
	    echo $$enc; \
	    ./txt2enc -m $$p > $$enc; \
	done
	@for p in jis0208.txt; do \
	    enc=`echo $$p | sed 's/\..*$$/\.enc/'`; \
	    echo $$enc; \
	    ./txt2enc -e 1 -u 2 $$p > $$enc; \
	done
	@for p in symbol.txt dingbats.txt macDingbats.txt; do \
	    enc=`echo $$p | sed 's/\..*$$/\.enc/'`; \







<
<
<
<
<







67
68
69
70
71
72
73





74
75
76
77
78
79
80
	@for p in *.txt; do \
	    enc=`echo $$p | sed 's/\..*$$/\.enc/'`; \
	    echo $$enc; \
	    ./txt2enc -e 0 -u 1 $$p > $$enc; \
	done
	@echo
	@echo Compiling special versions of encoding files.





	@for p in jis0208.txt; do \
	    enc=`echo $$p | sed 's/\..*$$/\.enc/'`; \
	    echo $$enc; \
	    ./txt2enc -e 1 -u 2 $$p > $$enc; \
	done
	@for p in symbol.txt dingbats.txt macDingbats.txt; do \
	    enc=`echo $$p | sed 's/\..*$$/\.enc/'`; \

Changes to tools/encoding/txt2enc.c.

102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
	usage:
	fputs("usage: mkencoding [-e column] [-u column] [-f fallback] [-t type] [-s] [-m] file\n", stderr);
	fputs("    -e\tcolumn containing characters in encoding (default: 0)\n", stderr);
	fputs("    -u\tcolumn containing characters in Unicode (default: 1)\n", stderr);
	fputs("    -f\tfallback character (default: QUESTION MARK)\n", stderr);
	fputs("    -t\toverride implicit type with single, double, or multi\n", stderr);
	fputs("    -s\tsymbol+ascii encoding\n", stderr);
	fputs("    -m\tdon't implicitly include range 0080 to 00FF\n", stderr);
	return 1;
    }

    fp = fopen(argv[argc - 1], "r");
    if (fp == NULL) {
        perror(argv[argc - 1]);
	return 1;







|







102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
	usage:
	fputs("usage: mkencoding [-e column] [-u column] [-f fallback] [-t type] [-s] [-m] file\n", stderr);
	fputs("    -e\tcolumn containing characters in encoding (default: 0)\n", stderr);
	fputs("    -u\tcolumn containing characters in Unicode (default: 1)\n", stderr);
	fputs("    -f\tfallback character (default: QUESTION MARK)\n", stderr);
	fputs("    -t\toverride implicit type with single, double, or multi\n", stderr);
	fputs("    -s\tsymbol+ascii encoding\n", stderr);
	fputs("    -m\tdon't implicitly include 007F\n", stderr);
	return 1;
    }

    fp = fopen(argv[argc - 1], "r");
    if (fp == NULL) {
        perror(argv[argc - 1]);
	return 1;
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
	    toUnicode[0] = (Rune *) malloc(256 * sizeof(Rune));
	    memset(toUnicode[0], 0, 256 * sizeof(Rune));
	}
	for (i = 0; i < 0x20; i++) {
	    toUnicode[0][i] = i;
	}
	if (fixmissing) {
	    for (i = 0x7F; i < 0xA0; i++) {
		if (toUnicode[i] == NULL && toUnicode[0][i] == 0) {
		    toUnicode[0][i] = i;
		}
	    }
	}
    }

    printf("# Encoding file: %s, %s-byte\n", argv[argc - 1], typeString[type]);

    if (fallbackChar == '\0') {







<
|
|
<







204
205
206
207
208
209
210

211
212

213
214
215
216
217
218
219
	    toUnicode[0] = (Rune *) malloc(256 * sizeof(Rune));
	    memset(toUnicode[0], 0, 256 * sizeof(Rune));
	}
	for (i = 0; i < 0x20; i++) {
	    toUnicode[0][i] = i;
	}
	if (fixmissing) {

	    if (toUnicode[0x7F] == NULL && toUnicode[0][0x7F] == 0) {
		toUnicode[0][0x7F] = 0x7F;

	    }
	}
    }

    printf("# Encoding file: %s, %s-byte\n", argv[argc - 1], typeString[type]);

    if (fallbackChar == '\0') {

Changes to tools/mkdepend.tcl.

248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
}

# addSearchPath --
#
#	Adds a new set of path and replacement string to the global list.
#
# Arguments:
#	newPathInfo	comma seperated path and replacement string
#
# Results:
#	None.

proc addSearchPath {newPathInfo} {
    global srcPathList srcPathReplaceList








|







248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
}

# addSearchPath --
#
#	Adds a new set of path and replacement string to the global list.
#
# Arguments:
#	newPathInfo	comma separated path and replacement string
#
# Results:
#	None.

proc addSearchPath {newPathInfo} {
    global srcPathList srcPathReplaceList

292
293
294
295
296
297
298
299
300
301
302
303
304
305
306

proc readInputListFile {objectListFile} {
    global srcFileList srcPathList source_extensions
    set f [open $objectListFile r]
    set fl [read $f]
    close $f

    # fix native path seperator so it isn't treated as an escape.
    regsub -all {\\} $fl {/} fl

    # Treat the string as a list so filenames between double quotes are
    # treated as list elements.
    foreach fname $fl {
	# Compiled .res resource files should be ignored.
	if {[file extension $fname] ne ".obj"} {continue}







|







292
293
294
295
296
297
298
299
300
301
302
303
304
305
306

proc readInputListFile {objectListFile} {
    global srcFileList srcPathList source_extensions
    set f [open $objectListFile r]
    set fl [read $f]
    close $f

    # fix native path separator so it isn't treated as an escape.
    regsub -all {\\} $fl {/} fl

    # Treat the string as a list so filenames between double quotes are
    # treated as list elements.
    foreach fname $fl {
	# Compiled .res resource files should be ignored.
	if {[file extension $fname] ne ".obj"} {continue}

Changes to tools/regexpTestLib.tcl.

38
39
40
41
42
43
44
45
46
47
48
49
50
51
52

    close $fileId
    return $i
}

#
# strings with embedded @'s are truncated
# unpreceeded @'s are replaced by {}
#
proc removeAts {ls} {
    set len [llength $ls]
    set newLs {}
    foreach item $ls {
	regsub @.* $item "" newItem
	lappend newLs $newItem







|







38
39
40
41
42
43
44
45
46
47
48
49
50
51
52

    close $fileId
    return $i
}

#
# strings with embedded @'s are truncated
# unpreceded @'s are replaced by {}
#
proc removeAts {ls} {
    set len [llength $ls]
    set newLs {}
    foreach item $ls {
	regsub @.* $item "" newItem
	lappend newLs $newItem

Changes to tools/tclOOScript.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
# tclOOScript.h --
#
# 	This file contains support scripts for TclOO. They are defined here so
# 	that the code can be definitely run even in safe interpreters; TclOO's
# 	core setup is safe.
#
# Copyright © 2012-2018 Donal K. Fellows
# Copyright © 2013 Andreas Kupries
# Copyright © 2017 Gerald Lester
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

::namespace eval ::oo {
    ::namespace path {}

    #
    # Commands that are made available to objects by default.
    #
    namespace eval Helpers {
	::namespace path {}

	# ------------------------------------------------------------------
	#
	# callback, mymethod --
	#
	#	Create a script prefix that calls a method on the current
	#	object. Same operation, two names.






|













|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
# tclOOScript.h --
#
# 	This file contains support scripts for TclOO. They are defined here so
# 	that the code can be definitely run even in safe interpreters; TclOO's
# 	core setup is safe.
#
# Copyright © 2012-2019 Donal K. Fellows
# Copyright © 2013 Andreas Kupries
# Copyright © 2017 Gerald Lester
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

::namespace eval ::oo {
    ::namespace path {}

    #
    # Commands that are made available to objects by default.
    #
    namespace eval Helpers {
	namespace path {}

	# ------------------------------------------------------------------
	#
	# callback, mymethod --
	#
	#	Create a script prefix that calls a method on the current
	#	object. Same operation, two names.
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
	    return
	}
	foreach c [info class superclass $class] {
	    set d [DelegateName $c]
	    if {![info object isa class $d]} {
		continue
	    }
	    define $delegate ::oo::define::superclass -append $d
	}
	objdefine $class ::oo::objdefine::mixin -append $delegate
    }

    # ----------------------------------------------------------------------
    #
    # UpdateClassDelegatesAfterClone --
    #
    #	Support code that is like [MixinClassDelegates] except for when a







|

|







149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
	    return
	}
	foreach c [info class superclass $class] {
	    set d [DelegateName $c]
	    if {![info object isa class $d]} {
		continue
	    }
	    define $delegate ::oo::define::superclass -appendifnew $d
	}
	objdefine $class ::oo::objdefine::mixin -appendifnew $delegate
    }

    # ----------------------------------------------------------------------
    #
    # UpdateClassDelegatesAfterClone --
    #
    #	Support code that is like [MixinClassDelegates] except for when a
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
	#
	#	Basic slot getter. Retrieves the contents of the slot.
	#	Particular slots must provide concrete non-erroring
	#	implementation.
	#
	# ------------------------------------------------------------------

	method Get {} {
	    return -code error -errorcode {TCLOO ABSTRACT_SLOT} "unimplemented"
	}

	# ------------------------------------------------------------------
	#
	# Slot Set --
	#
	#	Basic slot setter. Sets the contents of the slot.  Particular
	#	slots must provide concrete non-erroring implementation.
	#
	# ------------------------------------------------------------------

	method Set list {
	    return -code error -errorcode {TCLOO ABSTRACT_SLOT} "unimplemented"
	}

	# ------------------------------------------------------------------
	#
	# Slot Resolve --
	#
	#	Helper that lets a slot convert a list of arguments of a
	#	particular type to their canonical forms. Defaults to doing
	#	nothing (suitable for simple strings).
	#
	# ------------------------------------------------------------------

	method Resolve list {
	    return $list
	}

	# ------------------------------------------------------------------
	#
	# Slot -set, -append, -clear, --default-operation --
	#
	#	Standard public slot operations. If a slot can't figure out
	#	what method to call directly, it uses --default-operation.
	#
	# ------------------------------------------------------------------

	method -set args {
	    set my [namespace which my]
	    set args [lmap a $args {uplevel 1 [list $my Resolve $a]}]
	    tailcall my Set $args
	}
	method -append args {
	    set my [namespace which my]
	    set args [lmap a $args {uplevel 1 [list $my Resolve $a]}]
	    set current [uplevel 1 [list $my Get]]
	    tailcall my Set [list {*}$current {*}$args]
	}











	method -clear {} {tailcall my Set {}}
	method -prepend args {
	    set my [namespace which my]
	    set args [lmap a $args {uplevel 1 [list $my Resolve $a]}]
	    set current [uplevel 1 [list $my Get]]
	    tailcall my Set [list {*}$args {*}$current]
	}
	method -remove args {
	    set my [namespace which my]
	    set args [lmap a $args {uplevel 1 [list $my Resolve $a]}]
	    set current [uplevel 1 [list $my Get]]
	    tailcall my Set [lmap val $current {
		if {$val in $args} continue else {set val}
	    }]
	}

	# Default handling
	forward --default-operation my -append
	method unknown {args} {
	    set def --default-operation
	    if {[llength $args] == 0} {
		tailcall my $def
	    } elseif {![string match -* [lindex $args 0]]} {
		tailcall my $def {*}$args
	    }
	    next {*}$args
	}

	# Set up what is exported and what isn't
	export -set -append -clear -prepend -remove
	unexport unknown destroy
    }

    # Set the default operation differently for these slots
    objdefine define::superclass forward --default-operation my -set
    objdefine define::mixin forward --default-operation my -set
    objdefine objdefine::mixin forward --default-operation my -set

    # ----------------------------------------------------------------------
    #
    # oo::object <cloned> --
    #
    #	Handler for cloning objects that clones basic bits (only!) of the
    #	object's namespace. Non-procedures, traces, sub-namespaces, etc. need
    #	more complex (and class-specific) handling.
    #
    # ----------------------------------------------------------------------

    define object method <cloned> {originObject} {
	# Copy over the procedures from the original namespace
	foreach p [info procs [info object namespace $originObject]::*] {
	    set args [info args $p]
	    set idx -1
	    foreach a $args {
		if {[info default $p $a d]} {
		    lset args [incr idx] [list $a $d]







|












|













|












|




|





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





|










|









|
<
|

















|







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
	#
	#	Basic slot getter. Retrieves the contents of the slot.
	#	Particular slots must provide concrete non-erroring
	#	implementation.
	#
	# ------------------------------------------------------------------

	method Get -unexport {} {
	    return -code error -errorcode {TCLOO ABSTRACT_SLOT} "unimplemented"
	}

	# ------------------------------------------------------------------
	#
	# Slot Set --
	#
	#	Basic slot setter. Sets the contents of the slot.  Particular
	#	slots must provide concrete non-erroring implementation.
	#
	# ------------------------------------------------------------------

	method Set -unexport list {
	    return -code error -errorcode {TCLOO ABSTRACT_SLOT} "unimplemented"
	}

	# ------------------------------------------------------------------
	#
	# Slot Resolve --
	#
	#	Helper that lets a slot convert a list of arguments of a
	#	particular type to their canonical forms. Defaults to doing
	#	nothing (suitable for simple strings).
	#
	# ------------------------------------------------------------------

	method Resolve -unexport list {
	    return $list
	}

	# ------------------------------------------------------------------
	#
	# Slot -set, -append, -clear, --default-operation --
	#
	#	Standard public slot operations. If a slot can't figure out
	#	what method to call directly, it uses --default-operation.
	#
	# ------------------------------------------------------------------

	method -set -export args {
	    set my [namespace which my]
	    set args [lmap a $args {uplevel 1 [list $my Resolve $a]}]
	    tailcall my Set $args
	}
	method -append -export args {
	    set my [namespace which my]
	    set args [lmap a $args {uplevel 1 [list $my Resolve $a]}]
	    set current [uplevel 1 [list $my Get]]
	    tailcall my Set [list {*}$current {*}$args]
	}
	method -appendifnew -export args {
	    set my [namespace which my]
	    set current [uplevel 1 [list $my Get]]
	    foreach a $args {
		set a [uplevel 1 [list $my Resolve $a]]
		if {$a ni $current} {
		    lappend current $a
		}
	    }
	    tailcall my Set $current
	}
	method -clear -export {} {tailcall my Set {}}
	method -prepend -export args {
	    set my [namespace which my]
	    set args [lmap a $args {uplevel 1 [list $my Resolve $a]}]
	    set current [uplevel 1 [list $my Get]]
	    tailcall my Set [list {*}$args {*}$current]
	}
	method -remove -export args {
	    set my [namespace which my]
	    set args [lmap a $args {uplevel 1 [list $my Resolve $a]}]
	    set current [uplevel 1 [list $my Get]]
	    tailcall my Set [lmap val $current {
		if {$val in $args} continue else {set val}
	    }]
	}

	# Default handling
	forward --default-operation my -append
	method unknown -unexport {args} {
	    set def --default-operation
	    if {[llength $args] == 0} {
		tailcall my $def
	    } elseif {![string match -* [lindex $args 0]]} {
		tailcall my $def {*}$args
	    }
	    next {*}$args
	}

	# Hide destroy

	unexport destroy
    }

    # Set the default operation differently for these slots
    objdefine define::superclass forward --default-operation my -set
    objdefine define::mixin forward --default-operation my -set
    objdefine objdefine::mixin forward --default-operation my -set

    # ----------------------------------------------------------------------
    #
    # oo::object <cloned> --
    #
    #	Handler for cloning objects that clones basic bits (only!) of the
    #	object's namespace. Non-procedures, traces, sub-namespaces, etc. need
    #	more complex (and class-specific) handling.
    #
    # ----------------------------------------------------------------------

    define object method <cloned> -unexport {originObject} {
	# Copy over the procedures from the original namespace
	foreach p [info procs [info object namespace $originObject]::*] {
	    set args [info args $p]
	    set idx -1
	    foreach a $args {
		if {[info default $p $a d]} {
		    lset args [incr idx] [list $a $d]
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
    #
    # oo::class <cloned> --
    #
    #	Handler for cloning classes, which fixes up the delegates.
    #
    # ----------------------------------------------------------------------

    define class method <cloned> {originObject} {
	next $originObject
	# Rebuild the class inheritance delegation class
	::oo::UpdateClassDelegatesAfterClone $originObject [self]
    }

    # ----------------------------------------------------------------------
    #







|







403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
    #
    # oo::class <cloned> --
    #
    #	Handler for cloning classes, which fixes up the delegates.
    #
    # ----------------------------------------------------------------------

    define class method <cloned> -unexport {originObject} {
	next $originObject
	# Rebuild the class inheritance delegation class
	::oo::UpdateClassDelegatesAfterClone $originObject [self]
    }

    # ----------------------------------------------------------------------
    #
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
	    if {![info exists object] || ![info object isa object $object]} {
		set object [next {*}$args]
		::oo::objdefine $object {
		    method destroy {} {
			::return -code error -errorcode {TCLOO SINGLETON} \
			    "may not destroy a singleton object"
		    }
		    method <cloned> {originObject} {
			::return -code error -errorcode {TCLOO SINGLETON} \
			    "may not clone a singleton object"
		    }
		}
	    }
	    return $object
	}







|







430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
	    if {![info exists object] || ![info object isa object $object]} {
		set object [next {*}$args]
		::oo::objdefine $object {
		    method destroy {} {
			::return -code error -errorcode {TCLOO SINGLETON} \
			    "may not destroy a singleton object"
		    }
		    method <cloned> -unexport {originObject} {
			::return -code error -errorcode {TCLOO SINGLETON} \
			    "may not clone a singleton object"
		    }
		}
	    }
	    return $object
	}
443
444
445
446
447
448
449












































































































































































































































































































































450
451
452
453
454
455
456
    #
    # ----------------------------------------------------------------------

    class create abstract {
	superclass class
	unexport create createWithNamespace new
    }












































































































































































































































































































































}

# Local Variables:
# mode: tcl
# c-basic-offset: 4
# fill-column: 78
# End:







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







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

    class create abstract {
	superclass class
	unexport create createWithNamespace new
    }

    # ----------------------------------------------------------------------
    #
    # oo::configuresupport --
    #
    #	Namespace that holds all the implementation details of TIP #558.
    #	Also includes the commands:
    #
    #	 * readableproperties
    #	 * writableproperties
    #	 * objreadableproperties
    #	 * objwritableproperties
    #
    #	Those are all slot implementations that provide access to the C layer
    #	of property support (i.e., very fast cached lookup of property names).
    #
    # ----------------------------------------------------------------------

    ::namespace eval configuresupport {
	namespace path ::tcl

	# ------------------------------------------------------------------
	#
	# oo::configuresupport --
	#
	#	A metaclass that is used to make classes that can be configured.
	#
	# ------------------------------------------------------------------

	proc PropertyImpl {readslot writeslot args} {
	    for {set i 0} {$i < [llength $args]} {incr i} {
		# Parse the property name
		set prop [lindex $args $i]
		if {[string match "-*" $prop]} {
		    return -code error -level 2 \
			-errorcode {TCLOO PROPERTY_FORMAT} \
			"bad property name \"$prop\": must not begin with -"
		}
		if {$prop ne [list $prop]} {
		    return -code error -level 2 \
			-errorcode {TCLOO PROPERTY_FORMAT} \
			"bad property name \"$prop\": must be a simple word"
		}
		if {[string first "::" $prop] != -1} {
		    return -code error -level 2 \
			-errorcode {TCLOO PROPERTY_FORMAT} \
			"bad property name \"$prop\": must not contain namespace separators"
		}
		if {[string match {*[()]*} $prop]} {
		    return -code error -level 2 \
			-errorcode {TCLOO PROPERTY_FORMAT} \
			"bad property name \"$prop\": must not contain parentheses"
		}
		set realprop [string cat "-" $prop]
		set getter [format {::set [my varname %s]} $prop]
		set setter [format {::set [my varname %s] $value} $prop]
		set kind readwrite

		# Parse the extra options
		while {[set next [lindex $args [expr {$i + 1}]]
			string match "-*" $next]} {
		    set arg [lindex $args [incr i 2]]
		    switch [prefix match -error [list -level 2 -errorcode \
			    [list TCL LOOKUP INDEX option $next]] {-get -kind -set} $next] {
			-get {
			    if {$i >= [llength $args]} {
				return -code error -level 2 \
				    -errorcode {TCL WRONGARGS} \
				    "missing body to go with -get option"
			    }
			    set getter $arg
			}
			-set {
			    if {$i >= [llength $args]} {
				return -code error -level 2 \
				    -errorcode {TCL WRONGARGS} \
				    "missing body to go with -set option"
			    }
			    set setter $arg
			}
			-kind {
			    if {$i >= [llength $args]} {
				return -code error -level 2\
				    -errorcode {TCL WRONGARGS} \
				    "missing kind value to go with -kind option"
			    }
			    set kind [prefix match -message "kind" -error [list \
				    -level 2 \
				    -errorcode [list TCL LOOKUP INDEX kind $arg]] {
				readable readwrite writable
			    } $arg]
			}
		    }
		}

		# Install the option
		set reader <ReadProp$realprop>
		set writer <WriteProp$realprop>
		switch $kind {
		    readable {
			uplevel 2 [list $readslot -append $realprop]
			uplevel 2 [list $writeslot -remove $realprop]
			uplevel 2 [list method $reader -unexport {} $getter]
		    }
		    writable {
			uplevel 2 [list $readslot -remove $realprop]
			uplevel 2 [list $writeslot -append $realprop]
			uplevel 2 [list method $writer -unexport {value} $setter]
		    }
		    readwrite {
			uplevel 2 [list $readslot -append $realprop]
			uplevel 2 [list $writeslot -append $realprop]
			uplevel 2 [list method $reader -unexport {} $getter]
			uplevel 2 [list method $writer -unexport {value} $setter]
		    }
		}
	    }
	}

	# ------------------------------------------------------------------
	#
	# oo::configuresupport::configurableclass,
	# oo::configuresupport::configurableobject --
	#
	#	Namespaces used as implementation vectors for oo::define and
	#	oo::objdefine when the class/instance is configurable.
	#
	# ------------------------------------------------------------------

	namespace eval configurableclass {
	    ::proc property args {
		::oo::configuresupport::PropertyImpl \
		    ::oo::configuresupport::readableproperties \
		    ::oo::configuresupport::writableproperties {*}$args
	    }
	    # Plural alias just in case; deliberately NOT documented!
	    ::proc properties args {::tailcall property {*}$args}
	    ::namespace path ::oo::define
	    ::namespace export property
	}

	namespace eval configurableobject {
	    ::proc property args {
		::oo::configuresupport::PropertyImpl \
		    ::oo::configuresupport::objreadableproperties \
		    ::oo::configuresupport::objwritableproperties {*}$args
	    }
	    # Plural alias just in case; deliberately NOT documented!
	    ::proc properties args {::tailcall property {*}$args}
	    ::namespace path ::oo::objdefine
	    ::namespace export property
	}

	# ------------------------------------------------------------------
	#
	# oo::configuresupport::ReadAll --
	#
	#	The implementation of [$o configure] with no extra arguments.
	#
	# ------------------------------------------------------------------

	proc ReadAll {object my} {
	    set result {}
	    foreach prop [info object properties $object -all -readable] {
		try {
		    dict set result $prop [$my <ReadProp$prop>]
		} on error {msg opt} {
		    dict set opt -level 2
		    return -options $opt $msg
		} on return {msg opt} {
		    dict incr opt -level 2
		    return -options $opt $msg
		} on break {} {
		    return -code error -level 2 -errorcode {TCLOO SHENANIGANS} \
			"property getter for $prop did a break"
		} on continue {} {
		    return -code error -level 2 -errorcode {TCLOO SHENANIGANS} \
			"property getter for $prop did a continue"
		}
	    }
	    return $result
	}

	# ------------------------------------------------------------------
	#
	# oo::configuresupport::ReadOne --
	#
	#	The implementation of [$o configure -prop] with that single
	#	extra argument.
	#
	# ------------------------------------------------------------------

	proc ReadOne {object my propertyName} {
	    set props [info object properties $object -all -readable]
	    try {
		set prop [prefix match -message "property" $props $propertyName]
	    } on error {msg} {
		catch {
		    set wps [info object properties $object -all -writable]
		    set wprop [prefix match $wps $propertyName]
		    set msg "property \"$wprop\" is write only"
		}
		return -code error -level 2 -errorcode [list \
			TCL LOOKUP INDEX property $propertyName] $msg
	    }
	    try {
		set value [$my <ReadProp$prop>]
	    } on error {msg opt} {
		dict set opt -level 2
		return -options $opt $msg
	    } on return {msg opt} {
		dict incr opt -level 2
		return -options $opt $msg
	    } on break {} {
		return -code error -level 2 -errorcode {TCLOO SHENANIGANS} \
		    "property getter for $prop did a break"
	    } on continue {} {
		return -code error -level 2 -errorcode {TCLOO SHENANIGANS} \
		    "property getter for $prop did a continue"
	    }
	    return $value
	}

	# ------------------------------------------------------------------
	#
	# oo::configuresupport::WriteMany --
	#
	#	The implementation of [$o configure -prop val ?-prop val...?].
	#
	# ------------------------------------------------------------------

	proc WriteMany {object my setterMap} {
	    set props [info object properties $object -all -writable]
	    foreach {prop value} $setterMap {
		try {
		    set prop [prefix match -message "property" $props $prop]
		} on error {msg} {
		    catch {
			set rps [info object properties $object -all -readable]
			set rprop [prefix match $rps $prop]
			set msg "property \"$rprop\" is read only"
		    }
		    return -code error -level 2 -errorcode [list \
			    TCL LOOKUP INDEX property $prop] $msg
		}
		try {
		    $my <WriteProp$prop> $value
		} on error {msg opt} {
		    dict set opt -level 2
		    return -options $opt $msg
		} on return {msg opt} {
		    dict incr opt -level 2
		    return -options $opt $msg
		} on break {} {
		    return -code error -level 2 -errorcode {TCLOO SHENANIGANS} \
			"property setter for $prop did a break"
		} on continue {} {
		    return -code error -level 2 -errorcode {TCLOO SHENANIGANS} \
			"property setter for $prop did a continue"
		}
	    }
	    return
	}

	# ------------------------------------------------------------------
	#
	# oo::configuresupport::configurable --
	#
	#	The class that contains the implementation of the actual
	#	'configure' method (mixed into actually configurable classes).
	#	Great care needs to be taken in these methods as they are
	#	potentially used in classes where the current namespace is set
	#	up very strangely.
	#
	# ------------------------------------------------------------------

	::oo::class create configurable {
	    private variable my
	    #
	    # configure --
	    #	Method for providing client access to the property mechanism.
	    #	Has a user-facing API similar to that of [chan configure].
	    #
	    method configure -export args {
		::if {![::info exists my]} {
		    ::set my [::namespace which my]
		}
		::if {[::llength $args] == 0} {
		    # Read all properties
		    ::oo::configuresupport::ReadAll [self] $my
		} elseif {[::llength $args] == 1} {
		    # Read a single property
		    ::oo::configuresupport::ReadOne [self] $my \
			[::lindex $args 0]
		} elseif {[::llength $args] % 2 == 0} {
		    # Set properties, one or several
		    ::oo::configuresupport::WriteMany [self] $my $args
		} else {
		    # Invalid call
		    ::return -code error -errorcode {TCL WRONGARGS} \
			[::format {wrong # args: should be "%s"} \
			    "[self] configure ?-option value ...?"]
		}
	    }

	    definitionnamespace -instance configurableobject
	    definitionnamespace -class configurableclass
	}
    }

    # ----------------------------------------------------------------------
    #
    # oo::configurable --
    #
    #	A metaclass that is used to make classes that can be configured in
    #	their creation phase (and later too). All the metaclass itself does is
    #	arrange for the class created to have a 'configure' method and for
    #	oo::define and oo::objdefine (on the class and its instances) to have
    #	a property definition for setting things up for 'configure'.
    #
    # ----------------------------------------------------------------------

    class create configurable {
	superclass class

	constructor {{definitionScript ""}} {
	    next {mixin ::oo::configuresupport::configurable}
	    next $definitionScript
	}

	definitionnamespace -class configuresupport::configurableclass
    }
}

# Local Variables:
# mode: tcl
# c-basic-offset: 4
# fill-column: 78
# End:

Changes to tools/tcltk-man2html-utils.tcl.

1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
}

##
## merge copyright listings
##
proc merge-copyrights {l1 l2} {
    set merge {}
    set re1 {^Copyright +(?:\(c\)|\\\(co|&copy;) +(\w.*?)(?:all rights reserved)?(?:\. )*$}
    set re2 {^(\d+) +(?:by +)?(\w.*)$}         ;# date who
    set re3 {^(\d+)-(\d+) +(?:by +)?(\w.*)$}   ;# from to who
    set re4 {^(\d+), *(\d+) +(?:by +)?(\w.*)$} ;# date1 date2 who
    foreach copyright [concat $l1 $l2] {
	if {[regexp -nocase -- $re1 $copyright -> info]} {
	    set info [string trimright $info ". "] ; # remove extra period
	    if {[regexp -- $re2 $info -> date who]} {







|







1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
}

##
## merge copyright listings
##
proc merge-copyrights {l1 l2} {
    set merge {}
    set re1 {^Copyright +(?:\(c\)|\\\(co|&copy;) +(\w.*?)(?:all rights reserved)?(?:\. )*$}
    set re2 {^(\d+) +(?:by +)?(\w.*)$}         ;# date who
    set re3 {^(\d+)-(\d+) +(?:by +)?(\w.*)$}   ;# from to who
    set re4 {^(\d+), *(\d+) +(?:by +)?(\w.*)$} ;# date1 date2 who
    foreach copyright [concat $l1 $l2] {
	if {[regexp -nocase -- $re1 $copyright -> info]} {
	    set info [string trimright $info ". "] ; # remove extra period
	    if {[regexp -- $re2 $info -> date who]} {

Changes to tools/tcltk-man2html.tcl.

25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
set ::Version "50/9.0"
set ::CSSFILE "docs.css"

##
## Source the utility functions that provide most of the
## implementation of the transformation from nroff to html.
##
source [file join [file dirname [info script]] tcltk-man2html-utils.tcl]

proc getversion {tclh {name {}}} {
    if {[file exists $tclh]} {
	set chan [open $tclh]
	set data [read $chan]
	close $chan
	if {$name eq ""} {







|







25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
set ::Version "50/9.0"
set ::CSSFILE "docs.css"

##
## Source the utility functions that provide most of the
## implementation of the transformation from nroff to html.
##
source -encoding utf-8 [file join [file dirname [info script]] tcltk-man2html-utils.tcl]

proc getversion {tclh {name {}}} {
    if {[file exists $tclh]} {
	set chan [open $tclh]
	set data [read $chan]
	close $chan
	if {$name eq ""} {
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
    css-style h3 {
	font-size: 12px;
    }
    css-style h4 {
	font-size: 11px;
    }
    css-style ".keylist dt" ".arguments dt" {
	width: 20em;
	float: left;
	padding: 2px;
	border-top: 1px solid #999999;
    }
    css-style ".keylist dt" { font-weight: bold; }
    css-style ".keylist dd" ".arguments dd" {
	margin-left: 20em;
	padding: 2px;
	border-top: 1px solid #999999;
    }
    css-style .copy {
	background-color:  #F6FCFC;
	white-space:       pre;
	font-size:         80%;







|






|







289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
    css-style h3 {
	font-size: 12px;
    }
    css-style h4 {
	font-size: 11px;
    }
    css-style ".keylist dt" ".arguments dt" {
	width: 25em;
	float: left;
	padding: 2px;
	border-top: 1px solid #999999;
    }
    css-style ".keylist dt" { font-weight: bold; }
    css-style ".keylist dd" ".arguments dd" {
	margin-left: 25em;
	padding: 2px;
	border-top: 1px solid #999999;
    }
    css-style .copy {
	background-color:  #F6FCFC;
	white-space:       pre;
	font-size:         80%;

Added tools/valgrind_check_success.





























































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
#! /usr/bin/env tclsh


proc main {sourcetype source} {
	switch $sourcetype {
		file {
			set chan [open $source]
			try {
				set data [read $chan]
			} finally {
				close $chan
			}
		}
		string {
			set data $source
		}
		default {
			error [list {wrong # args}]
		}
	}
	set found [regexp -inline -all {blocks are\
	    (?:(?:(?:definitely|indirectly|possibly) lost)|still reachable)} $data]
	if {[llength $found]} {
		puts 0
	} else {
		puts 1
	}
	flush stdout
}
main {*}$argv

Changes to tools/valgrind_suppress.















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










14
15
16
17
18
19













20
21
22
23
24
25
26














{
   TclCreatesocketAddress/getaddrinfo/calloc
   Memcheck:Leak
   match-leak-kinds: reachable
   fun:calloc
   ...
   fun:getaddrinfo
   fun:TclCreateSocketAddress
}

{
   TclCreatesocketAddress/getaddrinfo/malloc
   Memcheck:Leak










   match-leak-kinds: reachable
   fun:malloc
   ...
   fun:getaddrinfo
   fun:TclCreateSocketAddress
}














{
   TclpDlopen/load
   Memcheck:Leak
   match-leak-kinds: reachable
   fun:calloc
   ...
>
>
>
>
>
>
>
>
>
>
>
>
>
>













>
>
>
>
>
>
>
>
>
>






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







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
#{
#    Tcl_GetChannelOption/TcpGetOptionProc/TcphostPortList/getnameinfo/gethostbyaddr_r
#    Memcheck:Leak
#    match-leak-kinds: reachable
#    fun:malloc
#    fun:strdup
#    ...
#    fun:module_load
#    ...
#    fun:getnameinfo
#    ...
#    fun:Tcl_GetChannelOption
#}

{
   TclCreatesocketAddress/getaddrinfo/calloc
   Memcheck:Leak
   match-leak-kinds: reachable
   fun:calloc
   ...
   fun:getaddrinfo
   fun:TclCreateSocketAddress
}

{
   TclCreatesocketAddress/getaddrinfo/malloc
   Memcheck:Leak
   match-leak-kinds: definite
   fun:malloc
   ...
   fun:getaddrinfo
   fun:TclCreateSocketAddress
}

{
   TclCreatesocketAddress/getaddrinfo/malloc
   Memcheck:Leak
   match-leak-kinds: reachable
   fun:malloc
   ...
   fun:getaddrinfo
   fun:TclCreateSocketAddress
}

{
   TclpDlopen/decompose_rpath
   Memcheck:Leak
   match-leak-kinds: reachable
   fun:malloc
   ...
   fun:decompose_rpath
   ...
   fun:dlopen_doit
   ...
   fun:TclpDlopen
}

{
   TclpDlopen/load
   Memcheck:Leak
   match-leak-kinds: reachable
   fun:calloc
   ...
67
68
69
70
71
72
73








































74
75
76
77
78
79
80
   fun:malloc
   ...
   fun:_nss_systemd_getgrnam_r
   ...
   fun:TclpGetGrNam
}









































{
   TclpGetPwNam/getpwname_r/__nss_next2/calloc
   Memcheck:Leak
   match-leak-kinds: reachable
   fun:calloc
   ...
   fun:__nss_next2







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







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
   fun:malloc
   ...
   fun:_nss_systemd_getgrnam_r
   ...
   fun:TclpGetGrNam
}

{
    TclpGeHostByName/gethostbyname_r/strdup/malloc
    Memcheck:Leak
    match-leak-kinds: reachable
    fun:malloc
    fun:strdup
    ...
    fun:dl_open_worker
    ...
    fun:do_dlopen
    ...
    fun:TclpGetHostByName
}

{
    TclpGeHostByName/gethostbyname_r/calloc
    Memcheck:Leak
    match-leak-kinds: reachable
    fun:calloc
    ...
    fun:dl_open_worker
    ...
    fun:do_dlopen
    ...
    fun:TclpGetHostByName
}

{
    TclpGeHostByName/gethostbyname_r/malloc
    Memcheck:Leak
    match-leak-kinds: reachable
    fun:malloc
    ...
    fun:dl_open_worker
    ...
    fun:do_dlopen
    ...
    fun:TclpGetHostByName
}

{
   TclpGetPwNam/getpwname_r/__nss_next2/calloc
   Memcheck:Leak
   match-leak-kinds: reachable
   fun:calloc
   ...
   fun:__nss_next2
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
   fun:malloc
   ...
   fun:_nss_systemd_getpwnam_r
   ...
   fun:TclpGetPwNam
}































































{
	TclpThreadExit/pthread_exit/calloc
    Memcheck:Leak
    match-leak-kinds: reachable
	fun:calloc
	...
	fun:pthread_exit
	fun:TclpThreadExit
}

{
	TclpThreadExit/pthread_exit/malloc
    Memcheck:Leak
    match-leak-kinds: reachable
	fun:malloc










	...
	fun:pthread_exit
	fun:TclpThreadExit
}








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















>
>
>
>
>
>
>
>
>
>





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
   fun:malloc
   ...
   fun:_nss_systemd_getpwnam_r
   ...
   fun:TclpGetPwNam
}

{
    TclpGetGrGid/getgrgid_r/tls_get_addr_tail
    Memcheck:Leak
    match-leak-kinds: reachable
    fun:malloc
    ...
    fun:tls_get_addr_tail
    ...
    fun:TclpGetGrGid
}

{
    TclpGetGrGid/getgrgid_r/module_load
    Memcheck:Leak
    match-leak-kinds: reachable
    fun:calloc
    ...
    fun:module_load
    ...
    fun:TclpGetGrGid
}

{
    TclpGetGrGid/getgrgid_r/module_load
    Memcheck:Leak
    match-leak-kinds: reachable
    fun:malloc
    ...
    fun:module_load
    ...
    fun:TclpGetGrGid
}

{
    TcphostPortList/getnameinfo/module_load/calloc
    Memcheck:Leak
    match-leak-kinds: definite,reachable
    fun:calloc
    ...
    fun:dl_open_worker_begin
    ...
    fun:module_load
    ...
    fun:getnameinfo
    fun:TcpHostPortList
}

{
    # see sourceware glibc Bug 14984 - getnameinfo() might be leaking memory
    TcphostPortList/getnameinfo/module_load/mallco
    Memcheck:Leak
    match-leak-kinds: definite,reachable
    fun:malloc
    ...
    fun:dl_open_worker_begin
    ...
    fun:module_load
    ...
    fun:getnameinfo
    fun:TcpHostPortList
}

{
	TclpThreadExit/pthread_exit/calloc
    Memcheck:Leak
    match-leak-kinds: reachable
	fun:calloc
	...
	fun:pthread_exit
	fun:TclpThreadExit
}

{
	TclpThreadExit/pthread_exit/malloc
    Memcheck:Leak
    match-leak-kinds: reachable
	fun:malloc
	...
	fun:pthread_exit
	fun:TclpThreadExit
}

{
	TclpThreadExit/pthread_exit/malloc
    Memcheck:Leak
    match-leak-kinds: definite
	fun:malloc
	...
	fun:pthread_exit
	fun:TclpThreadExit
}

Changes to unix/Makefile.in.

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
# The information below should be usable as is. The configure script won't
# modify it and you shouldn't need to modify it either.
#--------------------------------------------------------------------------

STUB_CC_SWITCHES = -I"${BUILD_DIR}" -I${UNIX_DIR} -I${GENERIC_DIR} -I${TOMMATH_DIR} \
	${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \
	${AC_FLAGS} ${ENV_FLAGS} ${EXTRA_CFLAGS} @EXTRA_CC_SWITCHES@ \
	${NO_DEPRECATED_FLAGS} -DMP_FIXED_CUTOFFS -DMP_NO_STDINT

CC_SWITCHES = $(STUB_CC_SWITCHES) -DBUILD_tcl

APP_CC_SWITCHES = $(STUB_CC_SWITCHES) @EXTRA_APP_CC_SWITCHES@

LIBS		= @TCL_LIBS@

DEPEND_SWITCHES	= ${CFLAGS} -I${UNIX_DIR} -I${GENERIC_DIR} \
	${AC_FLAGS} ${EXTRA_CFLAGS} @EXTRA_CC_SWITCHES@

TCLSH_OBJS = tclAppInit.o

TCLTEST_OBJS = tclTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \
	tclThreadTest.o tclUnixTest.o tclTestABSList.o

XTTEST_OBJS = xtTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \
	tclThreadTest.o tclUnixTest.o tclXtNotify.o tclXtTest.o \
	tclTestABSList.o

GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o \
	tclAbstractList.o tclArithSeries.o tclAlloc.o \
	tclAssembly.o tclAsync.o tclBasic.o tclBinary.o \
	tclCkalloc.o tclClock.o tclCmdAH.o tclCmdIL.o tclCmdMZ.o \
	tclCompCmds.o tclCompCmdsGR.o tclCompCmdsSZ.o tclCompExpr.o \
	tclCompile.o tclConfig.o tclDate.o tclDictObj.o tclDisassemble.o \
	tclEncoding.o tclEnsemble.o \
	tclEnv.o tclEvent.o tclExecute.o tclFCmd.o tclFileName.o tclGet.o \
	tclHash.o tclHistory.o tclIndexObj.o tclInterp.o tclIO.o tclIOCmd.o \
	tclIORChan.o tclIORTrans.o tclIOGT.o tclIOSock.o tclIOUtil.o \







|



















|
<
|







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
# The information below should be usable as is. The configure script won't
# modify it and you shouldn't need to modify it either.
#--------------------------------------------------------------------------

STUB_CC_SWITCHES = -I"${BUILD_DIR}" -I${UNIX_DIR} -I${GENERIC_DIR} -I${TOMMATH_DIR} \
	${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \
	${AC_FLAGS} ${ENV_FLAGS} ${EXTRA_CFLAGS} @EXTRA_CC_SWITCHES@ \
	${NO_DEPRECATED_FLAGS} -DMP_FIXED_CUTOFFS

CC_SWITCHES = $(STUB_CC_SWITCHES) -DBUILD_tcl

APP_CC_SWITCHES = $(STUB_CC_SWITCHES) @EXTRA_APP_CC_SWITCHES@

LIBS		= @TCL_LIBS@

DEPEND_SWITCHES	= ${CFLAGS} -I${UNIX_DIR} -I${GENERIC_DIR} \
	${AC_FLAGS} ${EXTRA_CFLAGS} @EXTRA_CC_SWITCHES@

TCLSH_OBJS = tclAppInit.o

TCLTEST_OBJS = tclTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \
	tclThreadTest.o tclUnixTest.o tclTestABSList.o

XTTEST_OBJS = xtTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \
	tclThreadTest.o tclUnixTest.o tclXtNotify.o tclXtTest.o \
	tclTestABSList.o

GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \

	tclArithSeries.o tclAssembly.o tclAsync.o tclBasic.o tclBinary.o \
	tclCkalloc.o tclClock.o tclCmdAH.o tclCmdIL.o tclCmdMZ.o \
	tclCompCmds.o tclCompCmdsGR.o tclCompCmdsSZ.o tclCompExpr.o \
	tclCompile.o tclConfig.o tclDate.o tclDictObj.o tclDisassemble.o \
	tclEncoding.o tclEnsemble.o \
	tclEnv.o tclEvent.o tclExecute.o tclFCmd.o tclFileName.o tclGet.o \
	tclHash.o tclHistory.o tclIndexObj.o tclInterp.o tclIO.o tclIOCmd.o \
	tclIORChan.o tclIORTrans.o tclIOGT.o tclIOSock.o tclIOUtil.o \
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
	bn_mp_get_mag_u64.o \
	bn_mp_grow.o bn_mp_init.o \
	bn_mp_init_copy.o bn_mp_init_multi.o bn_mp_init_set.o \
	bn_mp_init_size.o bn_s_mp_karatsuba_mul.o \
	bn_mp_init_i64.o bn_mp_init_u64.o \
	bn_s_mp_karatsuba_sqr.o bn_s_mp_balance_mul.o \
	bn_mp_lshd.o bn_mp_mod.o bn_mp_mod_2d.o bn_mp_mul.o bn_mp_mul_2.o \
	bn_mp_mul_2d.o bn_mp_mul_d.o bn_mp_neg.o bn_mp_or.o \
	bn_mp_radix_size.o bn_mp_radix_smap.o bn_mp_set_i64.o  \
	bn_mp_read_radix.o bn_mp_rshd.o \
	bn_mp_set_u64.o bn_mp_shrink.o \
	bn_mp_sqr.o bn_mp_sqrt.o bn_mp_sub.o bn_mp_sub_d.o \
	bn_mp_signed_rsh.o \
	bn_mp_to_ubin.o bn_mp_unpack.o \
	bn_s_mp_toom_mul.o bn_s_mp_toom_sqr.o bn_mp_to_radix.o \
	bn_mp_ubin_size.o bn_mp_xor.o bn_mp_zero.o bn_s_mp_add.o \
	bn_s_mp_mul_digs.o bn_s_mp_sqr.o bn_s_mp_sub.o







|
|
|







332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
	bn_mp_get_mag_u64.o \
	bn_mp_grow.o bn_mp_init.o \
	bn_mp_init_copy.o bn_mp_init_multi.o bn_mp_init_set.o \
	bn_mp_init_size.o bn_s_mp_karatsuba_mul.o \
	bn_mp_init_i64.o bn_mp_init_u64.o \
	bn_s_mp_karatsuba_sqr.o bn_s_mp_balance_mul.o \
	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_pack.o \
	bn_mp_pack_count.o bn_mp_radix_size.o bn_mp_radix_smap.o  \
	bn_mp_set_i64.o bn_mp_read_radix.o bn_mp_rshd.o \
	bn_mp_set_u64.o bn_mp_shrink.o \
	bn_mp_sqr.o bn_mp_sqrt.o bn_mp_sub.o bn_mp_sub_d.o \
	bn_mp_signed_rsh.o \
	bn_mp_to_ubin.o bn_mp_unpack.o \
	bn_s_mp_toom_mul.o bn_s_mp_toom_sqr.o bn_mp_to_radix.o \
	bn_mp_ubin_size.o bn_mp_xor.o bn_mp_zero.o bn_s_mp_add.o \
	bn_s_mp_mul_digs.o bn_s_mp_sqr.o bn_s_mp_sub.o
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
	$(GENERIC_DIR)/tcl.decls \
	$(GENERIC_DIR)/tclInt.decls \
	$(GENERIC_DIR)/tclOO.decls \
	$(GENERIC_DIR)/tclTomMath.decls

GENERIC_HDRS = \
	$(GENERIC_DIR)/tcl.h \
	$(GENERIC_DIR)/tclAbstractList.h \
	$(GENERIC_DIR)/tclArithSeries.h \
	$(GENERIC_DIR)/tclDecls.h \
	$(GENERIC_DIR)/tclInt.h \
	$(GENERIC_DIR)/tclIntDecls.h \
	$(GENERIC_DIR)/tclIntPlatDecls.h \
	$(GENERIC_DIR)/tclTomMath.h \
	$(GENERIC_DIR)/tclTomMathDecls.h \
	$(GENERIC_DIR)/tclOO.h \
	$(GENERIC_DIR)/tclOODecls.h \
	$(GENERIC_DIR)/tclOOInt.h \
	$(GENERIC_DIR)/tclOOIntDecls.h \
	$(GENERIC_DIR)/tclPatch.h \
	$(GENERIC_DIR)/tclPlatDecls.h \
	$(GENERIC_DIR)/tclPort.h \
	$(GENERIC_DIR)/tclRegexp.h


GENERIC_SRCS = \
	$(GENERIC_DIR)/regcomp.c \
	$(GENERIC_DIR)/regexec.c \
	$(GENERIC_DIR)/regfree.c \
	$(GENERIC_DIR)/regerror.c \
	$(GENERIC_DIR)/tclAbstractList.c \
	$(GENERIC_DIR)/tclArithSeries.c \
	$(GENERIC_DIR)/tclAlloc.c \
	$(GENERIC_DIR)/tclAssembly.c \
	$(GENERIC_DIR)/tclAsync.c \
	$(GENERIC_DIR)/tclBasic.c \
	$(GENERIC_DIR)/tclBinary.c \
	$(GENERIC_DIR)/tclCkalloc.c \
	$(GENERIC_DIR)/tclClock.c \
	$(GENERIC_DIR)/tclCmdAH.c \







<
<













|
>






|

<







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
	$(GENERIC_DIR)/tcl.decls \
	$(GENERIC_DIR)/tclInt.decls \
	$(GENERIC_DIR)/tclOO.decls \
	$(GENERIC_DIR)/tclTomMath.decls

GENERIC_HDRS = \
	$(GENERIC_DIR)/tcl.h \


	$(GENERIC_DIR)/tclDecls.h \
	$(GENERIC_DIR)/tclInt.h \
	$(GENERIC_DIR)/tclIntDecls.h \
	$(GENERIC_DIR)/tclIntPlatDecls.h \
	$(GENERIC_DIR)/tclTomMath.h \
	$(GENERIC_DIR)/tclTomMathDecls.h \
	$(GENERIC_DIR)/tclOO.h \
	$(GENERIC_DIR)/tclOODecls.h \
	$(GENERIC_DIR)/tclOOInt.h \
	$(GENERIC_DIR)/tclOOIntDecls.h \
	$(GENERIC_DIR)/tclPatch.h \
	$(GENERIC_DIR)/tclPlatDecls.h \
	$(GENERIC_DIR)/tclPort.h \
	$(GENERIC_DIR)/tclRegexp.h \
	$(GENERIC_DIR)/tclArithSeries.h

GENERIC_SRCS = \
	$(GENERIC_DIR)/regcomp.c \
	$(GENERIC_DIR)/regexec.c \
	$(GENERIC_DIR)/regfree.c \
	$(GENERIC_DIR)/regerror.c \
	$(GENERIC_DIR)/tclAlloc.c \
	$(GENERIC_DIR)/tclArithSeries.c \

	$(GENERIC_DIR)/tclAssembly.c \
	$(GENERIC_DIR)/tclAsync.c \
	$(GENERIC_DIR)/tclBasic.c \
	$(GENERIC_DIR)/tclBinary.c \
	$(GENERIC_DIR)/tclCkalloc.c \
	$(GENERIC_DIR)/tclClock.c \
	$(GENERIC_DIR)/tclCmdAH.c \
956
957
958
959
960
961
962





















963
964
965
966
967
968
969
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)

trace-shell: ${TCL_EXE}
	$(SHELL_ENV) ${TRACE} $(TRACE_OPTS) ./${TCL_EXE} $(SCRIPT)








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







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

testresults/valgrind/%.result: ${TCL_EXE} ${TCLTEST_EXE}
	@mkdir -p testresults/valgrind
	$(SHELL_ENV) $(VALGRIND) $(VALGRINDARGS) ./${TCLTEST_EXE} \
		$(TOP_DIR)/tests/all.tcl -singleproc 1 -constraints valgrind \
		-file $(basename $(notdir $@)) > [email protected] 2>&1
	@mv [email protected] $@
.PRECIOUS: testresults/valgrind/%.result


testresults/valgrind/%.success: testresults/valgrind/%.result
	@printf '%s' valgrind >&2
	@printf ' %s' $(basename $(notdir $@)) >&2
	@printf '\n >&2'
	@status=$$(./${TCLTEST_EXE} $(TOP_DIR)/tools/valgrind_check_success \
		file $(basename $@).result); \
	if [ "$$status" -eq 1 ]; then touch $@; exit 0; else exit 1; fi

valgrind_each: $(addprefix testresults/valgrind/,$(addsuffix .success,$(notdir\
	$(wildcard $(TOP_DIR)/tests/*.test))))


valgrindshell: ${TCL_EXE}
	$(SHELL_ENV) $(VALGRIND) $(VALGRINDARGS) ./${TCL_EXE} $(SCRIPT)

trace-shell: ${TCL_EXE}
	$(SHELL_ENV) ${TRACE} $(TRACE_OPTS) ./${TCL_EXE} $(SCRIPT)

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
	done;
	@echo "Installing package cookiejar 0.2 files to $(SCRIPT_INSTALL_DIR)/cookiejar0.2/"
	@for i in $(TOP_DIR)/library/cookiejar/*.tcl \
	          $(TOP_DIR)/library/cookiejar/*.gz; \
	    do \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/cookiejar0.2"; \
	    done
	@echo "Installing package http 2.10a4 as a Tcl Module"
	@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl \
		"$(MODULE_INSTALL_DIR)/9.0/http-2.10a4.tm"
	@echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/"
	@for i in $(TOP_DIR)/library/opt/*.tcl; do \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
	done
	@echo "Installing package msgcat 1.7.1 as a Tcl Module"
	@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl \
		"$(MODULE_INSTALL_DIR)/9.0/msgcat-1.7.1.tm"
	@echo "Installing package tcltest 2.5.5 as a Tcl Module"
	@$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl \
		"$(MODULE_INSTALL_DIR)/9.0/tcltest-2.5.5.tm"
	@echo "Installing package platform 1.0.19 as a Tcl Module"
	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl \
		"$(MODULE_INSTALL_DIR)/9.0/platform-1.0.19.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/"







|

|







|

|







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
	done;
	@echo "Installing package cookiejar 0.2 files to $(SCRIPT_INSTALL_DIR)/cookiejar0.2/"
	@for i in $(TOP_DIR)/library/cookiejar/*.tcl \
	          $(TOP_DIR)/library/cookiejar/*.gz; \
	    do \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/cookiejar0.2"; \
	    done
	@echo "Installing package http 2.10b1 as a Tcl Module"
	@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl \
		"$(MODULE_INSTALL_DIR)/9.0/http-2.10b1.tm"
	@echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/"
	@for i in $(TOP_DIR)/library/opt/*.tcl; do \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
	done
	@echo "Installing package msgcat 1.7.1 as a Tcl Module"
	@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl \
		"$(MODULE_INSTALL_DIR)/9.0/msgcat-1.7.1.tm"
	@echo "Installing package tcltest 2.5.6 as a Tcl Module"
	@$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl \
		"$(MODULE_INSTALL_DIR)/9.0/tcltest-2.5.6.tm"
	@echo "Installing package platform 1.0.19 as a Tcl Module"
	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl \
		"$(MODULE_INSTALL_DIR)/9.0/platform-1.0.19.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/"
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

regfree.o: $(REGHDRS) $(GENERIC_DIR)/regfree.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/regfree.c

regerror.o: $(REGHDRS) $(GENERIC_DIR)/regerrs.h $(GENERIC_DIR)/regerror.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/regerror.c

tclAbstractList.o: $(GENERIC_DIR)/tclAbstractList.c $(COMPILEHDR)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAbstractList.c

tclArithSeries.o: $(GENERIC_DIR)/tclArithSeries.c $(COMPILEHDR)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclArithSeries.c

tclAppInit.o: $(UNIX_DIR)/tclAppInit.c
	$(CC) -c $(APP_CC_SWITCHES) $(UNIX_DIR)/tclAppInit.c

tclAlloc.o: $(GENERIC_DIR)/tclAlloc.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAlloc.c




tclAssembly.o: $(GENERIC_DIR)/tclAssembly.c $(COMPILEHDR)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAssembly.c

tclAsync.o: $(GENERIC_DIR)/tclAsync.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAsync.c








<
<
<
<
<
<





>
>
>







1269
1270
1271
1272
1273
1274
1275






1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290

regfree.o: $(REGHDRS) $(GENERIC_DIR)/regfree.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/regfree.c

regerror.o: $(REGHDRS) $(GENERIC_DIR)/regerrs.h $(GENERIC_DIR)/regerror.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/regerror.c







tclAppInit.o: $(UNIX_DIR)/tclAppInit.c
	$(CC) -c $(APP_CC_SWITCHES) $(UNIX_DIR)/tclAppInit.c

tclAlloc.o: $(GENERIC_DIR)/tclAlloc.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAlloc.c

tclArithSeries.o: $(GENERIC_DIR)/tclArithSeries.c $(COMPILEHDR)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclArithSeries.c

tclAssembly.o: $(GENERIC_DIR)/tclAssembly.c $(COMPILEHDR)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAssembly.c

tclAsync.o: $(GENERIC_DIR)/tclAsync.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAsync.c

1701
1702
1703
1704
1705
1706
1707






1708
1709
1710
1711
1712
1713
1714

bn_mp_neg.o: $(TOMMATH_DIR)/bn_mp_neg.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_neg.c

bn_mp_or.o: $(TOMMATH_DIR)/bn_mp_or.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_or.c







bn_mp_radix_size.o: $(TOMMATH_DIR)/bn_mp_radix_size.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_radix_size.c

bn_mp_radix_smap.o: $(TOMMATH_DIR)/bn_mp_radix_smap.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_radix_smap.c

bn_mp_read_radix.o: $(TOMMATH_DIR)/bn_mp_read_radix.c $(MATHHDRS)







>
>
>
>
>
>







1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735

bn_mp_neg.o: $(TOMMATH_DIR)/bn_mp_neg.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_neg.c

bn_mp_or.o: $(TOMMATH_DIR)/bn_mp_or.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_or.c

bn_mp_pack.o: $(TOMMATH_DIR)/bn_mp_pack.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_pack.c

bn_mp_pack_count.o: $(TOMMATH_DIR)/bn_mp_pack_count.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_pack_count.c

bn_mp_radix_size.o: $(TOMMATH_DIR)/bn_mp_radix_size.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_radix_size.c

bn_mp_radix_smap.o: $(TOMMATH_DIR)/bn_mp_radix_smap.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_radix_smap.c

bn_mp_read_radix.o: $(TOMMATH_DIR)/bn_mp_read_radix.c $(MATHHDRS)
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
#--------------------------------------------------------------------------
# Compat binaries, these must be compiled for use in a shared library even
# though they may be placed in a static executable or library. Since they are
# included in both the tcl library and the stub library, they need to be
# relocatable.
#--------------------------------------------------------------------------

opendir.o: $(COMPAT_DIR)/opendir.c
	$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/opendir.c

mkstemp.o: $(COMPAT_DIR)/mkstemp.c
	$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/mkstemp.c

memcmp.o: $(COMPAT_DIR)/memcmp.c
	$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/memcmp.c

strncasecmp.o: $(COMPAT_DIR)/strncasecmp.c
	$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strncasecmp.c

strstr.o: $(COMPAT_DIR)/strstr.c
	$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strstr.c

strtol.o: $(COMPAT_DIR)/strtol.c
	$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strtol.c

strtoul.o: $(COMPAT_DIR)/strtoul.c
	$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strtoul.c

waitpid.o: $(COMPAT_DIR)/waitpid.c
	$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/waitpid.c

fake-rfc2553.o: $(COMPAT_DIR)/fake-rfc2553.c
	$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/fake-rfc2553.c

# For building zlib, only used in some build configurations







<
<
<



<
<
<



<
<
<
<
<
<
<
<
<







1886
1887
1888
1889
1890
1891
1892



1893
1894
1895



1896
1897
1898









1899
1900
1901
1902
1903
1904
1905
#--------------------------------------------------------------------------
# Compat binaries, these must be compiled for use in a shared library even
# though they may be placed in a static executable or library. Since they are
# included in both the tcl library and the stub library, they need to be
# relocatable.
#--------------------------------------------------------------------------




mkstemp.o: $(COMPAT_DIR)/mkstemp.c
	$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/mkstemp.c




strncasecmp.o: $(COMPAT_DIR)/strncasecmp.c
	$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strncasecmp.c










waitpid.o: $(COMPAT_DIR)/waitpid.c
	$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/waitpid.c

fake-rfc2553.o: $(COMPAT_DIR)/fake-rfc2553.c
	$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/fake-rfc2553.c

# For building zlib, only used in some build configurations
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
		$(UNIX_DIR)/tcl.pc.in $(DISTDIR)/unix
	$(DIST_INSTALL_SCRIPT) $(UNIX_DIR)/configure $(UNIX_DIR)/ldAix $(DISTDIR)/unix
	$(INSTALL_DATA_DIR) $(DISTDIR)/generic
	$(DIST_INSTALL_DATA) $(GENERIC_DIR)/*.[cdh] $(DISTDIR)/generic
	$(DIST_INSTALL_DATA) $(GENERIC_DIR)/*.decls $(DISTDIR)/generic
	$(DIST_INSTALL_DATA) $(GENERIC_DIR)/README $(DISTDIR)/generic
	$(DIST_INSTALL_DATA) $(GENERIC_DIR)/tclGetDate.y $(DISTDIR)/generic
	$(DIST_INSTALL_DATA) $(TOP_DIR)/changes $(TOP_DIR)/ChangeLog $(TOP_DIR)/README.md \
		$(TOP_DIR)/ChangeLog.[12]??? $(TOP_DIR)/license.terms \
		$(DISTDIR)
	$(INSTALL_DATA_DIR) $(DISTDIR)/library
	$(DIST_INSTALL_DATA) $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \
		$(TOP_DIR)/library/manifest.txt \
		$(TOP_DIR)/library/tclIndex $(DISTDIR)/library
	@for i in $(BUILTIN_PACKAGE_LIST); do \
	    $(INSTALL_DATA_DIR) $(DISTDIR)/library/$$i;\
	    $(DIST_INSTALL_DATA) $(TOP_DIR)/library/$$i/*.tcl $(DISTDIR)/library/$$i; \







|
|
<







2293
2294
2295
2296
2297
2298
2299
2300
2301

2302
2303
2304
2305
2306
2307
2308
		$(UNIX_DIR)/tcl.pc.in $(DISTDIR)/unix
	$(DIST_INSTALL_SCRIPT) $(UNIX_DIR)/configure $(UNIX_DIR)/ldAix $(DISTDIR)/unix
	$(INSTALL_DATA_DIR) $(DISTDIR)/generic
	$(DIST_INSTALL_DATA) $(GENERIC_DIR)/*.[cdh] $(DISTDIR)/generic
	$(DIST_INSTALL_DATA) $(GENERIC_DIR)/*.decls $(DISTDIR)/generic
	$(DIST_INSTALL_DATA) $(GENERIC_DIR)/README $(DISTDIR)/generic
	$(DIST_INSTALL_DATA) $(GENERIC_DIR)/tclGetDate.y $(DISTDIR)/generic
	$(DIST_INSTALL_DATA) $(TOP_DIR)/changes $(TOP_DIR)/README.md \
		$(TOP_DIR)/license.terms $(DISTDIR)

	$(INSTALL_DATA_DIR) $(DISTDIR)/library
	$(DIST_INSTALL_DATA) $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \
		$(TOP_DIR)/library/manifest.txt \
		$(TOP_DIR)/library/tclIndex $(DISTDIR)/library
	@for i in $(BUILTIN_PACKAGE_LIST); do \
	    $(INSTALL_DATA_DIR) $(DISTDIR)/library/$$i;\
	    $(DIST_INSTALL_DATA) $(TOP_DIR)/library/$$i/*.tcl $(DISTDIR)/library/$$i; \
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
	@EXTRA_BUILD_HTML@

html-tk: ${NATIVE_TCLSH}
	$(BUILD_HTML) --tk
	@EXTRA_BUILD_HTML@

BUILD_HTML = \
	@${NATIVE_TCLSH} $(TOOL_DIR)/tcltk-man2html.tcl \
		--useversion=$(MAJOR_VERSION).$(MINOR_VERSION) \
		--htmldir="$(HTML_INSTALL_DIR)" \
		--srcdir=$(TOP_DIR) $(BUILD_HTML_FLAGS)

#--------------------------------------------------------------------------
# The list of all the targets that do not correspond to real files. This stops
# 'make' from getting confused when someone makes an error in a rule.







|







2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
	@EXTRA_BUILD_HTML@

html-tk: ${NATIVE_TCLSH}
	$(BUILD_HTML) --tk
	@EXTRA_BUILD_HTML@

BUILD_HTML = \
	@${NATIVE_TCLSH} -encoding utf-8 $(TOOL_DIR)/tcltk-man2html.tcl \
		--useversion=$(MAJOR_VERSION).$(MINOR_VERSION) \
		--htmldir="$(HTML_INSTALL_DIR)" \
		--srcdir=$(TOP_DIR) $(BUILD_HTML_FLAGS)

#--------------------------------------------------------------------------
# The list of all the targets that do not correspond to real files. This stops
# 'make' from getting confused when someone makes an error in a rule.

Changes to unix/configure.

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
	ac_retval=1
fi
  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
  as_fn_set_status $ac_retval

} # ac_fn_c_try_compile

# ac_fn_c_try_link LINENO
# -----------------------
# Try to link conftest.$ac_ext, and return whether this succeeded.
ac_fn_c_try_link ()
{
  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
  rm -f conftest.$ac_objext conftest.beam conftest$ac_exeext
  if { { ac_try="$ac_link"
case "(($ac_try" in
  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
  *) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
printf "%s\n" "$ac_try_echo"; } >&5
  (eval "$ac_link") 2>conftest.err
  ac_status=$?
  if test -s conftest.err; then
    grep -v '^ *+' conftest.err >conftest.er1
    cat conftest.er1 >&5
    mv -f conftest.er1 conftest.err
  fi
  printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
  test $ac_status = 0; } && {
	 test -z "$ac_c_werror_flag" ||
	 test ! -s conftest.err
       } && test -s conftest$ac_exeext && {
	 test "$cross_compiling" = yes ||
	 test -x conftest$ac_exeext
       }
then :
  ac_retval=0
else $as_nop
  printf "%s\n" "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

	ac_retval=1
fi
  # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information
  # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would
  # interfere with the next link command; also delete a directory that is
  # left behind by Apple's compiler.  We do this before executing the actions.
  rm -rf conftest.dSYM conftest_ipa8_conftest.oo
  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
  as_fn_set_status $ac_retval

} # ac_fn_c_try_link

# ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES
# -------------------------------------------------------
# Tests whether HEADER exists and can be compiled using the include files in
# INCLUDES, setting the cache variable VAR accordingly.
ac_fn_c_check_header_compile ()
{
  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack







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







1600
1601
1602
1603
1604
1605
1606















































1607
1608
1609
1610
1611
1612
1613
	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
1717
1718
1719
1720
1721
1722
1723















































1724
1725
1726
1727
1728
1729
1730

    ac_retval=1
fi
  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
  as_fn_set_status $ac_retval

} # ac_fn_c_try_cpp
















































# ac_fn_c_check_func LINENO FUNC VAR
# ----------------------------------
# Tests whether FUNC exists, setting the cache variable VAR accordingly
ac_fn_c_check_func ()
{
  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack







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







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

    ac_retval=1
fi
  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
  as_fn_set_status $ac_retval

} # ac_fn_c_try_cpp

# ac_fn_c_try_link LINENO
# -----------------------
# Try to link conftest.$ac_ext, and return whether this succeeded.
ac_fn_c_try_link ()
{
  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
  rm -f conftest.$ac_objext conftest.beam conftest$ac_exeext
  if { { ac_try="$ac_link"
case "(($ac_try" in
  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
  *) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
printf "%s\n" "$ac_try_echo"; } >&5
  (eval "$ac_link") 2>conftest.err
  ac_status=$?
  if test -s conftest.err; then
    grep -v '^ *+' conftest.err >conftest.er1
    cat conftest.er1 >&5
    mv -f conftest.er1 conftest.err
  fi
  printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
  test $ac_status = 0; } && {
	 test -z "$ac_c_werror_flag" ||
	 test ! -s conftest.err
       } && test -s conftest$ac_exeext && {
	 test "$cross_compiling" = yes ||
	 test -x conftest$ac_exeext
       }
then :
  ac_retval=0
else $as_nop
  printf "%s\n" "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

	ac_retval=1
fi
  # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information
  # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would
  # interfere with the next link command; also delete a directory that is
  # left behind by Apple's compiler.  We do this before executing the actions.
  rm -rf conftest.dSYM conftest_ipa8_conftest.oo
  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
  as_fn_set_status $ac_retval

} # ac_fn_c_try_link

# ac_fn_c_check_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
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
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5
printf "%s\n" "$ac_cv_path_EGREP" >&6; }
 EGREP="$ac_cv_path_EGREP"



    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking dirent.h" >&5
printf %s "checking dirent.h... " >&6; }
if test ${tcl_cv_dirent_h+y}
then :
  printf %s "(cached) " >&6
else $as_nop

    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <sys/types.h>
#include <dirent.h>
int
main (void)
{

#ifndef _POSIX_SOURCE
#   ifdef __Lynx__
	/*
	 * Generate compilation error to make the test fail:  Lynx headers
	 * are only valid if really in the POSIX environment.
	 */

	missing_procedure();
#   endif
#endif
DIR *d;
struct dirent *entryPtr;
char *p;
d = opendir("foobar");
entryPtr = readdir(d);
p = entryPtr->d_name;
closedir(d);

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"
then :
  tcl_cv_dirent_h=yes
else $as_nop
  tcl_cv_dirent_h=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam \
    conftest$ac_exeext conftest.$ac_ext
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_dirent_h" >&5
printf "%s\n" "$tcl_cv_dirent_h" >&6; }

    if test $tcl_cv_dirent_h = no; then

printf "%s\n" "#define NO_DIRENT_H 1" >>confdefs.h

    fi

    ac_fn_c_check_header_compile "$LINENO" "stdlib.h" "ac_cv_header_stdlib_h" "$ac_includes_default"
if test "x$ac_cv_header_stdlib_h" = xyes
then :
  tcl_ok=1
else $as_nop
  tcl_ok=0
fi

    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <stdlib.h>

_ACEOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
  $EGREP "strtol" >/dev/null 2>&1
then :

else $as_nop
  tcl_ok=0
fi
rm -rf conftest*

    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <stdlib.h>

_ACEOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
  $EGREP "strtoul" >/dev/null 2>&1
then :

else $as_nop
  tcl_ok=0
fi
rm -rf conftest*

    if test $tcl_ok = 0; then

printf "%s\n" "#define NO_STDLIB_H 1" >>confdefs.h

    fi
    ac_fn_c_check_header_compile "$LINENO" "string.h" "ac_cv_header_string_h" "$ac_includes_default"
if test "x$ac_cv_header_string_h" = xyes
then :
  tcl_ok=1
else $as_nop
  tcl_ok=0
fi







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







4154
4155
4156
4157
4158
4159
4160
































































































4161
4162
4163
4164
4165
4166
4167
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"



































































































    ac_fn_c_check_header_compile "$LINENO" "string.h" "ac_cv_header_string_h" "$ac_includes_default"
if test "x$ac_cv_header_string_h" = xyes
then :
  tcl_ok=1
else $as_nop
  tcl_ok=0
fi
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
			if test $tcl_cv_cc_arch_x86_64 = yes
then :

			    CFLAGS="$CFLAGS -arch x86_64"
			    do64bit_ok=yes

fi;;
		    arm64|arm64e)
			{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking if compiler accepts -arch arm64e flag" >&5
printf %s "checking if compiler accepts -arch arm64e flag... " >&6; }
if test ${tcl_cv_cc_arch_arm64e+y}
then :
  printf %s "(cached) " >&6
else $as_nop

			    hold_cflags=$CFLAGS
			    CFLAGS="$CFLAGS -arch arm64e"
			    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

int
main (void)
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"
then :
  tcl_cv_cc_arch_arm64e=yes
else $as_nop
  tcl_cv_cc_arch_arm64e=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam \
    conftest$ac_exeext conftest.$ac_ext
			    CFLAGS=$hold_cflags
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_arch_arm64e" >&5
printf "%s\n" "$tcl_cv_cc_arch_arm64e" >&6; }
			if test $tcl_cv_cc_arch_arm64e = yes
then :

			    CFLAGS="$CFLAGS -arch arm64e"
			    do64bit_ok=yes

fi;;
		    *)
			{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: Don't know how enable 64-bit on architecture \`arch\`" >&5
printf "%s\n" "$as_me: WARNING: Don't know how enable 64-bit on architecture \`arch\`" >&2;};;
		esac

else $as_nop

		# Check for combined 32-bit and 64-bit fat build
		if echo "$CFLAGS " |grep -E -q -- '-arch (ppc64|x86_64|arm64e) ' \
		    && echo "$CFLAGS " |grep -E -q -- '-arch (ppc|i386) '
then :

		    fat_32_64=yes
fi

fi







|
|
|
|





|













|

|





|
|
|


|











|







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
6449
6450
6451
6452
6453
6454
6455
6456
6457
6458
6459
6460
6461
6462
6463
6464
6465
6466
6467
6468
			if test $tcl_cv_cc_arch_x86_64 = yes
then :

			    CFLAGS="$CFLAGS -arch x86_64"
			    do64bit_ok=yes

fi;;
		    arm64)
			{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking if compiler accepts -arch arm64 flag" >&5
printf %s "checking if compiler accepts -arch arm64 flag... " >&6; }
if test ${tcl_cv_cc_arch_arm64+y}
then :
  printf %s "(cached) " >&6
else $as_nop

			    hold_cflags=$CFLAGS
			    CFLAGS="$CFLAGS -arch arm64"
			    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

int
main (void)
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"
then :
  tcl_cv_cc_arch_arm64=yes
else $as_nop
  tcl_cv_cc_arch_arm64=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam \
    conftest$ac_exeext conftest.$ac_ext
			    CFLAGS=$hold_cflags
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_arch_arm64" >&5
printf "%s\n" "$tcl_cv_cc_arch_arm64" >&6; }
			if test $tcl_cv_cc_arch_arm64 = yes
then :

			    CFLAGS="$CFLAGS -arch arm64"
			    do64bit_ok=yes

fi;;
		    *)
			{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: Don't know how enable 64-bit on architecture \`arch\`" >&5
printf "%s\n" "$as_me: WARNING: Don't know how enable 64-bit on architecture \`arch\`" >&2;};;
		esac

else $as_nop

		# Check for combined 32-bit and 64-bit fat build
		if echo "$CFLAGS " |grep -E -q -- '-arch (ppc64|x86_64|arm64) ' \
		    && echo "$CFLAGS " |grep -E -q -- '-arch (ppc|i386) '
then :

		    fat_32_64=yes
fi

fi
6650
6651
6652
6653
6654
6655
6656
6657
6658
6659
6660
6661
6662
6663
6664
printf "%s\n" "#define MODULE_SCOPE __private_extern__" >>confdefs.h

		tcl_cv_cc_visibility_hidden=yes

fi
	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    LD_LIBRARY_PATH_VAR="DYLD_LIBRARY_PATH"

printf "%s\n" "#define MAC_OSX_TCL 1" >>confdefs.h

	    PLAT_OBJS='${MAC_OSX_OBJS}'
	    PLAT_SRCS='${MAC_OSX_SRCS}'
	    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether to use CoreFoundation" >&5
printf %s "checking whether to use CoreFoundation... " >&6; }







|







6554
6555
6556
6557
6558
6559
6560
6561
6562
6563
6564
6565
6566
6567
6568
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_FALLBACK_LIBRARY_PATH"

printf "%s\n" "#define MAC_OSX_TCL 1" >>confdefs.h

	    PLAT_OBJS='${MAC_OSX_OBJS}'
	    PLAT_SRCS='${MAC_OSX_SRCS}'
	    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether to use CoreFoundation" >&5
printf %s "checking whether to use CoreFoundation... " >&6; }
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
    if test "x${tcl_cv_flag__largefile64_source}" = "xyes" ; then

printf "%s\n" "#define _LARGEFILE64_SOURCE 1" >>confdefs.h

	tcl_flags="$tcl_flags _LARGEFILE64_SOURCE"
    fi


    if test ${tcl_cv_flag__largefile_source64+y}
then :
  printf %s "(cached) " >&6
else $as_nop
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <sys/stat.h>
int
main (void)
{
char *p = (char *)open64;
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_flag__largefile_source64=no
else $as_nop
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#define _LARGEFILE_SOURCE64 1
#include <sys/stat.h>
int
main (void)
{
char *p = (char *)open64;
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_flag__largefile_source64=yes
else $as_nop
  tcl_cv_flag__largefile_source64=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
fi

    if test "x${tcl_cv_flag__largefile_source64}" = "xyes" ; then

printf "%s\n" "#define _LARGEFILE_SOURCE64 1" >>confdefs.h

	tcl_flags="$tcl_flags _LARGEFILE_SOURCE64"
    fi

    if test "x${tcl_flags}" = "x" ; then
	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none" >&5
printf "%s\n" "none" >&6; }
    else
	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: ${tcl_flags}" >&5
printf "%s\n" "${tcl_flags}" >&6; }
    fi



    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for 64-bit integer type" >&5
printf %s "checking for 64-bit integer type... " >&6; }
    if test ${tcl_cv_type_64bit+y}
then :
  printf %s "(cached) " >&6
else $as_nop

	tcl_cv_type_64bit=none
	# See if we could use long anyway  Note that we substitute in the







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










|
|







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
    if test "x${tcl_cv_flag__largefile64_source}" = "xyes" ; then

printf "%s\n" "#define _LARGEFILE64_SOURCE 1" >>confdefs.h

	tcl_flags="$tcl_flags _LARGEFILE64_SOURCE"
    fi



















































    if test "x${tcl_flags}" = "x" ; then
	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none" >&5
printf "%s\n" "none" >&6; }
    else
	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: ${tcl_flags}" >&5
printf "%s\n" "${tcl_flags}" >&6; }
    fi



    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking if 'long' and 'long long' have the same size (64-bit)?" >&5
printf %s "checking if 'long' and 'long long' have the same size (64-bit)?... " >&6; }
    if test ${tcl_cv_type_64bit+y}
then :
  printf %s "(cached) " >&6
else $as_nop

	tcl_cv_type_64bit=none
	# See if we could use long anyway  Note that we substitute in the
7725
7726
7727
7728
7729
7730
7731


7732
7733
7734
7735
7736
7737
7738
    if test "${tcl_cv_type_64bit}" = none ; then

printf "%s\n" "#define TCL_WIDE_INT_IS_LONG 1" >>confdefs.h

	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5
printf "%s\n" "yes" >&6; }
    else


	# Now check for auxiliary declarations
	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for struct dirent64" >&5
printf %s "checking for struct dirent64... " >&6; }
if test ${tcl_cv_struct_dirent64+y}
then :
  printf %s "(cached) " >&6
else $as_nop







>
>







7579
7580
7581
7582
7583
7584
7585
7586
7587
7588
7589
7590
7591
7592
7593
7594
    if test "${tcl_cv_type_64bit}" = none ; then

printf "%s\n" "#define TCL_WIDE_INT_IS_LONG 1" >>confdefs.h

	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5
printf "%s\n" "yes" >&6; }
    else
	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5
printf "%s\n" "no" >&6; }
	# Now check for auxiliary declarations
	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for struct dirent64" >&5
printf %s "checking for struct dirent64... " >&6; }
if test ${tcl_cv_struct_dirent64+y}
then :
  printf %s "(cached) " >&6
else $as_nop
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
else $as_nop
  case " $LIBOBJS " in
  *" mkstemp.$ac_objext "* ) ;;
  *) LIBOBJS="$LIBOBJS mkstemp.$ac_objext"
 ;;
esac

fi
ac_fn_c_check_func "$LINENO" "opendir" "ac_cv_func_opendir"
if test "x$ac_cv_func_opendir" = xyes
then :
  printf "%s\n" "#define HAVE_OPENDIR 1" >>confdefs.h

else $as_nop
  case " $LIBOBJS " in
  *" opendir.$ac_objext "* ) ;;
  *) LIBOBJS="$LIBOBJS opendir.$ac_objext"
 ;;
esac

fi
ac_fn_c_check_func "$LINENO" "strtol" "ac_cv_func_strtol"
if test "x$ac_cv_func_strtol" = xyes
then :
  printf "%s\n" "#define HAVE_STRTOL 1" >>confdefs.h

else $as_nop
  case " $LIBOBJS " in
  *" strtol.$ac_objext "* ) ;;
  *) LIBOBJS="$LIBOBJS strtol.$ac_objext"
 ;;
esac

fi
ac_fn_c_check_func "$LINENO" "waitpid" "ac_cv_func_waitpid"
if test "x$ac_cv_func_waitpid" = xyes
then :
  printf "%s\n" "#define HAVE_WAITPID 1" >>confdefs.h

else $as_nop







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







8019
8020
8021
8022
8023
8024
8025


























8026
8027
8028
8029
8030
8031
8032
else $as_nop
  case " $LIBOBJS " in
  *" mkstemp.$ac_objext "* ) ;;
  *) LIBOBJS="$LIBOBJS mkstemp.$ac_objext"
 ;;
esac



























fi
ac_fn_c_check_func "$LINENO" "waitpid" "ac_cv_func_waitpid"
if test "x$ac_cv_func_waitpid" = xyes
then :
  printf "%s\n" "#define HAVE_WAITPID 1" >>confdefs.h

else $as_nop
8232
8233
8234
8235
8236
8237
8238






























8239
8240
8241
8242
8243
8244
8245
if test "x$ac_cv_func_wait3" = xyes
then :

else $as_nop

printf "%s\n" "#define NO_WAIT3 1" >>confdefs.h































fi

ac_fn_c_check_func "$LINENO" "uname" "ac_cv_func_uname"
if test "x$ac_cv_func_uname" = xyes
then :

else $as_nop







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







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
if test "x$ac_cv_func_wait3" = xyes
then :

else $as_nop

printf "%s\n" "#define NO_WAIT3 1" >>confdefs.h

fi

ac_fn_c_check_func "$LINENO" "fork" "ac_cv_func_fork"
if test "x$ac_cv_func_fork" = xyes
then :

else $as_nop

printf "%s\n" "#define NO_FORK 1" >>confdefs.h

fi

ac_fn_c_check_func "$LINENO" "mknod" "ac_cv_func_mknod"
if test "x$ac_cv_func_mknod" = xyes
then :

else $as_nop

printf "%s\n" "#define NO_MKNOD 1" >>confdefs.h

fi

ac_fn_c_check_func "$LINENO" "tcdrain" "ac_cv_func_tcdrain"
if test "x$ac_cv_func_tcdrain" = xyes
then :

else $as_nop

printf "%s\n" "#define NO_TCDRAIN 1" >>confdefs.h

fi

ac_fn_c_check_func "$LINENO" "uname" "ac_cv_func_uname"
if test "x$ac_cv_func_uname" = xyes
then :

else $as_nop
9520
9521
9522
9523
9524
9525
9526








9527
9528
9529
9530
9531
9532
9533
if test "x$ac_cv_member_struct_stat_st_blksize" = xyes
then :

printf "%s\n" "#define HAVE_STRUCT_STAT_ST_BLKSIZE 1" >>confdefs.h


fi









fi
ac_fn_c_check_type "$LINENO" "blkcnt_t" "ac_cv_type_blkcnt_t" "$ac_includes_default"
if test "x$ac_cv_type_blkcnt_t" = xyes
then :

printf "%s\n" "#define HAVE_BLKCNT_T 1" >>confdefs.h







>
>
>
>
>
>
>
>







9380
9381
9382
9383
9384
9385
9386
9387
9388
9389
9390
9391
9392
9393
9394
9395
9396
9397
9398
9399
9400
9401
if test "x$ac_cv_member_struct_stat_st_blksize" = xyes
then :

printf "%s\n" "#define HAVE_STRUCT_STAT_ST_BLKSIZE 1" >>confdefs.h


fi
ac_fn_c_check_member "$LINENO" "struct stat" "st_rdev" "ac_cv_member_struct_stat_st_rdev" "$ac_includes_default"
if test "x$ac_cv_member_struct_stat_st_rdev" = xyes
then :

printf "%s\n" "#define HAVE_STRUCT_STAT_ST_RDEV 1" >>confdefs.h


fi

fi
ac_fn_c_check_type "$LINENO" "blkcnt_t" "ac_cv_type_blkcnt_t" "$ac_includes_default"
if test "x$ac_cv_type_blkcnt_t" = xyes
then :

printf "%s\n" "#define HAVE_BLKCNT_T 1" >>confdefs.h
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

else $as_nop

printf "%s\n" "#define NO_FSTATFS 1" >>confdefs.h

fi


#--------------------------------------------------------------------
#       Some system have no memcmp or it does not work with 8 bit data, this
#       checks it and add memcmp.o to LIBOBJS if needed
#--------------------------------------------------------------------

{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for working memcmp" >&5
printf %s "checking for working memcmp... " >&6; }
if test ${ac_cv_func_memcmp_working+y}
then :
  printf %s "(cached) " >&6
else $as_nop
  if test "$cross_compiling" = yes
then :
  ac_cv_func_memcmp_working=no
else $as_nop
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
$ac_includes_default
int
main (void)
{

  /* Some versions of memcmp are not 8-bit clean.  */
  char c0 = '\100', c1 = '\200', c2 = '\201';
  if (memcmp(&c0, &c2, 1) >= 0 || memcmp(&c1, &c2, 1) >= 0)
    return 1;

  /* The Next x86 OpenStep bug shows up only when comparing 16 bytes
     or more and with at least one buffer not starting on a 4-byte boundary.
     William Lewis provided this test program.   */
  {
    char foo[21];
    char bar[21];
    int i;
    for (i = 0; i < 4; i++)
      {
	char *a = foo + i;
	char *b = bar + i;
	strcpy (a, "--------01111111");
	strcpy (b, "--------10000000");
	if (memcmp (a, b, 16) >= 0)
	  return 1;
      }
    return 0;
  }

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_run "$LINENO"
then :
  ac_cv_func_memcmp_working=yes
else $as_nop
  ac_cv_func_memcmp_working=no
fi
rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
  conftest.$ac_objext conftest.beam conftest.$ac_ext
fi

fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_memcmp_working" >&5
printf "%s\n" "$ac_cv_func_memcmp_working" >&6; }
test $ac_cv_func_memcmp_working = no && case " $LIBOBJS " in
  *" memcmp.$ac_objext "* ) ;;
  *) LIBOBJS="$LIBOBJS memcmp.$ac_objext"
 ;;
esac



#--------------------------------------------------------------------
#       Some system like SunOS 4 and other BSD like systems have no memmove
#       (we assume they have bcopy instead). {The replacement define is in
#       compat/string.h}
#--------------------------------------------------------------------








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







9409
9410
9411
9412
9413
9414
9415







































































9416
9417
9418
9419
9420
9421
9422

else $as_nop

printf "%s\n" "#define NO_FSTATFS 1" >>confdefs.h

fi









































































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

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
printf "%s\n" "#define NO_MEMMOVE 1" >>confdefs.h


printf "%s\n" "#define NO_STRING_H 1" >>confdefs.h

fi


#--------------------------------------------------------------------
#	On some systems strstr is broken: it returns a pointer even even if
#	the original string is empty.
#--------------------------------------------------------------------


    ac_fn_c_check_func "$LINENO" "strstr" "ac_cv_func_strstr"
if test "x$ac_cv_func_strstr" = xyes
then :
  tcl_ok=1
else $as_nop
  tcl_ok=0
fi

    if test "$tcl_ok" = 1; then
	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking proper strstr implementation" >&5
printf %s "checking proper strstr implementation... " >&6; }
if test ${tcl_cv_strstr_unbroken+y}
then :
  printf %s "(cached) " >&6
else $as_nop
  if test "$cross_compiling" = yes
then :
  tcl_cv_strstr_unbroken=unknown
else $as_nop
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

#include <stdlib.h>
#include <string.h>
int main() {
    exit(strstr("\0test", "test") ? 1 : 0);
}
_ACEOF
if ac_fn_c_try_run "$LINENO"
then :
  tcl_cv_strstr_unbroken=ok
else $as_nop
  tcl_cv_strstr_unbroken=broken
fi
rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
  conftest.$ac_objext conftest.beam conftest.$ac_ext
fi

fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_strstr_unbroken" >&5
printf "%s\n" "$tcl_cv_strstr_unbroken" >&6; }
	if test "$tcl_cv_strstr_unbroken" = "ok"; then
	    tcl_ok=1
	else
	    tcl_ok=0
	fi
    fi
    if test "$tcl_ok" = 0; then
	case " $LIBOBJS " in
  *" strstr.$ac_objext "* ) ;;
  *) LIBOBJS="$LIBOBJS strstr.$ac_objext"
 ;;
esac

	USE_COMPAT=1
    fi


#--------------------------------------------------------------------
#	Check for strtoul function.  This is tricky because under some
#	versions of AIX strtoul returns an incorrect terminator
#	pointer for the string "0".
#--------------------------------------------------------------------


    ac_fn_c_check_func "$LINENO" "strtoul" "ac_cv_func_strtoul"
if test "x$ac_cv_func_strtoul" = xyes
then :
  tcl_ok=1
else $as_nop
  tcl_ok=0
fi

    if test "$tcl_ok" = 1; then
	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking proper strtoul implementation" >&5
printf %s "checking proper strtoul implementation... " >&6; }
if test ${tcl_cv_strtoul_unbroken+y}
then :
  printf %s "(cached) " >&6
else $as_nop
  if test "$cross_compiling" = yes
then :
  tcl_cv_strtoul_unbroken=unknown
else $as_nop
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

#include <stdlib.h>
#include <string.h>
int main() {
    char *term, *string = "0";
    exit(strtoul(string,&term,0) != 0 || term != string+1);
}
_ACEOF
if ac_fn_c_try_run "$LINENO"
then :
  tcl_cv_strtoul_unbroken=ok
else $as_nop
  tcl_cv_strtoul_unbroken=broken
fi
rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
  conftest.$ac_objext conftest.beam conftest.$ac_ext
fi

fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_strtoul_unbroken" >&5
printf "%s\n" "$tcl_cv_strtoul_unbroken" >&6; }
	if test "$tcl_cv_strtoul_unbroken" = "ok"; then
	    tcl_ok=1
	else
	    tcl_ok=0
	fi
    fi
    if test "$tcl_ok" = 0; then
	case " $LIBOBJS " in
  *" strtoul.$ac_objext "* ) ;;
  *) LIBOBJS="$LIBOBJS strtoul.$ac_objext"
 ;;
esac

	USE_COMPAT=1
    fi


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







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







9430
9431
9432
9433
9434
9435
9436


































































































































9437
9438
9439
9440
9441
9442
9443
printf "%s\n" "#define NO_MEMMOVE 1" >>confdefs.h


printf "%s\n" "#define NO_STRING_H 1" >>confdefs.h

fi




































































































































#--------------------------------------------------------------------
#	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"
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
"
if test "x$ac_cv_type_uintptr_t" = xyes
then :

printf "%s\n" "#define HAVE_UINTPTR_T 1" >>confdefs.h


fi


#--------------------------------------------------------------------
#	If a system doesn't have an opendir function (man, that's old!)
#	then we have to supply a different version of dirent.h which
#	is compatible with the substitute version of opendir that's
#	provided.  This version only works with V7-style directories.
#--------------------------------------------------------------------

ac_fn_c_check_func "$LINENO" "opendir" "ac_cv_func_opendir"
if test "x$ac_cv_func_opendir" = xyes
then :

else $as_nop

printf "%s\n" "#define USE_DIRENT2_H 1" >>confdefs.h

fi


#--------------------------------------------------------------------
#	The check below checks whether <sys/wait.h> defines the type
#	"union wait" correctly.  It's needed because of weirdness in
#	HP-UX where "union wait" is defined in both the BSD and SYS-V







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







9586
9587
9588
9589
9590
9591
9592


















9593
9594
9595
9596
9597
9598
9599
"
if test "x$ac_cv_type_uintptr_t" = xyes
then :

printf "%s\n" "#define HAVE_UINTPTR_T 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

Changes to unix/configure.ac.

225
226
227
228
229
230
231
232
233
234
235



236
237
238
239
240
241
242
#--------------------------------------------------------------------

# Check if Posix compliant getcwd exists, if not we'll use getwd.
AC_CHECK_FUNCS(getcwd, , [AC_DEFINE(USEGETWD, 1, [Is getcwd Posix-compliant?])])
# 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_REPLACE_FUNCS(mkstemp opendir strtol waitpid)
AC_CHECK_FUNC(strerror, , [AC_DEFINE(NO_STRERROR, 1, [Do we have strerror()])])
AC_CHECK_FUNC(getwd, , [AC_DEFINE(NO_GETWD, 1, [Do we have getwd()])])
AC_CHECK_FUNC(wait3, , [AC_DEFINE(NO_WAIT3, 1, [Do we have wait3()])])



AC_CHECK_FUNC(uname, , [AC_DEFINE(NO_UNAME, 1, [Do we have uname()])])

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







|



>
>
>







225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
#--------------------------------------------------------------------

# Check if Posix compliant getcwd exists, if not we'll use getwd.
AC_CHECK_FUNCS(getcwd, , [AC_DEFINE(USEGETWD, 1, [Is getcwd Posix-compliant?])])
# 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_REPLACE_FUNCS(mkstemp waitpid)
AC_CHECK_FUNC(strerror, , [AC_DEFINE(NO_STRERROR, 1, [Do we have strerror()])])
AC_CHECK_FUNC(getwd, , [AC_DEFINE(NO_GETWD, 1, [Do we have getwd()])])
AC_CHECK_FUNC(wait3, , [AC_DEFINE(NO_WAIT3, 1, [Do we have wait3()])])
AC_CHECK_FUNC(fork, , [AC_DEFINE(NO_FORK, 1, [Do we have fork()])])
AC_CHECK_FUNC(mknod, , [AC_DEFINE(NO_MKNOD, 1, [Do we have mknod()])])
AC_CHECK_FUNC(tcdrain, , [AC_DEFINE(NO_TCDRAIN, 1, [Do we have tcdrain()])])
AC_CHECK_FUNC(uname, , [AC_DEFINE(NO_UNAME, 1, [Do we have uname()])])

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
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
#--------------------------------------------------------------------
#	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_CHECK_MEMBERS([struct stat.st_blocks, struct stat.st_blksize])
fi
AC_CHECK_TYPES([blkcnt_t])
AC_CHECK_FUNC(fstatfs, , [AC_DEFINE(NO_FSTATFS, 1, [Do we have fstatfs()?])])

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

AC_FUNC_MEMCMP

#--------------------------------------------------------------------
#       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_CHECK_FUNC(memmove, , [
    AC_DEFINE(NO_MEMMOVE, 1, [Do we have memmove()?])
    AC_DEFINE(NO_STRING_H, 1, [Do we have <string.h>?]) ])

#--------------------------------------------------------------------
#	On some systems strstr is broken: it returns a pointer even even if
#	the original string is empty.
#--------------------------------------------------------------------

SC_TCL_CHECK_BROKEN_FUNC(strstr, [
    exit(strstr("\0test", "test") ? 1 : 0);
])

#--------------------------------------------------------------------
#	Check for strtoul function.  This is tricky because under some
#	versions of AIX strtoul returns an incorrect terminator
#	pointer for the string "0".
#--------------------------------------------------------------------

SC_TCL_CHECK_BROKEN_FUNC(strtoul, [
    char *term, *string = "0";
    exit(strtoul(string,&term,0) != 0 || term != string+1);
])

#--------------------------------------------------------------------
#	Check for various typedefs and provide substitutes if
#	they don't exist.
#--------------------------------------------------------------------

AC_TYPE_MODE_T
AC_TYPE_PID_T







|




<
<
<
<
<
<
<










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







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
#--------------------------------------------------------------------
#	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_CHECK_MEMBERS([struct stat.st_blocks, struct stat.st_blksize, struct stat.st_rdev])
fi
AC_CHECK_TYPES([blkcnt_t])
AC_CHECK_FUNC(fstatfs, , [AC_DEFINE(NO_FSTATFS, 1, [Do we have fstatfs()?])])








#--------------------------------------------------------------------
#       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_CHECK_FUNC(memmove, , [
    AC_DEFINE(NO_MEMMOVE, 1, [Do we have memmove()?])
    AC_DEFINE(NO_STRING_H, 1, [Do we have <string.h>?]) ])





















#--------------------------------------------------------------------
#	Check for various typedefs and provide substitutes if
#	they don't exist.
#--------------------------------------------------------------------

AC_TYPE_MODE_T
AC_TYPE_PID_T
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
    AC_DEFINE(socklen_t, int, [Define as int if socklen_t is not available])
fi

AC_CHECK_TYPES([intptr_t, uintptr_t],,,[[
#include <stdint.h>
]])

#--------------------------------------------------------------------
#	If a system doesn't have an opendir function (man, that's old!)
#	then we have to supply a different version of dirent.h which
#	is compatible with the substitute version of opendir that's
#	provided.  This version only works with V7-style directories.
#--------------------------------------------------------------------

AC_CHECK_FUNC(opendir, , [AC_DEFINE(USE_DIRENT2_H, 1, [May we include <dirent2.h>?])])

#--------------------------------------------------------------------
#	The check below checks whether <sys/wait.h> defines the type
#	"union wait" correctly.  It's needed because of weirdness in
#	HP-UX where "union wait" is defined in both the BSD and SYS-V
#	environments.  Checking the usability of WIFEXITED seems to do
#	the trick.
#--------------------------------------------------------------------







<
<
<
<
<
<
<
<
<







407
408
409
410
411
412
413









414
415
416
417
418
419
420
    AC_DEFINE(socklen_t, int, [Define as int if socklen_t is not available])
fi

AC_CHECK_TYPES([intptr_t, uintptr_t],,,[[
#include <stdint.h>
]])










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

Changes to unix/dltest/Makefile.in.

13
14
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
DLTEST_SUFFIX =		@DLTEST_SUFFIX@
SRC_DIR =		@TCL_SRC_DIR@/unix/dltest
BUILD_DIR =		@builddir@
TCL_VERSION=		@TCL_VERSION@

CFLAGS_DEBUG		= @CFLAGS_DEBUG@
CFLAGS_OPTIMIZE		= @CFLAGS_OPTIMIZE@
CFLAGS			= @CFLAGS_DEFAULT@ @CFLAGS@ -DTCL_NO_DEPRECATED=1
LDFLAGS_DEBUG		= @LDFLAGS_DEBUG@
LDFLAGS_OPTIMIZE	= @LDFLAGS_OPTIMIZE@
LDFLAGS			= @LDFLAGS_DEFAULT@ @LDFLAGS@

CC_SWITCHES = $(CFLAGS) -I${SRC_DIR}/../../generic -DTCL_MEM_DEBUG \
	${SHLIB_CFLAGS} -DUSE_TCL_STUBS ${AC_FLAGS}

all: embtest tcl9pkga${SHLIB_SUFFIX} tcl9pkgb${SHLIB_SUFFIX} tcl9pkgc${SHLIB_SUFFIX} \
	tcl9pkgd${SHLIB_SUFFIX} tcl9pkge${SHLIB_SUFFIX} tcl9pkgua${SHLIB_SUFFIX} tcl9pkgooa${SHLIB_SUFFIX} \
	pkga${SHLIB_SUFFIX} pkgb${SHLIB_SUFFIX} pkgc${SHLIB_SUFFIX}
	@if test -n "$(DLTEST_SUFFIX)"; then $(MAKE) dltest_suffix; fi
	@touch ../dltest.marker

dltest_suffix: tcl9pkga${DLTEST_SUFFIX} tcl9pkgb${DLTEST_SUFFIX} tcl9pkgc${DLTEST_SUFFIX} \
	tcl9pkgd${DLTEST_SUFFIX} tcl9pkge${DLTEST_SUFFIX} tcl9pkgua${DLTEST_SUFFIX} tcl9pkgooa${DLTEST_SUFFIX} \
	pkga${DLTEST_SUFFIX} pkgb${DLTEST_SUFFIX} pkgc${DLTEST_SUFFIX}
	@touch ../dltest.marker

embtest.o: $(SRC_DIR)/embtest.c
	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/embtest.c

pkgπ.o: $(SRC_DIR)/pkgπ.c
	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgπ.c

pkga.o: $(SRC_DIR)/pkga.c
	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkga.c

pkgb.o: $(SRC_DIR)/pkgb.c
	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgb.c

pkgc.o: $(SRC_DIR)/pkgc.c
	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgc.c




tcl8pkga.o: $(SRC_DIR)/pkga.c
	$(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(SRC_DIR)/pkga.c

tcl8pkgb.o: $(SRC_DIR)/pkgb.c
	$(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(SRC_DIR)/pkgb.c

tcl8pkgc.o: $(SRC_DIR)/pkgc.c
	$(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(SRC_DIR)/pkgc.c




pkgd.o: $(SRC_DIR)/pkgd.c
	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgd.c

pkge.o: $(SRC_DIR)/pkge.c
	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkge.c

pkgua.o: $(SRC_DIR)/pkgua.c
	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgua.c

pkgooa.o: $(SRC_DIR)/pkgooa.c
	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgooa.c

embtest: embtest.o
	$(CC) -o $@ embtest.o ${SHLIB_LD_LIBS}

tcl9pkgπ${SHLIB_SUFFIX}: pkgπ.o
	${SHLIB_LD} -o $@ pkgπ.o ${SHLIB_LD_LIBS}

tcl9pkga${SHLIB_SUFFIX}: pkga.o
	${SHLIB_LD} -o $@ pkga.o ${SHLIB_LD_LIBS}

tcl9pkgb${SHLIB_SUFFIX}: pkgb.o
	${SHLIB_LD} -o $@ pkgb.o ${SHLIB_LD_LIBS}

tcl9pkgc${SHLIB_SUFFIX}: pkgc.o
	${SHLIB_LD} -o $@ pkgc.o ${SHLIB_LD_LIBS}




pkga${SHLIB_SUFFIX}: tcl8pkga.o
	${SHLIB_LD} -o $@ tcl8pkga.o ${SHLIB_LD_LIBS}

pkgb${SHLIB_SUFFIX}: tcl8pkgb.o
	${SHLIB_LD} -o $@ tcl8pkgb.o ${SHLIB_LD_LIBS}

pkgc${SHLIB_SUFFIX}: tcl8pkgc.o
	${SHLIB_LD} -o $@ tcl8pkgc.o ${SHLIB_LD_LIBS}




tcl9pkgd${SHLIB_SUFFIX}: pkgd.o
	${SHLIB_LD} -o $@ pkgd.o ${SHLIB_LD_LIBS}

tcl9pkge${SHLIB_SUFFIX}: pkge.o
	${SHLIB_LD} -o $@ pkge.o ${SHLIB_LD_LIBS}

tcl9pkgua${SHLIB_SUFFIX}: pkgua.o







|




|



|
|




|
|

















>
>
>









>
>
>













|













>
>
>









>
>
>







13
14
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
DLTEST_SUFFIX =		@DLTEST_SUFFIX@
SRC_DIR =		@TCL_SRC_DIR@/unix/dltest
BUILD_DIR =		@builddir@
TCL_VERSION=		@TCL_VERSION@

CFLAGS_DEBUG		= @CFLAGS_DEBUG@
CFLAGS_OPTIMIZE		= @CFLAGS_OPTIMIZE@
CFLAGS			= @CFLAGS_DEFAULT@ @CFLAGS@ -DTCL_NO_DEPRECATED=1 -Wall -Wextra -Wc++-compat -Wconversion -Werror
LDFLAGS_DEBUG		= @LDFLAGS_DEBUG@
LDFLAGS_OPTIMIZE	= @LDFLAGS_OPTIMIZE@
LDFLAGS			= @LDFLAGS_DEFAULT@ @LDFLAGS@

CC_SWITCHES = $(CFLAGS) -I${SRC_DIR}/../../generic \
	${SHLIB_CFLAGS} -DUSE_TCL_STUBS ${AC_FLAGS}

all: embtest tcl9pkga${SHLIB_SUFFIX} tcl9pkgb${SHLIB_SUFFIX} tcl9pkgc${SHLIB_SUFFIX} \
	tcl9pkgd${SHLIB_SUFFIX} tcl9pkge${SHLIB_SUFFIX} tcl9pkgt${SHLIB_SUFFIX} tcl9pkgua${SHLIB_SUFFIX} \
	tcl9pkgooa${SHLIB_SUFFIX} pkga${SHLIB_SUFFIX} pkgb${SHLIB_SUFFIX} pkgc${SHLIB_SUFFIX}  pkgt${SHLIB_SUFFIX}
	@if test -n "$(DLTEST_SUFFIX)"; then $(MAKE) dltest_suffix; fi
	@touch ../dltest.marker

dltest_suffix: tcl9pkga${DLTEST_SUFFIX} tcl9pkgb${DLTEST_SUFFIX} tcl9pkgc${DLTEST_SUFFIX} \
	tcl9pkgd${DLTEST_SUFFIX} tcl9pkge${DLTEST_SUFFIX} tcl9pkgt${DLTEST_SUFFIX} tcl9pkgua${DLTEST_SUFFIX} \
	tcl9pkgooa${DLTEST_SUFFIX} pkga${DLTEST_SUFFIX} pkgb${DLTEST_SUFFIX} pkgc${DLTEST_SUFFIX} pkgt${DLTEST_SUFFIX}
	@touch ../dltest.marker

embtest.o: $(SRC_DIR)/embtest.c
	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/embtest.c

pkgπ.o: $(SRC_DIR)/pkgπ.c
	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgπ.c

pkga.o: $(SRC_DIR)/pkga.c
	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkga.c

pkgb.o: $(SRC_DIR)/pkgb.c
	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgb.c

pkgc.o: $(SRC_DIR)/pkgc.c
	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgc.c

pkgt.o: $(SRC_DIR)/pkgt.c
	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgt.c

tcl8pkga.o: $(SRC_DIR)/pkga.c
	$(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(SRC_DIR)/pkga.c

tcl8pkgb.o: $(SRC_DIR)/pkgb.c
	$(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(SRC_DIR)/pkgb.c

tcl8pkgc.o: $(SRC_DIR)/pkgc.c
	$(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(SRC_DIR)/pkgc.c

tcl8pkgt.o: $(SRC_DIR)/pkgt.c
	$(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(SRC_DIR)/pkgt.c

pkgd.o: $(SRC_DIR)/pkgd.c
	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgd.c

pkge.o: $(SRC_DIR)/pkge.c
	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkge.c

pkgua.o: $(SRC_DIR)/pkgua.c
	$(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) $(CC_SWITCHES) -o $@ embtest.o ${SHLIB_LD_LIBS}

tcl9pkgπ${SHLIB_SUFFIX}: pkgπ.o
	${SHLIB_LD} -o $@ pkgπ.o ${SHLIB_LD_LIBS}

tcl9pkga${SHLIB_SUFFIX}: pkga.o
	${SHLIB_LD} -o $@ pkga.o ${SHLIB_LD_LIBS}

tcl9pkgb${SHLIB_SUFFIX}: pkgb.o
	${SHLIB_LD} -o $@ pkgb.o ${SHLIB_LD_LIBS}

tcl9pkgc${SHLIB_SUFFIX}: pkgc.o
	${SHLIB_LD} -o $@ pkgc.o ${SHLIB_LD_LIBS}

tcl9pkgt${SHLIB_SUFFIX}: pkgt.o
	${SHLIB_LD} -o $@ pkgt.o ${SHLIB_LD_LIBS}

pkga${SHLIB_SUFFIX}: tcl8pkga.o
	${SHLIB_LD} -o $@ tcl8pkga.o ${SHLIB_LD_LIBS}

pkgb${SHLIB_SUFFIX}: tcl8pkgb.o
	${SHLIB_LD} -o $@ tcl8pkgb.o ${SHLIB_LD_LIBS}

pkgc${SHLIB_SUFFIX}: tcl8pkgc.o
	${SHLIB_LD} -o $@ tcl8pkgc.o ${SHLIB_LD_LIBS}

pkgt${SHLIB_SUFFIX}: tcl8pkgt.o
	${SHLIB_LD} -o $@ tcl8pkgt.o ${SHLIB_LD_LIBS}

tcl9pkgd${SHLIB_SUFFIX}: pkgd.o
	${SHLIB_LD} -o $@ pkgd.o ${SHLIB_LD_LIBS}

tcl9pkge${SHLIB_SUFFIX}: pkge.o
	${SHLIB_LD} -o $@ pkge.o ${SHLIB_LD_LIBS}

tcl9pkgua${SHLIB_SUFFIX}: pkgua.o
116
117
118
119
120
121
122



123
124
125
126
127
128
129
130
131



132
133
134
135
136
137
138

tcl9pkgb${DLTEST_SUFFIX}: pkgb.o
	${DLTEST_LD} -o $@ pkgb.o ${SHLIB_LD_LIBS}

tcl9pkgc${DLTEST_SUFFIX}: pkgc.o
	${DLTEST_LD} -o $@ pkgc.o ${SHLIB_LD_LIBS}




pkga${DLTEST_SUFFIX}: tcl8pkga.o
	${DLTEST_LD} -o $@ tcl8pkga.o ${SHLIB_LD_LIBS}

pkgb${DLTEST_SUFFIX}: tcl8pkgb.o
	${DLTEST_LD} -o $@ tcl8pkgb.o ${SHLIB_LD_LIBS}

pkgc${DLTEST_SUFFIX}: tcl8pkgc.o
	${DLTEST_LD} -o $@ tcl8pkgc.o ${SHLIB_LD_LIBS}




tcl9pkgd${DLTEST_SUFFIX}: pkgd.o
	${DLTEST_LD} -o $@ pkgd.o ${SHLIB_LD_LIBS}

tcl9pkge${DLTEST_SUFFIX}: pkge.o
	${DLTEST_LD} -o $@ pkge.o ${SHLIB_LD_LIBS}

tcl9pkgua${DLTEST_SUFFIX}: pkgua.o







>
>
>









>
>
>







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

tcl9pkgb${DLTEST_SUFFIX}: pkgb.o
	${DLTEST_LD} -o $@ pkgb.o ${SHLIB_LD_LIBS}

tcl9pkgc${DLTEST_SUFFIX}: pkgc.o
	${DLTEST_LD} -o $@ pkgc.o ${SHLIB_LD_LIBS}

tcl9pkgt${DLTEST_SUFFIX}: pkgt.o
	${DLTEST_LD} -o $@ pkgt.o ${SHLIB_LD_LIBS}

pkga${DLTEST_SUFFIX}: tcl8pkga.o
	${DLTEST_LD} -o $@ tcl8pkga.o ${SHLIB_LD_LIBS}

pkgb${DLTEST_SUFFIX}: tcl8pkgb.o
	${DLTEST_LD} -o $@ tcl8pkgb.o ${SHLIB_LD_LIBS}

pkgc${DLTEST_SUFFIX}: tcl8pkgc.o
	${DLTEST_LD} -o $@ tcl8pkgc.o ${SHLIB_LD_LIBS}

pkgt${DLTEST_SUFFIX}: tcl8pkgt.o
	${DLTEST_LD} -o $@ tcl8pkgt.o ${SHLIB_LD_LIBS}

tcl9pkgd${DLTEST_SUFFIX}: pkgd.o
	${DLTEST_LD} -o $@ pkgd.o ${SHLIB_LD_LIBS}

tcl9pkge${DLTEST_SUFFIX}: pkge.o
	${DLTEST_LD} -o $@ pkge.o ${SHLIB_LD_LIBS}

tcl9pkgua${DLTEST_SUFFIX}: pkgua.o

Changes to unix/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;
}








>



















>
>
>









1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
#include "tcl.h"
#include <stdio.h>

MODULE_SCOPE const TclStubs *tclStubsPtr;

int main(int argc, char **argv) {
    const char *version;
    int exitcode = 0;
    (void)argc;

    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 (version != NULL) {
	printf("Tcl_FindExecutable gives version %s\n", version);
    }
    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.

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
    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 != 3) {
	Tcl_WrongNumArgs(interp, 1, objv,  "string1 string2");
	return TCL_ERROR;
    }

    str1 = Tcl_GetStringFromObj(objv[1], &len1);
    str2 = Tcl_GetStringFromObj(objv[2], &len2);
    if (len1 == len2) {
	result = (Tcl_UtfNcmp(str1, str2, len1) == 0);
    } else {
	result = 0;
    }
    Tcl_SetObjResult(interp, Tcl_NewIntObj(result));
    return TCL_OK;
}








|










|







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
    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;
    Tcl_Size len1, len2;
    (void)dummy;

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

    str1 = Tcl_GetStringFromObj(objv[1], &len1);
    str2 = Tcl_GetStringFromObj(objv[2], &len2);
    if (len1 == len2) {
	result = (Tcl_UtfNcmp(str1, str2, (size_t)len1) == 0);
    } else {
	result = 0;
    }
    Tcl_SetObjResult(interp, Tcl_NewIntObj(result));
    return TCL_OK;
}


Changes to unix/dltest/pkgb.c.

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



16
17
18
19
20
21
22
/*
 * pkgb.c --
 *
 *	This file contains a simple Tcl package "Pkgb" that is intended for
 *	testing the Tcl dynamic loading facilities. It can be used in both
 *	safe and unsafe interpreters.
 *
 * Copyright © 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#undef STATIC_BUILD
#include "tcl.h"




/*
 *----------------------------------------------------------------------
 *
 * Pkgb_SubObjCmd --
 *
 *	This procedure is invoked to process the "pkgb_sub" Tcl command. It



|











>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
/*
 * pkgb.c --
 *
 *	This file contains a simple Tcl package "pkgb" that is intended for
 *	testing the Tcl dynamic loading facilities. It can be used in both
 *	safe and unsafe interpreters.
 *
 * Copyright © 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#undef STATIC_BUILD
#include "tcl.h"
#if defined(_WIN32) && defined(_MSC_VER)
#   define snprintf _snprintf
#endif

/*
 *----------------------------------------------------------------------
 *
 * Pkgb_SubObjCmd --
 *
 *	This procedure is invoked to process the "pkgb_sub" Tcl command. It
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "num num");
	return TCL_ERROR;
    }
    if ((Tcl_GetIntFromObj(interp, objv[1], &first) != TCL_OK)
	    || (Tcl_GetIntFromObj(interp, objv[2], &second) != TCL_OK)) {
	char buf[TCL_INTEGER_SPACE];
	sprintf(buf, "%d", Tcl_GetErrorLine(interp));
	Tcl_AppendResult(interp, " in line: ", buf, NULL);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewIntObj(first - second));
    return TCL_OK;
}








|







47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "num num");
	return TCL_ERROR;
    }
    if ((Tcl_GetIntFromObj(interp, objv[1], &first) != TCL_OK)
	    || (Tcl_GetIntFromObj(interp, objv[2], &second) != TCL_OK)) {
	char buf[TCL_INTEGER_SPACE];
	snprintf(buf, sizeof(buf), "%d", Tcl_GetErrorLine(interp));
	Tcl_AppendResult(interp, " in line: ", buf, NULL);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewIntObj(first - second));
    return TCL_OK;
}

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
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    (void)dummy;
    (void)objc;
    (void)objv;

    return Tcl_EvalEx(interp, "list unsafe command invoked", -1, TCL_EVAL_GLOBAL);
}

static int
Pkgb_DemoObjCmd(
    void *dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_WideInt numChars;
    int result;
    (void)dummy;

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "arg1 arg2 num");
	return TCL_ERROR;
    }
    if (Tcl_GetWideIntFromObj(interp, objv[3], &numChars) != TCL_OK) {
	return TCL_ERROR;
    }
    result = Tcl_UtfNcmp(Tcl_GetString(objv[1]), Tcl_GetString(objv[2]), numChars);
    Tcl_SetObjResult(interp, Tcl_NewIntObj(result));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *







|




















|







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
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    (void)dummy;
    (void)objc;
    (void)objv;

    return Tcl_EvalEx(interp, "list unsafe command invoked", TCL_INDEX_NONE, TCL_EVAL_GLOBAL);
}

static int
Pkgb_DemoObjCmd(
    void *dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_WideInt numChars;
    int result;
    (void)dummy;

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "arg1 arg2 num");
	return TCL_ERROR;
    }
    if (Tcl_GetWideIntFromObj(interp, objv[3], &numChars) != TCL_OK) {
	return TCL_ERROR;
    }
    result = Tcl_UtfNcmp(Tcl_GetString(objv[1]), Tcl_GetString(objv[2]), (size_t)numChars);
    Tcl_SetObjResult(interp, Tcl_NewIntObj(result));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

Changes to unix/dltest/pkgc.c.

77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    (void)dummy;
    (void)objc;
    (void)objv;

    Tcl_SetObjResult(interp, Tcl_NewStringObj("unsafe command invoked", -1));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Pkgc_Init --







|







77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    (void)dummy;
    (void)objc;
    (void)objv;

    Tcl_SetObjResult(interp, Tcl_NewStringObj("unsafe command invoked", TCL_INDEX_NONE));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Pkgc_Init --

Changes to unix/dltest/pkgd.c.

1
2
3
4
5
6
7
8
9
10
11
/*
 * pkgd.c --
 *
 *	This file contains a simple Tcl package "PKGD" that is intended for
 *	testing the Tcl dynamic loading facilities. It can be used in both
 *	safe and unsafe interpreters.
 *
 * Copyright © 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.



|







1
2
3
4
5
6
7
8
9
10
11
/*
 * pkgd.c --
 *
 *	This file contains a simple Tcl package "pkgd" that is intended for
 *	testing the Tcl dynamic loading facilities. It can be used in both
 *	safe and unsafe interpreters.
 *
 * Copyright © 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    (void)dummy;
    (void)objc;
    (void)objv;

    Tcl_SetObjResult(interp, Tcl_NewStringObj("unsafe command invoked", -1));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Pkgd_Init --







|







77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    (void)dummy;
    (void)objc;
    (void)objv;

    Tcl_SetObjResult(interp, Tcl_NewStringObj("unsafe command invoked", TCL_INDEX_NONE));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Pkgd_Init --

Changes to unix/dltest/pkge.c.

37
38
39
40
41
42
43
44
45
				 * made available. */
{
    static const char script[] = "if 44 {open non_existent}";

    if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
	return TCL_ERROR;
    }
    return Tcl_EvalEx(interp, script, -1, 0);
}







|

37
38
39
40
41
42
43
44
45
				 * made available. */
{
    static const char script[] = "if 44 {open non_existent}";

    if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
	return TCL_ERROR;
    }
    return Tcl_EvalEx(interp, script, TCL_INDEX_NONE, 0);
}

Changes to unix/dltest/pkgooa.c.

90
91
92
93
94
95
96









97
98
99
100
101
102
103
#endif
#ifdef Tcl_GetClassOfObject
    ,NULL
#endif
#ifdef Tcl_GetObjectClassName
    ,NULL
#endif









};

DLLEXPORT int
Pkgooa_Init(
    Tcl_Interp *interp)		/* Interpreter in which the package is to be
				 * made available. */
{







>
>
>
>
>
>
>
>
>







90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
#endif
#ifdef Tcl_GetClassOfObject
    ,NULL
#endif
#ifdef Tcl_GetObjectClassName
    ,NULL
#endif
#ifdef Tcl_MethodIsType2
    ,NULL
#endif
#ifdef Tcl_NewInstanceMethod2
    ,NULL
#endif
#ifdef Tcl_NewMethod2
    ,NULL
#endif
};

DLLEXPORT int
Pkgooa_Init(
    Tcl_Interp *interp)		/* Interpreter in which the package is to be
				 * made available. */
{
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
     * to keep working in all future Tcl 8.x releases.
     */
    if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
	return TCL_ERROR;
    }
    if (tclStubsPtr == NULL) {
	Tcl_AppendResult(interp, "Tcl stubs are not initialized, "
		"did you compile using -DUSE_TCL_STUBS? ");
	return TCL_ERROR;
    }
    if (Tcl_OOInitStubs(interp) == NULL) {
	return TCL_ERROR;
    }
    if (tclOOStubsPtr == NULL) {
	Tcl_AppendResult(interp, "TclOO stubs are not initialized");
	return TCL_ERROR;
    }
    if (tclOOIntStubsPtr == NULL) {
	Tcl_AppendResult(interp, "TclOO internal stubs are not initialized");
	return TCL_ERROR;
    }

    /* Test case for Bug [f51efe99a7].
     *
     * Let tclOOStubsPtr point to an alternate stub table
     * (with only a single function, that's enough for







|






|



|







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
     * to keep working in all future Tcl 8.x releases.
     */
    if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
	return TCL_ERROR;
    }
    if (tclStubsPtr == NULL) {
	Tcl_AppendResult(interp, "Tcl stubs are not initialized, "
		"did you compile using -DUSE_TCL_STUBS? ", NULL);
	return TCL_ERROR;
    }
    if (Tcl_OOInitStubs(interp) == NULL) {
	return TCL_ERROR;
    }
    if (tclOOStubsPtr == NULL) {
	Tcl_AppendResult(interp, "TclOO stubs are not initialized", NULL);
	return TCL_ERROR;
    }
    if (tclOOIntStubsPtr == NULL) {
	Tcl_AppendResult(interp, "TclOO internal stubs are not initialized", NULL);
	return TCL_ERROR;
    }

    /* Test case for Bug [f51efe99a7].
     *
     * Let tclOOStubsPtr point to an alternate stub table
     * (with only a single function, that's enough for

Added unix/dltest/pkgt.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
/*
 * pkgt.c --
 *
 *	This file contains a simple Tcl package "pkgt" 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"

static int TraceProc2 (
    void *clientData,
    Tcl_Interp *interp,
    Tcl_Size level,
    const char *command,
    Tcl_Command commandInfo,
    Tcl_Size objc,
    struct Tcl_Obj *const *objv)
{
    (void)clientData;
    (void)interp;
    (void)level;
    (void)command;
    (void)commandInfo;
    (void)objc;
    (void)objv;

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Pkgt_EqObjCmd2 --
 *
 *	This procedure is invoked to process the "pkgt_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
Pkgt_EqObjCmd2(
    void *dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Size objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_WideInt result;
    const char *str1, *str2;
    Tcl_Size len1, len2;
    (void)dummy;

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

    str1 = Tcl_GetStringFromObj(objv[1], &len1);
    str2 = Tcl_GetStringFromObj(objv[2], &len2);
    if (len1 == len2) {
	result = (Tcl_UtfNcmp(str1, str2, (size_t) len1) == 0);
    } else {
	result = 0;
    }
    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(result));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Pkgt_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
Pkgt_Init(
    Tcl_Interp *interp)		/* Interpreter in which the package is to be
				 * made available. */
{
    int code;

    if (Tcl_InitStubs(interp, "8.7-", 0) == NULL) {
	return TCL_ERROR;
    }
    code = Tcl_PkgProvide(interp, "pkgt", "1.0");
    if (code != TCL_OK) {
	return code;
    }
    Tcl_CreateObjCommand2(interp, "pkgt_eq", Pkgt_EqObjCmd2, NULL, NULL);
    Tcl_CreateObjTrace2(interp, 0, 0, TraceProc2, NULL, NULL);
    return TCL_OK;
}

Changes to unix/dltest/pkgua.c.

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
    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 != 3) {
	Tcl_WrongNumArgs(interp, 1, objv,  "string1 string2");
	return TCL_ERROR;
    }

    str1 = Tcl_GetStringFromObj(objv[1], &len1);
    str2 = Tcl_GetStringFromObj(objv[2], &len2);
    if (len1 == len2) {
	result = (Tcl_UtfNcmp(str1, str2, len1) == 0);
    } else {
	result = 0;
    }
    Tcl_SetObjResult(interp, Tcl_NewIntObj(result));
    return TCL_OK;
}








|










|







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
    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;
    Tcl_Size len1, len2;
    (void)dummy;

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

    str1 = Tcl_GetStringFromObj(objv[1], &len1);
    str2 = Tcl_GetStringFromObj(objv[2], &len2);
    if (len1 == len2) {
	result = (Tcl_UtfNcmp(str1, str2, (size_t) len1) == 0);
    } else {
	result = 0;
    }
    Tcl_SetObjResult(interp, Tcl_NewIntObj(result));
    return TCL_OK;
}


Changes to unix/dltest/pkgπ.c.

34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
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;
    }








<
<
<







34
35
36
37
38
39
40



41
42
43
44
45
46
47
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. */
{



    (void)dummy;

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

Changes to unix/install-sh.

325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
	trap '
	  ret=$?
	  rmdir "$tmpdir/a/b" "$tmpdir/a" "$tmpdir" 2>/dev/null
	  exit $ret
	' 0

	# Because "mkdir -p" follows existing symlinks and we likely work
	# directly in world-writeable /tmp, make sure that the '$tmpdir'
	# directory is successfully created first before we actually test
	# 'mkdir -p'.
	if (umask $mkdir_umask &&
	    $mkdirprog $mkdir_mode "$tmpdir" &&
	    exec $mkdirprog $mkdir_mode -p -- "$tmpdir/a/b") >/dev/null 2>&1
	then
	  if test -z "$dir_arg" || {







|







325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
	trap '
	  ret=$?
	  rmdir "$tmpdir/a/b" "$tmpdir/a" "$tmpdir" 2>/dev/null
	  exit $ret
	' 0

	# Because "mkdir -p" follows existing symlinks and we likely work
	# directly in world-writable /tmp, make sure that the '$tmpdir'
	# directory is successfully created first before we actually test
	# 'mkdir -p'.
	if (umask $mkdir_umask &&
	    $mkdirprog $mkdir_mode "$tmpdir" &&
	    exec $mkdirprog $mkdir_mode -p -- "$tmpdir/a/b") >/dev/null 2>&1
	then
	  if test -z "$dir_arg" || {

Changes to unix/tcl.m4.

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
			    AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], [[]])],
				    [tcl_cv_cc_arch_x86_64=yes],[tcl_cv_cc_arch_x86_64=no])
			    CFLAGS=$hold_cflags])
			AS_IF([test $tcl_cv_cc_arch_x86_64 = yes], [
			    CFLAGS="$CFLAGS -arch x86_64"
			    do64bit_ok=yes
			]);;
		    arm64|arm64e)
			AC_CACHE_CHECK([if compiler accepts -arch arm64e flag],
				tcl_cv_cc_arch_arm64e, [
			    hold_cflags=$CFLAGS
			    CFLAGS="$CFLAGS -arch arm64e"
			    AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], [[]])],
				    [tcl_cv_cc_arch_arm64e=yes],[tcl_cv_cc_arch_arm64e=no])
			    CFLAGS=$hold_cflags])
			AS_IF([test $tcl_cv_cc_arch_arm64e = yes], [
			    CFLAGS="$CFLAGS -arch arm64e"
			    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|arm64e) ' \
		    && 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"







|
|
|

|

|

|
|







|







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
			    AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], [[]])],
				    [tcl_cv_cc_arch_x86_64=yes],[tcl_cv_cc_arch_x86_64=no])
			    CFLAGS=$hold_cflags])
			AS_IF([test $tcl_cv_cc_arch_x86_64 = yes], [
			    CFLAGS="$CFLAGS -arch x86_64"
			    do64bit_ok=yes
			]);;
		    arm64)
			AC_CACHE_CHECK([if compiler accepts -arch arm64 flag],
				tcl_cv_cc_arch_arm64, [
			    hold_cflags=$CFLAGS
			    CFLAGS="$CFLAGS -arch arm64"
			    AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], [[]])],
				    [tcl_cv_cc_arch_arm64=yes],[tcl_cv_cc_arch_arm64=no])
			    CFLAGS=$hold_cflags])
			AS_IF([test $tcl_cv_cc_arch_arm64 = yes], [
			    CFLAGS="$CFLAGS -arch arm64"
			    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|arm64) ' \
		    && 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"
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
	    AS_IF([test "$tcl_cv_cc_visibility_hidden" != yes], [
		AC_DEFINE(MODULE_SCOPE, [__private_extern__],
		    [Compiler support for module scope symbols])
		tcl_cv_cc_visibility_hidden=yes
	    ])
	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    LD_LIBRARY_PATH_VAR="DYLD_LIBRARY_PATH"
	    AC_DEFINE(MAC_OSX_TCL, 1, [Is this a Mac I see before me?])
	    PLAT_OBJS='${MAC_OSX_OBJS}'
	    PLAT_SRCS='${MAC_OSX_SRCS}'
	    AC_MSG_CHECKING([whether to use CoreFoundation])
	    AC_ARG_ENABLE(corefoundation,
		AS_HELP_STRING([--enable-corefoundation],
		    [use CoreFoundation API on MacOSX (default: on)]),







|







1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
	    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_FALLBACK_LIBRARY_PATH"
	    AC_DEFINE(MAC_OSX_TCL, 1, [Is this a Mac I see before me?])
	    PLAT_OBJS='${MAC_OSX_OBJS}'
	    PLAT_SRCS='${MAC_OSX_SRCS}'
	    AC_MSG_CHECKING([whether to use CoreFoundation])
	    AC_ARG_ENABLE(corefoundation,
		AS_HELP_STRING([--enable-corefoundation],
		    [use CoreFoundation API on MacOSX (default: on)]),
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
#
# Arguments:
#	none
#
# Results:
#
#	Defines some of the following vars:
#		NO_DIRENT_H
#		NO_STDLIB_H
#		NO_STRING_H
#		NO_SYS_WAIT_H
#		NO_DLFCN_H
#		HAVE_SYS_PARAM_H
#		HAVE_STRING_H ?
#
#--------------------------------------------------------------------

AC_DEFUN([SC_MISSING_POSIX_HEADERS], [
    AC_CACHE_CHECK([dirent.h], tcl_cv_dirent_h, [
    AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include <sys/types.h>
#include <dirent.h>]], [[
#ifndef _POSIX_SOURCE
#   ifdef __Lynx__
	/*
	 * Generate compilation error to make the test fail:  Lynx headers
	 * are only valid if really in the POSIX environment.
	 */

	missing_procedure();
#   endif
#endif
DIR *d;
struct dirent *entryPtr;
char *p;
d = opendir("foobar");
entryPtr = readdir(d);
p = entryPtr->d_name;
closedir(d);
]])],[tcl_cv_dirent_h=yes],[tcl_cv_dirent_h=no])])

    if test $tcl_cv_dirent_h = no; then
	AC_DEFINE(NO_DIRENT_H, 1, [Do we have <dirent.h>?])
    fi

    AC_CHECK_HEADER(stdlib.h, tcl_ok=1, tcl_ok=0)
    AC_EGREP_HEADER(strtol, stdlib.h, , tcl_ok=0)
    AC_EGREP_HEADER(strtoul, stdlib.h, , tcl_ok=0)
    if test $tcl_ok = 0; then
	AC_DEFINE(NO_STDLIB_H, 1, [Do we have <stdlib.h>?])
    fi
    AC_CHECK_HEADER(string.h, tcl_ok=1, tcl_ok=0)
    AC_EGREP_HEADER(strstr, string.h, , tcl_ok=0)
    AC_EGREP_HEADER(strerror, string.h, , tcl_ok=0)

    # See also memmove check below for a place where NO_STRING_H can be
    # set and why.








<
<









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







1928
1929
1930
1931
1932
1933
1934


1935
1936
1937
1938
1939
1940
1941
1942
1943
































1944
1945
1946
1947
1948
1949
1950
#
# Arguments:
#	none
#
# Results:
#
#	Defines some of the following vars:


#		NO_STRING_H
#		NO_SYS_WAIT_H
#		NO_DLFCN_H
#		HAVE_SYS_PARAM_H
#		HAVE_STRING_H ?
#
#--------------------------------------------------------------------

AC_DEFUN([SC_MISSING_POSIX_HEADERS], [
































    AC_CHECK_HEADER(string.h, tcl_ok=1, tcl_ok=0)
    AC_EGREP_HEADER(strstr, string.h, , tcl_ok=0)
    AC_EGREP_HEADER(strerror, string.h, , tcl_ok=0)

    # See also memmove check below for a place where NO_STRING_H can be
    # set and why.

2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
#	None
#
# Results:
#
#	Might define the following vars:
#		_ISOC99_SOURCE
#		_LARGEFILE64_SOURCE
#		_LARGEFILE_SOURCE64
#
#--------------------------------------------------------------------

AC_DEFUN([SC_TCL_EARLY_FLAG],[
    AC_CACHE_VAL([tcl_cv_flag_]translit($1,[A-Z],[a-z]),
	AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[$2]], [[$3]])],
	    [tcl_cv_flag_]translit($1,[A-Z],[a-z])=no,[AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[[#define ]$1[ 1







<







2291
2292
2293
2294
2295
2296
2297

2298
2299
2300
2301
2302
2303
2304
#	None
#
# Results:
#
#	Might define the following vars:
#		_ISOC99_SOURCE
#		_LARGEFILE64_SOURCE

#
#--------------------------------------------------------------------

AC_DEFUN([SC_TCL_EARLY_FLAG],[
    AC_CACHE_VAL([tcl_cv_flag_]translit($1,[A-Z],[a-z]),
	AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[$2]], [[$3]])],
	    [tcl_cv_flag_]translit($1,[A-Z],[a-z])=no,[AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[[#define ]$1[ 1
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
AC_DEFUN([SC_TCL_EARLY_FLAGS],[
    AC_MSG_CHECKING([for required early compiler flags])
    tcl_flags=""
    SC_TCL_EARLY_FLAG(_ISOC99_SOURCE,[#include <stdlib.h>],
	[char *p = (char *)strtoll; char *q = (char *)strtoull;])
    SC_TCL_EARLY_FLAG(_LARGEFILE64_SOURCE,[#include <sys/stat.h>],
	[struct stat64 buf; int i = stat64("/", &buf);])
    SC_TCL_EARLY_FLAG(_LARGEFILE_SOURCE64,[#include <sys/stat.h>],
	[char *p = (char *)open64;])
    if test "x${tcl_flags}" = "x" ; then
	AC_MSG_RESULT([none])
    else
	AC_MSG_RESULT([${tcl_flags}])
    fi
])








<
<







2314
2315
2316
2317
2318
2319
2320


2321
2322
2323
2324
2325
2326
2327
AC_DEFUN([SC_TCL_EARLY_FLAGS],[
    AC_MSG_CHECKING([for required early compiler flags])
    tcl_flags=""
    SC_TCL_EARLY_FLAG(_ISOC99_SOURCE,[#include <stdlib.h>],
	[char *p = (char *)strtoll; char *q = (char *)strtoull;])
    SC_TCL_EARLY_FLAG(_LARGEFILE64_SOURCE,[#include <sys/stat.h>],
	[struct stat64 buf; int i = stat64("/", &buf);])


    if test "x${tcl_flags}" = "x" ; then
	AC_MSG_RESULT([none])
    else
	AC_MSG_RESULT([${tcl_flags}])
    fi
])

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
#		HAVE_STRUCT_DIRENT64, HAVE_DIR64
#		HAVE_STRUCT_STAT64
#		HAVE_TYPE_OFF64_T
#
#--------------------------------------------------------------------

AC_DEFUN([SC_TCL_64BIT_FLAGS], [
    AC_MSG_CHECKING([for 64-bit integer type])
    AC_CACHE_VAL(tcl_cv_type_64bit,[
	tcl_cv_type_64bit=none
	# See if we could use long anyway  Note that we substitute in the
	# type that is our current guess for a 64-bit type inside this check
	# program, so it should be modified only carefully...
        AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[switch (0) {
            case 1: case (sizeof(long long)==sizeof(long)): ;
        }]])],[tcl_cv_type_64bit="long long"],[])])
    if test "${tcl_cv_type_64bit}" = none ; then
	AC_DEFINE(TCL_WIDE_INT_IS_LONG, 1, [Do 'long' and 'long long' have the same size (64-bit)?])
	AC_MSG_RESULT([yes])
    else

	# Now check for auxiliary declarations
	AC_CACHE_CHECK([for struct dirent64], tcl_cv_struct_dirent64,[
	    AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <sys/types.h>
#include <dirent.h>]], [[struct dirent64 p;]])],
		[tcl_cv_struct_dirent64=yes],[tcl_cv_struct_dirent64=no])])
	if test "x${tcl_cv_struct_dirent64}" = "xyes" ; then
	    AC_DEFINE(HAVE_STRUCT_DIRENT64, 1, [Is 'struct dirent64' in <sys/types.h>?])







|












>







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
#		HAVE_STRUCT_DIRENT64, HAVE_DIR64
#		HAVE_STRUCT_STAT64
#		HAVE_TYPE_OFF64_T
#
#--------------------------------------------------------------------

AC_DEFUN([SC_TCL_64BIT_FLAGS], [
    AC_MSG_CHECKING([if 'long' and 'long long' have the same size (64-bit)?])
    AC_CACHE_VAL(tcl_cv_type_64bit,[
	tcl_cv_type_64bit=none
	# See if we could use long anyway  Note that we substitute in the
	# type that is our current guess for a 64-bit type inside this check
	# program, so it should be modified only carefully...
        AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[switch (0) {
            case 1: case (sizeof(long long)==sizeof(long)): ;
        }]])],[tcl_cv_type_64bit="long long"],[])])
    if test "${tcl_cv_type_64bit}" = none ; then
	AC_DEFINE(TCL_WIDE_INT_IS_LONG, 1, [Do 'long' and 'long long' have the same size (64-bit)?])
	AC_MSG_RESULT([yes])
    else
	AC_MSG_RESULT([no])
	# Now check for auxiliary declarations
	AC_CACHE_CHECK([for struct dirent64], tcl_cv_struct_dirent64,[
	    AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <sys/types.h>
#include <dirent.h>]], [[struct dirent64 p;]])],
		[tcl_cv_struct_dirent64=yes],[tcl_cv_struct_dirent64=no])])
	if test "x${tcl_cv_struct_dirent64}" = "xyes" ; then
	    AC_DEFINE(HAVE_STRUCT_DIRENT64, 1, [Is 'struct dirent64' in <sys/types.h>?])

Changes to unix/tclAppInit.c.

87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
#ifdef TCL_LOCAL_MAIN_HOOK
    TCL_LOCAL_MAIN_HOOK(&argc, &argv);
#elif (TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6) && (!defined(_WIN32) || defined(UNICODE))
    /* New in Tcl 8.7. This doesn't work on Windows without UNICODE */
    TclZipfs_AppHook(&argc, &argv);
#endif

    Tcl_Main((size_t)argc, argv, TCL_LOCAL_APPINIT);
    return 0;			/* Needed only to prevent compiler warning. */
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppInit --







|







87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
#ifdef TCL_LOCAL_MAIN_HOOK
    TCL_LOCAL_MAIN_HOOK(&argc, &argv);
#elif (TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6) && (!defined(_WIN32) || defined(UNICODE))
    /* New in Tcl 8.7. This doesn't work on Windows without UNICODE */
    TclZipfs_AppHook(&argc, &argv);
#endif

    Tcl_Main(argc, argv, TCL_LOCAL_APPINIT);
    return 0;			/* Needed only to prevent compiler warning. */
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppInit --
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

    /*
     * 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", TCL_INDEX_NONE), NULL,
	    Tcl_NewStringObj("~/tclsh.rc", TCL_INDEX_NONE), TCL_GLOBAL_ONLY);
#else
    Tcl_ObjSetVar2(interp, Tcl_NewStringObj("tcl_rcFileName", TCL_INDEX_NONE), NULL,
	    Tcl_NewStringObj("~/.tclshrc", TCL_INDEX_NONE), TCL_GLOBAL_ONLY);
#endif





    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







<

<
|

<
|


>
>
>
>










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

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

#define INITFILENAME "tclshrc.tcl"
#else

#define INITFILENAME ".tclshrc"
#endif

    (void)Tcl_EvalEx(interp,
		     "set tcl_rcFileName [file tildeexpand ~/" INITFILENAME "]",
		     -1,
		     TCL_EVAL_GLOBAL);
    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to unix/tclConfig.h.in.

174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190

/* Do we have <net/errno.h>? */
#undef HAVE_NET_ERRNO_H

/* Define to 1 if you have the `open64' function. */
#undef HAVE_OPEN64

/* Define to 1 if you have the `opendir' function. */
#undef HAVE_OPENDIR

/* Define to 1 if you have the `OSSpinLockLock' function. */
#undef HAVE_OSSPINLOCKLOCK

/* Should we use pselect()? */
#undef HAVE_PSELECT

/* Define to 1 if you have the `pthread_atfork' function. */







<
<
<







174
175
176
177
178
179
180



181
182
183
184
185
186
187

/* Do we have <net/errno.h>? */
#undef HAVE_NET_ERRNO_H

/* Define to 1 if you have the `open64' function. */
#undef HAVE_OPEN64




/* Define to 1 if you have the `OSSpinLockLock' function. */
#undef HAVE_OSSPINLOCKLOCK

/* Should we use pselect()? */
#undef HAVE_PSELECT

/* Define to 1 if you have the `pthread_atfork' function. */
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229

/* Define to 1 if you have the <strings.h> header file. */
#undef HAVE_STRINGS_H

/* Define to 1 if you have the <string.h> header file. */
#undef HAVE_STRING_H

/* Define to 1 if you have the `strtol' function. */
#undef HAVE_STRTOL

/* Define to 1 if the system has the type `struct addrinfo'. */
#undef HAVE_STRUCT_ADDRINFO

/* Is 'struct dirent64' in <sys/types.h>? */
#undef HAVE_STRUCT_DIRENT64

/* Define to 1 if the system has the type `struct in6_addr'. */







<
<
<







210
211
212
213
214
215
216



217
218
219
220
221
222
223

/* Define to 1 if you have the <strings.h> header file. */
#undef HAVE_STRINGS_H

/* Define to 1 if you have the <string.h> header file. */
#undef HAVE_STRING_H




/* Define to 1 if the system has the type `struct addrinfo'. */
#undef HAVE_STRUCT_ADDRINFO

/* Is 'struct dirent64' in <sys/types.h>? */
#undef HAVE_STRUCT_DIRENT64

/* Define to 1 if the system has the type `struct in6_addr'. */
239
240
241
242
243
244
245



246
247
248
249
250
251
252
#undef HAVE_STRUCT_STAT64

/* Define to 1 if `st_blksize' is a member of `struct stat'. */
#undef HAVE_STRUCT_STAT_ST_BLKSIZE

/* Define to 1 if `st_blocks' is a member of `struct stat'. */
#undef HAVE_STRUCT_STAT_ST_BLOCKS




/* Define to 1 if you have the <sys/epoll.h> header file. */
#undef HAVE_SYS_EPOLL_H

/* Define to 1 if you have the <sys/eventfd.h> header file. */
#undef HAVE_SYS_EVENTFD_H








>
>
>







233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
#undef HAVE_STRUCT_STAT64

/* Define to 1 if `st_blksize' is a member of `struct stat'. */
#undef HAVE_STRUCT_STAT_ST_BLKSIZE

/* Define to 1 if `st_blocks' is a member of `struct stat'. */
#undef HAVE_STRUCT_STAT_ST_BLOCKS

/* Define to 1 if `st_rdev' is a member of `struct stat'. */
#undef HAVE_STRUCT_STAT_ST_RDEV

/* Define to 1 if you have the <sys/epoll.h> header file. */
#undef HAVE_SYS_EPOLL_H

/* Define to 1 if you have the <sys/eventfd.h> header file. */
#undef HAVE_SYS_EVENTFD_H

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

/* Is kqueue(2) supported? */
#undef NOTIFIER_KQUEUE

/* Is Darwin CoreFoundation unavailable for 64-bit? */
#undef NO_COREFOUNDATION_64

/* Do we have <dirent.h>? */
#undef NO_DIRENT_H

/* Do we have <dlfcn.h>? */
#undef NO_DLFCN_H

/* Do we have fd_set? */
#undef NO_FD_SET




/* Do we have fstatfs()? */
#undef NO_FSTATFS

/* Do we have gettimeofday()? */
#undef NO_GETTOD

/* Do we have getwd() */
#undef NO_GETWD

/* Do we have memmove()? */
#undef NO_MEMMOVE




/* Do we have realpath() */
#undef NO_REALPATH

/* Do we have <stdlib.h>? */
#undef NO_STDLIB_H

/* Do we have strerror() */
#undef NO_STRERROR

/* Do we have <string.h>? */
#undef NO_STRING_H

/* Do we have <sys/wait.h>? */
#undef NO_SYS_WAIT_H




/* Do we have uname() */
#undef NO_UNAME

/* Do we have a usable 'union wait'? */
#undef NO_UNION_WAIT








<
<
<





>
>
>












>
>
>




<
<
<








>
>
>







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

/* Is kqueue(2) supported? */
#undef NOTIFIER_KQUEUE

/* Is Darwin CoreFoundation unavailable for 64-bit? */
#undef NO_COREFOUNDATION_64




/* Do we have <dlfcn.h>? */
#undef NO_DLFCN_H

/* Do we have fd_set? */
#undef NO_FD_SET

/* Do we have fork() */
#undef NO_FORK

/* Do we have fstatfs()? */
#undef NO_FSTATFS

/* Do we have gettimeofday()? */
#undef NO_GETTOD

/* Do we have getwd() */
#undef NO_GETWD

/* Do we have memmove()? */
#undef NO_MEMMOVE

/* Do we have mknod() */
#undef NO_MKNOD

/* Do we have realpath() */
#undef NO_REALPATH




/* Do we have strerror() */
#undef NO_STRERROR

/* Do we have <string.h>? */
#undef NO_STRING_H

/* Do we have <sys/wait.h>? */
#undef NO_SYS_WAIT_H

/* Do we have tcdrain() */
#undef NO_TCDRAIN

/* Do we have uname() */
#undef NO_UNAME

/* Do we have a usable 'union wait'? */
#undef NO_UNION_WAIT

440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456

/* Tcl with external libtommath */
#undef TCL_WITH_EXTERNAL_TOMMATH

/* Is getcwd Posix-compliant? */
#undef USEGETWD

/* May we include <dirent2.h>? */
#undef USE_DIRENT2_H

/* Are we building with DTrace support? */
#undef USE_DTRACE

/* Should we use FIONBIO? */
#undef USE_FIONBIO

/* Should we use vfork() instead of fork()? */







<
<
<







440
441
442
443
444
445
446



447
448
449
450
451
452
453

/* Tcl with external libtommath */
#undef TCL_WITH_EXTERNAL_TOMMATH

/* Is getcwd Posix-compliant? */
#undef USEGETWD




/* Are we building with DTrace support? */
#undef USE_DTRACE

/* Should we use FIONBIO? */
#undef USE_FIONBIO

/* Should we use vfork() instead of fork()? */
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492

/* Add the _ISOC99_SOURCE flag when building */
#undef _ISOC99_SOURCE

/* Add the _LARGEFILE64_SOURCE flag when building */
#undef _LARGEFILE64_SOURCE

/* Add the _LARGEFILE_SOURCE64 flag when building */
#undef _LARGEFILE_SOURCE64

/* # needed in sys/socket.h Should OS/390 do the right thing with sockets? */
#undef _OE_SOCKETS

/* Do we really want to follow the standard? Yes we do! */
#undef _POSIX_PTHREAD_SEMANTICS

/* Do we want the reentrant OS API? */







<
<
<







473
474
475
476
477
478
479



480
481
482
483
484
485
486

/* Add the _ISOC99_SOURCE flag when building */
#undef _ISOC99_SOURCE

/* Add the _LARGEFILE64_SOURCE flag when building */
#undef _LARGEFILE64_SOURCE




/* # needed in sys/socket.h Should OS/390 do the right thing with sockets? */
#undef _OE_SOCKETS

/* Do we really want to follow the standard? Yes we do! */
#undef _POSIX_PTHREAD_SEMANTICS

/* Do we want the reentrant OS API? */

Changes to unix/tclLoadDl.c.

187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
	native = Tcl_DStringAppend(&newName, native, TCL_INDEX_NONE);
	proc = dlsym(handle, native);	/* INTL: Native. */
	Tcl_DStringFree(&newName);
    }
#ifdef __cplusplus
    if (proc == NULL) {
	char buf[32];
	sprintf(buf, "%d", (int)Tcl_DStringLength(&ds));
	Tcl_DStringInit(&newName);
	TclDStringAppendLiteral(&newName, "__Z");
	Tcl_DStringAppend(&newName, buf, TCL_INDEX_NONE);
	Tcl_DStringAppend(&newName, Tcl_DStringValue(&ds), TCL_INDEX_NONE);
	TclDStringAppendLiteral(&newName, "P10Tcl_Interp");
	native = Tcl_DStringValue(&newName);
	proc = dlsym(handle, native + 1);	/* INTL: Native. */







|







187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
	native = Tcl_DStringAppend(&newName, native, TCL_INDEX_NONE);
	proc = dlsym(handle, native);	/* INTL: Native. */
	Tcl_DStringFree(&newName);
    }
#ifdef __cplusplus
    if (proc == NULL) {
	char buf[32];
	snprintf(buf, sizeof(buf), "%d", (int)Tcl_DStringLength(&ds));
	Tcl_DStringInit(&newName);
	TclDStringAppendLiteral(&newName, "__Z");
	Tcl_DStringAppend(&newName, buf, TCL_INDEX_NONE);
	Tcl_DStringAppend(&newName, Tcl_DStringValue(&ds), TCL_INDEX_NONE);
	TclDStringAppendLiteral(&newName, "P10Tcl_Interp");
	native = Tcl_DStringValue(&newName);
	proc = dlsym(handle, native + 1);	/* INTL: Native. */

Changes to unix/tclSelectNotfy.c.

28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
    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. */
    ClientData clientData;	/* Argument to pass to proc. */
    struct FileHandler *nextPtr;/* Next in list of all files we care about. */
} FileHandler;

/*
 * The following structure contains a set of select() masks to track readable,
 * writable, and exception conditions.
 */







|







28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
    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. */
    void *clientData;	/* Argument to pass to proc. */
    struct FileHandler *nextPtr;/* Next in list of all files we care about. */
} FileHandler;

/*
 * The following structure contains a set of select() masks to track readable,
 * writable, and exception conditions.
 */
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
#endif /* TCL_THREADS */

/*
 * Static routines defined in this file.
 */

#if TCL_THREADS
static TCL_NORETURN void NotifierThreadProc(ClientData clientData);
#if defined(HAVE_PTHREAD_ATFORK)
static int atForkInit = 0;
static void		AtForkChild(void);
#endif /* HAVE_PTHREAD_ATFORK */
#endif /* TCL_THREADS */
static int		FileHandlerEventProc(Tcl_Event *evPtr, int flags);








|







210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
#endif /* TCL_THREADS */

/*
 * Static routines defined in this file.
 */

#if TCL_THREADS
static TCL_NORETURN void NotifierThreadProc(void *clientData);
#if defined(HAVE_PTHREAD_ATFORK)
static int atForkInit = 0;
static void		AtForkChild(void);
#endif /* HAVE_PTHREAD_ATFORK */
#endif /* TCL_THREADS */
static int		FileHandlerEventProc(Tcl_Event *evPtr, int flags);

309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

ClientData
TclpInitNotifier(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

#if TCL_THREADS
    tsdPtr->eventReady = 0;








|







309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void *
TclpInitNotifier(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

#if TCL_THREADS
    tsdPtr->eventReady = 0;

476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
    int fd,			/* Handle of stream to watch. */
    int mask,			/* OR'ed combination of TCL_READABLE,
				 * TCL_WRITABLE, and TCL_EXCEPTION: indicates
				 * conditions under which proc should be
				 * called. */
    Tcl_FileProc *proc,		/* Function to call for each selected
				 * event. */
    ClientData clientData)	/* Arbitrary data to pass to proc. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL);

    if (filePtr == NULL) {
	filePtr = (FileHandler *) Tcl_Alloc(sizeof(FileHandler));
	filePtr->fd = fd;







|







476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
    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. */
    void *clientData)	/* Arbitrary data to pass to proc. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL);

    if (filePtr == NULL) {
	filePtr = (FileHandler *) Tcl_Alloc(sizeof(FileHandler));
	filePtr->fd = fd;
934
935
936
937
938
939
940
941



942
943
944
945
946
947
948
     */

    if (pthread_equal(pthread_self(), (pthread_t) notifierThread)) {
	if (notifierThreadRunning) {
	    *flagPtr = value;
	    if (!asyncPending) {
		asyncPending = 1;
		write(triggerPipe, "S", 1);



	    }
	    return 1;
	}
	return 0;
    }

    /*







|
>
>
>







934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
     */

    if (pthread_equal(pthread_self(), (pthread_t) notifierThread)) {
	if (notifierThreadRunning) {
	    *flagPtr = value;
	    if (!asyncPending) {
		asyncPending = 1;
		if (write(triggerPipe, "S", 1) != 1) {
		    asyncPending = 0;
		    return 0;
		};
	    }
	    return 1;
	}
	return 0;
    }

    /*
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
	/*
	 * Consume the next byte from the notifier pipe if the pipe was
	 * readable. Note that there may be multiple bytes pending, but to
	 * avoid a race condition we only read one at a time.
	 */

	do {
	    i = read(receivePipe, buf, 1);
	    if (i <= 0) {
		break;
	    } else if ((i == 0) || ((i == 1) && (buf[0] == 'q'))) {
		/*
		 * Someone closed the write end of the pipe or sent us a Quit
		 * message [Bug: 4139] and then closed the write end of the
		 * pipe so we need to shut down the notifier thread.







|







1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
	/*
	 * Consume the next byte from the notifier pipe if the pipe was
	 * readable. Note that there may be multiple bytes pending, but to
	 * avoid a race condition we only read one at a time.
	 */

	do {
	    i = (int)read(receivePipe, buf, 1);
	    if (i <= 0) {
		break;
	    } else if ((i == 0) || ((i == 1) && (buf[0] == 'q'))) {
		/*
		 * Someone closed the write end of the pipe or sent us a Quit
		 * message [Bug: 4139] and then closed the write end of the
		 * pipe so we need to shut down the notifier thread.

Changes to unix/tclUnixChan.c.

120
121
122
123
124
125
126



127
128
129
130
131
132
133
 */

static int		FileBlockModeProc(void *instanceData, int mode);
static int		FileCloseProc(void *instanceData,
			    Tcl_Interp *interp, int flags);
static int		FileGetHandleProc(void *instanceData,
			    int direction, void **handlePtr);



static int		FileInputProc(void *instanceData, char *buf,
			    int toRead, int *errorCode);
static int		FileOutputProc(void *instanceData,
			    const char *buf, int toWrite, int *errorCode);
static int		FileTruncateProc(void *instanceData,
			    long long length);
static long long	FileWideSeekProc(void *instanceData,







>
>
>







120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
 */

static int		FileBlockModeProc(void *instanceData, int mode);
static int		FileCloseProc(void *instanceData,
			    Tcl_Interp *interp, int flags);
static int		FileGetHandleProc(void *instanceData,
			    int direction, void **handlePtr);
static int		FileGetOptionProc(void *instanceData,
			    Tcl_Interp *interp, const char *optionName,
			    Tcl_DString *dsPtr);
static int		FileInputProc(void *instanceData, char *buf,
			    int toRead, int *errorCode);
static int		FileOutputProc(void *instanceData,
			    const char *buf, int toWrite, int *errorCode);
static int		FileTruncateProc(void *instanceData,
			    long long length);
static long long	FileWideSeekProc(void *instanceData,
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
    "file",			/* Type name. */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    NULL,		/* Close proc. */
    FileInputProc,		/* Input proc. */
    FileOutputProc,		/* Output proc. */
	NULL,
    NULL,			/* Set option proc. */
    NULL,			/* Get option proc. */
    FileWatchProc,		/* Initialize notifier. */
    FileGetHandleProc,		/* Get OS handles out of channel. */
    FileCloseProc,		/* close2proc. */
    FileBlockModeProc,		/* Set blocking or non-blocking mode.*/
    NULL,			/* flush proc. */
    NULL,			/* handler proc. */
    FileWideSeekProc,		/* wide seek proc. */







|







163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
    "file",			/* Type name. */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    NULL,		/* Close proc. */
    FileInputProc,		/* Input proc. */
    FileOutputProc,		/* Output proc. */
	NULL,
    NULL,			/* Set option proc. */
    FileGetOptionProc,		/* Get option proc. */
    FileWatchProc,		/* Initialize notifier. */
    FileGetHandleProc,		/* Get OS handles out of channel. */
    FileCloseProc,		/* close2proc. */
    FileBlockModeProc,		/* Set blocking or non-blocking mode.*/
    NULL,			/* flush proc. */
    NULL,			/* handler proc. */
    FileWideSeekProc,		/* wide seek proc. */
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
     * Assume there is always enough input available. This will block
     * appropriately, and read will unblock as soon as a short read is
     * possible, if the channel is in blocking mode. If the channel is
     * nonblocking, the read will never block.
     */

    do {
	bytesRead = read(fsPtr->fd, buf, toRead);
    } while ((bytesRead < 0) && (errno == EINTR));

    if (bytesRead < 0) {
	*errorCodePtr = errno;
	return -1;
    }
    return bytesRead;







|







274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
     * 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, (size_t)toRead);
    } while ((bytesRead < 0) && (errno == EINTR));

    if (bytesRead < 0) {
	*errorCodePtr = errno;
	return -1;
    }
    return bytesRead;
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
	 * SF Tcl Bug 465765. Do not try to write nothing into a file. STREAM
	 * based implementations will considers this as EOF (if there is a
	 * pipe behind the file).
	 */

	return 0;
    }
    written = write(fsPtr->fd, buf, toWrite);
    if (written >= 0) {
	return written;
    }
    *errorCodePtr = errno;
    return -1;
}








|







323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
	 * SF Tcl Bug 465765. Do not try to write nothing into a file. STREAM
	 * based implementations will considers this as EOF (if there is a
	 * pipe behind the file).
	 */

	return 0;
    }
    written = write(fsPtr->fd, buf, (size_t)toWrite);
    if (written >= 0) {
	return written;
    }
    *errorCodePtr = errno;
    return -1;
}

529
530
531
532
533
534
535










































































































































































536
537
538
539
540
541
542

    if (direction & fsPtr->validMask) {
	*handlePtr = INT2PTR(fsPtr->fd);
	return TCL_OK;
    }
    return TCL_ERROR;
}











































































































































































#ifdef SUPPORTS_TTY
/*
 *----------------------------------------------------------------------
 *
 * TtyModemStatusStr --
 *







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







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

    if (direction & fsPtr->validMask) {
	*handlePtr = INT2PTR(fsPtr->fd);
	return TCL_OK;
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * FileGetOptionProc --
 *
 *	Gets an option associated with an open file. If the optionName arg is
 *	non-NULL, retrieves the value of that option. If the optionName arg is
 *	NULL, retrieves a list of alternating option names and values for the
 *	given channel.
 *
 * Results:
 *	A standard Tcl result. Also sets the supplied DString to the string
 *	value of the option(s) returned.  Sets error message if needed
 *	(by calling Tcl_BadChannelOption).
 *
 *----------------------------------------------------------------------
 */

static inline void
StoreElementInDict(
    Tcl_Obj *dictObj,
    const char *name,
    Tcl_Obj *valueObj)
{
    /*
     * We assume that the dict is being built fresh and that there's never any
     * duplicate keys.
     */

    Tcl_Obj *nameObj = Tcl_NewStringObj(name, -1);
    Tcl_DictObjPut(NULL, dictObj, nameObj, valueObj);
}

static inline const char *
GetTypeFromMode(
    int mode)
{
    /*
     * TODO: deduplicate with tclCmdAH.c
     */

    if (S_ISREG(mode)) {
	return "file";
    } else if (S_ISDIR(mode)) {
	return "directory";
    } else if (S_ISCHR(mode)) {
	return "characterSpecial";
    } else if (S_ISBLK(mode)) {
	return "blockSpecial";
    } else if (S_ISFIFO(mode)) {
	return "fifo";
#ifdef S_ISLNK
    } else if (S_ISLNK(mode)) {
	return "link";
#endif
#ifdef S_ISSOCK
    } else if (S_ISSOCK(mode)) {
	return "socket";
#endif
    }
    return "unknown";
}

static Tcl_Obj *
StatOpenFile(
    FileState *fsPtr)
{
    Tcl_StatBuf statBuf;	/* Not allocated on heap; we're definitely
				 * API-synchronized with how Tcl is built! */
    Tcl_Obj *dictObj;
    unsigned short mode;

    if (TclOSfstat(fsPtr->fd, &statBuf) < 0) {
	return NULL;
    }

    /*
     * TODO: merge with TIP 594 implementation (it's silly to have a
     * duplicate!)
     */

    TclNewObj(dictObj);
#define STORE_ELEM(name, value) StoreElementInDict(dictObj, name, value)

    STORE_ELEM("dev",     Tcl_NewWideIntObj((long) statBuf.st_dev));
    STORE_ELEM("ino",     Tcl_NewWideIntObj((Tcl_WideInt) statBuf.st_ino));
    STORE_ELEM("nlink",   Tcl_NewWideIntObj((long) statBuf.st_nlink));
    STORE_ELEM("uid",     Tcl_NewWideIntObj((long) statBuf.st_uid));
    STORE_ELEM("gid",     Tcl_NewWideIntObj((long) statBuf.st_gid));
    STORE_ELEM("size",    Tcl_NewWideIntObj((Tcl_WideInt) statBuf.st_size));
#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
    STORE_ELEM("blocks",  Tcl_NewWideIntObj((Tcl_WideInt) statBuf.st_blocks));
#endif
#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
    STORE_ELEM("blksize", Tcl_NewWideIntObj((long) statBuf.st_blksize));
#endif
#ifdef HAVE_STRUCT_STAT_ST_RDEV
    if (S_ISCHR(statBuf.st_mode) || S_ISBLK(statBuf.st_mode)) {
	STORE_ELEM("rdev", Tcl_NewWideIntObj((long) statBuf.st_rdev));
    }
#endif
    STORE_ELEM("atime",   Tcl_NewWideIntObj(
	    Tcl_GetAccessTimeFromStat(&statBuf)));
    STORE_ELEM("mtime",   Tcl_NewWideIntObj(
	    Tcl_GetModificationTimeFromStat(&statBuf)));
    STORE_ELEM("ctime",   Tcl_NewWideIntObj(
	    Tcl_GetChangeTimeFromStat(&statBuf)));
    mode = (unsigned short) statBuf.st_mode;
    STORE_ELEM("mode",    Tcl_NewWideIntObj(mode));
    STORE_ELEM("type",    Tcl_NewStringObj(GetTypeFromMode(mode), -1));
#undef STORE_ELEM

    return dictObj;
}

static int
FileGetOptionProc(
    void *instanceData,
    Tcl_Interp *interp,
    const char *optionName,
    Tcl_DString *dsPtr)
{
    FileState *fsPtr = (FileState *)instanceData;
    int valid = 0;		/* Flag if valid option parsed. */
    int len;

    if (optionName == NULL) {
	len = 0;
	valid = 1;
    } else {
	len = strlen(optionName);
    }

    /*
     * Get option -stat
     * Option is readonly and returned by [fconfigure chan -stat] but not
     * returned by [fconfigure chan] without explicit option name.
     */

    if ((len > 1) && (strncmp(optionName, "-stat", len) == 0)) {
	Tcl_Obj *dictObj = StatOpenFile(fsPtr);
	const char *dictContents;
	Tcl_Size dictLength;

	if (dictObj == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "couldn't read file channel status: %s",
		    Tcl_PosixError(interp)));
	    return TCL_ERROR;
	}

	/*
	 * Transfer dictionary to the DString. Note that we don't do this as
	 * an element as this is an option that can't be retrieved with a
	 * general probe.
	 */

	dictContents = Tcl_GetStringFromObj(dictObj, &dictLength);
	Tcl_DStringAppend(dsPtr, dictContents, dictLength);
	Tcl_DecrRefCount(dictObj);
	return TCL_OK;
    }

    if (valid) {
	return TCL_OK;
    }
    return Tcl_BadChannelOption(interp, optionName,
		"stat");
}

#ifdef SUPPORTS_TTY
/*
 *----------------------------------------------------------------------
 *
 * TtyModemStatusStr --
 *
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
    const char *optionName,	/* Which option to set? */
    const char *value)		/* New value for option. */
{
    TtyState *fsPtr = (TtyState *)instanceData;
    size_t len, vlen;
    TtyAttrs tty;
    size_t argc;
    const char **argv;
    struct termios iostate;

    len = strlen(optionName);
    vlen = strlen(value);

    /*







|







765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
    const char *optionName,	/* Which option to set? */
    const char *value)		/* New value for option. */
{
    TtyState *fsPtr = (TtyState *)instanceData;
    size_t len, vlen;
    TtyAttrs tty;
    Tcl_Size argc;
    const char **argv;
    struct termios iostate;

    len = strlen(optionName);
    vlen = strlen(value);

    /*
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
    /*
     * Option -ttycontrol {DTR 1 RTS 0 BREAK 0}
     */

    if ((len > 4) && (strncmp(optionName, "-ttycontrol", len) == 0)) {
#if defined(TIOCMGET) && defined(TIOCMSET)
	int control, flag;
	size_t i;

	if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
	    return TCL_ERROR;
	}
	if ((argc % 2) == 1) {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(







|







901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
    /*
     * Option -ttycontrol {DTR 1 RTS 0 BREAK 0}
     */

    if ((len > 4) && (strncmp(optionName, "-ttycontrol", len) == 0)) {
#if defined(TIOCMGET) && defined(TIOCMSET)
	int control, flag;
	Tcl_Size i;

	if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
	    return TCL_ERROR;
	}
	if ((argc % 2) == 1) {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
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
	Tcl_DStringAppendElement(dsPtr, "-mode");
    }
    if (len==0 || (len>2 && strncmp(optionName, "-mode", len)==0)) {
	TtyAttrs tty;

	valid = 1;
	TtyGetAttributes(fsPtr->fileState.fd, &tty);
	sprintf(buf, "%d,%c,%d,%d", tty.baud, tty.parity, tty.data, tty.stop);
	Tcl_DStringAppendElement(dsPtr, buf);
    }

    /*
     * Get option -xchar
     */

    if (len == 0) {
	Tcl_DStringAppendElement(dsPtr, "-xchar");
	Tcl_DStringStartSublist(dsPtr);
    }
    if (len==0 || (len>1 && strncmp(optionName, "-xchar", len)==0)) {
	Tcl_DString ds;

	valid = 1;
	tcgetattr(fsPtr->fileState.fd, &iostate);
	Tcl_DStringInit(&ds);

	Tcl_ExternalToUtfDStringEx(NULL, (char *) &iostate.c_cc[VSTART], 1, TCL_ENCODING_NOCOMPLAIN, &ds);
	Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds));
	TclDStringClear(&ds);

	Tcl_ExternalToUtfDStringEx(NULL, (char *) &iostate.c_cc[VSTOP], 1, TCL_ENCODING_NOCOMPLAIN, &ds);
	Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds));
	Tcl_DStringFree(&ds);
    }
    if (len == 0) {
	Tcl_DStringEndSublist(dsPtr);
    }








|


















|



|







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
	Tcl_DStringAppendElement(dsPtr, "-mode");
    }
    if (len==0 || (len>2 && strncmp(optionName, "-mode", len)==0)) {
	TtyAttrs tty;

	valid = 1;
	TtyGetAttributes(fsPtr->fileState.fd, &tty);
	snprintf(buf, sizeof(buf), "%d,%c,%d,%d", tty.baud, tty.parity, tty.data, tty.stop);
	Tcl_DStringAppendElement(dsPtr, buf);
    }

    /*
     * Get option -xchar
     */

    if (len == 0) {
	Tcl_DStringAppendElement(dsPtr, "-xchar");
	Tcl_DStringStartSublist(dsPtr);
    }
    if (len==0 || (len>1 && strncmp(optionName, "-xchar", len)==0)) {
	Tcl_DString ds;

	valid = 1;
	tcgetattr(fsPtr->fileState.fd, &iostate);
	Tcl_DStringInit(&ds);

	Tcl_ExternalToUtfDStringEx(NULL, NULL, (char *) &iostate.c_cc[VSTART], 1, TCL_ENCODING_PROFILE_TCL8, &ds, NULL);
	Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds));
	TclDStringClear(&ds);

	Tcl_ExternalToUtfDStringEx(NULL, NULL, (char *) &iostate.c_cc[VSTOP], 1, TCL_ENCODING_PROFILE_TCL8, &ds, NULL);
	Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds));
	Tcl_DStringFree(&ds);
    }
    if (len == 0) {
	Tcl_DStringEndSublist(dsPtr);
    }

1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067

	valid = 1;
	GETREADQUEUE(fsPtr->fileState.fd, inQueue);
	GETWRITEQUEUE(fsPtr->fileState.fd, outQueue);
	inBuffered = Tcl_InputBuffered(fsPtr->fileState.channel);
	outBuffered = Tcl_OutputBuffered(fsPtr->fileState.channel);

	sprintf(buf, "%d", inBuffered+inQueue);
	Tcl_DStringAppendElement(dsPtr, buf);
	sprintf(buf, "%d", outBuffered+outQueue);
	Tcl_DStringAppendElement(dsPtr, buf);
    }

#if defined(TIOCMGET)
    /*
     * Get option -ttystatus
     * Option is readonly and returned by [fconfigure chan -ttystatus] but not







|

|







1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240

	valid = 1;
	GETREADQUEUE(fsPtr->fileState.fd, inQueue);
	GETWRITEQUEUE(fsPtr->fileState.fd, outQueue);
	inBuffered = Tcl_InputBuffered(fsPtr->fileState.channel);
	outBuffered = Tcl_OutputBuffered(fsPtr->fileState.channel);

	snprintf(buf, sizeof(buf), "%d", inBuffered+inQueue);
	Tcl_DStringAppendElement(dsPtr, buf);
	snprintf(buf, sizeof(buf), "%d", outBuffered+outQueue);
	Tcl_DStringAppendElement(dsPtr, buf);
    }

#if defined(TIOCMGET)
    /*
     * Get option -ttystatus
     * Option is readonly and returned by [fconfigure chan -ttystatus] but not
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"couldn't read terminal size: %s",
			Tcl_PosixError(interp)));
	    }
	    return TCL_ERROR;
	}
	sprintf(buf, "%d", ws.ws_col);
	Tcl_DStringAppendElement(dsPtr, buf);
	sprintf(buf, "%d", ws.ws_row);
	Tcl_DStringAppendElement(dsPtr, buf);
    }
#endif /* TIOCGWINSZ */

    if (valid) {
	return TCL_OK;
    }







|

|







1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"couldn't read terminal size: %s",
			Tcl_PosixError(interp)));
	    }
	    return TCL_ERROR;
	}
	snprintf(buf, sizeof(buf), "%d", ws.ws_col);
	Tcl_DStringAppendElement(dsPtr, buf);
	snprintf(buf, sizeof(buf), "%d", ws.ws_row);
	Tcl_DStringAppendElement(dsPtr, buf);
    }
#endif /* TIOCGWINSZ */

    if (valid) {
	return TCL_OK;
    }
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474

    /*
     * Only allow setting mark/space parity on platforms that support it Make
     * sure to allow for the case where strchr is a macro. [Bug: 5089]
     *
     * We cannot if/else/endif the strchr arguments, it has to be the whole
     * function. On AIX this function is apparently a macro, and macros do
     * not allow pre-processor directives in their arguments.
     */

    if (
#if defined(PAREXT)
        strchr("noems", parity)
#else
        strchr("noe", parity)







|







1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647

    /*
     * Only allow setting mark/space parity on platforms that support it Make
     * sure to allow for the case where strchr is a macro. [Bug: 5089]
     *
     * We cannot if/else/endif the strchr arguments, it has to be the whole
     * function. On AIX this function is apparently a macro, and macros do
     * not allow preprocessor directives in their arguments.
     */

    if (
#if defined(PAREXT)
        strchr("noems", parity)
#else
        strchr("noe", parity)
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
	 * being set up is a device and has the same major/minor as the
	 * initial std FDs (beware reopening!) but that's nearly as messy.
	 */

	translation = "auto crlf";
	channelTypePtr = &ttyChannelType;
	TtyInit(fd);
	sprintf(channelName, "serial%d", fd);
    } else
#endif	/* SUPPORTS_TTY */
    {
	translation = NULL;
	channelTypePtr = &fileChannelType;
	sprintf(channelName, "file%d", fd);
    }

    fsPtr = (TtyState *)Tcl_Alloc(sizeof(TtyState));
    fsPtr->fileState.validMask = channelPermissions | TCL_EXCEPTION;
    fsPtr->fileState.fd = fd;
#ifdef SUPPORTS_TTY
    if (channelTypePtr == &ttyChannelType) {







|





|







1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
	 * being set up is a device and has the same major/minor as the
	 * initial std FDs (beware reopening!) but that's nearly as messy.
	 */

	translation = "auto crlf";
	channelTypePtr = &ttyChannelType;
	TtyInit(fd);
	snprintf(channelName, sizeof(channelName), "serial%d", fd);
    } else
#endif	/* SUPPORTS_TTY */
    {
	translation = NULL;
	channelTypePtr = &fileChannelType;
	snprintf(channelName, sizeof(channelName), "file%d", fd);
    }

    fsPtr = (TtyState *)Tcl_Alloc(sizeof(TtyState));
    fsPtr->fileState.validMask = channelPermissions | TCL_EXCEPTION;
    fsPtr->fileState.fd = fd;
#ifdef SUPPORTS_TTY
    if (channelTypePtr == &ttyChannelType) {
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
 *
 *----------------------------------------------------------------------
 */

Tcl_Channel
Tcl_MakeFileChannel(
    void *handle,		/* OS level handle. */
    int mode)			/* ORed combination of TCL_READABLE and
				 * TCL_WRITABLE to indicate file mode. */
{
    TtyState *fsPtr;
    char channelName[16 + TCL_INTEGER_SPACE];
    int fd = PTR2INT(handle);
    const Tcl_ChannelType *channelTypePtr;
    struct stat buf;

    if (mode == 0) {
	return NULL;
    }

#ifdef SUPPORTS_TTY
    if (isatty(fd)) {
	channelTypePtr = &ttyChannelType;
	sprintf(channelName, "serial%d", fd);
    } else
#endif /* SUPPORTS_TTY */
    if (fstat(fd, &buf) == 0 && S_ISSOCK(buf.st_mode)) {
	struct sockaddr sockaddr;
	socklen_t sockaddrLen = sizeof(sockaddr);

	sockaddr.sa_family = AF_UNSPEC;
	if ((getsockname(fd, (struct sockaddr *)&sockaddr, &sockaddrLen) == 0)
		&& (sockaddrLen > 0)
		&& (sockaddr.sa_family == AF_INET
			|| sockaddr.sa_family == AF_INET6)) {
	    return (Tcl_Channel)TclpMakeTcpClientChannelMode(INT2PTR(fd), mode);
	}
	goto normalChannelAfterAll;
    } else {
    normalChannelAfterAll:
	channelTypePtr = &fileChannelType;
	sprintf(channelName, "file%d", fd);
    }

    fsPtr = (TtyState *)Tcl_Alloc(sizeof(TtyState));
    fsPtr->fileState.fd = fd;
    fsPtr->fileState.validMask = mode | TCL_EXCEPTION;
    fsPtr->fileState.channel = Tcl_CreateChannel(channelTypePtr, channelName,
	    fsPtr, mode);







|















|

















|







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

Tcl_Channel
Tcl_MakeFileChannel(
    void *handle,		/* OS level handle. */
    int mode)			/* OR'ed combination of TCL_READABLE and
				 * TCL_WRITABLE to indicate file mode. */
{
    TtyState *fsPtr;
    char channelName[16 + TCL_INTEGER_SPACE];
    int fd = PTR2INT(handle);
    const Tcl_ChannelType *channelTypePtr;
    struct stat buf;

    if (mode == 0) {
	return NULL;
    }

#ifdef SUPPORTS_TTY
    if (isatty(fd)) {
	channelTypePtr = &ttyChannelType;
	snprintf(channelName, sizeof(channelName), "serial%d", fd);
    } else
#endif /* SUPPORTS_TTY */
    if (fstat(fd, &buf) == 0 && S_ISSOCK(buf.st_mode)) {
	struct sockaddr sockaddr;
	socklen_t sockaddrLen = sizeof(sockaddr);

	sockaddr.sa_family = AF_UNSPEC;
	if ((getsockname(fd, (struct sockaddr *)&sockaddr, &sockaddrLen) == 0)
		&& (sockaddrLen > 0)
		&& (sockaddr.sa_family == AF_INET
			|| sockaddr.sa_family == AF_INET6)) {
	    return (Tcl_Channel)TclpMakeTcpClientChannelMode(INT2PTR(fd), mode);
	}
	goto normalChannelAfterAll;
    } else {
    normalChannelAfterAll:
	channelTypePtr = &fileChannelType;
	snprintf(channelName, sizeof(channelName), "file%d", fd);
    }

    fsPtr = (TtyState *)Tcl_Alloc(sizeof(TtyState));
    fsPtr->fileState.fd = fd;
    fsPtr->fileState.validMask = mode | TCL_EXCEPTION;
    fsPtr->fileState.channel = Tcl_CreateChannel(channelTypePtr, channelName,
	    fsPtr, mode);

Changes to unix/tclUnixCompat.c.

730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
#endif /* NEED_COPYGRP */

/*
 *---------------------------------------------------------------------------
 *
 * CopyHostent --
 *
 *      Copies string fields of the hostnent structure to the private buffer,
 *      honouring the size of the buffer.
 *
 * Results:
 *      Number of bytes copied on success or -1 on error (errno = ERANGE)
 *
 * Side effects:
 *      None







|







730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
#endif /* NEED_COPYGRP */

/*
 *---------------------------------------------------------------------------
 *
 * CopyHostent --
 *
 *      Copies string fields of the hostent structure to the private buffer,
 *      honouring the size of the buffer.
 *
 * Results:
 *      Number of bytes copied on success or -1 on error (errno = ERANGE)
 *
 * Side effects:
 *      None

Changes to unix/tclUnixFCmd.c.

1
2
3
4
5
6
7
8
9
10
11
/*
 * tclUnixFCmd.c
 *
 *	This file implements the unix specific portion of file manipulation
 *	subcommands of the "file" command. All filename arguments should
 *	already be translated to native format.
 *
 * Copyright © 1996-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.



|







1
2
3
4
5
6
7
8
9
10
11
/*
 * tclUnixFCmd.c
 *
 *	This file implements the Unix specific portion of file manipulation
 *	subcommands of the "file" command. All filename arguments should
 *	already be translated to native format.
 *
 * Copyright © 1996-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
	return TCL_OK;
    }
    if (errno == ENOTEMPTY) {
	errno = EEXIST;
    }

    /*
     * IRIX returns EIO when you attept to move a directory into itself. We
     * just map EIO to EINVAL get the right message on SGI. Most platforms
     * don't return EIO except in really strange cases.
     */

    if (errno == EIO) {
	errno = EINVAL;
    }







|







339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
	return TCL_OK;
    }
    if (errno == ENOTEMPTY) {
	errno = EEXIST;
    }

    /*
     * IRIX returns EIO when you attempt to move a directory into itself. We
     * just map EIO to EINVAL get the right message on SGI. Most platforms
     * don't return EIO except in really strange cases.
     */

    if (errno == EIO) {
	errno = EINVAL;
    }
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
    const Tcl_StatBuf *statBufPtr,
				/* Used to determine mode and blocksize. */
    int dontCopyAtts)		/* If flag set, don't copy attributes. */
{
    int srcFd, dstFd;
    size_t blockSize;		/* Optimal I/O blocksize for filesystem */
    char *buffer;		/* Data buffer for copy */
    size_t nread;

#ifdef DJGPP
#define BINMODE |O_BINARY
#else
#define BINMODE
#endif /* DJGPP */








|







545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
    const Tcl_StatBuf *statBufPtr,
				/* Used to determine mode and blocksize. */
    int dontCopyAtts)		/* If flag set, don't copy attributes. */
{
    int srcFd, dstFd;
    size_t blockSize;		/* Optimal I/O blocksize for filesystem */
    char *buffer;		/* Data buffer for copy */
    ssize_t nread;

#ifdef DJGPP
#define BINMODE |O_BINARY
#else
#define BINMODE
#endif /* DJGPP */

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

    if (blockSize <= 0) {
	blockSize = DEFAULT_COPY_BLOCK_SIZE;
    }
    buffer = (char *)Tcl_Alloc(blockSize);
    while (1) {
	nread = read(srcFd, buffer, blockSize);
	if ((nread == TCL_IO_FAILURE) || (nread == 0)) {
	    break;
	}
	if ((size_t) write(dstFd, buffer, nread) != nread) {
	    nread = TCL_IO_FAILURE;
	    break;
	}
    }

    Tcl_Free(buffer);
    close(srcFd);
    if ((close(dstFd) != 0) || (nread == TCL_IO_FAILURE)) {
	unlink(dst);					/* INTL: Native. */
	return TCL_ERROR;
    }
    if (!dontCopyAtts && CopyFileAtts(src, dst, statBufPtr) == TCL_ERROR) {
	/*
	 * The copy succeeded, but setting the permissions failed, so be in a
	 * consistent state, we remove the file that was created by the copy.







|


|
|






|







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

    if (blockSize <= 0) {
	blockSize = DEFAULT_COPY_BLOCK_SIZE;
    }
    buffer = (char *)Tcl_Alloc(blockSize);
    while (1) {
	nread = read(srcFd, buffer, blockSize);
	if ((nread == -1) || (nread == 0)) {
	    break;
	}
	if (write(dstFd, buffer, nread) != nread) {
	    nread = -1;
	    break;
	}
    }

    Tcl_Free(buffer);
    close(srcFd);
    if ((close(dstFd) != 0) || (nread == -1)) {
	unlink(dst);					/* INTL: Native. */
	return TCL_ERROR;
    }
    if (!dontCopyAtts && CopyFileAtts(src, dst, statBufPtr) == TCL_ERROR) {
	/*
	 * The copy succeeded, but setting the permissions failed, so be in a
	 * consistent state, we remove the file that was created by the copy.
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
/*
 *---------------------------------------------------------------------------
 *
 * TclpObjCopyDirectory --
 *
 *	Recursively copies a directory. The target directory dst must not
 *	already exist. Note that this function does not merge two directory
 *	hierarchies, even if the target directory is an an empty directory.
 *
 * Results:
 *	If the directory was successfully copied, returns TCL_OK. Otherwise
 *	the return value is TCL_ERROR, errno is set to indicate the error, and
 *	the pathname of the file that caused the error is stored in errorPtr.
 *	See TclpObjCreateDirectory and TclpObjCopyFile for a description of
 *	possible values for errno.







|







729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
/*
 *---------------------------------------------------------------------------
 *
 * TclpObjCopyDirectory --
 *
 *	Recursively copies a directory. The target directory dst must not
 *	already exist. Note that this function does not merge two directory
 *	hierarchies, even if the target directory is an empty directory.
 *
 * Results:
 *	If the directory was successfully copied, returns TCL_OK. Otherwise
 *	the return value is TCL_ERROR, errno is set to indicate the error, and
 *	the pathname of the file that caused the error is stored in errorPtr.
 *	See TclpObjCreateDirectory and TclpObjCopyFile for a description of
 *	possible values for errno.
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
{
    Tcl_DString ds;
    Tcl_DString srcString, dstString;
    int ret;
    Tcl_Obj *transPtr;

    transPtr = Tcl_FSGetTranslatedPath(NULL,srcPathPtr);
    Tcl_UtfToExternalDStringEx(NULL,
	    (transPtr != NULL ? TclGetString(transPtr) : NULL),
	    -1, TCL_ENCODING_NOCOMPLAIN, &srcString);
    if (transPtr != NULL) {
	Tcl_DecrRefCount(transPtr);
    }
    transPtr = Tcl_FSGetTranslatedPath(NULL,destPathPtr);
    Tcl_UtfToExternalDStringEx(NULL,
	    (transPtr != NULL ? TclGetString(transPtr) : NULL),
	    -1, TCL_ENCODING_NOCOMPLAIN, &dstString);
    if (transPtr != NULL) {
	Tcl_DecrRefCount(transPtr);
    }

    ret = TraverseUnixTree(TraversalCopy, &srcString, &dstString, &ds, 0);

    Tcl_DStringFree(&srcString);







|

|




|

|







758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
{
    Tcl_DString ds;
    Tcl_DString srcString, dstString;
    int ret;
    Tcl_Obj *transPtr;

    transPtr = Tcl_FSGetTranslatedPath(NULL,srcPathPtr);
    Tcl_UtfToExternalDStringEx(NULL, NULL,
	    (transPtr != NULL ? TclGetString(transPtr) : NULL),
	    -1, TCL_ENCODING_PROFILE_TCL8, &srcString, NULL);
    if (transPtr != NULL) {
	Tcl_DecrRefCount(transPtr);
    }
    transPtr = Tcl_FSGetTranslatedPath(NULL,destPathPtr);
    Tcl_UtfToExternalDStringEx(NULL, NULL,
	    (transPtr != NULL ? TclGetString(transPtr) : NULL),
	    -1, TCL_ENCODING_PROFILE_TCL8, &dstString, NULL);
    if (transPtr != NULL) {
	Tcl_DecrRefCount(transPtr);
    }

    ret = TraverseUnixTree(TraversalCopy, &srcString, &dstString, &ds, 0);

    Tcl_DStringFree(&srcString);
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
    Tcl_Obj **errorPtr)
{
    Tcl_DString ds;
    Tcl_DString pathString;
    int ret;
    Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);

    Tcl_UtfToExternalDStringEx(NULL,
	    (transPtr != NULL ? TclGetString(transPtr) : NULL),
	    -1, TCL_ENCODING_NOCOMPLAIN, &pathString);
    if (transPtr != NULL) {
	Tcl_DecrRefCount(transPtr);
    }
    ret = DoRemoveDirectory(&pathString, recursive, &ds);
    Tcl_DStringFree(&pathString);

    if (ret != TCL_OK) {







|

|







822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
    Tcl_Obj **errorPtr)
{
    Tcl_DString ds;
    Tcl_DString pathString;
    int ret;
    Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);

    Tcl_UtfToExternalDStringEx(NULL, NULL,
	    (transPtr != NULL ? TclGetString(transPtr) : NULL),
	    -1, TCL_ENCODING_PROFILE_TCL8, &pathString, NULL);
    if (transPtr != NULL) {
	Tcl_DecrRefCount(transPtr);
    }
    ret = DoRemoveDirectory(&pathString, recursive, &ds);
    Tcl_DStringFree(&pathString);

    if (ret != TCL_OK) {
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
    if (errno == ENOTEMPTY) {
	errno = EEXIST;
    }

    result = TCL_OK;
    if ((errno != EEXIST) || (recursive == 0)) {
	if (errorPtr != NULL) {
	    Tcl_ExternalToUtfDStringEx(NULL, path, TCL_INDEX_NONE, TCL_ENCODING_NOCOMPLAIN, errorPtr);
	}
	result = TCL_ERROR;
    }

    /*
     * The directory is nonempty, but the recursive flag has been specified,
     * so we recursively remove all the files in the directory.







|







882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
    if (errno == ENOTEMPTY) {
	errno = EEXIST;
    }

    result = TCL_OK;
    if ((errno != EEXIST) || (recursive == 0)) {
	if (errorPtr != NULL) {
	    Tcl_ExternalToUtfDStringEx(NULL, NULL, path, TCL_INDEX_NONE, TCL_ENCODING_PROFILE_TCL8, errorPtr, NULL);
	}
	result = TCL_ERROR;
    }

    /*
     * The directory is nonempty, but the recursive flag has been specified,
     * so we recursively remove all the files in the directory.
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
	}
    }
#endif /* !HAVE_FTS */

  end:
    if (errfile != NULL) {
	if (errorPtr != NULL) {
	    Tcl_ExternalToUtfDStringEx(NULL, errfile, TCL_INDEX_NONE, TCL_ENCODING_NOCOMPLAIN, errorPtr);
	}
	result = TCL_ERROR;
    }
#ifdef HAVE_FTS
    if (fts != NULL) {
	fts_close(fts);
    }







|







1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
	}
    }
#endif /* !HAVE_FTS */

  end:
    if (errfile != NULL) {
	if (errorPtr != NULL) {
	    Tcl_ExternalToUtfDStringEx(NULL, NULL, errfile, TCL_INDEX_NONE, TCL_ENCODING_PROFILE_TCL8, errorPtr, NULL);
	}
	result = TCL_ERROR;
    }
#ifdef HAVE_FTS
    if (fts != NULL) {
	fts_close(fts);
    }
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216

    /*
     * There shouldn't be a problem with src, because we already checked it to
     * get here.
     */

    if (errorPtr != NULL) {
	Tcl_ExternalToUtfDStringEx(NULL, Tcl_DStringValue(dstPtr),
		Tcl_DStringLength(dstPtr), TCL_ENCODING_NOCOMPLAIN, errorPtr);
    }
    return TCL_ERROR;
}

/*
 *---------------------------------------------------------------------------
 *







|
|







1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216

    /*
     * There shouldn't be a problem with src, because we already checked it to
     * get here.
     */

    if (errorPtr != NULL) {
	Tcl_ExternalToUtfDStringEx(NULL, NULL, Tcl_DStringValue(dstPtr),
		Tcl_DStringLength(dstPtr), TCL_ENCODING_PROFILE_TCL8, errorPtr, NULL);
    }
    return TCL_ERROR;
}

/*
 *---------------------------------------------------------------------------
 *
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
    case DOTREE_POSTD:
	if (DoRemoveDirectory(srcPtr, 0, NULL) == 0) {
	    return TCL_OK;
	}
	break;
    }
    if (errorPtr != NULL) {
	Tcl_ExternalToUtfDStringEx(NULL, Tcl_DStringValue(srcPtr),
		Tcl_DStringLength(srcPtr), TCL_ENCODING_NOCOMPLAIN, errorPtr);
    }
    return TCL_ERROR;
}

/*
 *---------------------------------------------------------------------------
 *







|
|







1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
    case DOTREE_POSTD:
	if (DoRemoveDirectory(srcPtr, 0, NULL) == 0) {
	    return TCL_OK;
	}
	break;
    }
    if (errorPtr != NULL) {
	Tcl_ExternalToUtfDStringEx(NULL, NULL, Tcl_DStringValue(srcPtr),
		Tcl_DStringLength(srcPtr), TCL_ENCODING_PROFILE_TCL8, errorPtr, NULL);
    }
    return TCL_ERROR;
}

/*
 *---------------------------------------------------------------------------
 *
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
    pwPtr = TclpGetPwUid(statBuf.st_uid);

    if (pwPtr == NULL) {
	TclNewIntObj(*attributePtrPtr, statBuf.st_uid);
    } else {
	Tcl_DString ds;

	Tcl_ExternalToUtfDStringEx(NULL, pwPtr->pw_name, TCL_INDEX_NONE, TCL_ENCODING_NOCOMPLAIN, &ds);
	*attributePtrPtr = TclDStringToObj(&ds);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *







|
|







1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
    pwPtr = TclpGetPwUid(statBuf.st_uid);

    if (pwPtr == NULL) {
	TclNewIntObj(*attributePtrPtr, statBuf.st_uid);
    } else {
	Tcl_DString ds;

	Tcl_ExternalToUtfDStringEx(NULL, NULL, pwPtr->pw_name, TCL_INDEX_NONE, TCL_ENCODING_PROFILE_TCL8, &ds, NULL);
	*attributePtrPtr = Tcl_DStringToObj(&ds);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
    int result;
    const char *native;

    if (Tcl_GetWideIntFromObj(NULL, attributePtr, &gid) != TCL_OK) {
	Tcl_DString ds;
	struct group *groupPtr = NULL;
	const char *string;
	size_t length;

	string = Tcl_GetStringFromObj(attributePtr, &length);

	native = Tcl_UtfToExternalDString(NULL, string, length, &ds);
	groupPtr = TclpGetGrNam(native); /* INTL: Native. */
	Tcl_DStringFree(&ds);








|







1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
    int result;
    const char *native;

    if (Tcl_GetWideIntFromObj(NULL, attributePtr, &gid) != TCL_OK) {
	Tcl_DString ds;
	struct group *groupPtr = NULL;
	const char *string;
	Tcl_Size length;

	string = Tcl_GetStringFromObj(attributePtr, &length);

	native = Tcl_UtfToExternalDString(NULL, string, length, &ds);
	groupPtr = TclpGetGrNam(native); /* INTL: Native. */
	Tcl_DStringFree(&ds);

1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
    int result;
    const char *native;

    if (Tcl_GetWideIntFromObj(NULL, attributePtr, &uid) != TCL_OK) {
	Tcl_DString ds;
	struct passwd *pwPtr = NULL;
	const char *string;
	size_t length;

	string = Tcl_GetStringFromObj(attributePtr, &length);

	native = Tcl_UtfToExternalDString(NULL, string, length, &ds);
	pwPtr = TclpGetPwNam(native);			/* INTL: Native. */
	Tcl_DStringFree(&ds);








|







1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
    int result;
    const char *native;

    if (Tcl_GetWideIntFromObj(NULL, attributePtr, &uid) != TCL_OK) {
	Tcl_DString ds;
	struct passwd *pwPtr = NULL;
	const char *string;
	Tcl_Size length;

	string = Tcl_GetStringFromObj(attributePtr, &length);

	native = Tcl_UtfToExternalDString(NULL, string, length, &ds);
	pwPtr = TclpGetPwNam(native);			/* INTL: Native. */
	Tcl_DStringFree(&ds);

1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
    if ((modeStringPtr[scanned] == '0')
	    && (modeStringPtr[scanned+1] >= '0')
	    && (modeStringPtr[scanned+1] <= '7')) {
	/* Leading zero - attempt octal interpretation */
	Tcl_Obj *modeObj;

	TclNewLiteralStringObj(modeObj, "0o");
	Tcl_AppendToObj(modeObj, modeStringPtr+scanned+1, -1);
	result = Tcl_GetWideIntFromObj(NULL, modeObj, &mode);
	Tcl_DecrRefCount(modeObj);
    }
    if (result == TCL_OK
	    || Tcl_GetWideIntFromObj(NULL, attributePtr, &mode) == TCL_OK) {
	newMode = (mode_t) (mode & 0x00007FFF);
    } else {







|







1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
    if ((modeStringPtr[scanned] == '0')
	    && (modeStringPtr[scanned+1] >= '0')
	    && (modeStringPtr[scanned+1] <= '7')) {
	/* Leading zero - attempt octal interpretation */
	Tcl_Obj *modeObj;

	TclNewLiteralStringObj(modeObj, "0o");
	Tcl_AppendToObj(modeObj, modeStringPtr+scanned+1, TCL_INDEX_NONE);
	result = Tcl_GetWideIntFromObj(NULL, modeObj, &mode);
	Tcl_DecrRefCount(modeObj);
    }
    if (result == TCL_OK
	    || Tcl_GetWideIntFromObj(NULL, attributePtr, &mode) == TCL_OK) {
	newMode = (mode_t) (mode & 0x00007FFF);
    } else {
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
				 * at the end of a path part that is already
				 * normalized.  I.e. this is not the index of
				 * the byte just after the separator.  */

{
    const char *currentPathEndPosition;
    char cur;
    size_t pathLen;
    const char *path = Tcl_GetStringFromObj(pathPtr, &pathLen);
    Tcl_DString ds;
    const char *nativePath;
#ifndef NO_REALPATH
    char normPath[MAXPATHLEN];
#endif








|







1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
				 * at the end of a path part that is already
				 * normalized.  I.e. this is not the index of
				 * the byte just after the separator.  */

{
    const char *currentPathEndPosition;
    char cur;
    Tcl_Size pathLen;
    const char *path = Tcl_GetStringFromObj(pathPtr, &pathLen);
    Tcl_DString ds;
    const char *nativePath;
#ifndef NO_REALPATH
    char normPath[MAXPATHLEN];
#endif

2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
	     */

	    return 0;
	}

	nativePath = Tcl_UtfToExternalDString(NULL, path,nextCheckpoint, &ds);
	if (Realpath(nativePath, normPath) != NULL) {
	    size_t newNormLen;

	wholeStringOk:
	    newNormLen = strlen(normPath);
	    if ((newNormLen == Tcl_DStringLength(&ds))
		    && (strcmp(normPath, nativePath) == 0)) {
		/*
		 * The original path is unchanged.







|







2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
	     */

	    return 0;
	}

	nativePath = Tcl_UtfToExternalDString(NULL, path,nextCheckpoint, &ds);
	if (Realpath(nativePath, normPath) != NULL) {
	    Tcl_Size newNormLen;

	wholeStringOk:
	    newNormLen = strlen(normPath);
	    if ((newNormLen == Tcl_DStringLength(&ds))
		    && (strcmp(normPath, nativePath) == 0)) {
		/*
		 * The original path is unchanged.
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
	    }

	    /*
	     * Free the original path and replace it with the normalized path.
	     */

	    Tcl_DStringFree(&ds);
	    Tcl_ExternalToUtfDStringEx(NULL, normPath, newNormLen, TCL_ENCODING_NOCOMPLAIN, &ds);

	    if (path[nextCheckpoint] != '\0') {
		/*
		 * Append the remaining path components.
		 */

		int normLen = Tcl_DStringLength(&ds);







|







2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
	    }

	    /*
	     * Free the original path and replace it with the normalized path.
	     */

	    Tcl_DStringFree(&ds);
	    Tcl_ExternalToUtfDStringEx(NULL, NULL, normPath, newNormLen, TCL_ENCODING_PROFILE_TCL8, &ds, NULL);

	    if (path[nextCheckpoint] != '\0') {
		/*
		 * Append the remaining path components.
		 */

		int normLen = Tcl_DStringLength(&ds);
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
    Tcl_Obj *basenameObj,
    Tcl_Obj *extensionObj,
    Tcl_Obj *resultingNameObj)
{
    Tcl_DString templ, tmp;
    const char *string;
    int fd;
    size_t length;

    /*
     * We should also check against making more then TMP_MAX of these.
     */

    if (dirObj) {
	string = Tcl_GetStringFromObj(dirObj, &length);
	Tcl_UtfToExternalDStringEx(NULL, string, length, TCL_ENCODING_NOCOMPLAIN, &templ);
    } else {
	Tcl_DStringInit(&templ);
	Tcl_DStringAppend(&templ, DefaultTempDir(), TCL_INDEX_NONE); /* INTL: native */
    }

    TclDStringAppendLiteral(&templ, "/");

    if (basenameObj) {
	string = Tcl_GetStringFromObj(basenameObj, &length);
	Tcl_UtfToExternalDStringEx(NULL, string, length, TCL_ENCODING_NOCOMPLAIN, &tmp);
	TclDStringAppendDString(&templ, &tmp);
	Tcl_DStringFree(&tmp);
    } else {
	TclDStringAppendLiteral(&templ, "tcl");
    }

    TclDStringAppendLiteral(&templ, "_XXXXXX");

#ifdef HAVE_MKSTEMPS
    if (extensionObj) {
	string = Tcl_GetStringFromObj(extensionObj, &length);
	Tcl_UtfToExternalDStringEx(NULL, string, length, TCL_ENCODING_NOCOMPLAIN, &tmp);
	TclDStringAppendDString(&templ, &tmp);
	fd = mkstemps(Tcl_DStringValue(&templ), Tcl_DStringLength(&tmp));
	Tcl_DStringFree(&tmp);
    } else
#endif
    {
	fd = mkstemp(Tcl_DStringValue(&templ));
    }

    if (fd == -1) {
	Tcl_DStringFree(&templ);
	return -1;
    }

    if (resultingNameObj) {
	Tcl_ExternalToUtfDStringEx(NULL, Tcl_DStringValue(&templ),
		Tcl_DStringLength(&templ), TCL_ENCODING_NOCOMPLAIN, &tmp);
	Tcl_SetStringObj(resultingNameObj, Tcl_DStringValue(&tmp),
		Tcl_DStringLength(&tmp));
	Tcl_DStringFree(&tmp);
    } else {
	/*
	 * Try to delete the file immediately since we're not reporting the
	 * name to anyone. Note that we're *not* handling any errors from







|







|









|











|















|
|







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
    Tcl_Obj *basenameObj,
    Tcl_Obj *extensionObj,
    Tcl_Obj *resultingNameObj)
{
    Tcl_DString templ, tmp;
    const char *string;
    int fd;
    Tcl_Size length;

    /*
     * We should also check against making more then TMP_MAX of these.
     */

    if (dirObj) {
	string = Tcl_GetStringFromObj(dirObj, &length);
	Tcl_UtfToExternalDStringEx(NULL, NULL, string, length, TCL_ENCODING_PROFILE_TCL8, &templ, NULL);
    } else {
	Tcl_DStringInit(&templ);
	Tcl_DStringAppend(&templ, DefaultTempDir(), TCL_INDEX_NONE); /* INTL: native */
    }

    TclDStringAppendLiteral(&templ, "/");

    if (basenameObj) {
	string = Tcl_GetStringFromObj(basenameObj, &length);
	Tcl_UtfToExternalDStringEx(NULL, NULL, string, length, TCL_ENCODING_PROFILE_TCL8, &tmp, NULL);
	TclDStringAppendDString(&templ, &tmp);
	Tcl_DStringFree(&tmp);
    } else {
	TclDStringAppendLiteral(&templ, "tcl");
    }

    TclDStringAppendLiteral(&templ, "_XXXXXX");

#ifdef HAVE_MKSTEMPS
    if (extensionObj) {
	string = Tcl_GetStringFromObj(extensionObj, &length);
	Tcl_UtfToExternalDStringEx(NULL, NULL, string, length, TCL_ENCODING_PROFILE_TCL8, &tmp, NULL);
	TclDStringAppendDString(&templ, &tmp);
	fd = mkstemps(Tcl_DStringValue(&templ), Tcl_DStringLength(&tmp));
	Tcl_DStringFree(&tmp);
    } else
#endif
    {
	fd = mkstemp(Tcl_DStringValue(&templ));
    }

    if (fd == -1) {
	Tcl_DStringFree(&templ);
	return -1;
    }

    if (resultingNameObj) {
	Tcl_ExternalToUtfDStringEx(NULL, NULL, Tcl_DStringValue(&templ),
		Tcl_DStringLength(&templ), TCL_ENCODING_PROFILE_TCL8, &tmp, NULL);
	Tcl_SetStringObj(resultingNameObj, Tcl_DStringValue(&tmp),
		Tcl_DStringLength(&tmp));
	Tcl_DStringFree(&tmp);
    } else {
	/*
	 * Try to delete the file immediately since we're not reporting the
	 * name to anyone. Note that we're *not* handling any errors from
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
    /*
     * Build the template in writable memory from the user-supplied pieces and
     * some defaults.
     */

    if (dirObj) {
	string = TclGetString(dirObj);
	Tcl_UtfToExternalDStringEx(NULL, string, dirObj->length, TCL_ENCODING_NOCOMPLAIN, &templ);
    } else {
	Tcl_DStringInit(&templ);
	Tcl_DStringAppend(&templ, DefaultTempDir(), TCL_INDEX_NONE); /* INTL: native */
    }

    if (Tcl_DStringValue(&templ)[Tcl_DStringLength(&templ) - 1] != '/') {
	TclDStringAppendLiteral(&templ, "/");
    }

    if (basenameObj) {
	string = TclGetString(basenameObj);
	if (basenameObj->length) {
	    Tcl_UtfToExternalDStringEx(NULL, string, basenameObj->length, TCL_ENCODING_NOCOMPLAIN, &tmp);
	    TclDStringAppendDString(&templ, &tmp);
	    Tcl_DStringFree(&tmp);
	} else {
	    TclDStringAppendLiteral(&templ, DEFAULT_TEMP_DIR_PREFIX);
	}
    } else {
	TclDStringAppendLiteral(&templ, DEFAULT_TEMP_DIR_PREFIX);







|












|







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
    /*
     * Build the template in writable memory from the user-supplied pieces and
     * some defaults.
     */

    if (dirObj) {
	string = TclGetString(dirObj);
	Tcl_UtfToExternalDStringEx(NULL, NULL, string, dirObj->length, TCL_ENCODING_PROFILE_TCL8, &templ, NULL);
    } else {
	Tcl_DStringInit(&templ);
	Tcl_DStringAppend(&templ, DefaultTempDir(), TCL_INDEX_NONE); /* INTL: native */
    }

    if (Tcl_DStringValue(&templ)[Tcl_DStringLength(&templ) - 1] != '/') {
	TclDStringAppendLiteral(&templ, "/");
    }

    if (basenameObj) {
	string = TclGetString(basenameObj);
	if (basenameObj->length) {
	    Tcl_UtfToExternalDStringEx(NULL, NULL, string, basenameObj->length, TCL_ENCODING_PROFILE_TCL8, &tmp, NULL);
	    TclDStringAppendDString(&templ, &tmp);
	    Tcl_DStringFree(&tmp);
	} else {
	    TclDStringAppendLiteral(&templ, DEFAULT_TEMP_DIR_PREFIX);
	}
    } else {
	TclDStringAppendLiteral(&templ, DEFAULT_TEMP_DIR_PREFIX);
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
	return NULL;
    }

    /*
     * The template has been updated. Tell the caller what it was.
     */

    Tcl_ExternalToUtfDStringEx(NULL, Tcl_DStringValue(&templ),
	    Tcl_DStringLength(&templ), TCL_ENCODING_NOCOMPLAIN, &tmp);
    Tcl_DStringFree(&templ);
    return TclDStringToObj(&tmp);
}

#if defined(__CYGWIN__)

static void
StatError(
    Tcl_Interp *interp,		/* The interp that has the error */







|
|

|







2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
	return NULL;
    }

    /*
     * The template has been updated. Tell the caller what it was.
     */

    Tcl_ExternalToUtfDStringEx(NULL, NULL, Tcl_DStringValue(&templ),
	    Tcl_DStringLength(&templ), TCL_ENCODING_PROFILE_TCL8, &tmp, NULL);
    Tcl_DStringFree(&templ);
    return Tcl_DStringToObj(&tmp);
}

#if defined(__CYGWIN__)

static void
StatError(
    Tcl_Interp *interp,		/* The interp that has the error */

Changes to unix/tclUnixFile.c.

35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67

68
69
70
71
72
73
74
 */

#ifdef __CYGWIN__
void
TclpFindExecutable(
    TCL_UNUSED(const char *) /*argv0*/)
{
    Tcl_Encoding encoding;
    size_t length;
    wchar_t buf[PATH_MAX] = L"";
    char name[PATH_MAX * 3 + 1];

    GetModuleFileNameW(NULL, buf, PATH_MAX);
    cygwin_conv_path(3, buf, name, sizeof(name));
    length = strlen(name);
    if ((length > 4) && !strcasecmp(name + length - 4, ".exe")) {
	/* Strip '.exe' part. */
	length -= 4;
    }
    encoding = Tcl_GetEncoding(NULL, NULL);
    TclSetObjNameOfExecutable(
	    Tcl_NewStringObj(name, length), encoding);
}
#else
void
TclpFindExecutable(
    const char *argv0)		/* The value of the application's argv[0]
				 * (native). */
{
    Tcl_Encoding encoding;
    const char *name, *p;
    Tcl_StatBuf statBuf;
    Tcl_DString buffer, nameString, cwd, utfName;


    if (argv0 == NULL) {
	return;
    }
    Tcl_DStringInit(&buffer);

    name = argv0;







<











<

|











>







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

#ifdef __CYGWIN__
void
TclpFindExecutable(
    TCL_UNUSED(const char *) /*argv0*/)
{

    size_t length;
    wchar_t buf[PATH_MAX] = L"";
    char name[PATH_MAX * 3 + 1];

    GetModuleFileNameW(NULL, buf, PATH_MAX);
    cygwin_conv_path(3, buf, name, sizeof(name));
    length = strlen(name);
    if ((length > 4) && !strcasecmp(name + length - 4, ".exe")) {
	/* Strip '.exe' part. */
	length -= 4;
    }

    TclSetObjNameOfExecutable(
	    Tcl_NewStringObj(name, length), NULL);
}
#else
void
TclpFindExecutable(
    const char *argv0)		/* The value of the application's argv[0]
				 * (native). */
{
    Tcl_Encoding encoding;
    const char *name, *p;
    Tcl_StatBuf statBuf;
    Tcl_DString buffer, nameString, cwd, utfName;
    Tcl_Obj *obj;

    if (argv0 == NULL) {
	return;
    }
    Tcl_DStringInit(&buffer);

    name = argv0;
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
	    break;
	} else if (*(p+1) == 0) {
	    p = "./";
	} else {
	    p++;
	}
    }

    TclSetObjNameOfExecutable(Tcl_NewObj(), NULL);
    goto done;

    /*
     * If the name starts with "/" then just store it
     */

  gotName:
#ifdef DJGPP
    if (name[1] == ':')
#else
    if (name[0] == '/')
#endif
    {
	encoding = Tcl_GetEncoding(NULL, NULL);
	Tcl_ExternalToUtfDStringEx(encoding, name, TCL_INDEX_NONE, TCL_ENCODING_NOCOMPLAIN, &utfName);
	TclSetObjNameOfExecutable(
		Tcl_NewStringObj(Tcl_DStringValue(&utfName), TCL_INDEX_NONE), encoding);
	Tcl_DStringFree(&utfName);
	goto done;
    }

    if (TclpGetCwd(NULL, &cwd) == NULL) {

	TclSetObjNameOfExecutable(Tcl_NewObj(), NULL);
	goto done;
    }

    /*
     * The name is relative to the current working directory. First strip off
     * a leading "./", if any, then add the full path name of the current
     * working directory.
     */

    if ((name[0] == '.') && (name[1] == '/')) {
	name += 2;
    }

    Tcl_DStringInit(&nameString);
    Tcl_DStringAppend(&nameString, name, TCL_INDEX_NONE);

    Tcl_DStringFree(&buffer);
    Tcl_UtfToExternalDStringEx(NULL, Tcl_DStringValue(&cwd),
	    Tcl_DStringLength(&cwd), TCL_ENCODING_NOCOMPLAIN, &buffer);
    if (Tcl_DStringValue(&cwd)[Tcl_DStringLength(&cwd) -1] != '/') {
	TclDStringAppendLiteral(&buffer, "/");
    }
    Tcl_DStringFree(&cwd);
    TclDStringAppendDString(&buffer, &nameString);
    Tcl_DStringFree(&nameString);

    encoding = Tcl_GetEncoding(NULL, NULL);
    Tcl_ExternalToUtfDStringEx(encoding, Tcl_DStringValue(&buffer), TCL_INDEX_NONE,
	    TCL_ENCODING_NOCOMPLAIN, &utfName);
    TclSetObjNameOfExecutable(
	    Tcl_NewStringObj(Tcl_DStringValue(&utfName), TCL_INDEX_NONE), encoding);
    Tcl_DStringFree(&utfName);

  done:
    Tcl_DStringFree(&buffer);
}







>
|














|







>
|

















|
|








|
|







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
	    break;
	} else if (*(p+1) == 0) {
	    p = "./";
	} else {
	    p++;
	}
    }
    TclNewObj(obj);
    TclSetObjNameOfExecutable(obj, NULL);
    goto done;

    /*
     * If the name starts with "/" then just store it
     */

  gotName:
#ifdef DJGPP
    if (name[1] == ':')
#else
    if (name[0] == '/')
#endif
    {
	encoding = Tcl_GetEncoding(NULL, NULL);
	Tcl_ExternalToUtfDStringEx(NULL, encoding, name, TCL_INDEX_NONE, TCL_ENCODING_PROFILE_TCL8, &utfName, NULL);
	TclSetObjNameOfExecutable(
		Tcl_NewStringObj(Tcl_DStringValue(&utfName), TCL_INDEX_NONE), encoding);
	Tcl_DStringFree(&utfName);
	goto done;
    }

    if (TclpGetCwd(NULL, &cwd) == NULL) {
	TclNewObj(obj);
	TclSetObjNameOfExecutable(obj, NULL);
	goto done;
    }

    /*
     * The name is relative to the current working directory. First strip off
     * a leading "./", if any, then add the full path name of the current
     * working directory.
     */

    if ((name[0] == '.') && (name[1] == '/')) {
	name += 2;
    }

    Tcl_DStringInit(&nameString);
    Tcl_DStringAppend(&nameString, name, TCL_INDEX_NONE);

    Tcl_DStringFree(&buffer);
    Tcl_UtfToExternalDStringEx(NULL, NULL, Tcl_DStringValue(&cwd),
	    Tcl_DStringLength(&cwd), TCL_ENCODING_PROFILE_TCL8, &buffer, NULL);
    if (Tcl_DStringValue(&cwd)[Tcl_DStringLength(&cwd) -1] != '/') {
	TclDStringAppendLiteral(&buffer, "/");
    }
    Tcl_DStringFree(&cwd);
    TclDStringAppendDString(&buffer, &nameString);
    Tcl_DStringFree(&nameString);

    encoding = Tcl_GetEncoding(NULL, NULL);
    Tcl_ExternalToUtfDStringEx(NULL, encoding, Tcl_DStringValue(&buffer), TCL_INDEX_NONE,
	    TCL_ENCODING_PROFILE_TCL8, &utfName, NULL);
    TclSetObjNameOfExecutable(
	    Tcl_NewStringObj(Tcl_DStringValue(&utfName), TCL_INDEX_NONE), encoding);
    Tcl_DStringFree(&utfName);

  done:
    Tcl_DStringFree(&buffer);
}
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
 *	This function replaces the library version of getcwd().
 *
 * Results:
 *	The input and output are filesystem paths in native form. The result
 *	is either the given clientData, if the working directory hasn't
 *	changed, or a new clientData (owned by our caller), giving the new
 *	native path, or NULL if the current directory could not be determined.
 *	If NULL is returned, the caller can examine the standard posix error
 *	codes to determine the cause of the problem.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

ClientData
TclpGetNativeCwd(
    ClientData clientData)
{
    char buffer[MAXPATHLEN+1];

#ifdef USEGETWD
    if (getwd(buffer) == NULL) {			/* INTL: Native. */
	return NULL;
    }







|








|

|







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
 *	This function replaces the library version of getcwd().
 *
 * Results:
 *	The input and output are filesystem paths in native form. The result
 *	is either the given clientData, if the working directory hasn't
 *	changed, or a new clientData (owned by our caller), giving the new
 *	native path, or NULL if the current directory could not be determined.
 *	If NULL is returned, the caller can examine the standard Posix error
 *	codes to determine the cause of the problem.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void *
TclpGetNativeCwd(
    void *clientData)
{
    char buffer[MAXPATHLEN+1];

#ifdef USEGETWD
    if (getwd(buffer) == NULL) {			/* INTL: Native. */
	return NULL;
    }
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
TclpReadlink(
    const char *path,		/* Path of file to readlink (UTF-8). */
    Tcl_DString *linkPtr)	/* Uninitialized or free DString filled with
				 * contents of link (UTF-8). */
{
#ifndef DJGPP
    char link[MAXPATHLEN];
    int length;
    const char *native;
    Tcl_DString ds;

    native = Tcl_UtfToExternalDString(NULL, path, TCL_INDEX_NONE, &ds);
    length = readlink(native, link, sizeof(link));	/* INTL: Native. */
    Tcl_DStringFree(&ds);

    if (length < 0) {
	return NULL;
    }

    Tcl_ExternalToUtfDStringEx(NULL, link, length, TCL_ENCODING_NOCOMPLAIN, linkPtr);
    return Tcl_DStringValue(linkPtr);
#else
    return NULL;
#endif /* !DJGPP */
}

/*







|











|







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
TclpReadlink(
    const char *path,		/* Path of file to readlink (UTF-8). */
    Tcl_DString *linkPtr)	/* Uninitialized or free DString filled with
				 * contents of link (UTF-8). */
{
#ifndef DJGPP
    char link[MAXPATHLEN];
    ssize_t length;
    const char *native;
    Tcl_DString ds;

    native = Tcl_UtfToExternalDString(NULL, path, TCL_INDEX_NONE, &ds);
    length = readlink(native, link, sizeof(link));	/* INTL: Native. */
    Tcl_DStringFree(&ds);

    if (length < 0) {
	return NULL;
    }

    Tcl_ExternalToUtfDStringEx(NULL, NULL, link, (size_t)length, TCL_ENCODING_PROFILE_TCL8, linkPtr, NULL);
    return Tcl_DStringValue(linkPtr);
#else
    return NULL;
#endif /* !DJGPP */
}

/*
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
	/*
	 * Check symbolic link flag first, since we prefer to create these.
	 */

	if (linkAction & TCL_CREATE_SYMBOLIC_LINK) {
	    Tcl_DString ds;
	    Tcl_Obj *transPtr;
	    size_t length;

	    /*
	     * Now we don't want to link to the absolute, normalized path.
	     * Relative links are quite acceptable (but links to ~user are not
	     * -- these must be expanded first).
	     */








|







945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
	/*
	 * Check symbolic link flag first, since we prefer to create these.
	 */

	if (linkAction & TCL_CREATE_SYMBOLIC_LINK) {
	    Tcl_DString ds;
	    Tcl_Obj *transPtr;
	    Tcl_Size length;

	    /*
	     * Now we don't want to link to the absolute, normalized path.
	     * Relative links are quite acceptable (but links to ~user are not
	     * -- these must be expanded first).
	     */

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
	    return NULL;
	}
	return toPtr;
    } else {
	Tcl_Obj *linkPtr = NULL;

	char link[MAXPATHLEN];
	int length;
	Tcl_DString ds;
	Tcl_Obj *transPtr;

	transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
	if (transPtr == NULL) {
	    return NULL;
	}
	Tcl_DecrRefCount(transPtr);

	length = readlink((const char *)Tcl_FSGetNativePath(pathPtr), link, sizeof(link));
	if (length < 0) {
	    return NULL;
	}

	Tcl_ExternalToUtfDStringEx(NULL, link, length, TCL_ENCODING_NOCOMPLAIN, &ds);
	linkPtr = TclDStringToObj(&ds);
	Tcl_IncrRefCount(linkPtr);
	return linkPtr;
    }
}
#endif /* S_IFLNK */

/*







|














|
|







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
	    return NULL;
	}
	return toPtr;
    } else {
	Tcl_Obj *linkPtr = NULL;

	char link[MAXPATHLEN];
	ssize_t length;
	Tcl_DString ds;
	Tcl_Obj *transPtr;

	transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
	if (transPtr == NULL) {
	    return NULL;
	}
	Tcl_DecrRefCount(transPtr);

	length = readlink((const char *)Tcl_FSGetNativePath(pathPtr), link, sizeof(link));
	if (length < 0) {
	    return NULL;
	}

	Tcl_ExternalToUtfDStringEx(NULL, NULL, link, (size_t)length, TCL_ENCODING_PROFILE_TCL8, &ds, NULL);
	linkPtr = Tcl_DStringToObj(&ds);
	Tcl_IncrRefCount(linkPtr);
	return linkPtr;
    }
}
#endif /* S_IFLNK */

/*
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
 *	None.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
TclpNativeToNormalized(
    ClientData clientData)
{
    Tcl_DString ds;

    Tcl_ExternalToUtfDStringEx(NULL, (const char *) clientData, TCL_INDEX_NONE, TCL_ENCODING_NOCOMPLAIN, &ds);
    return TclDStringToObj(&ds);
}

/*
 *---------------------------------------------------------------------------
 *
 * TclNativeCreateNativeRep --
 *
 *	Create a native representation for the given path.
 *
 * Results:
 *	The nativePath representation.
 *
 * Side effects:
 *	Memory will be allocated. The path may need to be normalized.
 *
 *---------------------------------------------------------------------------
 */

ClientData
TclNativeCreateNativeRep(
    Tcl_Obj *pathPtr)
{
    char *nativePathPtr;
    const char *str;
    Tcl_DString ds;
    Tcl_Obj *validPathPtr;
    size_t len;

    if (TclFSCwdIsNative()) {
	/*
	 * The cwd is native, which means we can use the translated path
	 * without worrying about normalization (this will also usually be
	 * shorter so the utf-to-external conversion will be somewhat faster).
	 */







|



|
|


















|







|







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

Tcl_Obj *
TclpNativeToNormalized(
    void *clientData)
{
    Tcl_DString ds;

    Tcl_ExternalToUtfDStringEx(NULL, NULL, (const char *) clientData, TCL_INDEX_NONE, TCL_ENCODING_PROFILE_TCL8, &ds, NULL);
    return Tcl_DStringToObj(&ds);
}

/*
 *---------------------------------------------------------------------------
 *
 * TclNativeCreateNativeRep --
 *
 *	Create a native representation for the given path.
 *
 * Results:
 *	The nativePath representation.
 *
 * Side effects:
 *	Memory will be allocated. The path may need to be normalized.
 *
 *---------------------------------------------------------------------------
 */

void *
TclNativeCreateNativeRep(
    Tcl_Obj *pathPtr)
{
    char *nativePathPtr;
    const char *str;
    Tcl_DString ds;
    Tcl_Obj *validPathPtr;
    Tcl_Size len;

    if (TclFSCwdIsNative()) {
	/*
	 * The cwd is native, which means we can use the translated path
	 * without worrying about normalization (this will also usually be
	 * shorter so the utf-to-external conversion will be somewhat faster).
	 */
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
	if (validPathPtr == NULL) {
	    return NULL;
	}
	Tcl_IncrRefCount(validPathPtr);
    }

    str = Tcl_GetStringFromObj(validPathPtr, &len);
    Tcl_UtfToExternalDStringEx(NULL, str, len, TCL_ENCODING_NOCOMPLAIN, &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;
    }







|







1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
	if (validPathPtr == NULL) {
	    return NULL;
	}
	Tcl_IncrRefCount(validPathPtr);
    }

    str = Tcl_GetStringFromObj(validPathPtr, &len);
    Tcl_UtfToExternalDStringEx(NULL, NULL, str, len, TCL_ENCODING_PROFILE_TCL8, &ds, NULL);
    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;
    }
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
 *
 * Side effects:
 *	Memory will be allocated for the copy.
 *
 *---------------------------------------------------------------------------
 */

ClientData
TclNativeDupInternalRep(
    ClientData clientData)
{
    char *copy;
    size_t len;

    if (clientData == NULL) {
	return NULL;
    }







|

|







1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
 *
 * Side effects:
 *	Memory will be allocated for the copy.
 *
 *---------------------------------------------------------------------------
 */

void *
TclNativeDupInternalRep(
    void *clientData)
{
    char *copy;
    size_t len;

    if (clientData == NULL) {
	return NULL;
    }

Changes to unix/tclUnixInit.c.

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

void
TclpInitLibraryPath(
    char **valuePtr,
    size_t *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
#define LIBRARY_SIZE	    32
    Tcl_Obj *pathPtr, *objPtr;
    const char *str;
    Tcl_DString buffer;

    TclNewObj(pathPtr);

    /*
     * Look for the library relative to the TCL_LIBRARY env variable. If the
     * last dirname in the TCL_LIBRARY path does not match the last dirname in
     * the installLib variable, use the last dir name of installLib in
     * addition to the orginal TCL_LIBRARY path.
     */

    str = getenv("TCL_LIBRARY");			/* INTL: Native. */
    Tcl_ExternalToUtfDStringEx(NULL, str, TCL_INDEX_NONE, TCL_ENCODING_NOCOMPLAIN, &buffer);
    str = Tcl_DStringValue(&buffer);

    if ((str != NULL) && (str[0] != '\0')) {
	Tcl_DString ds;
	size_t pathc;
	const char **pathv;
	char installLib[LIBRARY_SIZE];

	Tcl_DStringInit(&ds);

	/*
	 * Initialize the substrings used when locating an executable. The
	 * installLib variable computes the path as though the executable is
	 * installed.
	 */

	sprintf(installLib, "lib/tcl%s", TCL_VERSION);

	/*
	 * If TCL_LIBRARY is set, search there.
	 */

	Tcl_ListObjAppendElement(NULL, pathPtr, Tcl_NewStringObj(str, TCL_INDEX_NONE));

	Tcl_SplitPath(str, &pathc, &pathv);
	if ((pathc > 0) && (strcasecmp(installLib + 4, pathv[pathc-1]) != 0)) {
	    /*
	     * If TCL_LIBRARY is set but refers to a different tcl
	     * installation than the current version, try fiddling with the
	     * specified directory to make it refer to this installation by
	     * removing the old "tclX.Y" and substituting the current version
	     * string.
	     */

	    pathv[pathc - 1] = installLib + 4;
	    str = Tcl_JoinPath(pathc, pathv, &ds);
	    Tcl_ListObjAppendElement(NULL, pathPtr, TclDStringToObj(&ds));
	}
	Tcl_Free(pathv);
    }

    /*
     * Finally, look for the library relative to the compiled-in path. This is
     * needed when users install Tcl with an exec-prefix that is different







|













|



|




|











|



















|







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

void
TclpInitLibraryPath(
    char **valuePtr,
    TCL_HASH_TYPE *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
#define LIBRARY_SIZE	    32
    Tcl_Obj *pathPtr, *objPtr;
    const char *str;
    Tcl_DString buffer;

    TclNewObj(pathPtr);

    /*
     * Look for the library relative to the TCL_LIBRARY env variable. If the
     * last dirname in the TCL_LIBRARY path does not match the last dirname in
     * the installLib variable, use the last dir name of installLib in
     * addition to the original TCL_LIBRARY path.
     */

    str = getenv("TCL_LIBRARY");			/* INTL: Native. */
    Tcl_ExternalToUtfDStringEx(NULL, NULL, str, TCL_INDEX_NONE, TCL_ENCODING_PROFILE_TCL8, &buffer, NULL);
    str = Tcl_DStringValue(&buffer);

    if ((str != NULL) && (str[0] != '\0')) {
	Tcl_DString ds;
	Tcl_Size pathc;
	const char **pathv;
	char installLib[LIBRARY_SIZE];

	Tcl_DStringInit(&ds);

	/*
	 * Initialize the substrings used when locating an executable. The
	 * installLib variable computes the path as though the executable is
	 * installed.
	 */

	snprintf(installLib, sizeof(installLib), "lib/tcl%s", TCL_VERSION);

	/*
	 * If TCL_LIBRARY is set, search there.
	 */

	Tcl_ListObjAppendElement(NULL, pathPtr, Tcl_NewStringObj(str, TCL_INDEX_NONE));

	Tcl_SplitPath(str, &pathc, &pathv);
	if ((pathc > 0) && (strcasecmp(installLib + 4, pathv[pathc-1]) != 0)) {
	    /*
	     * If TCL_LIBRARY is set but refers to a different tcl
	     * installation than the current version, try fiddling with the
	     * specified directory to make it refer to this installation by
	     * removing the old "tclX.Y" and substituting the current version
	     * string.
	     */

	    pathv[pathc - 1] = installLib + 4;
	    str = Tcl_JoinPath(pathc, pathv, &ds);
	    Tcl_ListObjAppendElement(NULL, pathPtr, Tcl_DStringToObj(&ds));
	}
	Tcl_Free(pathv);
    }

    /*
     * Finally, look for the library relative to the compiled-in path. This is
     * needed when users install Tcl with an exec-prefix that is different
540
541
542
543
544
545
546







547

548
549
550
551
552
553
554
555
556
	    objPtr = Tcl_NewStringObj(str, TCL_INDEX_NONE);
	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
	}
    }
    Tcl_DStringFree(&buffer);

    *encodingPtr = Tcl_GetEncoding(NULL, NULL);







    str = Tcl_GetStringFromObj(pathPtr, lengthPtr);

    *valuePtr = (char *)Tcl_Alloc(*lengthPtr + 1);
    memcpy(*valuePtr, str, *lengthPtr + 1);
    Tcl_DecrRefCount(pathPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpSetInitialEncodings --







>
>
>
>
>
>
>
|
>
|
|







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
	    objPtr = Tcl_NewStringObj(str, TCL_INDEX_NONE);
	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
	}
    }
    Tcl_DStringFree(&buffer);

    *encodingPtr = Tcl_GetEncoding(NULL, NULL);

    /*
     * Note lengthPtr is (TCL_HASH_TYPE *) which is unsigned so cannot
     * pass directly to Tcl_GetStringFromObj.
     * TODO - why is the type TCL_HASH_TYPE anyways?
     */
    Tcl_Size length;
    str = Tcl_GetStringFromObj(pathPtr, &length);
    *lengthPtr = length;
    *valuePtr = (char *)Tcl_Alloc(length + 1);
    memcpy(*valuePtr, str, length + 1);
    Tcl_DecrRefCount(pathPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpSetInitialEncodings --
893
894
895
896
897
898
899



900
901
902
903
904
905
906
907
908
	    GetVersionExW(&osInfo);
	}
	osInfoInitialized = 1;
    }

    GetSystemInfo(&sysInfo);




    Tcl_SetVar2(interp, "tcl_platform", "os", "Windows NT", TCL_GLOBAL_ONLY);
    sprintf(buffer, "%d.%d", osInfo.dwMajorVersion, osInfo.dwMinorVersion);
    Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY);
    if (sysInfo.wProcessorArchitecture < NUMPROCESSORS) {
	Tcl_SetVar2(interp, "tcl_platform", "machine",
		processors[sysInfo.wProcessorArchitecture],
		TCL_GLOBAL_ONLY);
    }








>
>
>

|







901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
	    GetVersionExW(&osInfo);
	}
	osInfoInitialized = 1;
    }

    GetSystemInfo(&sysInfo);

    if (osInfo.dwMajorVersion == 10 && osInfo.dwBuildNumber >= 22000) {
	osInfo.dwMajorVersion = 11;
    }
    Tcl_SetVar2(interp, "tcl_platform", "os", "Windows NT", TCL_GLOBAL_ONLY);
    snprintf(buffer, sizeof(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);
    }

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

/*
 *----------------------------------------------------------------------
 *
 * TclpFindVariable --
 *
 *	Locate the entry in environ for a given name. On Unix this routine is
 *	case sensetive, on Windows this matches mixed case.
 *
 * Results:
 *	The return value is the index in environ of an entry with the name
 *	"name", or TCL_INDEX_NONE if there is no such entry. The integer at *lengthPtr is
 *	filled in with the length of name (if a matching entry is found) or
 *	the length of the environ array (if no matching entry is found).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
TclpFindVariable(
    const char *name,		/* Name of desired environment variable
				 * (native). */
    size_t *lengthPtr)		/* Used to return length of name (for
				 * successful searches) or number of non-NULL
				 * entries in environ (for unsuccessful
				 * searches). */
{
    size_t i, result = TCL_INDEX_NONE;
    const char *env, *p1, *p2;
    Tcl_DString envString;

    Tcl_DStringInit(&envString);
    for (i = 0, env = environ[i]; env != NULL; i++, env = environ[i]) {
	p1 = Tcl_ExternalToUtfDString(NULL, env, TCL_INDEX_NONE, &envString);
	p2 = name;







|



|









|



|




|







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

/*
 *----------------------------------------------------------------------
 *
 * TclpFindVariable --
 *
 *	Locate the entry in environ for a given name. On Unix this routine is
 *	case sensitive, on Windows this matches mixed case.
 *
 * Results:
 *	The return value is the index in environ of an entry with the name
 *	"name", or -1 if there is no such entry. The integer at *lengthPtr is
 *	filled in with the length of name (if a matching entry is found) or
 *	the length of the environ array (if no matching entry is found).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Size
TclpFindVariable(
    const char *name,		/* Name of desired environment variable
				 * (native). */
    Tcl_Size *lengthPtr)	/* Used to return length of name (for
				 * successful searches) or number of non-NULL
				 * entries in environ (for unsuccessful
				 * searches). */
{
    Tcl_Size i, result = -1;
    const char *env, *p1, *p2;
    Tcl_DString envString;

    Tcl_DStringInit(&envString);
    for (i = 0, env = environ[i]; env != NULL; i++, env = environ[i]) {
	p1 = Tcl_ExternalToUtfDString(NULL, env, TCL_INDEX_NONE, &envString);
	p2 = name;

Changes to unix/tclUnixNotfy.c.

23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
static int		FileHandlerEventProc(Tcl_Event *evPtr, int flags);
#if !TCL_THREADS
# undef NOTIFIER_EPOLL
# undef NOTIFIER_KQUEUE
# define NOTIFIER_SELECT
#elif !defined(NOTIFIER_EPOLL) && !defined(NOTIFIER_KQUEUE)
# define NOTIFIER_SELECT
static TCL_NORETURN void NotifierThreadProc(ClientData clientData);
# if defined(HAVE_PTHREAD_ATFORK)
static void		AtForkChild(void);
# endif /* HAVE_PTHREAD_ATFORK */

/*
 *----------------------------------------------------------------------
 *







|







23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
static int		FileHandlerEventProc(Tcl_Event *evPtr, int flags);
#if !TCL_THREADS
# undef NOTIFIER_EPOLL
# undef NOTIFIER_KQUEUE
# define NOTIFIER_SELECT
#elif !defined(NOTIFIER_EPOLL) && !defined(NOTIFIER_KQUEUE)
# define NOTIFIER_SELECT
static TCL_NORETURN void NotifierThreadProc(void *clientData);
# if defined(HAVE_PTHREAD_ATFORK)
static void		AtForkChild(void);
# endif /* HAVE_PTHREAD_ATFORK */

/*
 *----------------------------------------------------------------------
 *
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
	     * threads, which are invalid here, so setting it to NULL is not
	     * unreasonable.
	     */
	    waitingListPtr = NULL;

	    /*
	     * The tsdPtr from before the fork is copied as well. But since we
	     * are paranoic, we don't trust its condvar and reset it.
	     */
#ifdef __CYGWIN__
	    DestroyWindow(tsdPtr->hwnd);
	    tsdPtr->hwnd = CreateWindowExW(NULL, className,
		    className, 0, 0, 0, 0, 0, NULL, NULL,
		    TclWinGetTclInstance(), NULL);
	    ResetEvent(tsdPtr->event);







|







435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
	     * threads, which are invalid here, so setting it to NULL is not
	     * unreasonable.
	     */
	    waitingListPtr = NULL;

	    /*
	     * The tsdPtr from before the fork is copied as well. But since we
	     * are paranoiac, we don't trust its condvar and reset it.
	     */
#ifdef __CYGWIN__
	    DestroyWindow(tsdPtr->hwnd);
	    tsdPtr->hwnd = CreateWindowExW(NULL, className,
		    className, 0, 0, 0, 0, 0, NULL, NULL,
		    TclWinGetTclInstance(), NULL);
	    ResetEvent(tsdPtr->event);
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

ClientData
TclpNotifierData(void)
{
#if defined(NOTIFIER_EPOLL) || defined(NOTIFIER_KQUEUE)
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    return (ClientData) tsdPtr;
#else
    return NULL;
#endif
}

/*
 *----------------------------------------------------------------------







|





|







493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void *
TclpNotifierData(void)
{
#if defined(NOTIFIER_EPOLL) || defined(NOTIFIER_KQUEUE)
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    return (void *) tsdPtr;
#else
    return NULL;
#endif
}

/*
 *----------------------------------------------------------------------

Changes to unix/tclUnixPipe.c.

389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
				 * converted. */
    TclFile inputFile,		/* If non-NULL, gives the file to use as input
				 * for the child process. If inputFile file is
				 * not readable or is NULL, the child will
				 * receive no standard input. */
    TclFile outputFile,		/* If non-NULL, gives the file that receives
				 * output from the child process. If
				 * outputFile file is not writeable or is
				 * NULL, output from the child will be
				 * discarded. */
    TclFile errorFile,		/* If non-NULL, gives the file that receives
				 * errors from the child process. If errorFile
				 * file is not writeable or is NULL, errors
				 * from the child will be discarded. errorFile
				 * may be the same as outputFile. */
    Tcl_Pid *pidPtr)		/* If this function is successful, pidPtr is
				 * filled with the process id of the child
				 * process. */
{
    TclFile errPipeIn, errPipeOut;







|




|







389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
				 * converted. */
    TclFile inputFile,		/* If non-NULL, gives the file to use as input
				 * for the child process. If inputFile file is
				 * not readable or is NULL, the child will
				 * receive no standard input. */
    TclFile outputFile,		/* If non-NULL, gives the file that receives
				 * output from the child process. If
				 * outputFile file is not writable or is
				 * NULL, output from the child will be
				 * discarded. */
    TclFile errorFile,		/* If non-NULL, gives the file that receives
				 * errors from the child process. If errorFile
				 * file is not writable or is NULL, errors
				 * from the child will be discarded. errorFile
				 * may be the same as outputFile. */
    Tcl_Pid *pidPtr)		/* If this function is successful, pidPtr is
				 * filled with the process id of the child
				 * process. */
{
    TclFile errPipeIn, errPipeOut;
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
	 */

	if (!SetupStdFile(inputFile, TCL_STDIN)
		|| !SetupStdFile(outputFile, TCL_STDOUT)
		|| (!joinThisError && !SetupStdFile(errorFile, TCL_STDERR))
		|| (joinThisError &&
			((dup2(1,2) == -1) || (fcntl(2, F_SETFD, 0) != 0)))) {
	    sprintf(errSpace,
		    "%dforked process couldn't set up input/output", errno);
	    len = strlen(errSpace);
	    if (len != (size_t) write(fd, errSpace, len)) {
		    Tcl_Panic("TclpCreateProcess: unable to write to errPipeOut");
	    }
	    _exit(1);
	}

	/*
	 * Close the input side of the error pipe.
	 */

	RestoreSignals();
	execvp(newArgv[0], newArgv);			/* INTL: Native. */
	sprintf(errSpace, "%dcouldn't execute \"%.150s\"", errno, argv[0]);
	len = strlen(errSpace);
	if (len != (size_t) write(fd, errSpace, len)) {
	    Tcl_Panic("TclpCreateProcess: unable to write to errPipeOut");
	}
	_exit(1);
    }








|














|







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

	if (!SetupStdFile(inputFile, TCL_STDIN)
		|| !SetupStdFile(outputFile, TCL_STDOUT)
		|| (!joinThisError && !SetupStdFile(errorFile, TCL_STDERR))
		|| (joinThisError &&
			((dup2(1,2) == -1) || (fcntl(2, F_SETFD, 0) != 0)))) {
	    snprintf(errSpace, sizeof(errSpace),
		    "%dforked process couldn't set up input/output", errno);
	    len = strlen(errSpace);
	    if (len != (size_t) write(fd, errSpace, len)) {
		    Tcl_Panic("TclpCreateProcess: unable to write to errPipeOut");
	    }
	    _exit(1);
	}

	/*
	 * Close the input side of the error pipe.
	 */

	RestoreSignals();
	execvp(newArgv[0], newArgv);			/* INTL: Native. */
	snprintf(errSpace, sizeof(errSpace), "%dcouldn't execute \"%.150s\"", errno, argv[0]);
	len = strlen(errSpace);
	if (len != (size_t) write(fd, errSpace, len)) {
	    Tcl_Panic("TclpCreateProcess: unable to write to errPipeOut");
	}
	_exit(1);
    }

545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
	/*
	 * Reap the child process now if an error occurred during its startup.
	 * We don't call this with WNOHANG because that can lead to defunct
	 * processes on an MP system. We shouldn't have to worry about hanging
	 * here, since this is the error case. [Bug: 6148]
	 */

	Tcl_WaitPid((Tcl_Pid) INT2PTR(pid), &status, 0);
    }

    if (errPipeIn) {
	TclpCloseFile(errPipeIn);
    }
    if (errPipeOut) {
	TclpCloseFile(errPipeOut);







|







545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
	/*
	 * Reap the child process now if an error occurred during its startup.
	 * We don't call this with WNOHANG because that can lead to defunct
	 * processes on an MP system. We shouldn't have to worry about hanging
	 * here, since this is the error case. [Bug: 6148]
	 */

	Tcl_WaitPid((Tcl_Pid)INT2PTR(pid), &status, 0);
    }

    if (errPipeIn) {
	TclpCloseFile(errPipeIn);
    }
    if (errPipeOut) {
	TclpCloseFile(errPipeOut);
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793

    /*
     * For backward compatibility with previous versions of Tcl, we use
     * "file%d" as the base name for pipes even though it would be more
     * natural to use "pipe%d".
     */

    sprintf(channelName, "file%d", channelId);
    statePtr->channel = Tcl_CreateChannel(&pipeChannelType, channelName,
	    statePtr, mode);
    return statePtr->channel;
}

/*
 *----------------------------------------------------------------------







|







779
780
781
782
783
784
785
786
787
788
789
790
791
792
793

    /*
     * For backward compatibility with previous versions of Tcl, we use
     * "file%d" as the base name for pipes even though it would be more
     * natural to use "pipe%d".
     */

    snprintf(channelName, sizeof(channelName), "file%d", channelId);
    statePtr->channel = Tcl_CreateChannel(&pipeChannelType, channelName,
	    statePtr, mode);
    return statePtr->channel;
}

/*
 *----------------------------------------------------------------------

Changes to unix/tclUnixPort.h.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
/*
 * tclUnixPort.h --
 *
 *	This header file handles porting issues that occur because of
 *	differences between systems. It reads in UNIX-related header files and
 *	sets up UNIX-related macros for Tcl's UNIX core. It should be the only
 *	file that contains #ifdefs to handle different flavors of UNIX. This
 *	file sets up the union of all UNIX-related things needed by any of the
 *	Tcl core files. This file depends on configuration #defines such as
 *	NO_DIRENT_H that are set up by the "configure" script.
 *
 *	Much of the material in this file was originally contributed by Karl
 *	Lehenbauer, Mark Diekhans and Peter da Silva.
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *









|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
/*
 * tclUnixPort.h --
 *
 *	This header file handles porting issues that occur because of
 *	differences between systems. It reads in UNIX-related header files and
 *	sets up UNIX-related macros for Tcl's UNIX core. It should be the only
 *	file that contains #ifdefs to handle different flavors of UNIX. This
 *	file sets up the union of all UNIX-related things needed by any of the
 *	Tcl core files. This file depends on configuration #defines such as
 *	HAVE_SYS_PARAM_H that are set up by the "configure" script.
 *
 *	Much of the material in this file was originally contributed by Karl
 *	Lehenbauer, Mark Diekhans and Peter da Silva.
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
#endif
#include <pwd.h>
#include <signal.h>
#ifdef HAVE_SYS_PARAM_H
#   include <sys/param.h>
#endif
#include <sys/types.h>
#ifdef USE_DIRENT2_H
#   include "../compat/dirent2.h"
#else
#ifdef NO_DIRENT_H
#   include "../compat/dirent.h"
#else
#   include <dirent.h>
#endif
#endif

/*
 *---------------------------------------------------------------------------
 * Parameterize for 64-bit filesystem support.
 *---------------------------------------------------------------------------
 */








<
<
<
<
<
<
|
<
<







36
37
38
39
40
41
42






43


44
45
46
47
48
49
50
#endif
#include <pwd.h>
#include <signal.h>
#ifdef HAVE_SYS_PARAM_H
#   include <sys/param.h>
#endif
#include <sys/types.h>






#include <dirent.h>



/*
 *---------------------------------------------------------------------------
 * Parameterize for 64-bit filesystem support.
 *---------------------------------------------------------------------------
 */

151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
#ifndef NO_SYS_WAIT_H
#   include <sys/wait.h>
#endif
#ifdef HAVE_INTTYPES_H
#   include <inttypes.h>
#endif
#include <limits.h>
#ifdef HAVE_STDINT_H
#   include <stdint.h>
#else
#   include "../compat/stdint.h"
#endif
#include <unistd.h>

MODULE_SCOPE int TclUnixSetBlockingMode(int fd, int mode);

#include <utime.h>

/*







<
<
<
<
<







143
144
145
146
147
148
149





150
151
152
153
154
155
156
#ifndef NO_SYS_WAIT_H
#   include <sys/wait.h>
#endif
#ifdef HAVE_INTTYPES_H
#   include <inttypes.h>
#endif
#include <limits.h>





#include <unistd.h>

MODULE_SCOPE int TclUnixSetBlockingMode(int fd, int mode);

#include <utime.h>

/*
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
#   define NFDBITS	NBBY*sizeof(fd_mask)
#endif /* NFDBITS */

#define MASK_SIZE	howmany(FD_SETSIZE, NFDBITS)

/*
 *---------------------------------------------------------------------------
 * Not all systems declare the errno variable in errno.h. so this file does it
 * explicitly. The list of system error messages also isn't generally declared
 * in a header file anywhere.
 *---------------------------------------------------------------------------
 */

#ifdef NO_ERRNO
extern int errno;







|







484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
#   define NFDBITS	NBBY*sizeof(fd_mask)
#endif /* NFDBITS */

#define MASK_SIZE	howmany(FD_SETSIZE, NFDBITS)

/*
 *---------------------------------------------------------------------------
 * Not all systems declare the errno variable in errno.h, so this file does it
 * explicitly. The list of system error messages also isn't generally declared
 * in a header file anywhere.
 *---------------------------------------------------------------------------
 */

#ifdef NO_ERRNO
extern int errno;

Changes to unix/tclUnixSock.c.

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
    struct sockaddr sa;
    struct sockaddr_in sa4;
    struct sockaddr_in6 sa6;
    struct sockaddr_storage sas;
} address;

/*
 * This structure describes per-instance state of a tcp based channel.
 */

typedef struct TcpState TcpState;

typedef struct TcpFdList {
    TcpState *statePtr;
    int fd;
    struct TcpFdList *next;
} TcpFdList;

struct TcpState {
    Tcl_Channel channel;	/* Channel associated with this file. */
    int flags;			/* ORed combination of the bitfields defined
				 * below. */
    TcpFdList fds;		/* The file descriptors of the sockets. */
    int interest;		/* Event types of interest */

    /*
     * Only needed for server sockets
     */







|












|







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
    struct sockaddr sa;
    struct sockaddr_in sa4;
    struct sockaddr_in6 sa6;
    struct sockaddr_storage sas;
} address;

/*
 * This structure describes per-instance state of a tcp-based channel.
 */

typedef struct TcpState TcpState;

typedef struct TcpFdList {
    TcpState *statePtr;
    int fd;
    struct TcpFdList *next;
} TcpFdList;

struct TcpState {
    Tcl_Channel channel;	/* Channel associated with this file. */
    int flags;			/* OR'ed combination of the bitfields defined
				 * below. */
    TcpFdList fds;		/* The file descriptors of the sockets. */
    int interest;		/* Event types of interest */

    /*
     * Only needed for server sockets
     */
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
    int filehandlers;           /* Caches FileHandlers that get set up while
                                 * an async socket is not yet connected. */
    int connectError;           /* Cache SO_ERROR of async socket. */
    int cachedBlocking;         /* Cache blocking mode of async socket. */
};

/*
 * These bits may be ORed together into the "flags" field of a TcpState
 * structure.
 */

#define TCP_NONBLOCKING		(1<<0)	/* Socket with non-blocking I/O */
#define TCP_ASYNC_CONNECT	(1<<1)	/* Async connect in progress. */
#define TCP_ASYNC_PENDING	(1<<4)	/* TcpConnect was called to
					 * process an async connect. This







|







78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
    int filehandlers;           /* Caches FileHandlers that get set up while
                                 * an async socket is not yet connected. */
    int connectError;           /* Cache SO_ERROR of async socket. */
    int cachedBlocking;         /* Cache blocking mode of async socket. */
};

/*
 * These bits may be OR'ed together into the "flags" field of a TcpState
 * structure.
 */

#define TCP_NONBLOCKING		(1<<0)	/* Socket with non-blocking I/O */
#define TCP_ASYNC_CONNECT	(1<<1)	/* Async connect in progress. */
#define TCP_ASYNC_PENDING	(1<<4)	/* TcpConnect was called to
					 * process an async connect. This
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
    Tcl_Obj *tclObj = TclGetProcessGlobalValue(&hostName);
    return TclGetString(tclObj);
}

/*
 * ----------------------------------------------------------------------
 *
 * TclpHasSockets --
 *
 *	Detect if sockets are available on this platform.
 *
 * Results:
 *	Returns TCL_OK.
 *
 * Side effects:
 *	None.
 *
 * ----------------------------------------------------------------------
 */

int
TclpHasSockets(
    TCL_UNUSED(Tcl_Interp *))
{
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclpFinalizeSockets --
 *
 *	Performs per-thread socket subsystem finalization.
 *
 * Results:
 *	None.
 *







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







315
316
317
318
319
320
321























322
323
324
325
326
327
328
    Tcl_Obj *tclObj = TclGetProcessGlobalValue(&hostName);
    return TclGetString(tclObj);
}

/*
 * ----------------------------------------------------------------------
 *























 * TclpFinalizeSockets --
 *
 *	Performs per-thread socket subsystem finalization.
 *
 * Results:
 *	None.
 *
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
/*
 * ----------------------------------------------------------------------
 *
 * WaitForConnect --
 *
 *	Check the state of an async connect process. If a connection attempt
 *	terminated, process it, which may finalize it or may start the next
 *	attempt. If a connect error occures, it is saved in
 *	statePtr->connectError to be reported by 'fconfigure -error'.
 *
 *	There are two modes of operation, defined by errorCodePtr:
 *	 *  non-NULL: Called by explicite read/write command. Blocks if the
 *	    socket is blocking.
 *	    May return two error codes:
 *	     *	EWOULDBLOCK: if connect is still in progress
 *	     *	ENOTCONN: if connect failed. This would be the error message
 *		of a rect or sendto syscall so this is emulated here.
 *	 *  NULL: Called by a backround operation. Do not block and do not
 *	    return any error code.
 *
 * Results:
 * 	0 if the connection has completed, -1 if still in progress or there is
 * 	an error.
 *
 * Side effects:







|



|




|
|







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
/*
 * ----------------------------------------------------------------------
 *
 * WaitForConnect --
 *
 *	Check the state of an async connect process. If a connection attempt
 *	terminated, process it, which may finalize it or may start the next
 *	attempt. If a connect error occurs, it is saved in
 *	statePtr->connectError to be reported by 'fconfigure -error'.
 *
 *	There are two modes of operation, defined by errorCodePtr:
 *	 *  non-NULL: Called by explicit read/write command. Blocks if the
 *	    socket is blocking.
 *	    May return two error codes:
 *	     *	EWOULDBLOCK: if connect is still in progress
 *	     *	ENOTCONN: if connect failed. This would be the error message
 *		of a recv or sendto syscall so this is emulated here.
 *	 *  NULL: Called by a background operation. Do not block and do not
 *	    return any error code.
 *
 * Results:
 * 	0 if the connection has completed, -1 if still in progress or there is
 * 	an error.
 *
 * Side effects:
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461

    if (errorCodePtr != NULL && GOT_BITS(statePtr->flags, TCP_ASYNC_FAILED)) {
	*errorCodePtr = ENOTCONN;
	return -1;
    }

    /*
     * Check if an async connect is running. If not return ok
     */

    if (!GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) {
	return 0;
    }

    /*







|







424
425
426
427
428
429
430
431
432
433
434
435
436
437
438

    if (errorCodePtr != NULL && GOT_BITS(statePtr->flags, TCP_ASYNC_FAILED)) {
	*errorCodePtr = ENOTCONN;
	return -1;
    }

    /*
     * Check if an async connect is running. If not return ok.
     */

    if (!GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) {
	return 0;
    }

    /*
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
            }
	    return TCL_ERROR;
	}
    }

    if ((len == 0) || ((len > 1) && (optionName[1] == 'k') &&
	    (strncmp(optionName, "-keepalive", len) == 0))) {

#if defined(SO_KEEPALIVE)
	socklen_t size;
#endif
	int opt = 0;

	if (len == 0) {
	    Tcl_DStringAppendElement(dsPtr, "-keepalive");
	}
#if defined(SO_KEEPALIVE)
	getsockopt(statePtr->fds.fd, SOL_SOCKET, SO_KEEPALIVE,
		(char *) &opt, &size);
#endif
	Tcl_DStringAppendElement(dsPtr, opt ? "1" : "0");
	if (len > 0) {
	    return TCL_OK;
	}
    }

    if ((len == 0) || ((len > 1) && (optionName[1] == 'n') &&
	    (strncmp(optionName, "-nodelay", len) == 0))) {

#if defined(SOL_TCP) && defined(TCP_NODELAY)
	socklen_t size;
#endif
	int opt = 0;

	if (len == 0) {
	    Tcl_DStringAppendElement(dsPtr, "-nodelay");
	}
#if defined(SOL_TCP) && defined(TCP_NODELAY)
	getsockopt(statePtr->fds.fd, SOL_TCP, TCP_NODELAY,
		(char *) &opt, &size);







>

|

<
















>

|

<







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

    if ((len == 0) || ((len > 1) && (optionName[1] == 'k') &&
	    (strncmp(optionName, "-keepalive", len) == 0))) {
	int opt = 0;
#if defined(SO_KEEPALIVE)
	socklen_t size = sizeof(opt);
#endif


	if (len == 0) {
	    Tcl_DStringAppendElement(dsPtr, "-keepalive");
	}
#if defined(SO_KEEPALIVE)
	getsockopt(statePtr->fds.fd, SOL_SOCKET, SO_KEEPALIVE,
		(char *) &opt, &size);
#endif
	Tcl_DStringAppendElement(dsPtr, opt ? "1" : "0");
	if (len > 0) {
	    return TCL_OK;
	}
    }

    if ((len == 0) || ((len > 1) && (optionName[1] == 'n') &&
	    (strncmp(optionName, "-nodelay", len) == 0))) {
	int opt = 0;
#if defined(SOL_TCP) && defined(TCP_NODELAY)
	socklen_t size = sizeof(opt);
#endif


	if (len == 0) {
	    Tcl_DStringAppendElement(dsPtr, "-nodelay");
	}
#if defined(SOL_TCP) && defined(TCP_NODELAY)
	getsockopt(statePtr->fds.fd, SOL_TCP, TCP_NODELAY,
		(char *) &opt, &size);
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234

	/*
	 * Whether it is a bug or feature or otherwise, it is a fact of life
	 * that on at least some Linux kernels select() fails to report that a
	 * socket file descriptor is writable when the other end of the socket
	 * is closed.  This is in contrast to the guarantees Tcl makes that
	 * its channels become writable and fire writable events on an error
	 * conditon.  This has caused a leak of file descriptors in a state of
	 * background flushing.  See Tcl ticket 1758a0b603.
	 *
	 * As a workaround, when our caller indicates an interest in writable
	 * notifications, we must tell the notifier built around select() that
	 * we are interested in the readable state of the file descriptor as
	 * well, as that is the only reliable means to get notified of error
	 * conditions.  Then it is the task of WrapNotify() above to untangle







|







1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211

	/*
	 * Whether it is a bug or feature or otherwise, it is a fact of life
	 * that on at least some Linux kernels select() fails to report that a
	 * socket file descriptor is writable when the other end of the socket
	 * is closed.  This is in contrast to the guarantees Tcl makes that
	 * its channels become writable and fire writable events on an error
	 * condition.  This has caused a leak of file descriptors in a state of
	 * background flushing.  See Tcl ticket 1758a0b603.
	 *
	 * As a workaround, when our caller indicates an interest in writable
	 * notifications, we must tell the notifier built around select() that
	 * we are interested in the readable state of the file descriptor as
	 * well, as that is the only reliable means to get notified of error
	 * conditions.  Then it is the task of WrapNotify() above to untangle
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
     */

    if (TcpConnect(interp, statePtr) != TCL_OK) {
        TcpCloseProc(statePtr, NULL);
        return NULL;
    }

    sprintf(channelName, SOCK_TEMPLATE, PTR2INT(statePtr));

    statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
            statePtr, TCL_READABLE | TCL_WRITABLE);
    if (Tcl_SetChannelOption(interp, statePtr->channel, "-translation",
	    "auto crlf") == TCL_ERROR) {
	Tcl_CloseEx(NULL, statePtr->channel, 0);
	return NULL;







|







1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
     */

    if (TcpConnect(interp, statePtr) != TCL_OK) {
        TcpCloseProc(statePtr, NULL);
        return NULL;
    }

    snprintf(channelName, sizeof(channelName), SOCK_TEMPLATE, PTR2INT(statePtr));

    statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
            statePtr, TCL_READABLE | TCL_WRITABLE);
    if (Tcl_SetChannelOption(interp, statePtr->channel, "-translation",
	    "auto crlf") == TCL_ERROR) {
	Tcl_CloseEx(NULL, statePtr->channel, 0);
	return NULL;
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
 *
 *----------------------------------------------------------------------
 */

void *
TclpMakeTcpClientChannelMode(
    void *sock,		/* The socket to wrap up into a channel. */
    int mode)			/* ORed combination of TCL_READABLE and
				 * TCL_WRITABLE to indicate file mode. */
{
    TcpState *statePtr;
    char channelName[SOCK_CHAN_LENGTH];

    statePtr = (TcpState *)Tcl_Alloc(sizeof(TcpState));
    memset(statePtr, 0, sizeof(TcpState));
    statePtr->fds.fd = PTR2INT(sock);
    statePtr->flags = 0;

    sprintf(channelName, SOCK_TEMPLATE, PTR2INT(statePtr));

    statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    statePtr, mode);
    if (Tcl_SetChannelOption(NULL, statePtr->channel, "-translation",
	    "auto crlf") == TCL_ERROR) {
	Tcl_CloseEx(NULL, statePtr->channel, 0);
	return NULL;







|










|







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

void *
TclpMakeTcpClientChannelMode(
    void *sock,		/* The socket to wrap up into a channel. */
    int mode)			/* OR'ed combination of TCL_READABLE and
				 * TCL_WRITABLE to indicate file mode. */
{
    TcpState *statePtr;
    char channelName[SOCK_CHAN_LENGTH];

    statePtr = (TcpState *)Tcl_Alloc(sizeof(TcpState));
    memset(statePtr, 0, sizeof(TcpState));
    statePtr->fds.fd = PTR2INT(sock);
    statePtr->flags = 0;

    snprintf(channelName, sizeof(channelName), SOCK_TEMPLATE, PTR2INT(statePtr));

    statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    statePtr, mode);
    if (Tcl_SetChannelOption(NULL, statePtr->channel, "-translation",
	    "auto crlf") == TCL_ERROR) {
	Tcl_CloseEx(NULL, statePtr->channel, 0);
	return NULL;
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
             * Allocate a new TcpState for this socket.
             */

            statePtr = (TcpState *)Tcl_Alloc(sizeof(TcpState));
            memset(statePtr, 0, sizeof(TcpState));
            statePtr->acceptProc = acceptProc;
            statePtr->acceptProcData = acceptProcData;
            sprintf(channelName, SOCK_TEMPLATE, PTR2INT(statePtr));
            newfds = &statePtr->fds;
        } else {
            newfds = (TcpFdList *)Tcl_Alloc(sizeof(TcpFdList));
            memset(newfds, (int) 0, sizeof(TcpFdList));
            fds->next = newfds;
        }
        newfds->fd = sock;







|







1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
             * Allocate a new TcpState for this socket.
             */

            statePtr = (TcpState *)Tcl_Alloc(sizeof(TcpState));
            memset(statePtr, 0, sizeof(TcpState));
            statePtr->acceptProc = acceptProc;
            statePtr->acceptProcData = acceptProcData;
            snprintf(channelName, sizeof(channelName), SOCK_TEMPLATE, PTR2INT(statePtr));
            newfds = &statePtr->fds;
        } else {
            newfds = (TcpFdList *)Tcl_Alloc(sizeof(TcpFdList));
            memset(newfds, (int) 0, sizeof(TcpFdList));
            fds->next = newfds;
        }
        newfds->fd = sock;
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
    (void) fcntl(newsock, F_SETFD, FD_CLOEXEC);

    newSockState = (TcpState *)Tcl_Alloc(sizeof(TcpState));
    memset(newSockState, 0, sizeof(TcpState));
    newSockState->flags = 0;
    newSockState->fds.fd = newsock;

    sprintf(channelName, SOCK_TEMPLATE, PTR2INT(newSockState));
    newSockState->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    newSockState, TCL_READABLE | TCL_WRITABLE);

    Tcl_SetChannelOption(NULL, newSockState->channel, "-translation",
	    "auto crlf");

    if (fds->statePtr->acceptProc != NULL) {







|







1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
    (void) fcntl(newsock, F_SETFD, FD_CLOEXEC);

    newSockState = (TcpState *)Tcl_Alloc(sizeof(TcpState));
    memset(newSockState, 0, sizeof(TcpState));
    newSockState->flags = 0;
    newSockState->fds.fd = newsock;

    snprintf(channelName, sizeof(channelName), SOCK_TEMPLATE, PTR2INT(newSockState));
    newSockState->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    newSockState, TCL_READABLE | TCL_WRITABLE);

    Tcl_SetChannelOption(NULL, newSockState->channel, "-translation",
	    "auto crlf");

    if (fds->statePtr->acceptProc != NULL) {

Changes to unix/tclUnixTest.c.

186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
    } else if (strcmp(Tcl_GetString(objv[1]), "counts") == 0) {
	char buf[TCL_INTEGER_SPACE * 2];

	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "index");
	    return TCL_ERROR;
	}
	sprintf(buf, "%d %d", pipePtr->readCount, pipePtr->writeCount);
	Tcl_AppendResult(interp, buf, NULL);
    } else if (strcmp(Tcl_GetString(objv[1]), "create") == 0) {
	if (objc != 5) {
	    Tcl_WrongNumArgs(interp, 2, objv, "index readMode writeMode");
	    return TCL_ERROR;
	}
	if (pipePtr->readFile == NULL) {







|







186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
    } else if (strcmp(Tcl_GetString(objv[1]), "counts") == 0) {
	char buf[TCL_INTEGER_SPACE * 2];

	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "index");
	    return TCL_ERROR;
	}
	snprintf(buf, sizeof(buf), "%d %d", pipePtr->readCount, pipePtr->writeCount);
	Tcl_AppendResult(interp, buf, NULL);
    } else if (strcmp(Tcl_GetString(objv[1]), "create") == 0) {
	if (objc != 5) {
	    Tcl_WrongNumArgs(interp, 2, objv, "index readMode writeMode");
	    return TCL_ERROR;
	}
	if (pipePtr->readFile == NULL) {
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
/*
 *---------------------------------------------------------------------------
 *
 * TestchmodCmd --
 *
 *	Implements the "testchmod" cmd.  Used when testing "file" command.
 *	The only attribute used by the Windows platform is the user write
 *	flag; if this is not set, the file is made read-only.  Otehrwise, the
 *	file is made read-write.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Changes permissions of specified files.







|







590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
/*
 *---------------------------------------------------------------------------
 *
 * TestchmodCmd --
 *
 *	Implements the "testchmod" cmd.  Used when testing "file" command.
 *	The only attribute used by the Windows platform is the user write
 *	flag; if this is not set, the file is made read-only.  Otherwise, the
 *	file is made read-write.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Changes permissions of specified files.

Changes to unix/tclUnixThrd.c.

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

int
TclpThreadCreate(
    Tcl_ThreadId *idPtr,	/* Return, the ID of the thread */
    Tcl_ThreadCreateProc *proc,	/* Main() function of the thread */
    ClientData clientData,	/* The one argument to Main() */
    size_t stackSize,		/* Size of stack for the new thread */
    int flags)			/* Flags controlling behaviour of the new
				 * thread. */
{
#if TCL_THREADS
    pthread_attr_t attr;
    pthread_t theThread;
    int result;

    pthread_attr_init(&attr);
    pthread_attr_setscope(&attr, PTHREAD_SCOPE_SYSTEM);

#ifdef HAVE_PTHREAD_ATTR_SETSTACKSIZE
    if (stackSize != TCL_THREAD_STACK_DEFAULT) {
	pthread_attr_setstacksize(&attr, stackSize);
#ifdef TCL_THREAD_STACK_MIN
    } else {
	/*
	 * Certain systems define a thread stack size that by default is too
	 * small for many operations. The user has the option of defining
	 * TCL_THREAD_STACK_MIN to a value large enough to work for their
	 * needs. This would look like (for 128K min stack):
	 *    make MEM_DEBUG_FLAGS=-DTCL_THREAD_STACK_MIN=131072L
	 *
	 * This solution is not optimal, as we should allow the user to
	 * specify a size at runtime, but we don't want to slow this function
	 * down, and that would still leave the main thread at the default.
	 */

	size_t size;

	result = pthread_attr_getstacksize(&attr, &size);
	if (!result && (size < TCL_THREAD_STACK_MIN)) {
	    pthread_attr_setstacksize(&attr, (size_t) TCL_THREAD_STACK_MIN);
	}
#endif /* TCL_THREAD_STACK_MIN */
    }
#endif /* HAVE_PTHREAD_ATTR_SETSTACKSIZE */

    if (!(flags & TCL_THREAD_JOINABLE)) {
	pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_DETACHED);







|
|













|


















|







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

int
TclpThreadCreate(
    Tcl_ThreadId *idPtr,	/* Return, the ID of the thread */
    Tcl_ThreadCreateProc *proc,	/* Main() function of the thread */
    void *clientData,	/* The one argument to Main() */
    TCL_HASH_TYPE stackSize,	/* Size of stack for the new thread */
    int flags)			/* Flags controlling behaviour of the new
				 * thread. */
{
#if TCL_THREADS
    pthread_attr_t attr;
    pthread_t theThread;
    int result;

    pthread_attr_init(&attr);
    pthread_attr_setscope(&attr, PTHREAD_SCOPE_SYSTEM);

#ifdef HAVE_PTHREAD_ATTR_SETSTACKSIZE
    if (stackSize != TCL_THREAD_STACK_DEFAULT) {
	pthread_attr_setstacksize(&attr, (size_t)stackSize);
#ifdef TCL_THREAD_STACK_MIN
    } else {
	/*
	 * Certain systems define a thread stack size that by default is too
	 * small for many operations. The user has the option of defining
	 * TCL_THREAD_STACK_MIN to a value large enough to work for their
	 * needs. This would look like (for 128K min stack):
	 *    make MEM_DEBUG_FLAGS=-DTCL_THREAD_STACK_MIN=131072L
	 *
	 * This solution is not optimal, as we should allow the user to
	 * specify a size at runtime, but we don't want to slow this function
	 * down, and that would still leave the main thread at the default.
	 */

	size_t size;

	result = pthread_attr_getstacksize(&attr, &size);
	if (!result && (size < TCL_THREAD_STACK_MIN)) {
	    pthread_attr_setstacksize(&attr, (size_t)TCL_THREAD_STACK_MIN);
	}
#endif /* TCL_THREAD_STACK_MIN */
    }
#endif /* HAVE_PTHREAD_ATTR_SETSTACKSIZE */

    if (!(flags & TCL_THREAD_JOINABLE)) {
	pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_DETACHED);

Changes to unix/tclUnixTime.c.

100
101
102
103
104
105
106
107
108
109
110
111
112
113
114

/*
 *----------------------------------------------------------------------
 *
 * TclpGetClicks --
 *
 *	This procedure returns a value that represents the highest resolution
 *	clock available on the system. There are no garantees on what the
 *	resolution will be. In Tcl we will call this value a "click". The
 *	start time is also system dependent.
 *
 * Results:
 *	Number of clicks from some start time.
 *
 * Side effects:







|







100
101
102
103
104
105
106
107
108
109
110
111
112
113
114

/*
 *----------------------------------------------------------------------
 *
 * TclpGetClicks --
 *
 *	This procedure returns a value that represents the highest resolution
 *	clock available on the system. There are no guarantees on what the
 *	resolution will be. In Tcl we will call this value a "click". The
 *	start time is also system dependent.
 *
 * Results:
 *	Number of clicks from some start time.
 *
 * Side effects:

Changes to unix/tclXtNotify.c.

13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
#ifndef USE_TCL_STUBS
#   define USE_TCL_STUBS
#endif
#include <X11/Intrinsic.h>
#include "tclInt.h"

/*
 * This structure is used to keep track of the notifier info for a a
 * registered file.
 */

typedef struct FileHandler {
    int fd;
    int mask;			/* Mask of desired events: TCL_READABLE,
				 * etc. */







|







13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
#ifndef USE_TCL_STUBS
#   define USE_TCL_STUBS
#endif
#include <X11/Intrinsic.h>
#include "tclInt.h"

/*
 * This structure is used to keep track of the notifier info for a
 * registered file.
 */

typedef struct FileHandler {
    int fd;
    int mask;			/* Mask of desired events: TCL_READABLE,
				 * etc. */

Changes to win/Makefile.in.

78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
CFLAGS_OPTIMIZE	= @CFLAGS_OPTIMIZE@

# To change the compiler switches, for example to change from optimization to
# debugging symbols, change the following line:
#CFLAGS = 		$(CFLAGS_DEBUG)
#CFLAGS = 		$(CFLAGS_OPTIMIZE)
#CFLAGS = 		$(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE)
CFLAGS = 		@CFLAGS@ @CFLAGS_DEFAULT@ -DMP_FIXED_CUTOFFS -D__USE_MINGW_ANSI_STDIO=0 -DMP_NO_STDINT

# To compile without backward compatibility and deprecated code uncomment the
# following
NO_DEPRECATED_FLAGS	=
#NO_DEPRECATED_FLAGS	= -DTCL_NO_DEPRECATED

# To enable compilation debugging reverse the comment characters on one of the







|







78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
CFLAGS_OPTIMIZE	= @CFLAGS_OPTIMIZE@

# To change the compiler switches, for example to change from optimization to
# debugging symbols, change the following line:
#CFLAGS = 		$(CFLAGS_DEBUG)
#CFLAGS = 		$(CFLAGS_OPTIMIZE)
#CFLAGS = 		$(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE)
CFLAGS = 		@CFLAGS@ @CFLAGS_DEFAULT@ -DMP_FIXED_CUTOFFS -D__USE_MINGW_ANSI_STDIO=0

# To compile without backward compatibility and deprecated code uncomment the
# following
NO_DEPRECATED_FLAGS	=
#NO_DEPRECATED_FLAGS	= -DTCL_NO_DEPRECATED

# To enable compilation debugging reverse the comment characters on one of the
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
TCL_VFS_ROOT		= libtcl.vfs


TCL_STUB_LIB_FILE	= @TCL_STUB_LIB_FILE@
TCL_DLL_FILE		= @TCL_DLL_FILE@
TCL_LIB_FILE		= @TCL_LIB_FILE@
DDE_DLL_FILE		= tcl9dde$(DDEVER)${DLLSUFFIX}
DDE_DLL_FILE8		= dde$(DDEVER)${DLLSUFFIX}
DDE_LIB_FILE		= @LIBPREFIX@tcldde$(DDEVER)${DLLSUFFIX}${LIBSUFFIX}
REG_DLL_FILE		= tcl9registry$(REGVER)${DLLSUFFIX}
REG_DLL_FILE8		= registry$(REGVER)${DLLSUFFIX}
REG_LIB_FILE		= @LIBPREFIX@tclregistry$(REGVER)${DLLSUFFIX}${LIBSUFFIX}
TEST_DLL_FILE		= tcltest$(VER)${DLLSUFFIX}
TEST_EXE_FILE		= tcltest${EXESUFFIX}
TEST_LIB_FILE		= @LIBPREFIX@tcltest$(VER)${DLLSUFFIX}${LIBSUFFIX}
TEST_LOAD_PRMS		= lappend ::auto_path {$(ROOT_DIR_WIN_NATIVE)/tests};\
			  package ifneeded dde 1.4.4 [list load [file normalize ${DDE_DLL_FILE}]];\
			  package ifneeded registry 1.3.6 [list load [file normalize ${REG_DLL_FILE}]]
TEST_LOAD_FACILITIES	= package ifneeded tcl::test ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest];\
			  $(TEST_LOAD_PRMS)
ZLIB_DLL_FILE		= zlib1.dll
TOMMATH_DLL_FILE		= libtommath.dll

SHARED_LIBRARIES 	= $(TCL_DLL_FILE) @ZLIB_DLL_FILE@ @TOMMATH_DLL_FILE@
STATIC_LIBRARIES	= $(TCL_LIB_FILE)







|


|





|
|







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
TCL_VFS_ROOT		= libtcl.vfs


TCL_STUB_LIB_FILE	= @TCL_STUB_LIB_FILE@
TCL_DLL_FILE		= @TCL_DLL_FILE@
TCL_LIB_FILE		= @TCL_LIB_FILE@
DDE_DLL_FILE		= tcl9dde$(DDEVER)${DLLSUFFIX}
DDE_DLL_FILE8		= tcldde$(DDEVER)${DLLSUFFIX}
DDE_LIB_FILE		= @LIBPREFIX@tcldde$(DDEVER)${DLLSUFFIX}${LIBSUFFIX}
REG_DLL_FILE		= tcl9registry$(REGVER)${DLLSUFFIX}
REG_DLL_FILE8		= tclregistry$(REGVER)${DLLSUFFIX}
REG_LIB_FILE		= @LIBPREFIX@tclregistry$(REGVER)${DLLSUFFIX}${LIBSUFFIX}
TEST_DLL_FILE		= tcltest$(VER)${DLLSUFFIX}
TEST_EXE_FILE		= tcltest${EXESUFFIX}
TEST_LIB_FILE		= @LIBPREFIX@tcltest$(VER)${DLLSUFFIX}${LIBSUFFIX}
TEST_LOAD_PRMS		= lappend ::auto_path {$(ROOT_DIR_WIN_NATIVE)/tests};\
			  package ifneeded dde 1.4.5 [list load [file normalize ${DDE_DLL_FILE}]];\
			  package ifneeded registry 1.3.7 [list load [file normalize ${REG_DLL_FILE}]]
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)
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
STUB_CC_SWITCHES = -I"${GENERIC_DIR_NATIVE}" -I"${TOMMATH_DIR_NATIVE}" \
-I"${ZLIB_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" \
${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} -DMP_PREC=4 \
${AC_FLAGS} ${COMPILE_DEBUG_FLAGS}

TCLTEST_OBJS = \
	tclTest.$(OBJEXT) \

	tclTestObj.$(OBJEXT) \
	tclTestProcBodyObj.$(OBJEXT) \
	tclThreadTest.$(OBJEXT) \
	tclWinTest.$(OBJEXT) \
	tclTestABSList.$(OBJEXT)

GENERIC_OBJS = \
	regcomp.$(OBJEXT) \
	regexec.$(OBJEXT) \
	regfree.$(OBJEXT) \
	regerror.$(OBJEXT) \
	tclAbstractList.$(OBJEXT) \
	tclArithSeries.$(OBJEXT) \
	tclAlloc.$(OBJEXT) \
	tclAssembly.$(OBJEXT) \
	tclAsync.$(OBJEXT) \
	tclBasic.$(OBJEXT) \
	tclBinary.$(OBJEXT) \
	tclCkalloc.$(OBJEXT) \
	tclClock.$(OBJEXT) \
	tclCmdAH.$(OBJEXT) \







>



|
<






|

<







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
STUB_CC_SWITCHES = -I"${GENERIC_DIR_NATIVE}" -I"${TOMMATH_DIR_NATIVE}" \
-I"${ZLIB_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" \
${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} -DMP_PREC=4 \
${AC_FLAGS} ${COMPILE_DEBUG_FLAGS}

TCLTEST_OBJS = \
	tclTest.$(OBJEXT) \
	tclTestABSList.$(OBJEXT) \
	tclTestObj.$(OBJEXT) \
	tclTestProcBodyObj.$(OBJEXT) \
	tclThreadTest.$(OBJEXT) \
	tclWinTest.$(OBJEXT)


GENERIC_OBJS = \
	regcomp.$(OBJEXT) \
	regexec.$(OBJEXT) \
	regfree.$(OBJEXT) \
	regerror.$(OBJEXT) \
	tclAlloc.$(OBJEXT) \
	tclArithSeries.$(OBJEXT) \

	tclAssembly.$(OBJEXT) \
	tclAsync.$(OBJEXT) \
	tclBasic.$(OBJEXT) \
	tclBinary.$(OBJEXT) \
	tclCkalloc.$(OBJEXT) \
	tclClock.$(OBJEXT) \
	tclCmdAH.$(OBJEXT) \
401
402
403
404
405
406
407


408
409
410
411
412
413
414
	bn_mp_mod_2d.${OBJEXT} \
	bn_mp_mul.${OBJEXT} \
	bn_mp_mul_2.${OBJEXT} \
	bn_mp_mul_2d.${OBJEXT} \
	bn_mp_mul_d.${OBJEXT} \
	bn_mp_neg.${OBJEXT} \
	bn_mp_or.${OBJEXT} \


	bn_mp_radix_size.${OBJEXT} \
	bn_mp_radix_smap.${OBJEXT} \
	bn_mp_read_radix.${OBJEXT} \
	bn_mp_rshd.${OBJEXT} \
	bn_mp_set_i64.${OBJEXT} \
	bn_mp_set_u64.${OBJEXT} \
	bn_mp_shrink.${OBJEXT} \







>
>







400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
	bn_mp_mod_2d.${OBJEXT} \
	bn_mp_mul.${OBJEXT} \
	bn_mp_mul_2.${OBJEXT} \
	bn_mp_mul_2d.${OBJEXT} \
	bn_mp_mul_d.${OBJEXT} \
	bn_mp_neg.${OBJEXT} \
	bn_mp_or.${OBJEXT} \
	bn_mp_pack.${OBJEXT} \
	bn_mp_pack_count.${OBJEXT} \
	bn_mp_radix_size.${OBJEXT} \
	bn_mp_radix_smap.${OBJEXT} \
	bn_mp_read_radix.${OBJEXT} \
	bn_mp_rshd.${OBJEXT} \
	bn_mp_set_i64.${OBJEXT} \
	bn_mp_set_u64.${OBJEXT} \
	bn_mp_shrink.${OBJEXT} \
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
	@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

${DDE_DLL_FILE8}: ${TCL_STUB_LIB_FILE} ${DDE_OBJS}
	@MAKE_DLL@ -DTCL_MAJOR_VERSION=8 ${DDE_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
	$(COPY) tclsh.exe.manifest ${DDE_DLL_FILE8}.manifest

${REG_DLL_FILE8}: ${TCL_STUB_LIB_FILE} ${REG_OBJS}
	@MAKE_DLL@ -DTCL_MAJOR_VERSION=8 ${REG_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
	$(COPY) tclsh.exe.manifest ${REG_DLL_FILE8}.manifest

${TEST_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${TCLTEST_OBJS}
	@$(RM) ${TEST_DLL_FILE} ${TEST_LIB_FILE}
	@MAKE_DLL@ ${TCLTEST_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
	$(COPY) tclsh.exe.manifest ${TEST_DLL_FILE}.manifest

${TEST_EXE_FILE}: ${TCL_STUB_LIB_FILE} ${TCLTEST_OBJS} tclTestMain.${OBJEXT}
	@$(RM) ${TEST_EXE_FILE}
	$(CC) $(CFLAGS) $(TCLTEST_OBJS) tclTestMain.$(OBJEXT) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \
        tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
	$(COPY) tclsh.exe.manifest ${TEST_EXE_FILE}.manifest

# use pre-built zlib1.dll
${ZLIB_DLL_FILE}: ${TCL_STUB_LIB_FILE}
	@if test "@ZLIB_LIBS@set" = "${ZLIB_DIR_NATIVE}/win64-arm/zdll.libset" ; then \
		$(COPY) $(ZLIB_DIR)/win64-arm/${ZLIB_DLL_FILE} ${ZLIB_DLL_FILE}; \
	elif test "@ZLIB_LIBS@set" = "${ZLIB_DIR_NATIVE}/win64-arm/libz.dll.aset" ; then \
		$(COPY) $(ZLIB_DIR)/win64-arm/${ZLIB_DLL_FILE} ${ZLIB_DLL_FILE}; \
	elif test "@ZLIB_LIBS@set" = "${ZLIB_DIR_NATIVE}/win32/zdll.libset" ; then \
		$(COPY) $(ZLIB_DIR)/win32/${ZLIB_DLL_FILE} ${ZLIB_DLL_FILE}; \







|
|


|
|













|







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

${DDE_DLL_FILE8}: ${TCL_STUB_LIB_FILE} tcl8WinDde.$(OBJEXT)
	@MAKE_DLL@ tcl8WinDde.$(OBJEXT) $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
	$(COPY) tclsh.exe.manifest ${DDE_DLL_FILE8}.manifest

${REG_DLL_FILE8}: ${TCL_STUB_LIB_FILE} tcl8WinReg.$(OBJEXT)
	@MAKE_DLL@ -DTCL_MAJOR_VERSION=8 tcl8WinReg.$(OBJEXT) $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
	$(COPY) tclsh.exe.manifest ${REG_DLL_FILE8}.manifest

${TEST_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${TCLTEST_OBJS}
	@$(RM) ${TEST_DLL_FILE} ${TEST_LIB_FILE}
	@MAKE_DLL@ ${TCLTEST_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
	$(COPY) tclsh.exe.manifest ${TEST_DLL_FILE}.manifest

${TEST_EXE_FILE}: ${TCL_STUB_LIB_FILE} ${TCLTEST_OBJS} tclTestMain.${OBJEXT}
	@$(RM) ${TEST_EXE_FILE}
	$(CC) $(CFLAGS) $(TCLTEST_OBJS) tclTestMain.$(OBJEXT) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \
        tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
	$(COPY) tclsh.exe.manifest ${TEST_EXE_FILE}.manifest

# use prebuilt zlib1.dll
${ZLIB_DLL_FILE}: ${TCL_STUB_LIB_FILE}
	@if test "@ZLIB_LIBS@set" = "${ZLIB_DIR_NATIVE}/win64-arm/zdll.libset" ; then \
		$(COPY) $(ZLIB_DIR)/win64-arm/${ZLIB_DLL_FILE} ${ZLIB_DLL_FILE}; \
	elif test "@ZLIB_LIBS@set" = "${ZLIB_DIR_NATIVE}/win64-arm/libz.dll.aset" ; then \
		$(COPY) $(ZLIB_DIR)/win64-arm/${ZLIB_DLL_FILE} ${ZLIB_DLL_FILE}; \
	elif test "@ZLIB_LIBS@set" = "${ZLIB_DIR_NATIVE}/win32/zdll.libset" ; then \
		$(COPY) $(ZLIB_DIR)/win32/${ZLIB_DLL_FILE} ${ZLIB_DLL_FILE}; \
649
650
651
652
653
654
655



656
657
658



659
660
661
662
663
664
665

tclWinPipe.${OBJEXT}: tclWinPipe.c
	$(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)

tclWinReg.${OBJEXT}: tclWinReg.c
	$(CC) -c $(CC_SWITCHES) $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)




tclWinDde.${OBJEXT}: tclWinDde.c
	$(CC) -c $(CC_SWITCHES) $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)




tclAppInit.${OBJEXT}: tclAppInit.c
	$(CC) -c $(CC_SWITCHES) $(EXTFLAGS) -DUNICODE -D_UNICODE @DEPARG@ $(CC_OBJNAME)

tclMainW.${OBJEXT}: tclMain.c
	$(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DUNICODE -D_UNICODE @DEPARG@ $(CC_OBJNAME)

# TIP #430, ZipFS Support







>
>
>



>
>
>







650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672

tclWinPipe.${OBJEXT}: tclWinPipe.c
	$(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)

tclWinReg.${OBJEXT}: tclWinReg.c
	$(CC) -c $(CC_SWITCHES) $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)

tcl8WinReg.${OBJEXT}: tclWinReg.c
	$(CC)  -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)

tclWinDde.${OBJEXT}: tclWinDde.c
	$(CC) -c $(CC_SWITCHES) $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)

tcl8WinDde.${OBJEXT}: tclWinDde.c
	$(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)

tclAppInit.${OBJEXT}: tclAppInit.c
	$(CC) -c $(CC_SWITCHES) $(EXTFLAGS) -DUNICODE -D_UNICODE @DEPARG@ $(CC_OBJNAME)

tclMainW.${OBJEXT}: tclMain.c
	$(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DUNICODE -D_UNICODE @DEPARG@ $(CC_OBJNAME)

# TIP #430, ZipFS Support
690
691
692
693
694
695
696


697
698
699
700
701
702
703
		-DCFG_RUNTIME_INCDIR="\"$(includedir_native)\"" \
		-DCFG_RUNTIME_DOCDIR="\"$(mandir_native)\"" \
		-DCFG_RUNTIME_DLLFILE="\"$(TCL_DLL_FILE)\"" \
		-DBUILD_tcl \
		@DEPARG@ $(CC_OBJNAME)

tclEvent.${OBJEXT}: tclEvent.c tclUuid.h



$(TOP_DIR)/manifest.uuid:
	printf "git-" >$(TOP_DIR)/manifest.uuid
	(cd $(TOP_DIR); git rev-parse HEAD >>$(TOP_DIR)/manifest.uuid || \
	    (printf "svn-r" >$(TOP_DIR)/manifest.uuid ; \
	    svn info --show-item last-changed-revision >>$(TOP_DIR)/manifest.uuid) || \
	    printf "unknown" >$(TOP_DIR)/manifest.uuid)







>
>







697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
		-DCFG_RUNTIME_INCDIR="\"$(includedir_native)\"" \
		-DCFG_RUNTIME_DOCDIR="\"$(mandir_native)\"" \
		-DCFG_RUNTIME_DLLFILE="\"$(TCL_DLL_FILE)\"" \
		-DBUILD_tcl \
		@DEPARG@ $(CC_OBJNAME)

tclEvent.${OBJEXT}: tclEvent.c tclUuid.h

tclTest.${OBJEXT}: tclTest.c tclUuid.h

$(TOP_DIR)/manifest.uuid:
	printf "git-" >$(TOP_DIR)/manifest.uuid
	(cd $(TOP_DIR); git rev-parse HEAD >>$(TOP_DIR)/manifest.uuid || \
	    (printf "svn-r" >$(TOP_DIR)/manifest.uuid ; \
	    svn info --show-item last-changed-revision >>$(TOP_DIR)/manifest.uuid) || \
	    printf "unknown" >$(TOP_DIR)/manifest.uuid)
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
	    $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)"; \
	    done;
	@echo "Installing package cookiejar 0.2"
	@for j in $(ROOT_DIR)/library/cookiejar/*.tcl \
	          $(ROOT_DIR)/library/cookiejar/*.gz; do \
	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/cookiejar0.2"; \
	    done;
	@echo "Installing package http 2.10a4 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/9.0/http-2.10a4.tm";
	@echo "Installing package opt 0.4.7";
	@for j in $(ROOT_DIR)/library/opt/*.tcl; do \
	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
	    done;
	@echo "Installing package msgcat 1.7.1 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl "$(MODULE_INSTALL_DIR)/9.0/msgcat-1.7.1.tm";
	@echo "Installing package tcltest 2.5.5 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl "$(MODULE_INSTALL_DIR)/9.0/tcltest-2.5.5.tm";
	@echo "Installing package platform 1.0.19 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/platform/platform.tcl "$(MODULE_INSTALL_DIR)/9.0/platform-1.0.19.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"; \







|
|






|
|







915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
	    $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)"; \
	    done;
	@echo "Installing package cookiejar 0.2"
	@for j in $(ROOT_DIR)/library/cookiejar/*.tcl \
	          $(ROOT_DIR)/library/cookiejar/*.gz; do \
	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/cookiejar0.2"; \
	    done;
	@echo "Installing package http 2.10b1 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/9.0/http-2.10b1.tm";
	@echo "Installing package opt 0.4.7";
	@for j in $(ROOT_DIR)/library/opt/*.tcl; do \
	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
	    done;
	@echo "Installing package msgcat 1.7.1 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl "$(MODULE_INSTALL_DIR)/9.0/msgcat-1.7.1.tm";
	@echo "Installing package tcltest 2.5.6 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl "$(MODULE_INSTALL_DIR)/9.0/tcltest-2.5.6.tm";
	@echo "Installing package platform 1.0.19 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/platform/platform.tcl "$(MODULE_INSTALL_DIR)/9.0/platform-1.0.19.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"; \
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
	@TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
	$(WINE) ./$(TCLSH) $(TESTFLAGS) -load "$(TEST_LOAD_FACILITIES)" $(SCRIPT)

# This target can be used to run tclsh from the build directory via
# `make shell SCRIPT=foo.tcl`
shell: binaries
	@TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
	$(WINE) ./$(TCLSH) $(SCRIPT)

# This target can be used to run tclsh inside either gdb or insight
gdb: binaries
	@echo "set env TCL_LIBRARY=$(LIBRARY_DIR)" > gdb.run
	gdb ./$(TCLSH) --command=gdb.run
	rm gdb.run








|







1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
	@TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
	$(WINE) ./$(TCLSH) $(TESTFLAGS) -load "$(TEST_LOAD_FACILITIES)" $(SCRIPT)

# This target can be used to run tclsh from the build directory via
# `make shell SCRIPT=foo.tcl`
shell: binaries
	@TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
	$(WINE) ./$(TCLSH) -encoding utf-8 $(SCRIPT)

# This target can be used to run tclsh inside either gdb or insight
gdb: binaries
	@echo "set env TCL_LIBRARY=$(LIBRARY_DIR)" > gdb.run
	gdb ./$(TCLSH) --command=gdb.run
	rm gdb.run

Changes to win/configure.

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
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_eh_disposition" >&5
printf "%s\n" "$tcl_cv_eh_disposition" >&6; }
	if test "$tcl_cv_eh_disposition" = "no" ; then

printf "%s\n" "#define EXCEPTION_DISPOSITION int" >>confdefs.h

	fi

	# Check to see if winnt.h defines CHAR, SHORT, and LONG
	# even if VOID has already been #defined. The win32api
	# used by mingw and cygwin is known to do this.

	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for winnt.h that ignores VOID define" >&5
printf %s "checking for winnt.h that ignores VOID define... " >&6; }
if test ${tcl_cv_winnt_ignore_void+y}
then :
  printf %s "(cached) " >&6
else $as_nop
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

		#define VOID void
		#define WIN32_LEAN_AND_MEAN
		#include <windows.h>
		#undef WIN32_LEAN_AND_MEAN

int
main (void)
{

		CHAR c;
		SHORT s;
		LONG l;

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"
then :
  tcl_cv_winnt_ignore_void=yes
else $as_nop
  tcl_cv_winnt_ignore_void=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext

fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_winnt_ignore_void" >&5
printf "%s\n" "$tcl_cv_winnt_ignore_void" >&6; }
	if test "$tcl_cv_winnt_ignore_void" = "yes" ; then

printf "%s\n" "#define HAVE_WINNT_IGNORE_VOID 1" >>confdefs.h

	fi

	ac_fn_c_check_header_compile "$LINENO" "stdbool.h" "ac_cv_header_stdbool_h" "$ac_includes_default"
if test "x$ac_cv_header_stdbool_h" = xyes
then :

printf "%s\n" "#define HAVE_STDBOOL_H 1" >>confdefs.h







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







4773
4774
4775
4776
4777
4778
4779















































4780
4781
4782
4783
4784
4785
4786
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_eh_disposition" >&5
printf "%s\n" "$tcl_cv_eh_disposition" >&6; }
	if test "$tcl_cv_eh_disposition" = "no" ; then

printf "%s\n" "#define EXCEPTION_DISPOSITION int" >>confdefs.h
















































	fi

	ac_fn_c_check_header_compile "$LINENO" "stdbool.h" "ac_cv_header_stdbool_h" "$ac_includes_default"
if test "x$ac_cv_header_stdbool_h" = xyes
then :

printf "%s\n" "#define HAVE_STDBOOL_H 1" >>confdefs.h

Changes to win/makefile.vc.

106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
#		set (ie: recent Platform SDK) then MACHINE is set from CPU.
#
#	TMP_DIR=<path>
#	OUT_DIR=<path>
#		Hooks to allow the intermediate and output directories to be
#		changed.  $(OUT_DIR) is assumed to be
#		$(BINROOT)\(Release|Debug) based on if symbols are requested.
#		$(TMP_DIR) will de $(OUT_DIR)\<buildtype> by default.
#
#	TESTPAT=<file>
#		Reads the tests requested to be run from this file.
#
# Examples:
#       c:\tcl_src\win\>nmake -f makefile.vc release
#       c:\tcl_src\win\>nmake -f makefile.vc test







|







106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
#		set (ie: recent Platform SDK) then MACHINE is set from CPU.
#
#	TMP_DIR=<path>
#	OUT_DIR=<path>
#		Hooks to allow the intermediate and output directories to be
#		changed.  $(OUT_DIR) is assumed to be
#		$(BINROOT)\(Release|Debug) based on if symbols are requested.
#		$(TMP_DIR) will be $(OUT_DIR)\<buildtype> by default.
#
#	TESTPAT=<file>
#		Reads the tests requested to be run from this file.
#
# Examples:
#       c:\tcl_src\win\>nmake -f makefile.vc release
#       c:\tcl_src\win\>nmake -f makefile.vc test
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
	$(TMP_DIR)\testMain.obj

COREOBJS = \
	$(TMP_DIR)\regcomp.obj \
	$(TMP_DIR)\regerror.obj \
	$(TMP_DIR)\regexec.obj \
	$(TMP_DIR)\regfree.obj \
	$(TMP_DIR)\tclAbstractList.obj \
	$(TMP_DIR)\tclArithSeries.obj \
	$(TMP_DIR)\tclAlloc.obj \
	$(TMP_DIR)\tclAssembly.obj \
	$(TMP_DIR)\tclAsync.obj \
	$(TMP_DIR)\tclBasic.obj \
	$(TMP_DIR)\tclBinary.obj \
	$(TMP_DIR)\tclCkalloc.obj \







<







232
233
234
235
236
237
238

239
240
241
242
243
244
245
	$(TMP_DIR)\testMain.obj

COREOBJS = \
	$(TMP_DIR)\regcomp.obj \
	$(TMP_DIR)\regerror.obj \
	$(TMP_DIR)\regexec.obj \
	$(TMP_DIR)\regfree.obj \

	$(TMP_DIR)\tclArithSeries.obj \
	$(TMP_DIR)\tclAlloc.obj \
	$(TMP_DIR)\tclAssembly.obj \
	$(TMP_DIR)\tclAsync.obj \
	$(TMP_DIR)\tclBasic.obj \
	$(TMP_DIR)\tclBinary.obj \
	$(TMP_DIR)\tclCkalloc.obj \
375
376
377
378
379
380
381


382
383
384
385
386
387
388
	$(TMP_DIR)\bn_mp_mod_2d.obj \
	$(TMP_DIR)\bn_mp_mul.obj \
	$(TMP_DIR)\bn_mp_mul_2.obj \
	$(TMP_DIR)\bn_mp_mul_2d.obj \
	$(TMP_DIR)\bn_mp_mul_d.obj \
	$(TMP_DIR)\bn_mp_neg.obj \
	$(TMP_DIR)\bn_mp_or.obj \


	$(TMP_DIR)\bn_mp_radix_size.obj \
	$(TMP_DIR)\bn_mp_radix_smap.obj \
	$(TMP_DIR)\bn_mp_read_radix.obj \
	$(TMP_DIR)\bn_mp_rshd.obj \
	$(TMP_DIR)\bn_mp_set_i64.obj \
	$(TMP_DIR)\bn_mp_set_u64.obj \
	$(TMP_DIR)\bn_mp_shrink.obj \







>
>







374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
	$(TMP_DIR)\bn_mp_mod_2d.obj \
	$(TMP_DIR)\bn_mp_mul.obj \
	$(TMP_DIR)\bn_mp_mul_2.obj \
	$(TMP_DIR)\bn_mp_mul_2d.obj \
	$(TMP_DIR)\bn_mp_mul_d.obj \
	$(TMP_DIR)\bn_mp_neg.obj \
	$(TMP_DIR)\bn_mp_or.obj \
	$(TMP_DIR)\bn_mp_pack.obj \
	$(TMP_DIR)\bn_mp_pack_count.obj \
	$(TMP_DIR)\bn_mp_radix_size.obj \
	$(TMP_DIR)\bn_mp_radix_smap.obj \
	$(TMP_DIR)\bn_mp_read_radix.obj \
	$(TMP_DIR)\bn_mp_rshd.obj \
	$(TMP_DIR)\bn_mp_set_i64.obj \
	$(TMP_DIR)\bn_mp_set_u64.obj \
	$(TMP_DIR)\bn_mp_shrink.obj \
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
!endif
setup:      default-setup

test: test-core test-pkgs
test-core: setup $(TCLTEST) dlls
	set TCL_LIBRARY=$(ROOT:\=/)/library
	$(DEBUGGER) $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile <<
		package ifneeded dde 1.4.4 [list load "$(TCLDDELIB:\=/)"]
		package ifneeded registry 1.3.6 [list load "$(TCLREGLIB:\=/)"]
<<

runtest: setup $(TCLTEST) dlls
	set TCL_LIBRARY=$(ROOT:\=/)/library
	$(DEBUGGER) $(TCLTEST) $(SCRIPT)

runshell: setup $(TCLSH) dlls







|
|







497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
!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.5 [list load "$(TCLDDELIB:\=/)"]
		package ifneeded registry 1.3.7 [list load "$(TCLREGLIB:\=/)"]
<<

runtest: setup $(TCLTEST) dlls
	set TCL_LIBRARY=$(ROOT:\=/)/library
	$(DEBUGGER) $(TCLTEST) $(SCRIPT)

runshell: setup $(TCLSH) dlls
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
HTMLBASE=TclTk$(VERSION)
HHPFILE=$(HTMLDIR)\$(HTMLBASE).hhp
CHMFILE=$(HTMLDIR)\$(HTMLBASE).chm

htmlhelp: chmsetup $(CHMFILE)

$(CHMFILE): $(DOCDIR)\*
	@$(TCLSH) $(TOOLSDIR)\tcltk-man2html.tcl "--htmldir=$(HTMLDIR)"
	@echo Compiling HTML help project
	-"$(HHC)" <<$(HHPFILE) >NUL
[OPTIONS]
Compatibility=1.1 or later
Compiled file=$(HTMLBASE).chm
Default topic=contents.htm
Display compile progress=no







|







673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
HTMLBASE=TclTk$(VERSION)
HHPFILE=$(HTMLDIR)\$(HTMLBASE).hhp
CHMFILE=$(HTMLDIR)\$(HTMLBASE).chm

htmlhelp: chmsetup $(CHMFILE)

$(CHMFILE): $(DOCDIR)\*
	@$(TCLSH) -encoding utf-8 $(TOOLSDIR)\tcltk-man2html.tcl "--htmldir=$(HTMLDIR)"
	@echo Compiling HTML help project
	-"$(HHC)" <<$(HHPFILE) >NUL
[OPTIONS]
Compatibility=1.1 or later
Compiled file=$(HTMLBASE).chm
Default topic=contents.htm
Display compile progress=no

Changes to win/nmakehlp.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
/*
 * ----------------------------------------------------------------------------
 * nmakehlp.c --
 *
 *	This is used to fix limitations within nmake and the environment.
 *
 * Copyright (c) 2002 by David Gravereaux.
 * Copyright (c) 2006 by Pat Thoyts
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 * ----------------------------------------------------------------------------
 */

#define _CRT_SECURE_NO_DEPRECATE
#include <windows.h>
#ifdef _MSC_VER
#pragma comment (lib, "user32.lib")
#pragma comment (lib, "kernel32.lib")
#endif
#include <stdio.h>
#include <math.h>










/* ISO hack for dumb VC++ */
#ifdef _MSC_VER
#define   snprintf	_snprintf
#endif


/* protos */

static int CheckForCompilerFeature(const char *option);






|
|















>
>
>
>
>
>
>
>
>

|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
/*
 * ----------------------------------------------------------------------------
 * nmakehlp.c --
 *
 *	This is used to fix limitations within nmake and the environment.
 *
 * Copyright (c) 2002 David Gravereaux.
 * Copyright (c) 2006 Pat Thoyts
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 * ----------------------------------------------------------------------------
 */

#define _CRT_SECURE_NO_DEPRECATE
#include <windows.h>
#ifdef _MSC_VER
#pragma comment (lib, "user32.lib")
#pragma comment (lib, "kernel32.lib")
#endif
#include <stdio.h>
#include <math.h>

/*
 * 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++ */
#if defined(_WIN32) && defined(_MSC_VER) && _MSC_VER < 1900
#define   snprintf	_snprintf
#endif


/* protos */

static int CheckForCompilerFeature(const char *option);
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
    char msg[300];
    BOOL ok;
    HANDLE hProcess, h, pipeThreads[2];
    char cmdline[100];

    hProcess = GetCurrentProcess();

    ZeroMemory(&pi, sizeof(PROCESS_INFORMATION));
    ZeroMemory(&si, sizeof(STARTUPINFO));
    si.cb = sizeof(STARTUPINFO);
    si.dwFlags   = STARTF_USESTDHANDLES;
    si.hStdInput = INVALID_HANDLE_VALUE;

    ZeroMemory(&sa, sizeof(SECURITY_ATTRIBUTES));
    sa.nLength = sizeof(SECURITY_ATTRIBUTES);
    sa.lpSecurityDescriptor = NULL;
    sa.bInheritHandle = FALSE;

    /*
     * Create a non-inheritible pipe.
     */

    CreatePipe(&Out.pipe, &h, &sa, 0);

    /*
     * Dupe the write side, make it inheritible, and close the original.
     */

    DuplicateHandle(hProcess, h, hProcess, &si.hStdOutput, 0, TRUE,
	    DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE);

    /*
     * Same as above, but for the error side.







|
|




|





|





|







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
    char msg[300];
    BOOL ok;
    HANDLE hProcess, h, pipeThreads[2];
    char cmdline[100];

    hProcess = GetCurrentProcess();

    memset(&pi, 0, sizeof(PROCESS_INFORMATION));
    memset(&si, 0, sizeof(STARTUPINFO));
    si.cb = sizeof(STARTUPINFO);
    si.dwFlags   = STARTF_USESTDHANDLES;
    si.hStdInput = INVALID_HANDLE_VALUE;

    memset(&sa, 0, sizeof(SECURITY_ATTRIBUTES));
    sa.nLength = sizeof(SECURITY_ATTRIBUTES);
    sa.lpSecurityDescriptor = NULL;
    sa.bInheritHandle = FALSE;

    /*
     * Create a non-inheritable pipe.
     */

    CreatePipe(&Out.pipe, &h, &sa, 0);

    /*
     * Dupe the write side, make it inheritable, and close the original.
     */

    DuplicateHandle(hProcess, h, hProcess, &si.hStdOutput, 0, TRUE,
	    DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE);

    /*
     * Same as above, but for the error side.
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
    BOOL ok;
    HANDLE hProcess, h, pipeThreads[2];
    int i;
    char cmdline[255];

    hProcess = GetCurrentProcess();

    ZeroMemory(&pi, sizeof(PROCESS_INFORMATION));
    ZeroMemory(&si, sizeof(STARTUPINFO));
    si.cb = sizeof(STARTUPINFO);
    si.dwFlags   = STARTF_USESTDHANDLES;
    si.hStdInput = INVALID_HANDLE_VALUE;

    ZeroMemory(&sa, sizeof(SECURITY_ATTRIBUTES));
    sa.nLength = sizeof(SECURITY_ATTRIBUTES);
    sa.lpSecurityDescriptor = NULL;
    sa.bInheritHandle = TRUE;

    /*
     * Create a non-inheritible pipe.
     */

    CreatePipe(&Out.pipe, &h, &sa, 0);

    /*
     * Dupe the write side, make it inheritible, and close the original.
     */

    DuplicateHandle(hProcess, h, hProcess, &si.hStdOutput, 0, TRUE,
	    DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE);

    /*
     * Same as above, but for the error side.







|
|




|











|







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
    BOOL ok;
    HANDLE hProcess, h, pipeThreads[2];
    int i;
    char cmdline[255];

    hProcess = GetCurrentProcess();

    memset(&pi, 0, sizeof(PROCESS_INFORMATION));
    memset(&si, 0, sizeof(STARTUPINFO));
    si.cb = sizeof(STARTUPINFO);
    si.dwFlags   = STARTF_USESTDHANDLES;
    si.hStdInput = INVALID_HANDLE_VALUE;

    memset(&sa, 0, sizeof(SECURITY_ATTRIBUTES));
    sa.nLength = sizeof(SECURITY_ATTRIBUTES);
    sa.lpSecurityDescriptor = NULL;
    sa.bInheritHandle = TRUE;

    /*
     * Create a non-inheritible pipe.
     */

    CreatePipe(&Out.pipe, &h, &sa, 0);

    /*
     * Dupe the write side, make it inheritable, and close the original.
     */

    DuplicateHandle(hProcess, h, hProcess, &si.hStdOutput, 0, TRUE,
	    DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE);

    /*
     * Same as above, but for the error side.
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
    }
}

/*
 * SubstituteFile --
 *	As windows doesn't provide anything useful like sed and it's unreliable
 *	to use the tclsh you are building against (consider x-platform builds -
 *	eg compiling AMD64 target from IX86) we provide a simple substitution
 *	option here to handle autoconf style substitutions.
 *	The substitution file is whitespace and line delimited. The file should
 *	consist of lines matching the regular expression:
 *	  \s*\S+\s+\S*$
 *
 *	Usage is something like:
 *	  nmakehlp -S << $** > $@







|







589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
    }
}

/*
 * SubstituteFile --
 *	As windows doesn't provide anything useful like sed and it's unreliable
 *	to use the tclsh you are building against (consider x-platform builds -
 *	e.g. compiling AMD64 target from IX86) we provide a simple substitution
 *	option here to handle autoconf style substitutions.
 *	The substitution file is whitespace and line delimited. The file should
 *	consist of lines matching the regular expression:
 *	  \s*\S+\s+\S*$
 *
 *	Usage is something like:
 *	  nmakehlp -S << $** > $@
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
    list_item_t *substPtr = NULL;
    FILE *fp, *sp;

    fp = fopen(filename, "rt");
    if (fp != NULL) {

	/*
	 * Build a list of substutitions from the first filename
	 */

	sp = fopen(substitutions, "rt");
	if (sp != NULL) {
	    while (fgets(szBuffer, sizeof(szBuffer), sp) != NULL) {
		unsigned char *ks, *ke, *vs, *ve;
		ks = (unsigned char*)szBuffer;







|







615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
    list_item_t *substPtr = NULL;
    FILE *fp, *sp;

    fp = fopen(filename, "rt");
    if (fp != NULL) {

	/*
	 * Build a list of substitutions from the first filename
	 */

	sp = fopen(substitutions, "rt");
	if (sp != NULL) {
	    while (fgets(szBuffer, sizeof(szBuffer), sp) != NULL) {
		unsigned char *ks, *ke, *vs, *ve;
		ks = (unsigned char*)szBuffer;
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
    int keylen, ret;
    WIN32_FIND_DATA finfo;

    if (dir == NULL || keypath == NULL) {
	return 2; /* Have no real error reporting mechanism into nmake */
    }
    dirlen = strlen(dir);
    if ((dirlen + 3) > sizeof(path)) {
	return 2;
    }
    strncpy(path, dir, dirlen);
    strncpy(path+dirlen, "\\*", 3);	/* Including terminating \0 */
    keylen = strlen(keypath);

#if 0 /* This function is not available in Visual C++ 6 */







|







727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
    int keylen, ret;
    WIN32_FIND_DATA finfo;

    if (dir == NULL || keypath == NULL) {
	return 2; /* Have no real error reporting mechanism into nmake */
    }
    dirlen = strlen(dir);
    if (dirlen > sizeof(path) - 3) {
	return 2;
    }
    strncpy(path, dir, dirlen);
    strncpy(path+dirlen, "\\*", 3);	/* Including terminating \0 */
    keylen = strlen(keypath);

#if 0 /* This function is not available in Visual C++ 6 */

Changes to win/rules.vc.

883
884
885
886
887
888
889

890
891
892
893
894
895
896
897
898
899
900
901
!endif

!if $(TCL_MAJOR_VERSION) == 8
!if [nmakehlp -f $(OPTS) "time64bit"]
!message *** Force 64-bit time_t
_USE_64BIT_TIME_T = 1
!endif


!if [nmakehlp -f $(OPTS) "utf16"]
!message *** Force UTF-16 internally
TCL_UTF_MAX = 3
!endif
!endif

# Yes, it's weird that the "symbols" option controls DEBUG and
# the "pdbs" option controls SYMBOLS. That's historical.
!if [nmakehlp -f $(OPTS) "symbols"]
!message *** Doing symbols
DEBUG		= 1







>




<







883
884
885
886
887
888
889
890
891
892
893
894

895
896
897
898
899
900
901
!endif

!if $(TCL_MAJOR_VERSION) == 8
!if [nmakehlp -f $(OPTS) "time64bit"]
!message *** Force 64-bit time_t
_USE_64BIT_TIME_T = 1
!endif
!endif

!if [nmakehlp -f $(OPTS) "utf16"]
!message *** Force UTF-16 internally
TCL_UTF_MAX = 3

!endif

# Yes, it's weird that the "symbols" option controls DEBUG and
# the "pdbs" option controls SYMBOLS. That's historical.
!if [nmakehlp -f $(OPTS) "symbols"]
!message *** Doing symbols
DEBUG		= 1
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
# 12. Set up actual options to be passed to the compiler and linker
# Now we have all the information we need, set up the actual flags and
# options that we will pass to the compiler and linker. The main
# makefile should use these in combination with whatever other flags
# and switches are specific to it.
# The following macros are defined, names are for historical compatibility:
# OPTDEFINES - /Dxxx C macro flags based on user-specified OPTS
# COMPILERFLAGS - /Dxxx C macro flags independent of any configuration opttions
# crt - Compiler switch that selects the appropriate C runtime
# cdebug - Compiler switches related to debug AND optimizations
# cwarn - Compiler switches that set warning levels
# cflags - complete compiler switches (subsumes cdebug and cwarn)
# ldebug - Linker switches controlling debug information and optimization
# lflags - complete linker switches (subsumes ldebug) except subsystem type
# dlllflags - complete linker switches to build DLLs (subsumes lflags)







|







1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
# 12. Set up actual options to be passed to the compiler and linker
# Now we have all the information we need, set up the actual flags and
# options that we will pass to the compiler and linker. The main
# makefile should use these in combination with whatever other flags
# and switches are specific to it.
# The following macros are defined, names are for historical compatibility:
# OPTDEFINES - /Dxxx C macro flags based on user-specified OPTS
# COMPILERFLAGS - /Dxxx C macro flags independent of any configuration options
# crt - Compiler switch that selects the appropriate C runtime
# cdebug - Compiler switches related to debug AND optimizations
# cwarn - Compiler switches that set warning levels
# cflags - complete compiler switches (subsumes cdebug and cwarn)
# ldebug - Linker switches controlling debug information and optimization
# lflags - complete linker switches (subsumes ldebug) except subsystem type
# dlllflags - complete linker switches to build DLLs (subsumes lflags)

Changes to win/tcl.dsp.

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

# Begin Group "compat"

# PROP Default_Filter ""
# Begin Source File

SOURCE=..\compat\dirent.h
# End Source File
# Begin Source File

SOURCE=..\compat\dirent2.h
# End Source File
# Begin Source File

SOURCE=..\compat\dlfcn.h
# End Source File
# Begin Source File

SOURCE=..\compat\gettod.c
# End Source File
# Begin Source File

SOURCE=..\compat\limits.h
# End Source File
# Begin Source File

SOURCE=..\compat\memcmp.c
# End Source File
# Begin Source File

SOURCE=..\compat\opendir.c
# End Source File
# Begin Source File

SOURCE=..\compat\README
# End Source File
# Begin Source File

SOURCE=..\compat\stdlib.h
# End Source File
# Begin Source File

SOURCE=..\compat\string.h
# End Source File
# Begin Source File

SOURCE=..\compat\strncasecmp.c
# End Source File
# Begin Source File

SOURCE=..\compat\strstr.c
# End Source File
# Begin Source File

SOURCE=..\compat\strtol.c
# End Source File
# Begin Source File

SOURCE=..\compat\strtoul.c
# End Source File
# Begin Source File

SOURCE=..\compat\tclErrno.h
# End Source File
# Begin Source File

SOURCE=..\compat\waitpid.c
# End Source File
# End Group
# Begin Group "doc"

# PROP Default_Filter ""
# Begin Source File

SOURCE=..\doc\Access.3







<
<
<
<
<
<
<
<












<
<
<
<
<
<
<
<




<
<
<
<


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







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

# Begin Group "compat"

# PROP Default_Filter ""
# Begin Source File









SOURCE=..\compat\dlfcn.h
# End Source File
# Begin Source File

SOURCE=..\compat\gettod.c
# End Source File
# Begin Source File

SOURCE=..\compat\limits.h
# End Source File
# Begin Source File









SOURCE=..\compat\README
# End Source File
# Begin Source File





SOURCE=..\compat\string.h
# End Source File
























# End Group
# Begin Group "doc"

# PROP Default_Filter ""
# Begin Source File

SOURCE=..\doc\Access.3

Changes to win/tcl.m4.

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
		[tcl_cv_eh_disposition=no])
	)
	if test "$tcl_cv_eh_disposition" = "no" ; then
	AC_DEFINE(EXCEPTION_DISPOSITION, int,
		[Defined when cygwin/mingw does not support EXCEPTION DISPOSITION])
	fi

	# Check to see if winnt.h defines CHAR, SHORT, and LONG
	# even if VOID has already been #defined. The win32api
	# used by mingw and cygwin is known to do this.

	AC_CACHE_CHECK(for winnt.h that ignores VOID define,
	    tcl_cv_winnt_ignore_void,
	    AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
		#define VOID void
		#define WIN32_LEAN_AND_MEAN
		#include <windows.h>
		#undef WIN32_LEAN_AND_MEAN
	    ]], [[
		CHAR c;
		SHORT s;
		LONG l;
	    ]])],
	    [tcl_cv_winnt_ignore_void=yes],
	    [tcl_cv_winnt_ignore_void=no])
	)
	if test "$tcl_cv_winnt_ignore_void" = "yes" ; then
	    AC_DEFINE(HAVE_WINNT_IGNORE_VOID, 1,
		    [Defined when cygwin/mingw ignores VOID define in winnt.h])
	fi

	AC_CHECK_HEADER(stdbool.h, [AC_DEFINE(HAVE_STDBOOL_H, 1, [Do we have <stdbool.h>?])],)

	# See if the compiler supports casting to a union type.
	# This is used to stop gcc from printing a compiler
	# warning when initializing a union member.

	AC_CACHE_CHECK(for cast to union support,







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







934
935
936
937
938
939
940
























941
942
943
944
945
946
947
		[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

























	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,
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
#	extension can't assume that an executable Tcl shell exists at
#	build time.
#
# Arguments
#	none
#
# Results
#	Subst's the following values:
#		TCLSH_PROG
#------------------------------------------------------------------------

AC_DEFUN([SC_PROG_TCLSH], [
    AC_MSG_CHECKING([for tclsh])

    AC_CACHE_VAL(ac_cv_path_tclsh, [







|







1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
#	extension can't assume that an executable Tcl shell exists at
#	build time.
#
# Arguments
#	none
#
# Results
#	Substitutes the following values:
#		TCLSH_PROG
#------------------------------------------------------------------------

AC_DEFUN([SC_PROG_TCLSH], [
    AC_MSG_CHECKING([for tclsh])

    AC_CACHE_VAL(ac_cv_path_tclsh, [
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
#	when running tests from an extension build directory. It is not
#	correct to use the TCLSH_PROG in cases like this.
#
# Arguments
#	none
#
# Results
#	Subst's the following values:
#		BUILD_TCLSH
#------------------------------------------------------------------------

AC_DEFUN([SC_BUILD_TCLSH], [
    AC_MSG_CHECKING([for tclsh in Tcl build directory])
    BUILD_TCLSH=${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}\${EXESUFFIX}
    AC_MSG_RESULT($BUILD_TCLSH)







|







1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
#	when running tests from an extension build directory. It is not
#	correct to use the TCLSH_PROG in cases like this.
#
# Arguments
#	none
#
# Results
#	Substitutes the following values:
#		BUILD_TCLSH
#------------------------------------------------------------------------

AC_DEFUN([SC_BUILD_TCLSH], [
    AC_MSG_CHECKING([for tclsh in Tcl build directory])
    BUILD_TCLSH=${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}\${EXESUFFIX}
    AC_MSG_RESULT($BUILD_TCLSH)

Changes to win/tcl.rc.

33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
BEGIN
    BLOCK "StringFileInfo"
    BEGIN
        BLOCK "040904b0" /* LANG_ENGLISH/SUBLANG_ENGLISH_US, Unicode CP */
        BEGIN
            VALUE "FileDescription", "Tcl DLL\0"
            VALUE "OriginalFilename", "tcl" STRINGIFY(TCL_MAJOR_VERSION) STRINGIFY(TCL_MINOR_VERSION) SUFFIX ".dll\0"
            VALUE "CompanyName", "ActiveState Corporation\0"
            VALUE "FileVersion", TCL_PATCH_LEVEL
            VALUE "LegalCopyright", "Copyright \251 2001 by ActiveState Corporation, et al\0"
            VALUE "ProductName", "Tcl " TCL_VERSION " for Windows\0"
            VALUE "ProductVersion", TCL_PATCH_LEVEL
        END
    END
    BLOCK "VarFileInfo"
    BEGIN
        VALUE "Translation", 0x409, 1200







<

|







33
34
35
36
37
38
39

40
41
42
43
44
45
46
47
48
BEGIN
    BLOCK "StringFileInfo"
    BEGIN
        BLOCK "040904b0" /* LANG_ENGLISH/SUBLANG_ENGLISH_US, Unicode CP */
        BEGIN
            VALUE "FileDescription", "Tcl DLL\0"
            VALUE "OriginalFilename", "tcl" STRINGIFY(TCL_MAJOR_VERSION) STRINGIFY(TCL_MINOR_VERSION) SUFFIX ".dll\0"

            VALUE "FileVersion", TCL_PATCH_LEVEL
            VALUE "LegalCopyright", "Copyright \251 1987-2022 Regents of the University of California and other parties\0"
            VALUE "ProductName", "Tcl " TCL_VERSION " for Windows\0"
            VALUE "ProductVersion", TCL_PATCH_LEVEL
        END
    END
    BLOCK "VarFileInfo"
    BEGIN
        VALUE "Translation", 0x409, 1200

Changes to win/tclAppInit.c.

137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
#ifdef TCL_LOCAL_MAIN_HOOK
    TCL_LOCAL_MAIN_HOOK(&argc, &argv);
#elif (TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6) && (!defined(_WIN32) || defined(UNICODE))
    /* New in Tcl 8.7. This doesn't work on Windows without UNICODE */
    TclZipfs_AppHook(&argc, &argv);
#endif

    Tcl_Main((size_t)argc, argv, TCL_LOCAL_APPINIT);
    return 0;			/* Needed only to prevent compiler warning. */
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppInit --







|







137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
#ifdef TCL_LOCAL_MAIN_HOOK
    TCL_LOCAL_MAIN_HOOK(&argc, &argv);
#elif (TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6) && (!defined(_WIN32) || defined(UNICODE))
    /* New in Tcl 8.7. This doesn't work on Windows without UNICODE */
    TclZipfs_AppHook(&argc, &argv);
#endif

    Tcl_Main(argc, argv, TCL_LOCAL_APPINIT);
    return 0;			/* Needed only to prevent compiler warning. */
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppInit --
211
212
213
214
215
216
217

218


219
220
221
222
223
224
225
226
    /*
     * 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", TCL_INDEX_NONE), NULL,


	    Tcl_NewStringObj("~/tclshrc.tcl", TCL_INDEX_NONE), TCL_GLOBAL_ONLY);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * setargv --







>
|
>
>
|







211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
    /*
     * 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.
     */

    (void)Tcl_EvalEx(interp,
		     "set tcl_rcFileName [file tildeexpand ~/tclshrc.tcl]",
		     -1,
		     TCL_EVAL_GLOBAL);

    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * setargv --

Changes to win/tclWin32Dll.c.

375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
		    alreadyStored = 1;
		    break;
		}
	    }
	    if (!alreadyStored) {
		dlPtr2 = (MountPointMap *)Tcl_Alloc(sizeof(MountPointMap));
		dlPtr2->volumeName = (WCHAR *)TclNativeDupInternalRep(Target);
		dlPtr2->driveLetter = (char) drive[0];
		dlPtr2->nextPtr = driveLetterLookup;
		driveLetterLookup = dlPtr2;
	    }
	}
    }

    /*







|







375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
		    alreadyStored = 1;
		    break;
		}
	    }
	    if (!alreadyStored) {
		dlPtr2 = (MountPointMap *)Tcl_Alloc(sizeof(MountPointMap));
		dlPtr2->volumeName = (WCHAR *)TclNativeDupInternalRep(Target);
		dlPtr2->driveLetter = (WCHAR) drive[0];
		dlPtr2->nextPtr = driveLetterLookup;
		driveLetterLookup = dlPtr2;
	    }
	}
    }

    /*
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
    /*
     * The volume doesn't appear to correspond to a drive letter - we remember
     * that fact and store '-1' so we don't have to look it up each time.
     */

    dlPtr2 = (MountPointMap *)Tcl_Alloc(sizeof(MountPointMap));
    dlPtr2->volumeName = (WCHAR *)TclNativeDupInternalRep((void *)mountPoint);
    dlPtr2->driveLetter = -1;
    dlPtr2->nextPtr = driveLetterLookup;
    driveLetterLookup = dlPtr2;
    Tcl_MutexUnlock(&mountPointMap);
    return -1;
}

/*







|







401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
    /*
     * The volume doesn't appear to correspond to a drive letter - we remember
     * that fact and store '-1' so we don't have to look it up each time.
     */

    dlPtr2 = (MountPointMap *)Tcl_Alloc(sizeof(MountPointMap));
    dlPtr2->volumeName = (WCHAR *)TclNativeDupInternalRep((void *)mountPoint);
    dlPtr2->driveLetter = (WCHAR)-1;
    dlPtr2->nextPtr = driveLetterLookup;
    driveLetterLookup = dlPtr2;
    Tcl_MutexUnlock(&mountPointMap);
    return -1;
}

/*

Changes to win/tclWinChan.c.

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
static void		FileChannelExitHandler(void *clientData);
static void		FileCheckProc(void *clientData, int flags);
static int		FileCloseProc(void *instanceData,
			    Tcl_Interp *interp, int flags);
static int		FileEventProc(Tcl_Event *evPtr, int flags);
static int		FileGetHandleProc(void *instanceData,
			    int direction, void **handlePtr);



static ThreadSpecificData *FileInit(void);
static int		FileInputProc(void *instanceData, char *buf,
			    int toRead, int *errorCode);
static int		FileOutputProc(void *instanceData,
			    const char *buf, int toWrite, int *errorCode);
static long long	FileWideSeekProc(void *instanceData,
			    long long offset, int mode, int *errorCode);
static void		FileSetupProc(void *clientData, int flags);
static void		FileWatchProc(void *instanceData, int mask);
static void		FileThreadActionProc(void *instanceData,
			    int action);
static int		FileTruncateProc(void *instanceData,
			    long long length);
static DWORD		FileGetType(HANDLE handle);
static int		NativeIsComPort(const WCHAR *nativeName);



/*
 * This structure describes the channel type structure for file based IO.
 */

static const Tcl_ChannelType fileChannelType = {
    "file",			/* Type name. */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    NULL,		/* Close proc. */
    FileInputProc,		/* Input proc. */
    FileOutputProc,		/* Output proc. */
	NULL,
    NULL,			/* Set option proc. */
    NULL,			/* Get option proc. */
    FileWatchProc,		/* Set up the notifier to watch the channel. */
    FileGetHandleProc,		/* Get an OS handle from channel. */
    FileCloseProc,		/* close2proc. */
    FileBlockProc,		/* Set blocking or non-blocking mode.*/
    NULL,			/* flush proc. */
    NULL,			/* handler proc. */
    FileWideSeekProc,		/* Wide seek proc. */
    FileThreadActionProc,	/* Thread action proc. */
    FileTruncateProc		/* Truncate proc. */
};

/*
 * General useful clarification macros.
 */

#define SET_FLAG(var, flag)	((var) |= (flag))
#define CLEAR_FLAG(var, flag)	((var) &= ~(flag))
#define TEST_FLAG(value, flag)	(((value) & (flag)) != 0)










/*
 *----------------------------------------------------------------------
 *
 * FileInit --
 *
 *	This function creates the window used to simulate file events.







>
>
>















>
>













|


















>
>
>
>
>
>
>
>
>







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
static void		FileChannelExitHandler(void *clientData);
static void		FileCheckProc(void *clientData, int flags);
static int		FileCloseProc(void *instanceData,
			    Tcl_Interp *interp, int flags);
static int		FileEventProc(Tcl_Event *evPtr, int flags);
static int		FileGetHandleProc(void *instanceData,
			    int direction, void **handlePtr);
static int		FileGetOptionProc(ClientData instanceData,
			    Tcl_Interp *interp, const char *optionName,
			    Tcl_DString *dsPtr);
static ThreadSpecificData *FileInit(void);
static int		FileInputProc(void *instanceData, char *buf,
			    int toRead, int *errorCode);
static int		FileOutputProc(void *instanceData,
			    const char *buf, int toWrite, int *errorCode);
static long long	FileWideSeekProc(void *instanceData,
			    long long offset, int mode, int *errorCode);
static void		FileSetupProc(void *clientData, int flags);
static void		FileWatchProc(void *instanceData, int mask);
static void		FileThreadActionProc(void *instanceData,
			    int action);
static int		FileTruncateProc(void *instanceData,
			    long long length);
static DWORD		FileGetType(HANDLE handle);
static int		NativeIsComPort(const WCHAR *nativeName);
static Tcl_Channel OpenFileChannel(HANDLE handle, char *channelName,
			    int permissions, int appendMode);

/*
 * This structure describes the channel type structure for file based IO.
 */

static const Tcl_ChannelType fileChannelType = {
    "file",			/* Type name. */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    NULL,		/* Close proc. */
    FileInputProc,		/* Input proc. */
    FileOutputProc,		/* Output proc. */
	NULL,
    NULL,			/* Set option proc. */
    FileGetOptionProc,		/* Get option proc. */
    FileWatchProc,		/* Set up the notifier to watch the channel. */
    FileGetHandleProc,		/* Get an OS handle from channel. */
    FileCloseProc,		/* close2proc. */
    FileBlockProc,		/* Set blocking or non-blocking mode.*/
    NULL,			/* flush proc. */
    NULL,			/* handler proc. */
    FileWideSeekProc,		/* Wide seek proc. */
    FileThreadActionProc,	/* Thread action proc. */
    FileTruncateProc		/* Truncate proc. */
};

/*
 * General useful clarification macros.
 */

#define SET_FLAG(var, flag)	((var) |= (flag))
#define CLEAR_FLAG(var, flag)	((var) &= ~(flag))
#define TEST_FLAG(value, flag)	(((value) & (flag)) != 0)

/*
 * The number of 100-ns intervals between the Windows system epoch (1601-01-01
 * on the proleptic Gregorian calendar) and the Posix epoch (1970-01-01).
 */

#define POSIX_EPOCH_AS_FILETIME	\
	((long long) 116444736 * (long long) 1000000000)


/*
 *----------------------------------------------------------------------
 *
 * FileInit --
 *
 *	This function creates the window used to simulate file events.
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
     * write a console driver. We should probably do this at some point, but
     * for now, we just block. The same problem exists for files being read
     * over the network.
     */

    if (ReadFile(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
	    (LPOVERLAPPED) NULL) != FALSE) {
	return bytesRead;
    }

    Tcl_WinConvertError(GetLastError());
    *errorCode = errno;
    if (errno == EPIPE) {
	return 0;
    }







|







623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
     * write a console driver. We should probably do this at some point, but
     * for now, we just block. The same problem exists for files being read
     * over the network.
     */

    if (ReadFile(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
	    (LPOVERLAPPED) NULL) != FALSE) {
	return (int)bytesRead;
    }

    Tcl_WinConvertError(GetLastError());
    *errorCode = errno;
    if (errno == EPIPE) {
	return 0;
    }
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
    if (WriteFile(infoPtr->handle, (LPVOID) buf, (DWORD) toWrite,
	    &bytesWritten, (LPOVERLAPPED) NULL) == FALSE) {
	Tcl_WinConvertError(GetLastError());
	*errorCode = errno;
	return -1;
    }
    infoPtr->dirty = 1;
    return bytesWritten;
}

/*
 *----------------------------------------------------------------------
 *
 * FileWatchProc --
 *







|







680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
    if (WriteFile(infoPtr->handle, (LPVOID) buf, (DWORD) toWrite,
	    &bytesWritten, (LPOVERLAPPED) NULL) == FALSE) {
	Tcl_WinConvertError(GetLastError());
	*errorCode = errno;
	return -1;
    }
    infoPtr->dirty = 1;
    return (int)bytesWritten;
}

/*
 *----------------------------------------------------------------------
 *
 * FileWatchProc --
 *
739
740
741
742
743
744
745





























































































































































































746
747
748
749
750
751
752
    if (!TEST_FLAG(direction, infoPtr->validMask)) {
	return TCL_ERROR;
    }

    *handlePtr = (void *) infoPtr->handle;
    return TCL_OK;
}






























































































































































































/*
 *----------------------------------------------------------------------
 *
 * TclpOpenFileChannel --
 *
 *	Open an File based channel on Unix systems.







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







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
    if (!TEST_FLAG(direction, infoPtr->validMask)) {
	return TCL_ERROR;
    }

    *handlePtr = (void *) infoPtr->handle;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * FileGetOptionProc --
 *
 *	Gets an option associated with an open file. If the optionName arg is
 *	non-NULL, retrieves the value of that option. If the optionName arg is
 *	NULL, retrieves a list of alternating option names and values for the
 *	given channel.
 *
 * Results:
 *	A standard Tcl result. Also sets the supplied DString to the string
 *	value of the option(s) returned.  Sets error message if needed
 *	(by calling Tcl_BadChannelOption).
 *
 *----------------------------------------------------------------------
 */

static inline ULONGLONG
CombineDwords(
    DWORD hi,
    DWORD lo)
{
    ULARGE_INTEGER converter;

    converter.LowPart = lo;
    converter.HighPart = hi;
    return converter.QuadPart;
}

static inline void
StoreElementInDict(
    Tcl_Obj *dictObj,
    const char *name,
    Tcl_Obj *valueObj)
{
    /*
     * We assume that the dict is being built fresh and that there's never any
     * duplicate keys.
     */

    Tcl_Obj *nameObj = Tcl_NewStringObj(name, -1);
    Tcl_DictObjPut(NULL, dictObj, nameObj, valueObj);
}

static inline time_t
ToCTime(
    FILETIME fileTime)		/* UTC time */
{
    LARGE_INTEGER convertedTime;

    convertedTime.LowPart = fileTime.dwLowDateTime;
    convertedTime.HighPart = (LONG) fileTime.dwHighDateTime;

    return (time_t) ((convertedTime.QuadPart -
	    (long long) POSIX_EPOCH_AS_FILETIME) / (long long) 10000000);
}

static Tcl_Obj *
StatOpenFile(
    FileInfo *infoPtr)
{
    DWORD attr;
    int dev, nlink = 1;
    unsigned short mode;
    unsigned long long size, inode;
    long long atime, ctime, mtime;
    BY_HANDLE_FILE_INFORMATION data;
    Tcl_Obj *dictObj;

    if (GetFileInformationByHandle(infoPtr->handle, &data) != TRUE) {
	Tcl_SetErrno(ENOENT);
	return NULL;
    }

    atime = ToCTime(data.ftLastAccessTime);
    mtime = ToCTime(data.ftLastWriteTime);
    ctime = ToCTime(data.ftCreationTime);
    attr = data.dwFileAttributes;
    size = CombineDwords(data.nFileSizeHigh, data.nFileSizeLow);
    nlink = data.nNumberOfLinks;

    /*
     * Unfortunately our stat definition's inode field (unsigned short) will
     * throw away most of the precision we have here, which means we can't
     * rely on inode as a unique identifier of a file. We'd really like to do
     * something like how we handle 'st_size'.
     */

    inode = CombineDwords(data.nFileIndexHigh, data.nFileIndexLow);

    dev = data.dwVolumeSerialNumber;

    /*
     * Note that this code has no idea whether the file can be executed.
     */

    mode = (attr & FILE_ATTRIBUTE_DIRECTORY) ? S_IFDIR|S_IEXEC : S_IFREG;
    mode |= (attr & FILE_ATTRIBUTE_READONLY) ? S_IREAD : S_IREAD|S_IWRITE;
    mode |= (mode & (S_IREAD|S_IWRITE|S_IEXEC)) >> 3;
    mode |= (mode & (S_IREAD|S_IWRITE|S_IEXEC)) >> 6;

    /*
     * We don't construct a Tcl_StatBuf; we're using the info immediately.
     */

    TclNewObj(dictObj);
#define STORE_ELEM(name, value) StoreElementInDict(dictObj, name, value)

    STORE_ELEM("dev",      Tcl_NewWideIntObj((long) dev));
    STORE_ELEM("ino",      Tcl_NewWideIntObj((long long) inode));
    STORE_ELEM("nlink",    Tcl_NewIntObj(nlink));
    STORE_ELEM("uid",      Tcl_NewIntObj(0));
    STORE_ELEM("gid",      Tcl_NewIntObj(0));
    STORE_ELEM("size",     Tcl_NewWideIntObj((long long) size));
    STORE_ELEM("atime",    Tcl_NewWideIntObj(atime));
    STORE_ELEM("mtime",    Tcl_NewWideIntObj(mtime));
    STORE_ELEM("ctime",    Tcl_NewWideIntObj(ctime));
    STORE_ELEM("mode",     Tcl_NewWideIntObj(mode));

    /*
     * Windows only has files and directories, as far as we're concerned.
     * Anything else and we definitely couldn't have got here anyway.
     */
    if (attr & FILE_ATTRIBUTE_DIRECTORY) {
	STORE_ELEM("type", Tcl_NewStringObj("directory", -1));
    } else {
	STORE_ELEM("type", Tcl_NewStringObj("file", -1));
    }
#undef STORE_ELEM

    return dictObj;
}

static int
FileGetOptionProc(
    ClientData instanceData,	/* The file state. */
    Tcl_Interp *interp,		/* For error reporting. */
    const char *optionName,	/* What option to read, or NULL for all. */
    Tcl_DString *dsPtr)		/* Where to write the value read. */
{
    FileInfo *infoPtr = (FileInfo *)instanceData;
    int valid = 0;		/* Flag if valid option parsed. */
    int len;

    if (optionName == NULL) {
	len = 0;
	valid = 1;
    } else {
	len = strlen(optionName);
    }

    /*
     * Get option -stat
     * Option is readonly and returned by [fconfigure chan -stat] but not
     * returned by [fconfigure chan] without explicit option name.
     */

    if ((len > 1) && (strncmp(optionName, "-stat", len) == 0)) {
	Tcl_Obj *dictObj = StatOpenFile(infoPtr);
	const char *dictContents;
	Tcl_Size dictLength;

	if (dictObj == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "couldn't read file channel status: %s",
		    Tcl_PosixError(interp)));
	    return TCL_ERROR;
	}

	/*
	 * Transfer dictionary to the DString. Note that we don't do this as
	 * an element as this is an option that can't be retrieved with a
	 * general probe.
	 */

	dictContents = Tcl_GetStringFromObj(dictObj, &dictLength);
	Tcl_DStringAppend(dsPtr, dictContents, dictLength);
	Tcl_DecrRefCount(dictObj);
	return TCL_OK;
    }

    if (valid) {
	return TCL_OK;
    }
    return Tcl_BadChannelOption(interp, optionName,
		"stat");
}

/*
 *----------------------------------------------------------------------
 *
 * TclpOpenFileChannel --
 *
 *	Open an File based channel on Unix systems.
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
			"couldn't open serial \"%s\": %s",
			TclGetString(pathPtr), Tcl_PosixError(interp)));
	    }
	    return NULL;
	}

	/*
	 * For natively named Windows serial ports we are done.
	 */

	channel = TclWinOpenSerialChannel(handle, channelName,
		channelPermissions);

	return channel;
    }







|







1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
			"couldn't open serial \"%s\": %s",
			TclGetString(pathPtr), Tcl_PosixError(interp)));
	    }
	    return NULL;
	}

	/*
	 * For natively-named Windows serial ports we are done.
	 */

	channel = TclWinOpenSerialChannel(handle, channelName,
		channelPermissions);

	return channel;
    }
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
	    writeFile = TclWinMakeFile(handle);
	}
	channel = TclpCreateCommandChannel(readFile, writeFile, NULL, 0, NULL);
	break;
    case FILE_TYPE_CHAR:
    case FILE_TYPE_DISK:
    case FILE_TYPE_UNKNOWN:
	channel = TclWinOpenFileChannel(handle, channelName,
		channelPermissions,
		TEST_FLAG(mode, O_APPEND) ? FILE_APPEND : 0);
	break;

    default:
	/*
	 * The handle is of an unknown type, probably /dev/nul equivalent or







|







1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
	    writeFile = TclWinMakeFile(handle);
	}
	channel = TclpCreateCommandChannel(readFile, writeFile, NULL, 0, NULL);
	break;
    case FILE_TYPE_CHAR:
    case FILE_TYPE_DISK:
    case FILE_TYPE_UNKNOWN:
	channel = OpenFileChannel(handle, channelName,
		channelPermissions,
		TEST_FLAG(mode, O_APPEND) ? FILE_APPEND : 0);
	break;

    default:
	/*
	 * The handle is of an unknown type, probably /dev/nul equivalent or
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
 *
 *----------------------------------------------------------------------
 */

Tcl_Channel
Tcl_MakeFileChannel(
    void *rawHandle,	/* OS level handle */
    int mode)			/* ORed combination of TCL_READABLE and
				 * TCL_WRITABLE to indicate file mode. */
{
#if defined(HAVE_NO_SEH) && !defined(_WIN64) && !defined(__clang__)
    TCLEXCEPTION_REGISTRATION registration;
#endif
    char channelName[16 + TCL_INTEGER_SPACE];
    Tcl_Channel channel = NULL;
    HANDLE handle = (HANDLE) rawHandle;
    HANDLE dupedHandle;
    TclFile readFile = NULL, writeFile = NULL;
    BOOL result;

    if (mode == 0) {
	return NULL;
    }

    switch (FileGetType(handle)) {
    case FILE_TYPE_SERIAL:
	channel = TclWinOpenSerialChannel(handle, channelName, mode);
	break;







|












|







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

Tcl_Channel
Tcl_MakeFileChannel(
    void *rawHandle,	/* OS level handle */
    int mode)			/* OR'ed combination of TCL_READABLE and
				 * TCL_WRITABLE to indicate file mode. */
{
#if defined(HAVE_NO_SEH) && !defined(_WIN64) && !defined(__clang__)
    TCLEXCEPTION_REGISTRATION registration;
#endif
    char channelName[16 + TCL_INTEGER_SPACE];
    Tcl_Channel channel = NULL;
    HANDLE handle = (HANDLE) rawHandle;
    HANDLE dupedHandle;
    TclFile readFile = NULL, writeFile = NULL;
    BOOL result;

    if ((mode & (TCL_READABLE|TCL_WRITABLE)) == 0) {
	return NULL;
    }

    switch (FileGetType(handle)) {
    case FILE_TYPE_SERIAL:
	channel = TclWinOpenSerialChannel(handle, channelName, mode);
	break;
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
	    writeFile = TclWinMakeFile(handle);
	}
	channel = TclpCreateCommandChannel(readFile, writeFile, NULL, 0, NULL);
	break;

    case FILE_TYPE_DISK:
    case FILE_TYPE_CHAR:
	channel = TclWinOpenFileChannel(handle, channelName, mode, 0);
	break;

    case FILE_TYPE_UNKNOWN:
    default:
	/*
	 * The handle is of an unknown type. Test the validity of this OS
	 * handle by duplicating it, then closing the dupe. The Win32 API







|







1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
	    writeFile = TclWinMakeFile(handle);
	}
	channel = TclpCreateCommandChannel(readFile, writeFile, NULL, 0, NULL);
	break;

    case FILE_TYPE_DISK:
    case FILE_TYPE_CHAR:
	channel = OpenFileChannel(handle, channelName, mode, 0);
	break;

    case FILE_TYPE_UNKNOWN:
    default:
	/*
	 * The handle is of an unknown type. Test the validity of this OS
	 * handle by duplicating it, then closing the dupe. The Win32 API
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
	/*
	 * Fall through, the handle is valid.
	 *
	 * Create the undefined channel, anyways, because we know the handle
	 * is valid to something.
	 */

	channel = TclWinOpenFileChannel(handle, channelName, mode, 0);
    }

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







|







1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
	/*
	 * Fall through, the handle is valid.
	 *
	 * Create the undefined channel, anyways, because we know the handle
	 * is valid to something.
	 */

	channel = OpenFileChannel(handle, channelName, mode, 0);
    }

    return channel;
}

/*
 *----------------------------------------------------------------------
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
    }
    return channel;
}

/*
 *----------------------------------------------------------------------
 *
 * TclWinOpenFileChannel --
 *
 *	Constructs a File channel for the specified standard OS handle. This
 *	is a helper function to break up the construction of channels into
 *	File, Console, or Serial.
 *
 * Results:
 *	Returns the new channel, or NULL.
 *
 * Side effects:
 *	May open the channel and may cause creation of a file on the file
 *	system.
 *
 *----------------------------------------------------------------------
 */

Tcl_Channel
TclWinOpenFileChannel(
    HANDLE handle,		/* Win32 HANDLE to swallow */
    char *channelName,		/* Buffer to receive channel name */
    int permissions,		/* OR'ed combination of TCL_READABLE,
				 * TCL_WRITABLE, or TCL_EXCEPTION, indicating
				 * which operations are valid on the file. */
    int appendMode)		/* OR'ed combination of bits indicating what
				 * additional configuration of the channel is
				 * present. */
{
    FileInfo *infoPtr;
    ThreadSpecificData *tsdPtr = FileInit();

    /*
     * See if a channel with this handle already exists.
     */

    for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
	    infoPtr = infoPtr->nextPtr) {
	if (infoPtr->handle == (HANDLE) handle) {
	    return (permissions==infoPtr->validMask) ? infoPtr->channel : NULL;
	}
    }

    infoPtr = (FileInfo *)Tcl_Alloc(sizeof(FileInfo));

    /*
     * TIP #218. Removed the code inserting the new structure into the global
     * list. This is now handled in the thread action callbacks, and only
     * there.
     */

    infoPtr->nextPtr = NULL;
    infoPtr->validMask = permissions;
    infoPtr->watchMask = 0;
    infoPtr->flags = appendMode;
    infoPtr->handle = handle;
    infoPtr->dirty = 0;
    sprintf(channelName, "file%" TCL_Z_MODIFIER "x", (size_t) infoPtr);

    infoPtr->channel = Tcl_CreateChannel(&fileChannelType, channelName,
	    infoPtr, permissions);

    /*
     * Files have default translation of AUTO and ^Z eof char, which means
     * that a ^Z will be accepted as EOF when reading.







|
















|



















|












|




|







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
    }
    return channel;
}

/*
 *----------------------------------------------------------------------
 *
 * OpenFileChannel --
 *
 *	Constructs a File channel for the specified standard OS handle. This
 *	is a helper function to break up the construction of channels into
 *	File, Console, or Serial.
 *
 * Results:
 *	Returns the new channel, or NULL.
 *
 * Side effects:
 *	May open the channel and may cause creation of a file on the file
 *	system.
 *
 *----------------------------------------------------------------------
 */

Tcl_Channel
OpenFileChannel(
    HANDLE handle,		/* Win32 HANDLE to swallow */
    char *channelName,		/* Buffer to receive channel name */
    int permissions,		/* OR'ed combination of TCL_READABLE,
				 * TCL_WRITABLE, or TCL_EXCEPTION, indicating
				 * which operations are valid on the file. */
    int appendMode)		/* OR'ed combination of bits indicating what
				 * additional configuration of the channel is
				 * present. */
{
    FileInfo *infoPtr;
    ThreadSpecificData *tsdPtr = FileInit();

    /*
     * See if a channel with this handle already exists.
     */

    for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
	    infoPtr = infoPtr->nextPtr) {
	if (infoPtr->handle == (HANDLE) handle) {
	    return ((permissions & (TCL_READABLE|TCL_WRITABLE|TCL_EXCEPTION))==infoPtr->validMask) ? infoPtr->channel : NULL;
	}
    }

    infoPtr = (FileInfo *)Tcl_Alloc(sizeof(FileInfo));

    /*
     * TIP #218. Removed the code inserting the new structure into the global
     * list. This is now handled in the thread action callbacks, and only
     * there.
     */

    infoPtr->nextPtr = NULL;
    infoPtr->validMask = permissions & (TCL_READABLE|TCL_WRITABLE|TCL_EXCEPTION);
    infoPtr->watchMask = 0;
    infoPtr->flags = appendMode;
    infoPtr->handle = handle;
    infoPtr->dirty = 0;
    snprintf(channelName, 16 + TCL_INTEGER_SPACE, "file%" TCL_Z_MODIFIER "x", (size_t) infoPtr);

    infoPtr->channel = Tcl_CreateChannel(&fileChannelType, channelName,
	    infoPtr, permissions);

    /*
     * Files have default translation of AUTO and ^Z eof char, which means
     * that a ^Z will be accepted as EOF when reading.
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
 */

static int
NativeIsComPort(
    const WCHAR *nativePath)	/* Path of file to access, native encoding. */
{
    const WCHAR *p = (const WCHAR *) nativePath;
    int i, len = wcslen(p);

    /*
     * 1. Look for com[1-9]:?
     */

    if ((len == 4) && (_wcsnicmp(p, L"com", 3) == 0)) {
	/*







|







1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
 */

static int
NativeIsComPort(
    const WCHAR *nativePath)	/* Path of file to access, native encoding. */
{
    const WCHAR *p = (const WCHAR *) nativePath;
    size_t i, len = wcslen(p);

    /*
     * 1. Look for com[1-9]:?
     */

    if ((len == 4) && (_wcsnicmp(p, L"com", 3) == 0)) {
	/*

Changes to win/tclWinConsole.c.

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
#define CONSOLE_BUFFER_SIZE 8000 /* In bytes */
#endif

/*
 * Ring buffer for storing data. Actual data is from bufPtr[start]:bufPtr[size-1]
 * and bufPtr[0]:bufPtr[length - (size-start)].
 */
#if TCL_MAJOR_VERSION > 8
typedef ptrdiff_t RingSizeT; /* Tcl9 TODO */
#define RingSizeT_MAX PTRDIFF_MAX
#else
typedef int RingSizeT;
#define RingSizeT_MAX INT_MAX
#endif
typedef struct RingBuffer {
    char *bufPtr;	/* Pointer to buffer storage */
    RingSizeT capacity;	/* Size of the buffer in RingBufferChar */
    RingSizeT start;	/* Start of the data within the buffer. */
    RingSizeT length;	/* Number of RingBufferChar*/
} RingBuffer;
#define RingBufferLength(ringPtr_) ((ringPtr_)->length)
#define RingBufferHasFreeSpace(ringPtr_) ((ringPtr_)->length < (ringPtr_)->capacity)
#define RINGBUFFER_ASSERT(ringPtr_) assert(RingBufferCheck(ringPtr_))

/*
 * The Win32 console API does not support non-blocking I/O in any form. Thus







<
<
<
<
<
<
<


|
|
|







80
81
82
83
84
85
86







87
88
89
90
91
92
93
94
95
96
97
98
#define CONSOLE_BUFFER_SIZE 8000 /* In bytes */
#endif

/*
 * Ring buffer for storing data. Actual data is from bufPtr[start]:bufPtr[size-1]
 * and bufPtr[0]:bufPtr[length - (size-start)].
 */







typedef struct RingBuffer {
    char *bufPtr;	/* Pointer to buffer storage */
    Tcl_Size capacity;	/* Size of the buffer in RingBufferChar */
    Tcl_Size start;	/* Start of the data within the buffer. */
    Tcl_Size length;	/* Number of RingBufferChar*/
} RingBuffer;
#define RingBufferLength(ringPtr_) ((ringPtr_)->length)
#define RingBufferHasFreeSpace(ringPtr_) ((ringPtr_)->length < (ringPtr_)->capacity)
#define RINGBUFFER_ASSERT(ringPtr_) assert(RingBufferCheck(ringPtr_))

/*
 * The Win32 console API does not support non-blocking I/O in any form. Thus
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
		    Tcl_Interp *interp, const char *optionName,
		    const char *value);
static void	ConsoleSetupProc(void *clientData, int flags);
static void	ConsoleWatchProc(void *instanceData, int mask);
static void	ProcExitHandler(void *clientData);
static void	ConsoleThreadActionProc(void *instanceData, int action);
static DWORD	ReadConsoleChars(HANDLE hConsole, WCHAR *lpBuffer,
		    RingSizeT nChars, RingSizeT *nCharsReadPtr);
static DWORD	WriteConsoleChars(HANDLE hConsole,
		    const WCHAR *lpBuffer, RingSizeT nChars,
		    RingSizeT *nCharsWritten);
static void	RingBufferInit(RingBuffer *ringPtr, RingSizeT capacity);
static void	RingBufferClear(RingBuffer *ringPtr);
static RingSizeT	RingBufferIn(RingBuffer *ringPtr, const char *srcPtr,
			    RingSizeT srcLen, int partialCopyOk);
static RingSizeT	RingBufferOut(RingBuffer *ringPtr, char *dstPtr,
			    RingSizeT dstCapacity, int partialCopyOk);
static ConsoleHandleInfo *AllocateConsoleHandleInfo(HANDLE consoleHandle,
			    int permissions);
static ConsoleHandleInfo *FindConsoleInfo(const ConsoleChannelInfo *);
static DWORD WINAPI	ConsoleReaderThread(LPVOID arg);
static DWORD WINAPI	ConsoleWriterThread(LPVOID arg);
static void		NudgeWatchers(HANDLE consoleHandle);
#ifndef NDEBUG







|

|
|
|

|
|
|
|







223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
		    Tcl_Interp *interp, const char *optionName,
		    const char *value);
static void	ConsoleSetupProc(void *clientData, int flags);
static void	ConsoleWatchProc(void *instanceData, int mask);
static void	ProcExitHandler(void *clientData);
static void	ConsoleThreadActionProc(void *instanceData, int action);
static DWORD	ReadConsoleChars(HANDLE hConsole, WCHAR *lpBuffer,
		    Tcl_Size nChars, Tcl_Size *nCharsReadPtr);
static DWORD	WriteConsoleChars(HANDLE hConsole,
		    const WCHAR *lpBuffer, Tcl_Size nChars,
		    Tcl_Size *nCharsWritten);
static void	RingBufferInit(RingBuffer *ringPtr, Tcl_Size capacity);
static void	RingBufferClear(RingBuffer *ringPtr);
static Tcl_Size	RingBufferIn(RingBuffer *ringPtr, const char *srcPtr,
			    Tcl_Size srcLen, int partialCopyOk);
static Tcl_Size	RingBufferOut(RingBuffer *ringPtr, char *dstPtr,
			    Tcl_Size dstCapacity, int partialCopyOk);
static ConsoleHandleInfo *AllocateConsoleHandleInfo(HANDLE consoleHandle,
			    int permissions);
static ConsoleHandleInfo *FindConsoleInfo(const ConsoleChannelInfo *);
static DWORD WINAPI	ConsoleReaderThread(LPVOID arg);
static DWORD WINAPI	ConsoleWriterThread(LPVOID arg);
static void		NudgeWatchers(HANDLE consoleHandle);
#ifndef NDEBUG
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
 *
 * Side effects:
 *    Panics on allocation failure.
 *
 *------------------------------------------------------------------------
 */
static void
RingBufferInit(RingBuffer *ringPtr, RingSizeT capacity)
{
    if (capacity <= 0 || capacity > RingSizeT_MAX) {
	Tcl_Panic("Internal error: invalid ring buffer capacity requested.");
    }
    ringPtr->bufPtr = (char *)Tcl_Alloc(capacity);
    ringPtr->capacity = capacity;
    ringPtr->start    = 0;
    ringPtr->length   = 0;
}







|

|







320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
 *
 * Side effects:
 *    Panics on allocation failure.
 *
 *------------------------------------------------------------------------
 */
static void
RingBufferInit(RingBuffer *ringPtr, Tcl_Size capacity)
{
    if (capacity <= 0 || capacity > TCL_SIZE_MAX) {
	Tcl_Panic("Internal error: invalid ring buffer capacity requested.");
    }
    ringPtr->bufPtr = (char *)Tcl_Alloc(capacity);
    ringPtr->capacity = capacity;
    ringPtr->start    = 0;
    ringPtr->length   = 0;
}
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
 *    Returns number of bytes copied.
 *
 * Side effects:
 *    Internal buffer is updated.
 *
 *------------------------------------------------------------------------
 */
static RingSizeT
RingBufferIn(
    RingBuffer *ringPtr,
    const char *srcPtr, /* Source to be copied */
    RingSizeT srcLen,	  /* Length of source */
    int partialCopyOk 		  /* If true, partial copy is permitted */
    )
{
    RingSizeT freeSpace;

    RINGBUFFER_ASSERT(ringPtr);

    freeSpace = ringPtr->capacity - ringPtr->length;
    if (freeSpace < srcLen) {
	if (!partialCopyOk) {
	    return 0;
	}
	/* Copy only as much as free space allows */
	srcLen = freeSpace;
    }

    if (ringPtr->capacity - ringPtr->start > ringPtr->length) {
	/* There is room at the back */
	RingSizeT endSpaceStart = ringPtr->start + ringPtr->length;
	RingSizeT endSpace      = ringPtr->capacity - endSpaceStart;
	if (endSpace >= srcLen) {
	    /* Everything fits at the back */
	    memmove(endSpaceStart + ringPtr->bufPtr, srcPtr, srcLen);
	} else {
	    /* srcLen > endSpace */
	    memmove(endSpaceStart + ringPtr->bufPtr, srcPtr, endSpace);
	    memmove(ringPtr->bufPtr, endSpace + srcPtr, srcLen - endSpace);
	}
    } else {
	/* No room at the back. Existing data wrap to front. */
	RingSizeT wrapLen =
	    ringPtr->start + ringPtr->length - ringPtr->capacity;
	memmove(wrapLen + ringPtr->bufPtr, srcPtr, srcLen);
    }

    ringPtr->length += srcLen;

    RINGBUFFER_ASSERT(ringPtr);







|



|



|














|
|










|







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
 *    Returns number of bytes copied.
 *
 * Side effects:
 *    Internal buffer is updated.
 *
 *------------------------------------------------------------------------
 */
static Tcl_Size
RingBufferIn(
    RingBuffer *ringPtr,
    const char *srcPtr, /* Source to be copied */
    Tcl_Size srcLen,	  /* Length of source */
    int partialCopyOk 		  /* If true, partial copy is permitted */
    )
{
    Tcl_Size freeSpace;

    RINGBUFFER_ASSERT(ringPtr);

    freeSpace = ringPtr->capacity - ringPtr->length;
    if (freeSpace < srcLen) {
	if (!partialCopyOk) {
	    return 0;
	}
	/* Copy only as much as free space allows */
	srcLen = freeSpace;
    }

    if (ringPtr->capacity - ringPtr->start > ringPtr->length) {
	/* There is room at the back */
	Tcl_Size endSpaceStart = ringPtr->start + ringPtr->length;
	Tcl_Size endSpace      = ringPtr->capacity - endSpaceStart;
	if (endSpace >= srcLen) {
	    /* Everything fits at the back */
	    memmove(endSpaceStart + ringPtr->bufPtr, srcPtr, srcLen);
	} else {
	    /* srcLen > endSpace */
	    memmove(endSpaceStart + ringPtr->bufPtr, srcPtr, endSpace);
	    memmove(ringPtr->bufPtr, endSpace + srcPtr, srcLen - endSpace);
	}
    } else {
	/* No room at the back. Existing data wrap to front. */
	Tcl_Size wrapLen =
	    ringPtr->start + ringPtr->length - ringPtr->capacity;
	memmove(wrapLen + ringPtr->bufPtr, srcPtr, srcLen);
    }

    ringPtr->length += srcLen;

    RINGBUFFER_ASSERT(ringPtr);
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
 *    Returns number of bytes copied or removed.
 *
 * Side effects:
 *    Internal buffer is updated.
 *
 *------------------------------------------------------------------------
 */
static RingSizeT
RingBufferOut(RingBuffer *ringPtr,
	      char *dstPtr,	      /* Buffer for output data. May be NULL */
	      RingSizeT dstCapacity,  /* Size of buffer */
	      int partialCopyOk)      /* If true, return what's available */
{
    RingSizeT leadLen;

    RINGBUFFER_ASSERT(ringPtr);

    if (dstCapacity > ringPtr->length) {
	if (dstPtr && !partialCopyOk) {
	    return 0;
	}







|


|


|







436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
 *    Returns number of bytes copied or removed.
 *
 * Side effects:
 *    Internal buffer is updated.
 *
 *------------------------------------------------------------------------
 */
static Tcl_Size
RingBufferOut(RingBuffer *ringPtr,
	      char *dstPtr,	      /* Buffer for output data. May be NULL */
	      Tcl_Size dstCapacity,  /* Size of buffer */
	      int partialCopyOk)      /* If true, return what's available */
{
    Tcl_Size leadLen;

    RINGBUFFER_ASSERT(ringPtr);

    if (dstCapacity > ringPtr->length) {
	if (dstPtr && !partialCopyOk) {
	    return 0;
	}
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
    }
    if (leadLen >= dstCapacity) {
	if (dstPtr) {
	    memmove(dstPtr, ringPtr->start + ringPtr->bufPtr, dstCapacity);
	}
	ringPtr->start += dstCapacity;
    } else {
	RingSizeT wrapLen = dstCapacity - leadLen;
	if (dstPtr) {
	    memmove(dstPtr,
		    ringPtr->start + ringPtr->bufPtr,
		    leadLen);
	    memmove(
		leadLen + dstPtr, ringPtr->bufPtr, wrapLen);
	}







|







466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
    }
    if (leadLen >= dstCapacity) {
	if (dstPtr) {
	    memmove(dstPtr, ringPtr->start + ringPtr->bufPtr, dstCapacity);
	}
	ringPtr->start += dstCapacity;
    } else {
	Tcl_Size wrapLen = dstCapacity - leadLen;
	if (dstPtr) {
	    memmove(dstPtr,
		    ringPtr->start + ringPtr->bufPtr,
		    leadLen);
	    memmove(
		leadLen + dstPtr, ringPtr->bufPtr, wrapLen);
	}
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
 *
 *------------------------------------------------------------------------
 */
static DWORD
ReadConsoleChars(
    HANDLE hConsole,
    WCHAR *lpBuffer,
    RingSizeT nChars,
    RingSizeT *nCharsReadPtr)
{
    DWORD nRead;
    BOOL result;

    /*
     * If user types a Ctrl-Break or Ctrl-C, ReadConsole will return success
     * with ntchars == 0 and GetLastError() will be ERROR_OPERATION_ABORTED.







|
|







518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
 *
 *------------------------------------------------------------------------
 */
static DWORD
ReadConsoleChars(
    HANDLE hConsole,
    WCHAR *lpBuffer,
    Tcl_Size nChars,
    Tcl_Size *nCharsReadPtr)
{
    DWORD nRead;
    BOOL result;

    /*
     * If user types a Ctrl-Break or Ctrl-C, ReadConsole will return success
     * with ntchars == 0 and GetLastError() will be ERROR_OPERATION_ABORTED.
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
 *------------------------------------------------------------------------
 */

static DWORD
WriteConsoleChars(
    HANDLE hConsole,
    const WCHAR *lpBuffer,
    RingSizeT nChars,
    RingSizeT *nCharsWrittenPtr)
{
    DWORD nCharsWritten;
    BOOL result;

    /* See comments in ReadConsoleChars, not sure that applies here */
    nCharsWritten = (DWORD)-1;
    result = WriteConsoleW(hConsole, lpBuffer, nChars, &nCharsWritten, NULL);







|
|







578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
 *------------------------------------------------------------------------
 */

static DWORD
WriteConsoleChars(
    HANDLE hConsole,
    const WCHAR *lpBuffer,
    Tcl_Size nChars,
    Tcl_Size *nCharsWrittenPtr)
{
    DWORD nCharsWritten;
    BOOL result;

    /* See comments in ReadConsoleChars, not sure that applies here */
    nCharsWritten = (DWORD)-1;
    result = WriteConsoleW(hConsole, lpBuffer, nChars, &nCharsWritten, NULL);
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
	    /*
	     * TCL_READABLE watch means someone is looking out for data being
	     * available, let reader thread know. Note channel need not be
	     * ASYNC! (Bug [baa51423c2])
	     */
	    handleInfoPtr->flags |= CONSOLE_DATA_AWAITED;
	    WakeConditionVariable(&handleInfoPtr->consoleThreadCV);
	}
	else if (chanInfoPtr->watchMask & TCL_WRITABLE) {
	    if (RingBufferHasFreeSpace(&handleInfoPtr->buffer)) {
		needEvent = 1; /* Output space available */
	    }
	}
	ReleaseSRWLockShared(&handleInfoPtr->lock);

	if (needEvent) {







<
|







871
872
873
874
875
876
877

878
879
880
881
882
883
884
885
	    /*
	     * TCL_READABLE watch means someone is looking out for data being
	     * available, let reader thread know. Note channel need not be
	     * ASYNC! (Bug [baa51423c2])
	     */
	    handleInfoPtr->flags |= CONSOLE_DATA_AWAITED;
	    WakeConditionVariable(&handleInfoPtr->consoleThreadCV);

	} else if (chanInfoPtr->watchMask & TCL_WRITABLE) {
	    if (RingBufferHasFreeSpace(&handleInfoPtr->buffer)) {
		needEvent = 1; /* Output space available */
	    }
	}
	ReleaseSRWLockShared(&handleInfoPtr->lock);

	if (needEvent) {
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
    char *bufPtr,		/* Where to store data read. */
    int bufSize,		/* How much space is available in the
				 * buffer? */
    int *errorCode)		/* Where to store error code. */
{
    ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData;
    ConsoleHandleInfo *handleInfoPtr;
    RingSizeT numRead;

    if (chanInfoPtr->handle == INVALID_HANDLE_VALUE) {
	return 0; /* EOF */
    }

    *errorCode = 0;








|







1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
    char *bufPtr,		/* Where to store data read. */
    int bufSize,		/* How much space is available in the
				 * buffer? */
    int *errorCode)		/* Where to store error code. */
{
    ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData;
    ConsoleHandleInfo *handleInfoPtr;
    Tcl_Size numRead;

    if (chanInfoPtr->handle == INVALID_HANDLE_VALUE) {
	return 0; /* EOF */
    }

    *errorCode = 0;

1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
	 * reader thread which handles these case rather than dealing with
	 * them here (which is a little trickier than it might sound.)
	 */
	if ((1 & (ptrdiff_t)bufPtr) == 0 /* aligned buffer */
	    && bufSize > 1         /* Not single byte read */
	) {
	    DWORD lastError;
	    RingSizeT numChars;
	    ReleaseSRWLockExclusive(&handleInfoPtr->lock);
	    lastError = ReadConsoleChars(chanInfoPtr->handle,
					 (WCHAR *)bufPtr,
					 bufSize / sizeof(WCHAR),
					 &numChars);
	    /* NOTE lock released so DON'T break. Return instead */
	    if (lastError != ERROR_SUCCESS) {







|







1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
	 * reader thread which handles these case rather than dealing with
	 * them here (which is a little trickier than it might sound.)
	 */
	if ((1 & (ptrdiff_t)bufPtr) == 0 /* aligned buffer */
	    && bufSize > 1         /* Not single byte read */
	) {
	    DWORD lastError;
	    Tcl_Size numChars;
	    ReleaseSRWLockExclusive(&handleInfoPtr->lock);
	    lastError = ReadConsoleChars(chanInfoPtr->handle,
					 (WCHAR *)bufPtr,
					 bufSize / sizeof(WCHAR),
					 &numChars);
	    /* NOTE lock released so DON'T break. Return instead */
	    if (lastError != ERROR_SUCCESS) {
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
    void *instanceData,	/* Console state. */
    const char *buf,		/* The data buffer. */
    int toWrite,		/* How many bytes to write? */
    int *errorCode)		/* Where to store error code. */
{
    ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData;
    ConsoleHandleInfo *handleInfoPtr;
    RingSizeT numWritten;

    *errorCode = 0;

    if (chanInfoPtr->handle == INVALID_HANDLE_VALUE) {
	/* Some other thread would have *previously* closed the stdio handle */
	*errorCode = EPIPE;
	return -1;







|







1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
    void *instanceData,	/* Console state. */
    const char *buf,		/* The data buffer. */
    int toWrite,		/* How many bytes to write? */
    int *errorCode)		/* Where to store error code. */
{
    ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData;
    ConsoleHandleInfo *handleInfoPtr;
    Tcl_Size numWritten;

    *errorCode = 0;

    if (chanInfoPtr->handle == INVALID_HANDLE_VALUE) {
	/* Some other thread would have *previously* closed the stdio handle */
	*errorCode = EPIPE;
	return -1;
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
static DWORD WINAPI
ConsoleReaderThread(
    LPVOID arg)
{
    ConsoleHandleInfo *handleInfoPtr = (ConsoleHandleInfo *) arg;
    ConsoleHandleInfo **iterator;
    char inputChars[200]; /* Temporary buffer */
    RingSizeT inputLen = 0;
    RingSizeT inputOffset = 0;

    /*
     * Keep looping until one of the following happens.
     * - there are no more channels listening on the console
     * - the console handle has been closed
     */








|
|







1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
static DWORD WINAPI
ConsoleReaderThread(
    LPVOID arg)
{
    ConsoleHandleInfo *handleInfoPtr = (ConsoleHandleInfo *) arg;
    ConsoleHandleInfo **iterator;
    char inputChars[200]; /* Temporary buffer */
    Tcl_Size inputLen = 0;
    Tcl_Size inputOffset = 0;

    /*
     * Keep looping until one of the following happens.
     * - there are no more channels listening on the console
     * - the console handle has been closed
     */

1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
	 * copy that. Else check if there has been an error. In both cases
	 * notify the interp threads.
	 */
	if (inputLen > 0 || handleInfoPtr->lastError != 0) {
	    HANDLE consoleHandle;
	    if (inputLen > 0) {
		/* Private buffer has data. Copy it over. */
		RingSizeT nStored;

		assert((inputLen - inputOffset) > 0);

		nStored = RingBufferIn(&handleInfoPtr->buffer,
				       inputOffset + inputChars,
				       inputLen - inputOffset,
				       1);







|







1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
	 * copy that. Else check if there has been an error. In both cases
	 * notify the interp threads.
	 */
	if (inputLen > 0 || handleInfoPtr->lastError != 0) {
	    HANDLE consoleHandle;
	    if (inputLen > 0) {
		/* Private buffer has data. Copy it over. */
		Tcl_Size nStored;

		assert((inputLen - inputOffset) > 0);

		nStored = RingBufferIn(&handleInfoPtr->buffer,
				       inputOffset + inputChars,
				       inputLen - inputOffset,
				       1);
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
 */
static DWORD WINAPI
ConsoleWriterThread(LPVOID arg)
{
    ConsoleHandleInfo *handleInfoPtr = (ConsoleHandleInfo *) arg;
    ConsoleHandleInfo **iterator;
    BOOL success;
    RingSizeT numBytes;
    /*
     * This buffer size has no relation really with the size of the shared
     * buffer. Could be bigger or smaller. Make larger as multiple threads
     * could potentially be writing to it.
     */
    char buffer[2*CONSOLE_BUFFER_SIZE];








|







1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
 */
static DWORD WINAPI
ConsoleWriterThread(LPVOID arg)
{
    ConsoleHandleInfo *handleInfoPtr = (ConsoleHandleInfo *) arg;
    ConsoleHandleInfo **iterator;
    BOOL success;
    Tcl_Size numBytes;
    /*
     * This buffer size has no relation really with the size of the shared
     * buffer. Could be bigger or smaller. Make larger as multiple threads
     * could potentially be writing to it.
     */
    char buffer[2*CONSOLE_BUFFER_SIZE];

1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
	RingBufferOut(&handleInfoPtr->buffer, buffer, numBytes, 0);

	consoleHandle = handleInfoPtr->console;
	WakeConditionVariable(&handleInfoPtr->interpThreadCV);
	ReleaseSRWLockExclusive(&handleInfoPtr->lock);
	offset = 0;
	while (numBytes > 0) {
	    RingSizeT numWChars = numBytes / sizeof(WCHAR);
	    DWORD status;
	    status = WriteConsoleChars(handleInfoPtr->console,
				       (WCHAR *)(offset + buffer),
				       numWChars,
				       &numWChars);
	    if (status != 0) {
		/* Only overwrite if no previous error */







|







1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
	RingBufferOut(&handleInfoPtr->buffer, buffer, numBytes, 0);

	consoleHandle = handleInfoPtr->console;
	WakeConditionVariable(&handleInfoPtr->interpThreadCV);
	ReleaseSRWLockExclusive(&handleInfoPtr->lock);
	offset = 0;
	while (numBytes > 0) {
	    Tcl_Size numWChars = numBytes / sizeof(WCHAR);
	    DWORD status;
	    status = WriteConsoleChars(handleInfoPtr->console,
				       (WCHAR *)(offset + buffer),
				       numWChars,
				       &numWChars);
	    if (status != 0) {
		/* Only overwrite if no previous error */
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134

    /*
     * Use the pointer for the name of the result channel. This keeps the
     * channel names unique, since some may share handles (stdin/stdout/stderr
     * for instance).
     */

    sprintf(channelName, "file%" TCL_Z_MODIFIER "x", (size_t) chanInfoPtr);

    if (permissions & TCL_READABLE) {
	/*
	 * Make sure the console input buffer is ready for only character
	 * input notifications and the buffer is set for line buffering. IOW,
	 * we only want to catch when complete lines are ready for reading.
	 */







|







2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126

    /*
     * Use the pointer for the name of the result channel. This keeps the
     * channel names unique, since some may share handles (stdin/stdout/stderr
     * for instance).
     */

    snprintf(channelName, 16 + TCL_INTEGER_SPACE, "file%" TCL_Z_MODIFIER "x", (size_t) chanInfoPtr);

    if (permissions & TCL_READABLE) {
	/*
	 * Make sure the console input buffer is ready for only character
	 * input notifications and the buffer is set for line buffering. IOW,
	 * we only want to catch when complete lines are ready for reading.
	 */
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
			interp,
			Tcl_ObjPrintf("couldn't read console size: %s",
				      Tcl_PosixError(interp)));
		}
		return TCL_ERROR;
	    }
	    Tcl_DStringStartSublist(dsPtr);
	    sprintf(buf,
		    "%d",
		    consoleInfo.srWindow.Right - consoleInfo.srWindow.Left + 1);
	    Tcl_DStringAppendElement(dsPtr, buf);
	    sprintf(buf,
		    "%d",
		    consoleInfo.srWindow.Bottom - consoleInfo.srWindow.Top + 1);
	    Tcl_DStringAppendElement(dsPtr, buf);
	    Tcl_DStringEndSublist(dsPtr);
	}
    }








|



|







2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
			interp,
			Tcl_ObjPrintf("couldn't read console size: %s",
				      Tcl_PosixError(interp)));
		}
		return TCL_ERROR;
	    }
	    Tcl_DStringStartSublist(dsPtr);
	    snprintf(buf, sizeof(buf),
		    "%d",
		    consoleInfo.srWindow.Right - consoleInfo.srWindow.Left + 1);
	    Tcl_DStringAppendElement(dsPtr, buf);
	    snprintf(buf, sizeof(buf),
		    "%d",
		    consoleInfo.srWindow.Bottom - consoleInfo.srWindow.Top + 1);
	    Tcl_DStringAppendElement(dsPtr, buf);
	    Tcl_DStringEndSublist(dsPtr);
	}
    }

Changes to win/tclWinDde.c.

75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
 */

static HSZ ddeServiceGlobal = 0;
static DWORD ddeInstance;	/* The application instance handle given to us
				 * by DdeInitialize. */
static int ddeIsServer = 0;

#define TCL_DDE_VERSION		"1.4.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







|







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.5"
#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
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
static int		MakeDdeConnection(Tcl_Interp *interp,
			    const WCHAR *name, HCONV *ddeConvPtr);
static void		SetDdeError(Tcl_Interp *interp);
static int		DdeObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);

#if (TCL_MAJOR_VERSION < 9) && (TCL_MINOR_VERSION < 7)
# if TCL_UTF_MAX > 3
#   define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c)
#   define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c)
# else
#   define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString
#   define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString
# endif
#endif

static unsigned char *
getByteArrayFromObj(
	Tcl_Obj *objPtr,
	size_t *lengthPtr
) {
    int length;

    unsigned char *result = Tcl_GetByteArrayFromObj(objPtr, &length);
#if TCL_MAJOR_VERSION > 8
    if (sizeof(TCL_HASH_TYPE) > sizeof(int)) {
	/* 64-bit and TIP #494 situation: */
	 *lengthPtr = *(TCL_HASH_TYPE *) objPtr->internalRep.twoPtrValue.ptr1;
    } else
#endif
	/* 32-bit or without TIP #494 */
    *lengthPtr = (size_t) (unsigned) length;
    return result;
}

#ifdef __cplusplus
extern "C" {
#endif
DLLEXPORT int		Dde_Init(Tcl_Interp *interp);
DLLEXPORT int		Dde_SafeInit(Tcl_Interp *interp);





#ifdef __cplusplus
}
#endif

/*
 *----------------------------------------------------------------------
 *







|







<
|
<
<
<
<
<
<
|
<
<
<
<
<
<

<
<
<
<






>
>
>
>
>







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
static int		MakeDdeConnection(Tcl_Interp *interp,
			    const WCHAR *name, HCONV *ddeConvPtr);
static void		SetDdeError(Tcl_Interp *interp);
static int		DdeObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);

#if (TCL_MAJOR_VERSION < 9) && defined(TCL_MINOR_VERSION) && (TCL_MINOR_VERSION < 7)
# if TCL_UTF_MAX > 3
#   define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c)
#   define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c)
# else
#   define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString
#   define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString
# endif

#define Tcl_Size int






#define TCL_INDEX_NONE -1






#endif





#ifdef __cplusplus
extern "C" {
#endif
DLLEXPORT int		Dde_Init(Tcl_Interp *interp);
DLLEXPORT int		Dde_SafeInit(Tcl_Interp *interp);
#if TCL_MAJOR_VERSION < 9
/* With those additional entries, "load dde14.dll" works without 3th argument */
DLLEXPORT int		Tcldde_Init(Tcl_Interp *interp);
DLLEXPORT int		Tcldde_SafeInit(Tcl_Interp *interp);
#endif
#ifdef __cplusplus
}
#endif

/*
 *----------------------------------------------------------------------
 *
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185








186
187
188
189
190
191
192
 *----------------------------------------------------------------------
 */

int
Dde_Init(
    Tcl_Interp *interp)
{
    if (!Tcl_InitStubs(interp, "8.5", 0)) {
	return TCL_ERROR;
    }

    Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, NULL, NULL);
    Tcl_CreateExitHandler(DdeExitProc, NULL);
    return Tcl_PkgProvideEx(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION, NULL);
}









/*
 *----------------------------------------------------------------------
 *
 * Dde_SafeInit --
 *
 *	This function initializes the dde command within a safe interp







|







>
>
>
>
>
>
>
>







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

int
Dde_Init(
    Tcl_Interp *interp)
{
    if (!Tcl_InitStubs(interp, "8.5-", 0)) {
	return TCL_ERROR;
    }

    Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, NULL, NULL);
    Tcl_CreateExitHandler(DdeExitProc, NULL);
    return Tcl_PkgProvideEx(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION, NULL);
}
#if TCL_MAJOR_VERSION < 9
int
Tcldde_Init(
    Tcl_Interp *interp)
{
    return Dde_Init(interp);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Dde_SafeInit --
 *
 *	This function initializes the dde command within a safe interp
206
207
208
209
210
211
212








213
214
215
216
217
218
219
{
    int result = Dde_Init(interp);
    if (result == TCL_OK) {
	Tcl_HideCommand(interp, "dde", "dde");
    }
    return result;
}









/*
 *----------------------------------------------------------------------
 *
 * Initialize --
 *
 *	Initialize the global DDE instance.







>
>
>
>
>
>
>
>







202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
{
    int result = Dde_Init(interp);
    if (result == TCL_OK) {
	Tcl_HideCommand(interp, "dde", "dde");
    }
    return result;
}
#if TCL_MAJOR_VERSION < 9
int
Tcldde_SafeInit(
    Tcl_Interp *interp)
{
    return Dde_SafeInit(interp);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Initialize --
 *
 *	Initialize the global DDE instance.
305
306
307
308
309
310
311
312
313
314
315
316

317
318
319
320
321
322
323
324
    const WCHAR *name, /* The name that will be used to refer to the
				 * interpreter in later "send" commands. Must
				 * be globally unique. */
    int flags,		/* DDE_FLAG_FORCE or 0 */
    Tcl_Obj *handlerPtr)	/* Name of the optional proc/command to handle
				 * incoming Dde eval's */
{
    int suffix, offset;
    RegisteredInterp *riPtr, *prevPtr;
    Tcl_DString dString;
    const WCHAR *actualName;
    Tcl_Obj *srvListPtr = NULL, **srvPtrPtr = NULL;

    int n, srvCount = 0, lastSuffix, r = TCL_OK;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    /*
     * See if the application is already registered; if so, remove its current
     * name from the registry. The deletion of the command will take care of
     * disposing of this entry.
     */







|




>
|







309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
    const WCHAR *name, /* The name that will be used to refer to the
				 * interpreter in later "send" commands. Must
				 * be globally unique. */
    int flags,		/* DDE_FLAG_FORCE or 0 */
    Tcl_Obj *handlerPtr)	/* Name of the optional proc/command to handle
				 * incoming Dde eval's */
{
    int suffix;
    RegisteredInterp *riPtr, *prevPtr;
    Tcl_DString dString;
    const WCHAR *actualName;
    Tcl_Obj *srvListPtr = NULL, **srvPtrPtr = NULL;
    Tcl_Size n, srvCount = 0, offset;
    int lastSuffix, r = TCL_OK;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    /*
     * See if the application is already registered; if so, remove its current
     * name from the registry. The deletion of the command will take care of
     * disposing of this entry.
     */
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420

	    for (n = 0; n < srvCount; ++n) {
		Tcl_Obj* namePtr;
		Tcl_DString ds;

		Tcl_ListObjIndex(interp, srvPtrPtr[n], 1, &namePtr);
		Tcl_DStringInit(&ds);
		Tcl_UtfToWCharDString(Tcl_GetString(namePtr), -1, &ds);
		if (wcscmp(actualName, (WCHAR *)Tcl_DStringValue(&ds)) == 0) {
		    suffix++;
		    Tcl_DStringFree(&ds);
		    break;
		}
		Tcl_DStringFree(&ds);
	    }







|







411
412
413
414
415
416
417
418
419
420
421
422
423
424
425

	    for (n = 0; n < srvCount; ++n) {
		Tcl_Obj* namePtr;
		Tcl_DString ds;

		Tcl_ListObjIndex(interp, srvPtrPtr[n], 1, &namePtr);
		Tcl_DStringInit(&ds);
		Tcl_UtfToWCharDString(Tcl_GetString(namePtr), TCL_INDEX_NONE, &ds);
		if (wcscmp(actualName, (WCHAR *)Tcl_DStringValue(&ds)) == 0) {
		    suffix++;
		    Tcl_DStringFree(&ds);
		    break;
		}
		Tcl_DStringFree(&ds);
	    }
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
{
    Tcl_Obj *returnPackagePtr;
    int result = TCL_OK;

    if ((riPtr->handlerPtr == NULL) && Tcl_IsSafe(riPtr->interp)) {
	Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj("permission denied: "
		"a handler procedure must be defined for use in a safe "
		"interp", -1));
	Tcl_SetErrorCode(riPtr->interp, "TCL", "DDE", "SECURITY_CHECK", NULL);
	result = TCL_ERROR;
    }

    if (riPtr->handlerPtr != NULL) {
	/*
	 * Add the dde request data to the handler proc list.







|







569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
{
    Tcl_Obj *returnPackagePtr;
    int result = TCL_OK;

    if ((riPtr->handlerPtr == NULL) && Tcl_IsSafe(riPtr->interp)) {
	Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj("permission denied: "
		"a handler procedure must be defined for use in a safe "
		"interp", TCL_INDEX_NONE));
	Tcl_SetErrorCode(riPtr->interp, "TCL", "DDE", "SECURITY_CHECK", NULL);
	result = TCL_ERROR;
    }

    if (riPtr->handlerPtr != NULL) {
	/*
	 * Add the dde request data to the handler proc list.
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
    HSZ ddeTopic, HSZ ddeItem,	/* String handles. Transaction-type
				 * dependent. */
    HDDEDATA hData,		/* DDE data. Transaction-type dependent. */
    DWORD unused1, DWORD unused2)
				/* Transaction-dependent data. */
{
    Tcl_DString dString;
    size_t len;
    DWORD dlen;
    WCHAR *utilString;
    Tcl_Obj *ddeObjectPtr;
    HDDEDATA ddeReturn = NULL;
    RegisteredInterp *riPtr;
    Conversation *convPtr, *prevConvPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);







|







648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
    HSZ ddeTopic, HSZ ddeItem,	/* String handles. Transaction-type
				 * dependent. */
    HDDEDATA hData,		/* DDE data. Transaction-type dependent. */
    DWORD unused1, DWORD unused2)
				/* Transaction-dependent data. */
{
    Tcl_DString dString;
    Tcl_Size len;
    DWORD dlen;
    WCHAR *utilString;
    Tcl_Obj *ddeObjectPtr;
    HDDEDATA ddeReturn = NULL;
    RegisteredInterp *riPtr;
    Conversation *convPtr, *prevConvPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
	    Tcl_DStringInit(&dsBuf);
	    Tcl_DStringSetLength(&dString, (len + 1) * sizeof(WCHAR) - 1);
	    utilString = (WCHAR *) Tcl_DStringValue(&dString);
	    DdeQueryStringW(ddeInstance, ddeItem, utilString, (DWORD) len + 1,
		    CP_WINUNICODE);
	    if (_wcsicmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) {
		returnString =
			Tcl_GetString(convPtr->returnPackagePtr);
		len = convPtr->returnPackagePtr->length;
		if (uFmt != CF_TEXT) {
		    Tcl_DStringInit(&dsBuf);
		    Tcl_UtfToWCharDString(returnString, len, &dsBuf);
		    returnString = Tcl_DStringValue(&dsBuf);
		    len = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR) - 1;
		}
		ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString,







|
<







768
769
770
771
772
773
774
775

776
777
778
779
780
781
782
	    Tcl_DStringInit(&dsBuf);
	    Tcl_DStringSetLength(&dString, (len + 1) * sizeof(WCHAR) - 1);
	    utilString = (WCHAR *) Tcl_DStringValue(&dString);
	    DdeQueryStringW(ddeInstance, ddeItem, utilString, (DWORD) len + 1,
		    CP_WINUNICODE);
	    if (_wcsicmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) {
		returnString =
			Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len);

		if (uFmt != CF_TEXT) {
		    Tcl_DStringInit(&dsBuf);
		    Tcl_UtfToWCharDString(returnString, len, &dsBuf);
		    returnString = Tcl_DStringValue(&dsBuf);
		    len = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR) - 1;
		}
		ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString,
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801

		    Tcl_DStringInit(&ds);
		    Tcl_WCharToUtfDString(utilString, wcslen(utilString), &ds);
		    variableObjPtr = Tcl_GetVar2Ex(
			    convPtr->riPtr->interp, Tcl_DStringValue(&ds), NULL,
			    TCL_GLOBAL_ONLY);
		    if (variableObjPtr != NULL) {
			returnString = Tcl_GetString(variableObjPtr);
			len = variableObjPtr->length;
			if (uFmt != CF_TEXT) {
			    Tcl_DStringInit(&dsBuf);
			    Tcl_UtfToWCharDString(returnString, len, &dsBuf);
			    returnString = Tcl_DStringValue(&dsBuf);
			    len = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR) - 1;
			}
			ddeReturn = DdeCreateDataHandle(ddeInstance,







|
<







790
791
792
793
794
795
796
797

798
799
800
801
802
803
804

		    Tcl_DStringInit(&ds);
		    Tcl_WCharToUtfDString(utilString, wcslen(utilString), &ds);
		    variableObjPtr = Tcl_GetVar2Ex(
			    convPtr->riPtr->interp, Tcl_DStringValue(&ds), NULL,
			    TCL_GLOBAL_ONLY);
		    if (variableObjPtr != NULL) {
			returnString = Tcl_GetStringFromObj(variableObjPtr, &len);

			if (uFmt != CF_TEXT) {
			    Tcl_DStringInit(&dsBuf);
			    Tcl_UtfToWCharDString(returnString, len, &dsBuf);
			    returnString = Tcl_DStringValue(&dsBuf);
			    len = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR) - 1;
			}
			ddeReturn = DdeCreateDataHandle(ddeInstance,
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
	    utilString = (WCHAR *) DdeAccessData(hData, &len2);
	    len = len2;
	    if (uFmt != CF_TEXT) {
		Tcl_DStringInit(&ds2);
		Tcl_WCharToUtfDString(utilString, wcslen(utilString), &ds2);
		utilString = (WCHAR *) Tcl_DStringValue(&ds2);
	    }
	    variableObjPtr = Tcl_NewStringObj((char *)utilString, -1);

	    Tcl_SetVar2Ex(convPtr->riPtr->interp, Tcl_DStringValue(&ds), NULL,
		    variableObjPtr, TCL_GLOBAL_ONLY);

	    Tcl_DStringFree(&ds2);
	    Tcl_DStringFree(&ds);
	    Tcl_DStringFree(&dString);
		ddeReturn = (HDDEDATA) DDE_FACK;
	}
	return ddeReturn;

#endif
    case XTYP_EXECUTE: {
	/*
	 * Execute this script. The results will be saved into a list object
	 * which will be retreived later. See ExecuteRemoteObject.
	 */

	Tcl_Obj *returnPackagePtr;
	char *string;

	for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
		&& (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {







|















|







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
	    utilString = (WCHAR *) DdeAccessData(hData, &len2);
	    len = len2;
	    if (uFmt != CF_TEXT) {
		Tcl_DStringInit(&ds2);
		Tcl_WCharToUtfDString(utilString, wcslen(utilString), &ds2);
		utilString = (WCHAR *) Tcl_DStringValue(&ds2);
	    }
	    variableObjPtr = Tcl_NewStringObj((char *)utilString, TCL_INDEX_NONE);

	    Tcl_SetVar2Ex(convPtr->riPtr->interp, Tcl_DStringValue(&ds), NULL,
		    variableObjPtr, TCL_GLOBAL_ONLY);

	    Tcl_DStringFree(&ds2);
	    Tcl_DStringFree(&ds);
	    Tcl_DStringFree(&dString);
		ddeReturn = (HDDEDATA) DDE_FACK;
	}
	return ddeReturn;

#endif
    case XTYP_EXECUTE: {
	/*
	 * Execute this script. The results will be saved into a list object
	 * which will be retrieved later. See ExecuteRemoteObject.
	 */

	Tcl_Obj *returnPackagePtr;
	char *string;

	for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
		&& (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907

	utilString = (WCHAR *) DdeAccessData(hData, &dlen);
	string = (char *) utilString;
	if (!dlen) {
	    /* Empty binary array. */
	    ddeObjectPtr = Tcl_NewObj();
	} else if ((dlen & 1) || utilString[(dlen>>1)-1]) {
	    /* Cannot be unicode, so assume utf-8 */
	    if (!string[dlen-1]) {
		dlen--;
	    }
	    ddeObjectPtr = Tcl_NewStringObj(string, dlen);
	} else {
	    /* unicode */
	    Tcl_DString dsBuf;

	    Tcl_DStringInit(&dsBuf);
	    Tcl_WCharToUtfDString(utilString, (dlen>>1) - 1, &dsBuf);
	    ddeObjectPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsBuf),
		    Tcl_DStringLength(&dsBuf));
	    Tcl_DStringFree(&dsBuf);







|





|







890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910

	utilString = (WCHAR *) DdeAccessData(hData, &dlen);
	string = (char *) utilString;
	if (!dlen) {
	    /* Empty binary array. */
	    ddeObjectPtr = Tcl_NewObj();
	} else if ((dlen & 1) || utilString[(dlen>>1)-1]) {
	    /* Cannot be Unicode, so assume utf-8 */
	    if (!string[dlen-1]) {
		dlen--;
	    }
	    ddeObjectPtr = Tcl_NewStringObj(string, dlen);
	} else {
	    /* Unicode */
	    Tcl_DString dsBuf;

	    Tcl_DStringInit(&dsBuf);
	    Tcl_WCharToUtfDString(utilString, (dlen>>1) - 1, &dsBuf);
	    ddeObjectPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsBuf),
		    Tcl_DStringLength(&dsBuf));
	    Tcl_DStringFree(&dsBuf);
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

    case XTYP_WILDCONNECT: {
	/*
	 * Dde wants a list of services and topics that we support.
	 */

	HSZPAIR *returnPtr;
	int i;
	int numItems;

	for (i = 0, riPtr = tsdPtr->interpListPtr; riPtr != NULL;
		i++, riPtr = riPtr->nextPtr) {
	    /*
	     * Empty loop body.
	     */
	}




	numItems = i;
	ddeReturn = DdeCreateDataHandle(ddeInstance, NULL,
		(numItems + 1) * sizeof(HSZPAIR), 0, 0, 0, 0);
	returnPtr = (HSZPAIR *) DdeAccessData(ddeReturn, &dlen);
	len = dlen;
	for (i = 0, riPtr = tsdPtr->interpListPtr; i < numItems;
		i++, riPtr = riPtr->nextPtr) {
	    returnPtr[i].hszSvc = DdeCreateStringHandleW(ddeInstance,
		    TCL_DDE_SERVICE_NAME, CP_WINUNICODE);
	    returnPtr[i].hszTopic = DdeCreateStringHandleW(ddeInstance,
		    riPtr->name, CP_WINUNICODE);
	}
	returnPtr[i].hszSvc = NULL;







|
|








>
>
>
|

|


|







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

    case XTYP_WILDCONNECT: {
	/*
	 * Dde wants a list of services and topics that we support.
	 */

	HSZPAIR *returnPtr;
	Tcl_Size i;
	DWORD numItems;

	for (i = 0, riPtr = tsdPtr->interpListPtr; riPtr != NULL;
		i++, riPtr = riPtr->nextPtr) {
	    /*
	     * Empty loop body.
	     */
	}

	if ((size_t)i >= UINT_MAX/sizeof(HSZPAIR)) {
	    return NULL;
	}
	numItems = (DWORD)i;
	ddeReturn = DdeCreateDataHandle(ddeInstance, NULL,
		(numItems + 1) * (DWORD)sizeof(HSZPAIR), 0, 0, 0, 0);
	returnPtr = (HSZPAIR *) DdeAccessData(ddeReturn, &dlen);
	len = dlen;
	for (i = 0, riPtr = tsdPtr->interpListPtr; i < (Tcl_Size)numItems;
		i++, riPtr = riPtr->nextPtr) {
	    returnPtr[i].hszSvc = DdeCreateStringHandleW(ddeInstance,
		    TCL_DDE_SERVICE_NAME, CP_WINUNICODE);
	    returnPtr[i].hszTopic = DdeCreateStringHandleW(ddeInstance,
		    riPtr->name, CP_WINUNICODE);
	}
	returnPtr[i].hszSvc = NULL;
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
	    && ((es->topic == (ATOM)0) || (es->topic == topic))) {
	Tcl_Obj *matchPtr = Tcl_NewListObj(0, NULL);
	Tcl_Obj *resultPtr = Tcl_GetObjResult(es->interp);

	GlobalGetAtomNameW(service, sz, 255);
	Tcl_DStringInit(&dString);
	Tcl_WCharToUtfDString(sz, wcslen(sz), &dString);
	Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(Tcl_DStringValue(&dString), -1));
	Tcl_DStringFree(&dString);
	GlobalGetAtomNameW(topic, sz, 255);
	Tcl_DStringInit(&dString);
	Tcl_WCharToUtfDString(sz, wcslen(sz), &dString);
	Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(Tcl_DStringValue(&dString), -1));
	Tcl_DStringFree(&dString);

	/*
	 * Adding the hwnd as a third list element provides a unique
	 * identifier in the case of multiple servers with the name
	 * application and topic names.
	 */







|




|







1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
	    && ((es->topic == (ATOM)0) || (es->topic == topic))) {
	Tcl_Obj *matchPtr = Tcl_NewListObj(0, NULL);
	Tcl_Obj *resultPtr = Tcl_GetObjResult(es->interp);

	GlobalGetAtomNameW(service, sz, 255);
	Tcl_DStringInit(&dString);
	Tcl_WCharToUtfDString(sz, wcslen(sz), &dString);
	Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(Tcl_DStringValue(&dString), TCL_INDEX_NONE));
	Tcl_DStringFree(&dString);
	GlobalGetAtomNameW(topic, sz, 255);
	Tcl_DStringInit(&dString);
	Tcl_WCharToUtfDString(sz, wcslen(sz), &dString);
	Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(Tcl_DStringValue(&dString), TCL_INDEX_NONE));
	Tcl_DStringFree(&dString);

	/*
	 * Adding the hwnd as a third list element provides a unique
	 * identifier in the case of multiple servers with the name
	 * application and topic names.
	 */
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
	errorCode = "NOCANDO";
	break;
    default:
	errorMessage = "dde command failed";
	errorCode = "FAILED";
    }

    Tcl_SetObjResult(interp, Tcl_NewStringObj(errorMessage, -1));
    Tcl_SetErrorCode(interp, "TCL", "DDE", errorCode, NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * DdeObjCmd --







|







1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
	errorCode = "NOCANDO";
	break;
    default:
	errorMessage = "dde command failed";
	errorCode = "FAILED";
    }

    Tcl_SetObjResult(interp, Tcl_NewStringObj(errorMessage, TCL_INDEX_NONE));
    Tcl_SetErrorCode(interp, "TCL", "DDE", errorCode, NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * DdeObjCmd --
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
	"-async", NULL
    };
    static const char *const ddeReqOptions[] = {
	"-binary", NULL
    };

    int index, i, argIndex;
    size_t length;
    int flags = 0, result = TCL_OK, firstArg = 0;
    HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL;
    HDDEDATA ddeData = NULL, ddeItemData = NULL, ddeReturn;
    HCONV hConv = NULL;
    const WCHAR *serviceName = NULL, *topicName = NULL;
    const char *string;
    DWORD ddeResult;







|







1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
	"-async", NULL
    };
    static const char *const ddeReqOptions[] = {
	"-binary", NULL
    };

    int index, i, argIndex;
    Tcl_Size length;
    int flags = 0, result = TCL_OK, firstArg = 0;
    HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL;
    HDDEDATA ddeData = NULL, ddeItemData = NULL, ddeReturn;
    HCONV hConv = NULL;
    const WCHAR *serviceName = NULL, *topicName = NULL;
    const char *string;
    DWORD ddeResult;
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
	    break;
	}
    }

    Initialize();

    if (firstArg != 1) {
	const char *src = Tcl_GetString(objv[firstArg]);

	length = objv[firstArg]->length;
	Tcl_DStringInit(&serviceBuf);
	Tcl_UtfToWCharDString(src, length, &serviceBuf);
	serviceName = (WCHAR *) Tcl_DStringValue(&serviceBuf);
	length = Tcl_DStringLength(&serviceBuf) / sizeof(WCHAR);
    } else {
	length = 0;
    }

    if (length == 0) {
	serviceName = NULL;
    } else if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) {
	ddeService = DdeCreateStringHandleW(ddeInstance, serviceName,
		CP_WINUNICODE);
    }

    if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) {
	const char *src = Tcl_GetString(objv[firstArg + 1]);

	length = objv[firstArg + 1]->length;
	Tcl_DStringInit(&topicBuf);
	topicName = Tcl_UtfToWCharDString(src, length, &topicBuf);
	length = Tcl_DStringLength(&topicBuf) / sizeof(WCHAR);
	if (length == 0) {
	    topicName = NULL;
	} else {
	    ddeTopic = DdeCreateStringHandleW(ddeInstance, topicName,







|

<
















|

<







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

    Initialize();

    if (firstArg != 1) {
	const char *src = Tcl_GetStringFromObj(objv[firstArg], &length);


	Tcl_DStringInit(&serviceBuf);
	Tcl_UtfToWCharDString(src, length, &serviceBuf);
	serviceName = (WCHAR *) Tcl_DStringValue(&serviceBuf);
	length = Tcl_DStringLength(&serviceBuf) / sizeof(WCHAR);
    } else {
	length = 0;
    }

    if (length == 0) {
	serviceName = NULL;
    } else if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) {
	ddeService = DdeCreateStringHandleW(ddeInstance, serviceName,
		CP_WINUNICODE);
    }

    if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) {
	const char *src = Tcl_GetStringFromObj(objv[firstArg + 1], &length);


	Tcl_DStringInit(&topicBuf);
	topicName = Tcl_UtfToWCharDString(src, length, &topicBuf);
	length = Tcl_DStringLength(&topicBuf) / sizeof(WCHAR);
	if (length == 0) {
	    topicName = NULL;
	} else {
	    ddeTopic = DdeCreateStringHandleW(ddeInstance, topicName,
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
	    Tcl_DStringFree(&dsBuf);
	} else {
	    Tcl_ResetResult(interp);
	}
	break;

    case DDE_EXECUTE: {
	size_t dataLength;
	const void *dataString;
	Tcl_DString dsBuf;

	Tcl_DStringInit(&dsBuf);
	if (flags & DDE_FLAG_BINARY) {
	    dataString =
		    getByteArrayFromObj(objv[firstArg + 2], &dataLength);
	} else {
	    const char *src;

	    src = Tcl_GetString(objv[firstArg + 2]);
	    dataLength = objv[firstArg + 2]->length;
	    Tcl_DStringInit(&dsBuf);
	    dataString =
		    Tcl_UtfToWCharDString(src, dataLength, &dsBuf);
	    dataLength = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR);
	}

	if (dataLength + 1 < 2) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("cannot execute null data", -1));
	    Tcl_DStringFree(&dsBuf);
	    Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL);
	    result = TCL_ERROR;
	    break;
	}
	hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
	DdeFreeStringHandle(ddeInstance, ddeService);







|






|



|
<








|







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
	    Tcl_DStringFree(&dsBuf);
	} else {
	    Tcl_ResetResult(interp);
	}
	break;

    case DDE_EXECUTE: {
	Tcl_Size dataLength;
	const void *dataString;
	Tcl_DString dsBuf;

	Tcl_DStringInit(&dsBuf);
	if (flags & DDE_FLAG_BINARY) {
	    dataString =
		    Tcl_GetByteArrayFromObj(objv[firstArg + 2], &dataLength);
	} else {
	    const char *src;

	    src = Tcl_GetStringFromObj(objv[firstArg + 2], &dataLength);

	    Tcl_DStringInit(&dsBuf);
	    dataString =
		    Tcl_UtfToWCharDString(src, dataLength, &dsBuf);
	    dataLength = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR);
	}

	if (dataLength + 1 < 2) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("cannot execute null data", TCL_INDEX_NONE));
	    Tcl_DStringFree(&dsBuf);
	    Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL);
	    result = TCL_ERROR;
	    break;
	}
	hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
	DdeFreeStringHandle(ddeInstance, ddeService);
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
	Tcl_DStringFree(&dsBuf);
	break;
    }
    case DDE_REQUEST: {
	const WCHAR *itemString;
	const char *src;

	src = Tcl_GetString(objv[firstArg + 2]);
	length = objv[firstArg + 2]->length;
	Tcl_DStringInit(&itemBuf);
	itemString = Tcl_UtfToWCharDString(src, length, &itemBuf);
	length = Tcl_DStringLength(&itemBuf) / sizeof(WCHAR);

	if (length == 0) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("cannot request value of null data", -1));
	    Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL);
	    result = TCL_ERROR;
	    goto cleanup;
	}
	hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
	DdeFreeStringHandle(ddeInstance, ddeService);
	DdeFreeStringHandle(ddeInstance, ddeTopic);







|
<






|







1603
1604
1605
1606
1607
1608
1609
1610

1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
	Tcl_DStringFree(&dsBuf);
	break;
    }
    case DDE_REQUEST: {
	const WCHAR *itemString;
	const char *src;

	src = Tcl_GetStringFromObj(objv[firstArg + 2], &length);

	Tcl_DStringInit(&itemBuf);
	itemString = Tcl_UtfToWCharDString(src, length, &itemBuf);
	length = Tcl_DStringLength(&itemBuf) / sizeof(WCHAR);

	if (length == 0) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("cannot request value of null data", TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL);
	    result = TCL_ERROR;
	    goto cleanup;
	}
	hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
	DdeFreeStringHandle(ddeInstance, ddeService);
	DdeFreeStringHandle(ddeInstance, ddeTopic);
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
			returnObjPtr =
				Tcl_NewByteArrayObj((BYTE *) dataString, tmp);
		    } else {
			Tcl_DString dsBuf;

			if ((tmp >= sizeof(WCHAR))
				&& !dataString[tmp / sizeof(WCHAR) - 1]) {
			    tmp -= sizeof(WCHAR);
			}
			Tcl_DStringInit(&dsBuf);
			Tcl_WCharToUtfDString(dataString, tmp>>1, &dsBuf);
			returnObjPtr =
			    Tcl_NewStringObj(Tcl_DStringValue(&dsBuf),
				    Tcl_DStringLength(&dsBuf));
			Tcl_DStringFree(&dsBuf);







|







1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
			returnObjPtr =
				Tcl_NewByteArrayObj((BYTE *) dataString, tmp);
		    } else {
			Tcl_DString dsBuf;

			if ((tmp >= sizeof(WCHAR))
				&& !dataString[tmp / sizeof(WCHAR) - 1]) {
			    tmp -= (DWORD)sizeof(WCHAR);
			}
			Tcl_DStringInit(&dsBuf);
			Tcl_WCharToUtfDString(dataString, tmp>>1, &dsBuf);
			returnObjPtr =
			    Tcl_NewStringObj(Tcl_DStringValue(&dsBuf),
				    Tcl_DStringLength(&dsBuf));
			Tcl_DStringFree(&dsBuf);
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
    }
    case DDE_POKE: {
	Tcl_DString dsBuf;
	const WCHAR *itemString;
	BYTE *dataString;
	const char *src;

	src = Tcl_GetString(objv[firstArg + 2]);
	length = objv[firstArg + 2]->length;
	Tcl_DStringInit(&itemBuf);
	itemString = Tcl_UtfToWCharDString(src, length, &itemBuf);
	length = Tcl_DStringLength(&itemBuf) / sizeof(WCHAR);
	if (length == 0) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("cannot have a null item", -1));
	    Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL);
	    result = TCL_ERROR;
	    goto cleanup;
	}
	Tcl_DStringInit(&dsBuf);
	if (flags & DDE_FLAG_BINARY) {
	    dataString = (BYTE *)
		    getByteArrayFromObj(objv[firstArg + 3], &length);
	} else {
	    const char *data =
		    Tcl_GetString(objv[firstArg + 3]);
	    length = objv[firstArg + 3]->length;
	    Tcl_DStringInit(&dsBuf);
	    dataString = (BYTE *)
		    Tcl_UtfToWCharDString(data, length, &dsBuf);
	    length = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR);
	}

	hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);







|
<





|







|


|
<







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
    }
    case DDE_POKE: {
	Tcl_DString dsBuf;
	const WCHAR *itemString;
	BYTE *dataString;
	const char *src;

	src = Tcl_GetStringFromObj(objv[firstArg + 2], &length);

	Tcl_DStringInit(&itemBuf);
	itemString = Tcl_UtfToWCharDString(src, length, &itemBuf);
	length = Tcl_DStringLength(&itemBuf) / sizeof(WCHAR);
	if (length == 0) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("cannot have a null item", TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL);
	    result = TCL_ERROR;
	    goto cleanup;
	}
	Tcl_DStringInit(&dsBuf);
	if (flags & DDE_FLAG_BINARY) {
	    dataString = (BYTE *)
		    Tcl_GetByteArrayFromObj(objv[firstArg + 3], &length);
	} else {
	    const char *data =
		    Tcl_GetStringFromObj(objv[firstArg + 3], &length);

	    Tcl_DStringInit(&dsBuf);
	    dataString = (BYTE *)
		    Tcl_UtfToWCharDString(data, length, &dsBuf);
	    length = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR);
	}

	hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744

    case DDE_EVAL: {
	RegisteredInterp *riPtr;
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

	if (serviceName == NULL) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("invalid service name \"\"", -1));
	    Tcl_SetErrorCode(interp, "TCL", "DDE", "NO_SERVER", NULL);
	    result = TCL_ERROR;
	    goto cleanup;
	}

	objc -= firstArg + 1;
	objv += firstArg + 1;







|







1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744

    case DDE_EVAL: {
	RegisteredInterp *riPtr;
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

	if (serviceName == NULL) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("invalid service name \"\"", TCL_INDEX_NONE));
	    Tcl_SetErrorCode(interp, "TCL", "DDE", "NO_SERVER", NULL);
	    result = TCL_ERROR;
	    goto cleanup;
	}

	objc -= firstArg + 1;
	objv += firstArg + 1;
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
	     * interp is then deleted, the bytecode structure would be
	     * referring to deallocated objects.
	     */

	    if (Tcl_IsSafe(riPtr->interp) && (riPtr->handlerPtr == NULL)) {
		Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj(
			"permission denied: a handler procedure must be"
			" defined for use in a safe interp", -1));
		Tcl_SetErrorCode(interp, "TCL", "DDE", "SECURITY_CHECK",
			NULL);
		result = TCL_ERROR;
	    }

	    if (result == TCL_OK) {
		if (objc == 1) {







|







1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
	     * interp is then deleted, the bytecode structure would be
	     * referring to deallocated objects.
	     */

	    if (Tcl_IsSafe(riPtr->interp) && (riPtr->handlerPtr == NULL)) {
		Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj(
			"permission denied: a handler procedure must be"
			" defined for use in a safe interp", TCL_INDEX_NONE));
		Tcl_SetErrorCode(interp, "TCL", "DDE", "SECURITY_CHECK",
			NULL);
		result = TCL_ERROR;
	    }

	    if (result == TCL_OK) {
		if (objc == 1) {
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
	     * This is a non-local request. Send the script to the server and
	     * poll it for a result.
	     */

	    if (MakeDdeConnection(interp, serviceName, &hConv) != TCL_OK) {
	    invalidServerResponse:
		Tcl_SetObjResult(interp,
			Tcl_NewStringObj("invalid data returned from server", -1));
		Tcl_SetErrorCode(interp, "TCL", "DDE", "BAD_RESPONSE", NULL);
		result = TCL_ERROR;
		goto cleanup;
	    }

	    objPtr = Tcl_ConcatObj(objc, objv);
	    string = Tcl_GetString(objPtr);
	    length = objPtr->length;
	    Tcl_DStringInit(&dsBuf);
	    Tcl_UtfToWCharDString(string, length, &dsBuf);
	    string = Tcl_DStringValue(&dsBuf);
	    length = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR);
	    ddeItemData = DdeCreateDataHandle(ddeInstance, (BYTE *) string,
		    (DWORD) length, 0, 0, CF_UNICODETEXT, 0);
	    Tcl_DStringFree(&dsBuf);







|






|
<







1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858

1859
1860
1861
1862
1863
1864
1865
	     * This is a non-local request. Send the script to the server and
	     * poll it for a result.
	     */

	    if (MakeDdeConnection(interp, serviceName, &hConv) != TCL_OK) {
	    invalidServerResponse:
		Tcl_SetObjResult(interp,
			Tcl_NewStringObj("invalid data returned from server", TCL_INDEX_NONE));
		Tcl_SetErrorCode(interp, "TCL", "DDE", "BAD_RESPONSE", NULL);
		result = TCL_ERROR;
		goto cleanup;
	    }

	    objPtr = Tcl_ConcatObj(objc, objv);
	    string = Tcl_GetStringFromObj(objPtr, &length);

	    Tcl_DStringInit(&dsBuf);
	    Tcl_UtfToWCharDString(string, length, &dsBuf);
	    string = Tcl_DStringValue(&dsBuf);
	    length = Tcl_DStringLength(&dsBuf) + sizeof(WCHAR);
	    ddeItemData = DdeCreateDataHandle(ddeInstance, (BYTE *) string,
		    (DWORD) length, 0, 0, CF_UNICODETEXT, 0);
	    Tcl_DStringFree(&dsBuf);
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
		 * variable "errorCode", and the fourth is the value of the
		 * variable "errorInfo".
		 */

		length = DdeGetData(ddeData, NULL, 0, 0);
		ddeDataString = (WCHAR *) Tcl_Alloc(length);
		DdeGetData(ddeData, (BYTE *) ddeDataString, (DWORD) length, 0);
		if (length > sizeof(WCHAR)) {
		    length -= sizeof(WCHAR);
		}
		Tcl_DStringInit(&dsBuf);
		Tcl_WCharToUtfDString(ddeDataString, length>>1, &dsBuf);
		resultPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsBuf),
			Tcl_DStringLength(&dsBuf));
		Tcl_DStringFree(&dsBuf);







|







1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
		 * variable "errorCode", and the fourth is the value of the
		 * variable "errorInfo".
		 */

		length = DdeGetData(ddeData, NULL, 0, 0);
		ddeDataString = (WCHAR *) Tcl_Alloc(length);
		DdeGetData(ddeData, (BYTE *) ddeDataString, (DWORD) length, 0);
		if (length > (Tcl_Size)sizeof(WCHAR)) {
		    length -= sizeof(WCHAR);
		}
		Tcl_DStringInit(&dsBuf);
		Tcl_WCharToUtfDString(ddeDataString, length>>1, &dsBuf);
		resultPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsBuf),
			Tcl_DStringLength(&dsBuf));
		Tcl_DStringFree(&dsBuf);

Changes to win/tclWinFCmd.c.

305
306
307
308
309
310
311
312

313
314
315
316
317
318
319
	return TCL_ERROR;
    }
    if (errno == EACCES) {
    decode:
	if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) {
	    WCHAR *nativeSrcRest, *nativeDstRest;
	    const char **srcArgv, **dstArgv;
	    size_t size, srcArgc, dstArgc;

	    WCHAR nativeSrcPath[MAX_PATH];
	    WCHAR nativeDstPath[MAX_PATH];
	    Tcl_DString srcString, dstString;
	    const char *src, *dst;

	    size = GetFullPathNameW(nativeSrc, MAX_PATH,
		    nativeSrcPath, &nativeSrcRest);







|
>







305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
	return TCL_ERROR;
    }
    if (errno == EACCES) {
    decode:
	if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) {
	    WCHAR *nativeSrcRest, *nativeDstRest;
	    const char **srcArgv, **dstArgv;
	    size_t size;
	    Tcl_Size srcArgc, dstArgc;
	    WCHAR nativeSrcPath[MAX_PATH];
	    WCHAR nativeDstPath[MAX_PATH];
	    Tcl_DString srcString, dstString;
	    const char *src, *dst;

	    size = GetFullPathNameW(nativeSrc, MAX_PATH,
		    nativeSrcPath, &nativeSrcRest);
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
/*
 *---------------------------------------------------------------------------
 *
 * TclpObjCopyDirectory --
 *
 *	Recursively copies a directory. The target directory dst must not
 *	already exist. Note that this function does not merge two directory
 *	hierarchies, even if the target directory is an an empty directory.
 *
 * Results:
 *	If the directory was successfully copied, returns TCL_OK. Otherwise
 *	the return value is TCL_ERROR, errno is set to indicate the error, and
 *	the pathname of the file that caused the error is stored in errorPtr.
 *	See TclpCreateDirectory and TclpCopyFile for a description of possible
 *	values for errno.







|







876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
/*
 *---------------------------------------------------------------------------
 *
 * TclpObjCopyDirectory --
 *
 *	Recursively copies a directory. The target directory dst must not
 *	already exist. Note that this function does not merge two directory
 *	hierarchies, even if the target directory is an empty directory.
 *
 * Results:
 *	If the directory was successfully copied, returns TCL_OK. Otherwise
 *	the return value is TCL_ERROR, errno is set to indicate the error, and
 *	the pathname of the file that caused the error is stored in errorPtr.
 *	See TclpCreateDirectory and TclpCopyFile for a description of possible
 *	values for errno.
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
    normDestPtr = Tcl_FSGetNormalizedPath(NULL,destPathPtr);
    if ((normSrcPtr == NULL) || (normDestPtr == NULL)) {
	return TCL_ERROR;
    }

    Tcl_DStringInit(&srcString);
    Tcl_DStringInit(&dstString);
    Tcl_UtfToWCharDString(TclGetString(normSrcPtr), -1, &srcString);
    Tcl_UtfToWCharDString(TclGetString(normDestPtr), -1, &dstString);

    ret = TraverseWinTree(TraversalCopy, &srcString, &dstString, &ds);

    Tcl_DStringFree(&srcString);
    Tcl_DStringFree(&dstString);

    if (ret != TCL_OK) {







|
|







912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
    normDestPtr = Tcl_FSGetNormalizedPath(NULL,destPathPtr);
    if ((normSrcPtr == NULL) || (normDestPtr == NULL)) {
	return TCL_ERROR;
    }

    Tcl_DStringInit(&srcString);
    Tcl_DStringInit(&dstString);
    Tcl_UtfToWCharDString(TclGetString(normSrcPtr), TCL_INDEX_NONE, &srcString);
    Tcl_UtfToWCharDString(TclGetString(normDestPtr), TCL_INDEX_NONE, &dstString);

    ret = TraverseWinTree(TraversalCopy, &srcString, &dstString, &ds);

    Tcl_DStringFree(&srcString);
    Tcl_DStringFree(&dstString);

    if (ret != TCL_OK) {
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

	Tcl_DString native;
	normPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
	if (normPtr == NULL) {
	    return TCL_ERROR;
	}
	Tcl_DStringInit(&native);
	Tcl_UtfToWCharDString(TclGetString(normPtr), -1, &native);
	ret = DoRemoveDirectory(&native, recursive, &ds);
	Tcl_DStringFree(&native);
    } else {
	ret = DoRemoveJustDirectory((const WCHAR *)Tcl_FSGetNativePath(pathPtr), 0, &ds);
    }

    if (ret != TCL_OK) {
	if (Tcl_DStringLength(&ds) > 0) {
	    if (normPtr != NULL &&
		    !strcmp(Tcl_DStringValue(&ds), TclGetString(normPtr))) {
		*errorPtr = pathPtr;
	    } else {
		*errorPtr = TclDStringToObj(&ds);
	    }
	    Tcl_IncrRefCount(*errorPtr);
	}
	Tcl_DStringFree(&ds);
    }

    return ret;







|












|







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

	Tcl_DString native;
	normPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
	if (normPtr == NULL) {
	    return TCL_ERROR;
	}
	Tcl_DStringInit(&native);
	Tcl_UtfToWCharDString(TclGetString(normPtr), TCL_INDEX_NONE, &native);
	ret = DoRemoveDirectory(&native, recursive, &ds);
	Tcl_DStringFree(&native);
    } else {
	ret = DoRemoveJustDirectory((const WCHAR *)Tcl_FSGetNativePath(pathPtr), 0, &ds);
    }

    if (ret != TCL_OK) {
	if (Tcl_DStringLength(&ds) > 0) {
	    if (normPtr != NULL &&
		    !strcmp(Tcl_DStringValue(&ds), TclGetString(normPtr))) {
		*errorPtr = pathPtr;
	    } else {
		*errorPtr = Tcl_DStringToObj(&ds);
	    }
	    Tcl_IncrRefCount(*errorPtr);
	}
	Tcl_DStringFree(&ds);
    }

    return ret;
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
	 * It is hidden. However there is a bug on some Windows OSes in which
	 * root volumes (drives) formatted as NTFS are declared hidden when
	 * they are not (and cannot be).
	 *
	 * We test for, and fix that case, here.
	 */

	size_t len;
	const char *str = Tcl_GetStringFromObj(fileName, &len);

	if (len < 4) {
	    if (len == 0) {
		/*
		 * Not sure if this is possible, but we pass it on anyway.
		 */







|







1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
	 * It is hidden. However there is a bug on some Windows OSes in which
	 * root volumes (drives) formatted as NTFS are declared hidden when
	 * they are not (and cannot be).
	 *
	 * We test for, and fix that case, here.
	 */

	Tcl_Size 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.
		 */
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
ConvertFileNameFormat(
    Tcl_Interp *interp,		/* The interp we are using for errors. */
    TCL_UNUSED(int) /*objIndex*/,
    Tcl_Obj *fileName,		/* The name of the file. */
    int longShort,		/* 0 to short name, 1 to long name. */
    Tcl_Obj **attributePtrPtr)	/* A pointer to return the object with. */
{
    size_t pathc, i;
    Tcl_Obj *splitPath;
    size_t length;

    splitPath = Tcl_FSSplitPath(fileName, &pathc);

    if (splitPath == NULL || pathc == 0) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not read \"%s\": no such file or directory",







|

<







1592
1593
1594
1595
1596
1597
1598
1599
1600

1601
1602
1603
1604
1605
1606
1607
ConvertFileNameFormat(
    Tcl_Interp *interp,		/* The interp we are using for errors. */
    TCL_UNUSED(int) /*objIndex*/,
    Tcl_Obj *fileName,		/* The name of the file. */
    int longShort,		/* 0 to short name, 1 to long name. */
    Tcl_Obj **attributePtrPtr)	/* A pointer to return the object with. */
{
    Tcl_Size pathc, i, length;
    Tcl_Obj *splitPath;


    splitPath = Tcl_FSSplitPath(fileName, &pathc);

    if (splitPath == NULL || pathc == 0) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not read \"%s\": no such file or directory",
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
	     *	fprintf(stderr, "%d\n", ((WCHAR *) nativeName)[0]);
	     */

	    Tcl_DStringInit(&dsTemp);
	    Tcl_WCharToUtfDString(nativeName, TCL_INDEX_NONE, &dsTemp);
	    Tcl_DStringFree(&ds);

            tempPath = TclDStringToObj(&dsTemp);
            Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath);
	    FindClose(handle);
	}
    }

    *attributePtrPtr = Tcl_FSJoinPath(splitPath, -1);

    if (splitPath != NULL) {
	/*
	 * Unfortunately, the object we will return may have its only refCount
	 * as part of the list splitPath. This means if we free splitPath, the
	 * object will disappear. So, we have to be very careful here.
	 * Unfortunately this means we must manipulate the object's refCount







|





|







1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
	     *	fprintf(stderr, "%d\n", ((WCHAR *) nativeName)[0]);
	     */

	    Tcl_DStringInit(&dsTemp);
	    Tcl_WCharToUtfDString(nativeName, TCL_INDEX_NONE, &dsTemp);
	    Tcl_DStringFree(&ds);

            tempPath = Tcl_DStringToObj(&dsTemp);
            Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath);
	    FindClose(handle);
	}
    }

    *attributePtrPtr = Tcl_FSJoinPath(splitPath, TCL_INDEX_NONE);

    if (splitPath != NULL) {
	/*
	 * Unfortunately, the object we will return may have its only refCount
	 * as part of the list splitPath. This means if we free splitPath, the
	 * object will disappear. So, we have to be very careful here.
	 * Unfortunately this means we must manipulate the object's refCount
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

    if (dirObj) {
	Tcl_GetString(dirObj);
	if (dirObj->length < 1) {
	    goto useSystemTemp;
	}
	Tcl_DStringInit(&base);
	Tcl_UtfToWCharDString(Tcl_GetString(dirObj), -1, &base);
	if (dirObj->bytes[dirObj->length - 1] != '\\') {
	    Tcl_UtfToWCharDString("\\", -1, &base);
	}
    } else {
    useSystemTemp:
	Tcl_DStringInit(&base);
	Tcl_DStringAppend(&base, (char *) tempBuf, len * sizeof(WCHAR));
    }

    /*
     * Next, the base of the directory name.
     */

#define DEFAULT_TEMP_DIR_PREFIX	"tcl"
#define SUFFIX_LENGTH	8

    if (basenameObj) {
	Tcl_UtfToWCharDString(Tcl_GetString(basenameObj), -1, &base);
    } else {
	Tcl_UtfToWCharDString(DEFAULT_TEMP_DIR_PREFIX, -1, &base);
    }
    Tcl_UtfToWCharDString("_", -1, &base);

    /*
     * Now we keep on trying random suffixes until we get one that works
     * (i.e., that doesn't trigger the ERROR_ALREADY_EXISTS error). Note that
     * SUFFIX_LENGTH is longer than on Unix because we expect to be not on a
     * case-sensitive filesystem.
     */







|

|















|

|

|







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

    if (dirObj) {
	Tcl_GetString(dirObj);
	if (dirObj->length < 1) {
	    goto useSystemTemp;
	}
	Tcl_DStringInit(&base);
	Tcl_UtfToWCharDString(Tcl_GetString(dirObj), TCL_INDEX_NONE, &base);
	if (dirObj->bytes[dirObj->length - 1] != '\\') {
	    Tcl_UtfToWCharDString("\\", TCL_INDEX_NONE, &base);
	}
    } else {
    useSystemTemp:
	Tcl_DStringInit(&base);
	Tcl_DStringAppend(&base, (char *) tempBuf, len * sizeof(WCHAR));
    }

    /*
     * Next, the base of the directory name.
     */

#define DEFAULT_TEMP_DIR_PREFIX	"tcl"
#define SUFFIX_LENGTH	8

    if (basenameObj) {
	Tcl_UtfToWCharDString(Tcl_GetString(basenameObj), TCL_INDEX_NONE, &base);
    } else {
	Tcl_UtfToWCharDString(DEFAULT_TEMP_DIR_PREFIX, TCL_INDEX_NONE, &base);
    }
    Tcl_UtfToWCharDString("_", TCL_INDEX_NONE, &base);

    /*
     * Now we keep on trying random suffixes until we get one that works
     * (i.e., that doesn't trigger the ERROR_ALREADY_EXISTS error). Note that
     * SUFFIX_LENGTH is longer than on Unix because we expect to be not on a
     * case-sensitive filesystem.
     */
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056

	error = ERROR_SUCCESS;
	tempbuf[SUFFIX_LENGTH] = '\0';
	for (i = 0 ; i < SUFFIX_LENGTH; i++) {
	    tempbuf[i] = randChars[(int) (rand() % numRandChars)];
	}
	Tcl_DStringSetLength(&base, baseLen);
	Tcl_UtfToWCharDString(tempbuf, -1, &base);
    } while (!CreateDirectoryW((LPCWSTR) Tcl_DStringValue(&base), NULL)
	    && (error = GetLastError()) == ERROR_ALREADY_EXISTS);

    /*
     * Check for other errors. The big ones are ERROR_PATH_NOT_FOUND and
     * ERROR_ACCESS_DENIED.
     */







|







2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056

	error = ERROR_SUCCESS;
	tempbuf[SUFFIX_LENGTH] = '\0';
	for (i = 0 ; i < SUFFIX_LENGTH; i++) {
	    tempbuf[i] = randChars[(int) (rand() % numRandChars)];
	}
	Tcl_DStringSetLength(&base, baseLen);
	Tcl_UtfToWCharDString(tempbuf, TCL_INDEX_NONE, &base);
    } while (!CreateDirectoryW((LPCWSTR) Tcl_DStringValue(&base), NULL)
	    && (error = GetLastError()) == ERROR_ALREADY_EXISTS);

    /*
     * Check for other errors. The big ones are ERROR_PATH_NOT_FOUND and
     * ERROR_ACCESS_DENIED.
     */
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
     * We actually made the directory, so we're done! Report what we made back
     * as a (clean) Tcl_Obj.
     */

    Tcl_DStringInit(&name);
    Tcl_WCharToUtfDString((LPCWSTR) Tcl_DStringValue(&base), TCL_INDEX_NONE, &name);
    Tcl_DStringFree(&base);
    return TclDStringToObj(&name);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|









2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
     * We actually made the directory, so we're done! Report what we made back
     * as a (clean) Tcl_Obj.
     */

    Tcl_DStringInit(&name);
    Tcl_WCharToUtfDString((LPCWSTR) Tcl_DStringValue(&base), TCL_INDEX_NONE, &name);
    Tcl_DStringFree(&base);
    return Tcl_DStringToObj(&name);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to win/tclWinFile.c.

166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
static int		NativeReadReparse(const WCHAR *LinkDirectory,
			    REPARSE_DATA_BUFFER *buffer, DWORD desiredAccess);
static int		NativeWriteReparse(const WCHAR *LinkDirectory,
			    REPARSE_DATA_BUFFER *buffer);
static int		NativeMatchType(int isDrive, DWORD attr,
			    const WCHAR *nativeName, Tcl_GlobTypeData *types);
static int		WinIsDrive(const char *name, size_t nameLen);
static int		WinIsReserved(const char *path);
static Tcl_Obj *	WinReadLink(const WCHAR *LinkSource);
static Tcl_Obj *	WinReadLinkDirectory(const WCHAR *LinkDirectory);
static int		WinLink(const WCHAR *LinkSource,
			    const WCHAR *LinkTarget, int linkAction);
static int		WinSymLinkDirectory(const WCHAR *LinkDirectory,
			    const WCHAR *LinkTarget);
MODULE_SCOPE void	tclWinDebugPanic(const char *format, ...);







|







166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
static int		NativeReadReparse(const WCHAR *LinkDirectory,
			    REPARSE_DATA_BUFFER *buffer, DWORD desiredAccess);
static int		NativeWriteReparse(const WCHAR *LinkDirectory,
			    REPARSE_DATA_BUFFER *buffer);
static int		NativeMatchType(int isDrive, DWORD attr,
			    const WCHAR *nativeName, Tcl_GlobTypeData *types);
static int		WinIsDrive(const char *name, size_t nameLen);
static size_t		WinIsReserved(const char *path);
static Tcl_Obj *	WinReadLink(const WCHAR *LinkSource);
static Tcl_Obj *	WinReadLinkDirectory(const WCHAR *LinkDirectory);
static int		WinLink(const WCHAR *LinkSource,
			    const WCHAR *LinkTarget, int linkAction);
static int		WinSymLinkDirectory(const WCHAR *LinkDirectory,
			    const WCHAR *LinkTarget);
MODULE_SCOPE void	tclWinDebugPanic(const char *format, ...);
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
	if (norm != NULL) {
	    /*
	     * Match a single file directly.
	     */

	    DWORD attr;
	    WIN32_FILE_ATTRIBUTE_DATA data;
	    size_t length = 0;
	    const char *str = Tcl_GetStringFromObj(norm, &length);

	    native = (const WCHAR *)Tcl_FSGetNativePath(pathPtr);

	    if (GetFileAttributesExW(native,
		    GetFileExInfoStandard, &data) != TRUE) {
		return TCL_OK;
	    }
	    attr = data.dwFileAttributes;

	    if (NativeMatchType(WinIsDrive(str, length), attr, native, types)) {
		Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
	    }
	}
	return TCL_OK;
    } else {
	DWORD attr;
	HANDLE handle;
	WIN32_FIND_DATAW data;
	const char *dirName;	/* UTF-8 dir name, later with pattern
				 * appended. */
	size_t dirLength;
	int matchSpecialDots;
	Tcl_DString ds;		/* Native encoding of dir, also used
				 * temporarily for other things. */
	Tcl_DString dsOrig;	/* UTF-8 encoding of dir. */
	Tcl_Obj *fileNamePtr;
	char lastChar;








|
|









|










|







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
	if (norm != NULL) {
	    /*
	     * Match a single file directly.
	     */

	    DWORD attr;
	    WIN32_FILE_ATTRIBUTE_DATA data;
	    Tcl_Size len = 0;
	    const char *str = Tcl_GetStringFromObj(norm, &len);

	    native = (const WCHAR *)Tcl_FSGetNativePath(pathPtr);

	    if (GetFileAttributesExW(native,
		    GetFileExInfoStandard, &data) != TRUE) {
		return TCL_OK;
	    }
	    attr = data.dwFileAttributes;

	    if (NativeMatchType(WinIsDrive(str, len), attr, native, types)) {
		Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
	    }
	}
	return TCL_OK;
    } else {
	DWORD attr;
	HANDLE handle;
	WIN32_FIND_DATAW data;
	const char *dirName;	/* UTF-8 dir name, later with pattern
				 * appended. */
	Tcl_Size dirLength;
	int matchSpecialDots;
	Tcl_DString ds;		/* Native encoding of dir, also used
				 * temporarily for other things. */
	Tcl_DString dsOrig;	/* UTF-8 encoding of dir. */
	Tcl_Obj *fileNamePtr;
	char lastChar;

1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021

	    dirName = Tcl_DStringAppend(&dsOrig, pattern, TCL_INDEX_NONE);
	} else {
	    dirName = TclDStringAppendLiteral(&dsOrig, "*.*");
	}

	Tcl_DStringInit(&ds);
	native = Tcl_UtfToWCharDString(dirName, -1, &ds);
	if ((types == NULL) || (types->type != TCL_GLOB_TYPE_DIR)) {
	    handle = FindFirstFileW(native, &data);
	} else {
	    /*
	     * We can be more efficient, for pure directory requests.
	     */








|







1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021

	    dirName = Tcl_DStringAppend(&dsOrig, pattern, TCL_INDEX_NONE);
	} else {
	    dirName = TclDStringAppendLiteral(&dsOrig, "*.*");
	}

	Tcl_DStringInit(&ds);
	native = Tcl_UtfToWCharDString(dirName, TCL_INDEX_NONE, &ds);
	if ((types == NULL) || (types->type != TCL_GLOB_TYPE_DIR)) {
	    handle = FindFirstFileW(native, &data);
	} else {
	    /*
	     * We can be more efficient, for pure directory requests.
	     */

1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236

/*
 * Does the given path represent a reserved window path name? If not return 0,
 * if true, return the number of characters of the path that we actually want
 * (not any trailing :).
 */

static int
WinIsReserved(
    const char *path)		/* Path in UTF-8 */
{
    if ((path[0] == 'c' || path[0] == 'C')
	    && (path[1] == 'o' || path[1] == 'O')) {
	if ((path[2] == 'm' || path[2] == 'M')
		&& path[3] >= '1' && path[3] <= '9') {







|







1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236

/*
 * Does the given path represent a reserved window path name? If not return 0,
 * if true, return the number of characters of the path that we actually want
 * (not any trailing :).
 */

static size_t
WinIsReserved(
    const char *path)		/* Path in UTF-8 */
{
    if ((path[0] == 'c' || path[0] == 'C')
	    && (path[1] == 'o' || path[1] == 'O')) {
	if ((path[2] == 'm' || path[2] == 'M')
		&& path[3] >= '1' && path[3] <= '9') {
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
    Tcl_DStringInit(bufferPtr);

    wDomain = NULL;
    domain = Tcl_UtfFindFirst(name, '@');
    if (domain == NULL) {
	const char *ptr;

	/*
	 * No domain. Firstly check it's the current user










	 */




	ptr = TclpGetUserName(&ds);
	if (ptr != NULL && strcasecmp(name, ptr) == 0) {
	    /*



	     * Try safest and fastest way to get current user home
	     */

	    ptr = TclGetEnv("HOME", &ds);
	    if (ptr != NULL) {


		Tcl_JoinPath(1, &ptr, bufferPtr);

		rc = 1;
		result = Tcl_DStringValue(bufferPtr);



	    }
	}
	Tcl_DStringFree(&ds);
    } else {
	Tcl_DStringInit(&ds);
	wName = Tcl_UtfToWCharDString(domain + 1, -1, &ds);
	rc = NetGetDCName(NULL, wName, (LPBYTE *) &wDomain);
	Tcl_DStringFree(&ds);
	nameLen = domain - name;
    }
    if (rc == 0) {
	Tcl_DStringInit(&ds);
	wName = Tcl_UtfToWCharDString(name, nameLen, &ds);







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


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





|







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

    wDomain = NULL;
    domain = Tcl_UtfFindFirst(name, '@');
    if (domain == NULL) {
	const char *ptr;

        /*
         * Treat the current user as a special case because the general case
         * below does not properly retrieve the path. The NetUserGetInfo
         * call returns an empty path and the code defaults to the user's
         * name in the profiles directory. On modern Windows systems, this
         * is generally wrong as when the account is a Microsoft account,
         * for example [email protected], the directory name is
         * abcde and not abcdefghi.
         *
         * Note we could have just used env(USERPROFILE) here but
         * the intent is to retrieve (as on Unix) the system's view
         * of the home irrespective of environment settings of HOME
         * and USERPROFILE.
         *
         * Fixing this for the general user needs more investigating but
         * at least for the current user we can use a direct call.
         */
	ptr = TclpGetUserName(&ds);
	if (ptr != NULL && strcasecmp(name, ptr) == 0) {

	    HANDLE hProcess;
	    WCHAR buf[MAX_PATH];
	    DWORD nChars = sizeof(buf) / sizeof(buf[0]);
	    /* Sadly GetCurrentProcessToken not in Win 7 so slightly longer */

	    hProcess = GetCurrentProcess(); /* Need not be closed */

	    if (hProcess) {
		HANDLE hToken;
		if (OpenProcessToken(hProcess, TOKEN_QUERY, &hToken)) {
		    if (GetUserProfileDirectoryW(hToken, buf, &nChars)) {
			result = Tcl_WCharToUtfDString(buf, nChars-1, (bufferPtr));
			rc = 1;

		    }
		    CloseHandle(hToken);
		}
	    }
	}
	Tcl_DStringFree(&ds);
    } else {
	Tcl_DStringInit(&ds);
	wName = Tcl_UtfToWCharDString(domain + 1, TCL_INDEX_NONE, &ds);
	rc = NetGetDCName(NULL, wName, (LPBYTE *) &wDomain);
	Tcl_DStringFree(&ds);
	nameLen = domain - name;
    }
    if (rc == 0) {
	Tcl_DStringInit(&ds);
	wName = Tcl_UtfToWCharDString(name, nameLen, &ds);
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
	    }
	    NetApiBufferFree((void *) uiPtr);
	}
	Tcl_DStringFree(&ds);
    }
    if (wDomain != NULL) {
	NetApiBufferFree((void *) wDomain);
    }
    if (result == NULL) {
	/*
	 * Look in the "Password Lists" section of system.ini for the local
	 * user. There are also entries in that section that begin with a "*"
	 * character that are used by Windows for other purposes; ignore user
	 * names beginning with a "*".
	 */

	char buf[MAX_PATH];

	if (name[0] != '*') {
	    if (GetPrivateProfileStringA("Password Lists", name, "", buf,
		    MAX_PATH, "system.ini") > 0) {
		/*
		 * User exists, but there is no such thing as a home directory
		 * in system.ini. Return "{Windows drive}:/".
		 */

		GetWindowsDirectoryA(buf, MAX_PATH);
		Tcl_DStringAppend(bufferPtr, buf, 3);
		result = Tcl_DStringValue(bufferPtr);
	    }
	}
    }

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







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







1537
1538
1539
1540
1541
1542
1543
























1544
1545
1546
1547
1548
1549
1550
	    }
	    NetApiBufferFree((void *) uiPtr);
	}
	Tcl_DStringFree(&ds);
    }
    if (wDomain != NULL) {
	NetApiBufferFree((void *) wDomain);
























    }

    return result;
}

/*
 *---------------------------------------------------------------------------
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
	    if (GetLastError() == ERROR_ACCESS_DENIED) {
		Tcl_SetErrno(EACCES);
		return -1;
	    }
	}

	/*
	 * We cannnot verify the access fast, check it below using security
	 * info.
	 */
    }

    /*
     * It looks as if the permissions are ok, but if we are on NT, 2000 or XP,
     * we have a more complex permissions structure so we try to check that.







|







1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
	    if (GetLastError() == ERROR_ACCESS_DENIED) {
		Tcl_SetErrno(EACCES);
		return -1;
	    }
	}

	/*
	 * We cannot verify the access fast, check it below using security
	 * info.
	 */
    }

    /*
     * It looks as if the permissions are ok, but if we are on NT, 2000 or XP,
     * we have a more complex permissions structure so we try to check that.
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796

	    goto accessError;
	}

	RevertToSelf();

	/*
	 * Setup desiredAccess according to the access priveleges we are
	 * checking.
	 */

	if (mode & R_OK) {
	    desiredAccess |= FILE_GENERIC_READ;
	}
	if (mode & W_OK) {







|







1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790

	    goto accessError;
	}

	RevertToSelf();

	/*
	 * Setup desiredAccess according to the access privileges we are
	 * checking.
	 */

	if (mode & R_OK) {
	    desiredAccess |= FILE_GENERIC_READ;
	}
	if (mode & W_OK) {
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
    /*
     * If we can use 'createFile' on this, then we can use the resulting
     * fileHandle to read more information (nlink, ino) than we can get from
     * other attributes reading APIs. If not, then we try to fall back on the
     * 'getFileAttributesExProc', and if that isn't available, then on even
     * simpler routines.
     *
     * Special consideration must be given to Windows hardcoded names like
     * CON, NULL, COM1, LPT1 etc. For these, we still need to do the
     * CreateFile as some may not exist (e.g. there is no CON in wish by
     * default). However the subsequent GetFileInformationByHandle will
     * fail. We do a WinIsReserved to see if it is one of the special names,
     * and if successful, mock up a BY_HANDLE_FILE_INFORMATION structure.
     */








|







2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
    /*
     * If we can use 'createFile' on this, then we can use the resulting
     * fileHandle to read more information (nlink, ino) than we can get from
     * other attributes reading APIs. If not, then we try to fall back on the
     * 'getFileAttributesExProc', and if that isn't available, then on even
     * simpler routines.
     *
     * Special consideration must be given to Windows hard-coded names like
     * CON, NULL, COM1, LPT1 etc. For these, we still need to do the
     * CreateFile as some may not exist (e.g. there is no CON in wish by
     * default). However the subsequent GetFileInformationByHandle will
     * fail. We do a WinIsReserved to see if it is one of the special names,
     * and if successful, mock up a BY_HANDLE_FILE_INFORMATION structure.
     */

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
 *	This function replaces the library version of getcwd().
 *
 * Results:
 *	The input and output are filesystem paths in native form. The result
 *	is either the given clientData, if the working directory hasn't
 *	changed, or a new clientData (owned by our caller), giving the new
 *	native path, or NULL if the current directory could not be determined.
 *	If NULL is returned, the caller can examine the standard posix error
 *	codes to determine the cause of the problem.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

ClientData
TclpGetNativeCwd(
    ClientData clientData)
{
    WCHAR buffer[MAX_PATH];

    if (GetCurrentDirectoryW(MAX_PATH, buffer) == 0) {
	Tcl_WinConvertError(GetLastError());
	return NULL;
    }







|








|

|







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
 *	This function replaces the library version of getcwd().
 *
 * Results:
 *	The input and output are filesystem paths in native form. The result
 *	is either the given clientData, if the working directory hasn't
 *	changed, or a new clientData (owned by our caller), giving the new
 *	native path, or NULL if the current directory could not be determined.
 *	If NULL is returned, the caller can examine the standard Posix error
 *	codes to determine the cause of the problem.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void *
TclpGetNativeCwd(
    void *clientData)
{
    WCHAR buffer[MAX_PATH];

    if (GetCurrentDirectoryW(MAX_PATH, buffer) == 0) {
	Tcl_WinConvertError(GetLastError());
	return NULL;
    }
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
    if (found == 0) {
	return NULL;
    } else {
	Tcl_DString ds;

	Tcl_DStringInit(&ds);
	Tcl_WCharToUtfDString(volType, TCL_INDEX_NONE, &ds);
	return TclDStringToObj(&ds);
    }
#undef VOL_BUF_SIZE
}

/*
 * This define can be turned on to experiment with a different way of
 * normalizing paths (using a different Windows API). Unfortunately the new







|







2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
    if (found == 0) {
	return NULL;
    } else {
	Tcl_DString ds;

	Tcl_DStringInit(&ds);
	Tcl_WCharToUtfDString(volType, TCL_INDEX_NONE, &ds);
	return Tcl_DStringToObj(&ds);
    }
#undef VOL_BUF_SIZE
}

/*
 * This define can be turned on to experiment with a different way of
 * normalizing paths (using a different Windows API). Unfortunately the new
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
	    if (GetFileAttributesExW(nativePath,
		    GetFileExInfoStandard, &data) != TRUE) {
		/*
		 * File doesn't exist.
		 */

		if (isDrive) {
		    int len = WinIsReserved(path);

		    if (len > 0) {
			/*
			 * Actually it does exist - COM1, etc.
			 */

			int i;

			for (i=0 ; i<len ; i++) {
			    WCHAR wc = ((WCHAR *) nativePath)[i];

			    if (wc >= 'a') {
				wc -= ('a' - 'A');
				((WCHAR *) nativePath)[i] = wc;
			    }
			}
			Tcl_DStringAppend(&dsNorm,
				(const char *)nativePath,
				(int)(sizeof(WCHAR) * len));
			lastValidPathEnd = currentPathEndPosition;
		    } else if (nextCheckpoint == 0) {
			/*
			 * Path starts with a drive designation that's not
			 * actually on the system. We still must normalize up
			 * past the first separator. [Bug 3603434]
			 */







|






|


|








|







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
	    if (GetFileAttributesExW(nativePath,
		    GetFileExInfoStandard, &data) != TRUE) {
		/*
		 * File doesn't exist.
		 */

		if (isDrive) {
		    size_t len = WinIsReserved(path);

		    if (len > 0) {
			/*
			 * Actually it does exist - COM1, etc.
			 */

			size_t i;

			for (i=0 ; i<len ; i++) {
			    WCHAR wc = ((WCHAR *)nativePath)[i];

			    if (wc >= 'a') {
				wc -= ('a' - 'A');
				((WCHAR *) nativePath)[i] = wc;
			    }
			}
			Tcl_DStringAppend(&dsNorm,
				(const char *)nativePath,
				sizeof(WCHAR) * len);
			lastValidPathEnd = currentPathEndPosition;
		    } else if (nextCheckpoint == 0) {
			/*
			 * Path starts with a drive designation that's not
			 * actually on the system. We still must normalize up
			 * past the first separator. [Bug 3603434]
			 */
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
			    nativeName = fData.cAlternateFileName;
			}
			FindClose(handle);
			Tcl_DStringAppend(&dsNorm, (const char *) L"/",
				sizeof(WCHAR));
			Tcl_DStringAppend(&dsNorm,
				(const char *) nativeName,
				(int) (wcslen(nativeName)*sizeof(WCHAR)));
		    }
		}
	    }
#endif /* !TclNORM_LONG_PATH */
	    Tcl_DStringFree(&ds);
	    lastValidPathEnd = currentPathEndPosition;
	    if (cur == 0) {







|







2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
			    nativeName = fData.cAlternateFileName;
			}
			FindClose(handle);
			Tcl_DStringAppend(&dsNorm, (const char *) L"/",
				sizeof(WCHAR));
			Tcl_DStringAppend(&dsNorm,
				(const char *) nativeName,
				wcslen(nativeName)*sizeof(WCHAR));
		    }
		}
	    }
#endif /* !TclNORM_LONG_PATH */
	    Tcl_DStringFree(&ds);
	    lastValidPathEnd = currentPathEndPosition;
	    if (cur == 0) {
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
	nextCheckpoint = Tcl_DStringLength(&ds);
	if (*lastValidPathEnd != 0) {
	    /*
	     * Not the end of the string.
	     */

	    Tcl_Obj *tmpPathPtr;
	    size_t length;

	    tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),
		    nextCheckpoint);
	    Tcl_AppendToObj(tmpPathPtr, lastValidPathEnd, TCL_INDEX_NONE);
	    path = Tcl_GetStringFromObj(tmpPathPtr, &length);
	    Tcl_SetStringObj(pathPtr, path, length);
	    Tcl_DecrRefCount(tmpPathPtr);
	} else {
	    /*
	     * End of string was reached above.
	     */

	    Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&ds), nextCheckpoint);







|




|
|







2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
	nextCheckpoint = Tcl_DStringLength(&ds);
	if (*lastValidPathEnd != 0) {
	    /*
	     * Not the end of the string.
	     */

	    Tcl_Obj *tmpPathPtr;
	    Tcl_Size len;

	    tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),
		    nextCheckpoint);
	    Tcl_AppendToObj(tmpPathPtr, lastValidPathEnd, TCL_INDEX_NONE);
	    path = Tcl_GetStringFromObj(tmpPathPtr, &len);
	    Tcl_SetStringObj(pathPtr, path, len);
	    Tcl_DecrRefCount(tmpPathPtr);
	} else {
	    /*
	     * End of string was reached above.
	     */

	    Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&ds), nextCheckpoint);
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
	 */
    } else {
	/*
	 * Path of form C:foo/bar, but this only makes sense if the cwd is
	 * also on drive C.
	 */

	size_t cwdLen;
	const char *drive = Tcl_GetStringFromObj(useThisCwd, &cwdLen);
	char drive_cur = path[0];

	if (drive_cur >= 'a') {
	    drive_cur -= ('a' - 'A');
	}
	if (drive[0] == drive_cur) {







|







2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
	 */
    } else {
	/*
	 * Path of form C:foo/bar, but this only makes sense if the cwd is
	 * also on drive C.
	 */

	Tcl_Size 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) {
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
 *	None.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
TclpNativeToNormalized(
    ClientData clientData)
{
    Tcl_DString ds;
    Tcl_Obj *objPtr;
    size_t len;
    char *copy, *p;

    Tcl_DStringInit(&ds);







|







2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
 *	None.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
TclpNativeToNormalized(
    void *clientData)
{
    Tcl_DString ds;
    Tcl_Obj *objPtr;
    size_t len;
    char *copy, *p;

    Tcl_DStringInit(&ds);
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
 *
 * Side effects:
 *	Memory will be allocated. The path might be normalized.
 *
 *---------------------------------------------------------------------------
 */

ClientData
TclNativeCreateNativeRep(
    Tcl_Obj *pathPtr)
{
    WCHAR *nativePathPtr = NULL;
    const char *str;
    Tcl_Obj *validPathPtr;
    size_t len;
    WCHAR *wp;

    if (TclFSCwdIsNative()) {
	/*
	 * The cwd is native, which means we can use the translated path
	 * without worrying about normalization (this will also usually be
	 * shorter so the utf-to-external conversion will be somewhat faster).







|






|







3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
 *
 * Side effects:
 *	Memory will be allocated. The path might be normalized.
 *
 *---------------------------------------------------------------------------
 */

void *
TclNativeCreateNativeRep(
    Tcl_Obj *pathPtr)
{
    WCHAR *nativePathPtr = NULL;
    const char *str;
    Tcl_Obj *validPathPtr;
    Tcl_Size len;
    WCHAR *wp;

    if (TclFSCwdIsNative()) {
	/*
	 * The cwd is native, which means we can use the translated path
	 * without worrying about normalization (this will also usually be
	 * shorter so the utf-to-external conversion will be somewhat faster).
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
	 */

	Tcl_IncrRefCount(validPathPtr);
    }

    str = Tcl_GetStringFromObj(validPathPtr, &len);

    if (strlen(str) != len) {
	/*
	 * String contains NUL-bytes. This is invalid.
	 */

	goto done;
    }








|







3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
	 */

	Tcl_IncrRefCount(validPathPtr);
    }

    str = Tcl_GetStringFromObj(validPathPtr, &len);

    if (strlen(str) != (size_t)len) {
	/*
	 * String contains NUL-bytes. This is invalid.
	 */

	goto done;
    }

3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
 *
 * Side effects:
 *	Memory allocation for the copy.
 *
 *---------------------------------------------------------------------------
 */

ClientData
TclNativeDupInternalRep(
    ClientData clientData)
{
    char *copy;
    size_t len;

    if (clientData == NULL) {
	return NULL;
    }







|

|







3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
 *
 * Side effects:
 *	Memory allocation for the copy.
 *
 *---------------------------------------------------------------------------
 */

void *
TclNativeDupInternalRep(
    void *clientData)
{
    char *copy;
    size_t len;

    if (clientData == NULL) {
	return NULL;
    }

Changes to win/tclWinInit.c.

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

void
TclpInitLibraryPath(
    char **valuePtr,
    size_t *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
#define LIBRARY_SIZE	    64
    Tcl_Obj *pathPtr;
    char installLib[LIBRARY_SIZE];
    const char *bytes;
    size_t length;

    TclNewObj(pathPtr);

    /*
     * Initialize the substring used when locating the script library. The
     * installLib variable computes the script library path relative to the
     * installed DLL.
     */

    sprintf(installLib, "lib/tcl%s", TCL_VERSION);

    /*
     * Look for the library relative to the TCL_LIBRARY env variable. If the
     * last dirname in the TCL_LIBRARY path does not match the last dirname in
     * the installLib variable, use the last dir name of installLib in
     * addition to the orginal TCL_LIBRARY path.
     */

    AppendEnvironment(pathPtr, installLib);

    /*
     * Look for the library in its default location.
     */







|






|









|





|







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

void
TclpInitLibraryPath(
    char **valuePtr,
    TCL_HASH_TYPE *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
#define LIBRARY_SIZE	    64
    Tcl_Obj *pathPtr;
    char installLib[LIBRARY_SIZE];
    const char *bytes;
    Tcl_Size length;

    TclNewObj(pathPtr);

    /*
     * Initialize the substring used when locating the script library. The
     * installLib variable computes the script library path relative to the
     * installed DLL.
     */

    snprintf(installLib, sizeof(installLib), "lib/tcl%s", TCL_VERSION);

    /*
     * Look for the library relative to the TCL_LIBRARY env variable. If the
     * last dirname in the TCL_LIBRARY path does not match the last dirname in
     * the installLib variable, use the last dir name of installLib in
     * addition to the original TCL_LIBRARY path.
     */

    AppendEnvironment(pathPtr, installLib);

    /*
     * Look for the library in its default location.
     */
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
 */

static void
AppendEnvironment(
    Tcl_Obj *pathPtr,
    const char *lib)
{
    size_t pathc;
    WCHAR wBuf[MAX_PATH];
    char buf[MAX_PATH * 3];
    Tcl_Obj *objPtr;
    Tcl_DString ds;
    const char **pathv;
    char *shortlib;








|







194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
 */

static void
AppendEnvironment(
    Tcl_Obj *pathPtr,
    const char *lib)
{
    Tcl_Size pathc;
    WCHAR wBuf[MAX_PATH];
    char buf[MAX_PATH * 3];
    Tcl_Obj *objPtr;
    Tcl_DString ds;
    const char **pathv;
    char *shortlib;

221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
	}
    }
    if (shortlib == lib) {
	Tcl_Panic("no '/' character found in lib");
    }

    /*
     * The "L" preceeding the TCL_LIBRARY string is used to tell VC++ that
     * this is a unicode string.
     */

    GetEnvironmentVariableW(L"TCL_LIBRARY", wBuf, MAX_PATH);
    WideCharToMultiByte(CP_UTF8, 0, wBuf, -1, buf, MAX_PATH * 3, NULL, NULL);

    if (buf[0] != '\0') {
	objPtr = Tcl_NewStringObj(buf, TCL_INDEX_NONE);







|
|







221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
	}
    }
    if (shortlib == lib) {
	Tcl_Panic("no '/' character found in lib");
    }

    /*
     * The "L" preceding the TCL_LIBRARY string is used to tell VC++ that
     * this is a Unicode string.
     */

    GetEnvironmentVariableW(L"TCL_LIBRARY", wBuf, MAX_PATH);
    WideCharToMultiByte(CP_UTF8, 0, wBuf, -1, buf, MAX_PATH * 3, NULL, NULL);

    if (buf[0] != '\0') {
	objPtr = Tcl_NewStringObj(buf, TCL_INDEX_NONE);
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
	     * directory to make it refer to this installation by removing the
	     * old "tclX.Y" and substituting the current version string.
	     */

	    pathv[pathc - 1] = shortlib;
	    Tcl_DStringInit(&ds);
	    (void) Tcl_JoinPath(pathc, pathv, &ds);
	    objPtr = TclDStringToObj(&ds);
	} else {
	    objPtr = Tcl_NewStringObj(buf, TCL_INDEX_NONE);
	}
	Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
	Tcl_Free((void *)pathv);
    }
}







|







251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
	     * directory to make it refer to this installation by removing the
	     * old "tclX.Y" and substituting the current version string.
	     */

	    pathv[pathc - 1] = shortlib;
	    Tcl_DStringInit(&ds);
	    (void) Tcl_JoinPath(pathc, pathv, &ds);
	    objPtr = Tcl_DStringToObj(&ds);
	} else {
	    objPtr = Tcl_NewStringObj(buf, TCL_INDEX_NONE);
	}
	Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
	Tcl_Free((void *)pathv);
    }
}
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
    p = strrchr(name, '\\');
    if (p != NULL) {
	end = p;
    }
    *end = '\\';

    TclWinNoBackslash(name);
    sprintf(end + 1, "lib/tcl%s", TCL_VERSION);
    *lengthPtr = strlen(name);
    *valuePtr = (char *)Tcl_Alloc(*lengthPtr + 1);
    *encodingPtr = NULL;
    memcpy(*valuePtr, name, *lengthPtr + 1);
}

/*







|







300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
    p = strrchr(name, '\\');
    if (p != NULL) {
	end = p;
    }
    *end = '\\';

    TclWinNoBackslash(name);
    snprintf(end + 1, LIBRARY_SIZE, "lib/tcl%s", TCL_VERSION);
    *lengthPtr = strlen(name);
    *valuePtr = (char *)Tcl_Alloc(*lengthPtr + 1);
    *encodingPtr = NULL;
    memcpy(*valuePtr, name, *lengthPtr + 1);
}

/*
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
    p = strrchr(name, '\\');
    if (p != NULL) {
	end = p;
    }
    *end = '\\';

    TclWinNoBackslash(name);
    sprintf(end + 1, "../library");
    *lengthPtr = strlen(name);
    *valuePtr = (char *)Tcl_Alloc(*lengthPtr + 1);
    *encodingPtr = NULL;
    memcpy(*valuePtr, name, *lengthPtr + 1);
}

/*







|







348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
    p = strrchr(name, '\\');
    if (p != NULL) {
	end = p;
    }
    *end = '\\';

    TclWinNoBackslash(name);
    snprintf(end + 1, LIBRARY_SIZE, "../library");
    *lengthPtr = strlen(name);
    *valuePtr = (char *)Tcl_Alloc(*lengthPtr + 1);
    *encodingPtr = NULL;
    memcpy(*valuePtr, name, *lengthPtr + 1);
}

/*
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
    UINT acp = GetACP();

    Tcl_DStringInit(bufPtr);
    if (acp == CP_UTF8) {
	Tcl_DStringAppend(bufPtr, "utf-8", 5);
    } else {
	Tcl_DStringSetLength(bufPtr, 2+TCL_INTEGER_SPACE);
	wsprintfA(Tcl_DStringValue(bufPtr), "cp%d", GetACP());
	Tcl_DStringSetLength(bufPtr, strlen(Tcl_DStringValue(bufPtr)));
    }
    return Tcl_DStringValue(bufPtr);
}

const char *
TclpGetUserName(







|







400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
    UINT acp = GetACP();

    Tcl_DStringInit(bufPtr);
    if (acp == CP_UTF8) {
	Tcl_DStringAppend(bufPtr, "utf-8", 5);
    } else {
	Tcl_DStringSetLength(bufPtr, 2+TCL_INTEGER_SPACE);
	snprintf(Tcl_DStringValue(bufPtr), 2+TCL_INTEGER_SPACE, "cp%d", GetACP());
	Tcl_DStringSetLength(bufPtr, strlen(Tcl_DStringValue(bufPtr)));
    }
    return Tcl_DStringValue(bufPtr);
}

const char *
TclpGetUserName(
481
482
483
484
485
486
487



488
489
490
491
492
493
494
495
     * Define the tcl_platform array.
     */

    Tcl_SetVar2(interp, "tcl_platform", "platform", "windows",
	    TCL_GLOBAL_ONLY);
    Tcl_SetVar2(interp, "tcl_platform", "os",
	    "Windows NT", TCL_GLOBAL_ONLY);



    wsprintfA(buffer, "%d.%d", osInfo.dwMajorVersion, osInfo.dwMinorVersion);
    Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY);
    if (sys.oemId.wProcessorArchitecture < NUMPROCESSORS) {
	Tcl_SetVar2(interp, "tcl_platform", "machine",
		processors[sys.oemId.wProcessorArchitecture],
		TCL_GLOBAL_ONLY);
    }








>
>
>
|







481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
     * Define the tcl_platform array.
     */

    Tcl_SetVar2(interp, "tcl_platform", "platform", "windows",
	    TCL_GLOBAL_ONLY);
    Tcl_SetVar2(interp, "tcl_platform", "os",
	    "Windows NT", TCL_GLOBAL_ONLY);
    if (osInfo.dwMajorVersion == 10 && osInfo.dwBuildNumber >= 22000) {
	osInfo.dwMajorVersion = 11;
    }
    snprintf(buffer, sizeof(buffer), "%ld.%ld", osInfo.dwMajorVersion, osInfo.dwMinorVersion);
    Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY);
    if (sys.oemId.wProcessorArchitecture < NUMPROCESSORS) {
	Tcl_SetVar2(interp, "tcl_platform", "machine",
		processors[sys.oemId.wProcessorArchitecture],
		TCL_GLOBAL_ONLY);
    }

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
 * TclpFindVariable --
 *
 *	Locate the entry in environ for a given name. On Unix this routine is
 *	case sensitive, on Windows this matches mixed case.
 *
 * Results:
 *	The return value is the index in environ of an entry with the name
 *	"name", or TCL_INDEX_NONE if there is no such entry. The integer
 *	at *lengthPtr is filled in with the length of name (if a matching
 *	entry is found) or the length of the environ array (if no
 *	matching entry is found).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#  define tenviron2utfdstr(string, len, dsPtr) \
		(char *)Tcl_Char16ToUtfDString((const unsigned short *)(string), ((((len) + 2) >> 1) - 1), (dsPtr))

size_t
TclpFindVariable(
    const char *name,		/* Name of desired environment variable
				 * (UTF-8). */
    size_t *lengthPtr)		/* Used to return length of name (for
				 * successful searches) or number of non-NULL
				 * entries in environ (for unsuccessful
				 * searches). */
{
    size_t i, length, result = TCL_INDEX_NONE;
    const WCHAR *env;
    const char *p1, *p2;
    char *envUpper, *nameUpper;
    Tcl_DString envString;

    /*
     * Convert the name to all upper case for the case insensitive comparison.







|













|



|




|







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
 * TclpFindVariable --
 *
 *	Locate the entry in environ for a given name. On Unix this routine is
 *	case sensitive, on Windows this matches mixed case.
 *
 * Results:
 *	The return value is the index in environ of an entry with the name
 *	"name", or -1 if there is no such entry. The integer
 *	at *lengthPtr is filled in with the length of name (if a matching
 *	entry is found) or the length of the environ array (if no
 *	matching entry is found).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#  define tenviron2utfdstr(string, len, dsPtr) \
		(char *)Tcl_Char16ToUtfDString((const unsigned short *)(string), ((((len) + 2) >> 1) - 1), (dsPtr))

Tcl_Size
TclpFindVariable(
    const char *name,		/* Name of desired environment variable
				 * (UTF-8). */
    Tcl_Size *lengthPtr)		/* Used to return length of name (for
				 * successful searches) or number of non-NULL
				 * entries in environ (for unsuccessful
				 * searches). */
{
    Tcl_Size i, length, result = -1;
    const WCHAR *env;
    const char *p1, *p2;
    char *envUpper, *nameUpper;
    Tcl_DString envString;

    /*
     * Convert the name to all upper case for the case insensitive comparison.
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
	/*
	 * Chop the env string off after the equal sign, then Convert the name
	 * to all upper case, so we do not have to convert all the characters
	 * after the equal sign.
	 */

	Tcl_DStringInit(&envString);
	envUpper = Tcl_WCharToUtfDString(env, TCL_INDEX_NONE, &envString);
	p1 = strchr(envUpper, '=');
	if (p1 == NULL) {
	    continue;
	}
	length = p1 - envUpper;
	Tcl_DStringSetLength(&envString, length+1);
	Tcl_UtfToUpper(envUpper);







|







600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
	/*
	 * Chop the env string off after the equal sign, then Convert the name
	 * to all upper case, so we do not have to convert all the characters
	 * after the equal sign.
	 */

	Tcl_DStringInit(&envString);
	envUpper = Tcl_WCharToUtfDString(env, -1, &envString);
	p1 = strchr(envUpper, '=');
	if (p1 == NULL) {
	    continue;
	}
	length = p1 - envUpper;
	Tcl_DStringSetLength(&envString, length+1);
	Tcl_UtfToUpper(envUpper);

Changes to win/tclWinInt.h.

39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
MODULE_SCOPE char	TclWinDriveLetterForVolMountPoint(
			    const WCHAR *mountPoint);
MODULE_SCOPE void	TclWinEncodingsCleanup(void);
MODULE_SCOPE void	TclWinInit(HINSTANCE hInst);
MODULE_SCOPE TclFile	TclWinMakeFile(HANDLE handle);
MODULE_SCOPE Tcl_Channel TclWinOpenConsoleChannel(HANDLE handle,
			    char *channelName, int permissions);
MODULE_SCOPE Tcl_Channel TclWinOpenFileChannel(HANDLE handle, char *channelName,
			    int permissions, int appendMode);
MODULE_SCOPE Tcl_Channel TclWinOpenSerialChannel(HANDLE handle,
			    char *channelName, int permissions);
MODULE_SCOPE HANDLE	TclWinSerialOpen(HANDLE handle, const WCHAR *name,
			    DWORD access);
MODULE_SCOPE int	TclWinSymLinkCopyDirectory(const WCHAR *LinkOriginal,
			    const WCHAR *LinkCopy);
MODULE_SCOPE int	TclWinSymLinkDelete(const WCHAR *LinkOriginal,







<
<







39
40
41
42
43
44
45


46
47
48
49
50
51
52
MODULE_SCOPE char	TclWinDriveLetterForVolMountPoint(
			    const WCHAR *mountPoint);
MODULE_SCOPE void	TclWinEncodingsCleanup(void);
MODULE_SCOPE void	TclWinInit(HINSTANCE hInst);
MODULE_SCOPE TclFile	TclWinMakeFile(HANDLE handle);
MODULE_SCOPE Tcl_Channel TclWinOpenConsoleChannel(HANDLE handle,
			    char *channelName, int permissions);


MODULE_SCOPE Tcl_Channel TclWinOpenSerialChannel(HANDLE handle,
			    char *channelName, int permissions);
MODULE_SCOPE HANDLE	TclWinSerialOpen(HANDLE handle, const WCHAR *name,
			    DWORD access);
MODULE_SCOPE int	TclWinSymLinkCopyDirectory(const WCHAR *LinkOriginal,
			    const WCHAR *LinkCopy);
MODULE_SCOPE int	TclWinSymLinkDelete(const WCHAR *LinkOriginal,

Changes to win/tclWinLoad.c.

94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
         * Remember the first error on load attempt to be used if the
         * second load attempt below also fails.
        */
        firstError = (nativeName == NULL) ?
		ERROR_MOD_NOT_FOUND : GetLastError();

	Tcl_DStringInit(&ds);
	nativeName = Tcl_UtfToWCharDString(TclGetString(pathPtr), -1, &ds);
	hInstance = LoadLibraryExW(nativeName, NULL,
		LOAD_WITH_ALTERED_SEARCH_PATH);
	Tcl_DStringFree(&ds);
    }

    if (hInstance == NULL) {
	DWORD lastError;







|







94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
         * Remember the first error on load attempt to be used if the
         * second load attempt below also fails.
        */
        firstError = (nativeName == NULL) ?
		ERROR_MOD_NOT_FOUND : GetLastError();

	Tcl_DStringInit(&ds);
	nativeName = Tcl_UtfToWCharDString(TclGetString(pathPtr), TCL_INDEX_NONE, &ds);
	hInstance = LoadLibraryExW(nativeName, NULL,
		LOAD_WITH_ALTERED_SEARCH_PATH);
	Tcl_DStringFree(&ds);
    }

    if (hInstance == NULL) {
	DWORD lastError;
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
	    case ERROR_MOD_NOT_FOUND:
		Tcl_SetErrorCode(interp, "WIN_LOAD", "MOD_NOT_FOUND", NULL);
		goto notFoundMsg;
	    case ERROR_DLL_NOT_FOUND:
		Tcl_SetErrorCode(interp, "WIN_LOAD", "DLL_NOT_FOUND", NULL);
	    notFoundMsg:
		Tcl_AppendToObj(errMsg, "this library or a dependent library"
			" could not be found in library path", -1);
		break;
	    case ERROR_PROC_NOT_FOUND:
		Tcl_SetErrorCode(interp, "WIN_LOAD", "PROC_NOT_FOUND", NULL);
		Tcl_AppendToObj(errMsg, "A function specified in the import"
			" table could not be resolved by the system. Windows"
			" is not telling which one, I'm sorry.", -1);
		break;
	    case ERROR_INVALID_DLL:
		Tcl_SetErrorCode(interp, "WIN_LOAD", "INVALID_DLL", NULL);
		Tcl_AppendToObj(errMsg, "this library or a dependent library"
			" is damaged", -1);
		break;
	    case ERROR_DLL_INIT_FAILED:
		Tcl_SetErrorCode(interp, "WIN_LOAD", "DLL_INIT_FAILED", NULL);
		Tcl_AppendToObj(errMsg, "the library initialization"
			" routine failed", -1);
		break;
            case ERROR_BAD_EXE_FORMAT:
		Tcl_SetErrorCode(interp, "WIN_LOAD", "BAD_EXE_FORMAT", NULL);
		Tcl_AppendToObj(errMsg, "Bad exe format. Possibly a 32/64-bit mismatch.", -1);
                break;
            default:
		Tcl_WinConvertError(lastError);
		Tcl_AppendToObj(errMsg, Tcl_PosixError(interp), -1);
	    }
	    Tcl_SetObjResult(interp, errMsg);
	}
	return TCL_ERROR;
    }

    /*
     * Succeded; package everything up for Tcl.
     */

    handlePtr = (Tcl_LoadHandle)Tcl_Alloc(sizeof(struct Tcl_LoadHandle_));
    handlePtr->clientData = (ClientData) hInstance;
    handlePtr->findSymbolProcPtr = &FindSymbol;
    handlePtr->unloadFileProcPtr = &UnloadFile;
    *loadHandle = handlePtr;
    *unloadProcPtr = &UnloadFile;
    return TCL_OK;
}








|





|




|




|



|



|











|







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
	    case ERROR_MOD_NOT_FOUND:
		Tcl_SetErrorCode(interp, "WIN_LOAD", "MOD_NOT_FOUND", NULL);
		goto notFoundMsg;
	    case ERROR_DLL_NOT_FOUND:
		Tcl_SetErrorCode(interp, "WIN_LOAD", "DLL_NOT_FOUND", NULL);
	    notFoundMsg:
		Tcl_AppendToObj(errMsg, "this library or a dependent library"
			" could not be found in library path", TCL_INDEX_NONE);
		break;
	    case ERROR_PROC_NOT_FOUND:
		Tcl_SetErrorCode(interp, "WIN_LOAD", "PROC_NOT_FOUND", NULL);
		Tcl_AppendToObj(errMsg, "A function specified in the import"
			" table could not be resolved by the system. Windows"
			" is not telling which one, I'm sorry.", TCL_INDEX_NONE);
		break;
	    case ERROR_INVALID_DLL:
		Tcl_SetErrorCode(interp, "WIN_LOAD", "INVALID_DLL", NULL);
		Tcl_AppendToObj(errMsg, "this library or a dependent library"
			" is damaged", TCL_INDEX_NONE);
		break;
	    case ERROR_DLL_INIT_FAILED:
		Tcl_SetErrorCode(interp, "WIN_LOAD", "DLL_INIT_FAILED", NULL);
		Tcl_AppendToObj(errMsg, "the library initialization"
			" routine failed", TCL_INDEX_NONE);
		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.", TCL_INDEX_NONE);
                break;
            default:
		Tcl_WinConvertError(lastError);
		Tcl_AppendToObj(errMsg, Tcl_PosixError(interp), TCL_INDEX_NONE);
	    }
	    Tcl_SetObjResult(interp, errMsg);
	}
	return TCL_ERROR;
    }

    /*
     * Succeded; package everything up for Tcl.
     */

    handlePtr = (Tcl_LoadHandle)Tcl_Alloc(sizeof(struct Tcl_LoadHandle_));
    handlePtr->clientData = (void *)hInstance;
    handlePtr->findSymbolProcPtr = &FindSymbol;
    handlePtr->unloadFileProcPtr = &UnloadFile;
    *loadHandle = handlePtr;
    *unloadProcPtr = &UnloadFile;
    return TCL_OK;
}


Changes to win/tclWinNotify.c.

10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

/*
 * The follwing static indicates whether this module has been initialized.
 */

#define INTERVAL_TIMER	1	/* Handle of interval timer. */

#define WM_WAKEUP	WM_USER	/* Message that is send by
				 * Tcl_AlertNotifier. */
/*







|







10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

/*
 * The following static indicates whether this module has been initialized.
 */

#define INTERVAL_TIMER	1	/* Handle of interval timer. */

#define WM_WAKEUP	WM_USER	/* Message that is send by
				 * Tcl_AlertNotifier. */
/*
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

ClientData
TclpInitNotifier(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    TclpGlobalLock();
    if (!initialized) {
	initialized = 1;







|







72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void *
TclpInitNotifier(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    TclpGlobalLock();
    if (!initialized) {
	initialized = 1;
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
 *	May dispose of the notifier window and class.
 *
 *----------------------------------------------------------------------
 */

void
TclpFinalizeNotifier(
    ClientData clientData)	/* Pointer to notifier data. */
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;

    /*
     * Only finalize the notifier if a notifier was installed in the current
     * thread; there is a route in which this is not guaranteed to be true
     * (when tclWin32Dll.c:DllMain() is called with the flag







|







144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
 *	May dispose of the notifier window and class.
 *
 *----------------------------------------------------------------------
 */

void
TclpFinalizeNotifier(
    void *clientData)	/* Pointer to notifier data. */
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;

    /*
     * Only finalize the notifier if a notifier was installed in the current
     * thread; there is a route in which this is not guaranteed to be true
     * (when tclWin32Dll.c:DllMain() is called with the flag
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
 *	isn't already one pending.
 *
 *----------------------------------------------------------------------
 */

void
TclpAlertNotifier(
    ClientData clientData)	/* Pointer to thread data. */
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;

    /*
     * Note that we do not need to lock around access to the hwnd because the
     * race condition has no effect since any race condition implies that the
     * notifier thread is already awake.







|







214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
 *	isn't already one pending.
 *
 *----------------------------------------------------------------------
 */

void
TclpAlertNotifier(
    void *clientData)	/* Pointer to thread data. */
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;

    /*
     * Note that we do not need to lock around access to the hwnd because the
     * race condition has no effect since any race condition implies that the
     * notifier thread is already awake.
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
	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;







|







283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
	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 = (UINT)timePtr->sec * 1000 + (unsigned long)timePtr->usec / 1000;
	if (timeout == 0) {
	    timeout = 1;
	}
    }

    if (timeout != 0) {
	tsdPtr->timerActive = 1;
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

ClientData
TclpNotifierData(void)
{
    return NULL;
}

/*
 *----------------------------------------------------------------------







|







433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void *
TclpNotifierData(void)
{
    return NULL;
}

/*
 *----------------------------------------------------------------------
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
	myTime.sec  = timePtr->sec;
	myTime.usec = timePtr->usec;

	if (myTime.sec != 0 || myTime.usec != 0) {
	    TclScaleTime(&myTime);
	}

	timeout = myTime.sec * 1000 + myTime.usec / 1000;
    } else {
	timeout = INFINITE;
    }

    /*
     * Check to see if there are any messages in the queue before waiting
     * because MsgWaitForMultipleObjects will not wake up if there are events







|







486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
	myTime.sec  = timePtr->sec;
	myTime.usec = timePtr->usec;

	if (myTime.sec != 0 || myTime.usec != 0) {
	    TclScaleTime(&myTime);
	}

	timeout = (DWORD)myTime.sec * 1000 + (unsigned long)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
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
    }

    /*
     * TIP #233: Scale delay from virtual to real-time.
     */

    TclScaleTime(&vdelay);
    sleepTime = vdelay.sec * 1000 + vdelay.usec / 1000;

    for (;;) {
	SleepEx(sleepTime, TRUE);
	Tcl_GetTime(&now);
	if (now.sec > desired.sec) {
	    break;
	} else if ((now.sec == desired.sec) && (now.usec >= desired.usec)) {
	    break;
	}

	vdelay.sec  = desired.sec  - now.sec;
	vdelay.usec = desired.usec - now.usec;

	TclScaleTime(&vdelay);
	sleepTime = vdelay.sec * 1000 + vdelay.usec / 1000;
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|














|










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
    }

    /*
     * TIP #233: Scale delay from virtual to real-time.
     */

    TclScaleTime(&vdelay);
    sleepTime = (DWORD)vdelay.sec * 1000 + (unsigned long)vdelay.usec / 1000;

    for (;;) {
	SleepEx(sleepTime, TRUE);
	Tcl_GetTime(&now);
	if (now.sec > desired.sec) {
	    break;
	} else if ((now.sec == desired.sec) && (now.usec >= desired.usec)) {
	    break;
	}

	vdelay.sec  = desired.sec  - now.sec;
	vdelay.usec = desired.usec - now.usec;

	TclScaleTime(&vdelay);
	sleepTime = (DWORD)vdelay.sec * 1000 + (unsigned long)vdelay.usec / 1000;
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to win/tclWinPanic.c.

52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
    if (msgString[TCL_MAX_WARN_LEN-1] != '\0') {
	memcpy(msgString + (TCL_MAX_WARN_LEN - 5), L" ...", 5 * sizeof(WCHAR));
    }

    if (IsDebuggerPresent()) {
	OutputDebugStringW(msgString);
    } else if (_isatty(2)) {
	WriteConsoleW(handle, msgString, wcslen(msgString), &dummy, 0);
    } else {
	buf[0] = '\xEF'; buf[1] = '\xBB'; buf[2] = '\xBF'; /* UTF-8 bom */
	WriteFile(handle, buf, strlen(buf), &dummy, 0);
	WriteFile(handle, "\n", 1, &dummy, 0);
	FlushFileBuffers(handle);
    }
#   if defined(__GNUC__)
	__builtin_trap();
#   elif defined(_WIN64)
	__debugbreak();







|


|







52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
    if (msgString[TCL_MAX_WARN_LEN-1] != '\0') {
	memcpy(msgString + (TCL_MAX_WARN_LEN - 5), L" ...", 5 * sizeof(WCHAR));
    }

    if (IsDebuggerPresent()) {
	OutputDebugStringW(msgString);
    } else if (_isatty(2)) {
	WriteConsoleW(handle, msgString, (DWORD)wcslen(msgString), &dummy, 0);
    } else {
	buf[0] = '\xEF'; buf[1] = '\xBB'; buf[2] = '\xBF'; /* UTF-8 bom */
	WriteFile(handle, buf, (DWORD)strlen(buf), &dummy, 0);
	WriteFile(handle, "\n", 1, &dummy, 0);
	FlushFileBuffers(handle);
    }
#   if defined(__GNUC__)
	__builtin_trap();
#   elif defined(_WIN64)
	__debugbreak();

Changes to win/tclWinPipe.c.

574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
	break;
    default:
	createMode = OPEN_EXISTING;
	break;
    }

    Tcl_DStringInit(&ds);
    nativePath = Tcl_UtfToWCharDString(path, -1, &ds);

    /*
     * If the file is not being created, use the existing file attributes.
     */

    flags = 0;
    if (!(mode & O_CREAT)) {







|







574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
	break;
    default:
	createMode = OPEN_EXISTING;
	break;
    }

    Tcl_DStringInit(&ds);
    nativePath = Tcl_UtfToWCharDString(path, TCL_INDEX_NONE, &ds);

    /*
     * If the file is not being created, use the existing file attributes.
     */

    flags = 0;
    if (!(mode & O_CREAT)) {
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
{
    ProcInfo *infoPtr;

    PipeInit();

    Tcl_MutexLock(&pipeMutex);
    for (infoPtr = procList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
	if (infoPtr->dwProcessId == (size_t) pid) {
	    Tcl_MutexUnlock(&pipeMutex);
	    return infoPtr->dwProcessId;
	}
    }
    Tcl_MutexUnlock(&pipeMutex);
    return TCL_INDEX_NONE;
}







|







865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
{
    ProcInfo *infoPtr;

    PipeInit();

    Tcl_MutexLock(&pipeMutex);
    for (infoPtr = procList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
	if (infoPtr->dwProcessId == (size_t)pid) {
	    Tcl_MutexUnlock(&pipeMutex);
	    return infoPtr->dwProcessId;
	}
    }
    Tcl_MutexUnlock(&pipeMutex);
    return TCL_INDEX_NONE;
}
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
				 * arguments have not been converted. */
    TclFile inputFile,		/* If non-NULL, gives the file to use as input
				 * for the child process. If inputFile file is
				 * not readable or is NULL, the child will
				 * receive no standard input. */
    TclFile outputFile,		/* If non-NULL, gives the file that receives
				 * output from the child process. If
				 * outputFile file is not writeable or is
				 * NULL, output from the child will be
				 * discarded. */
    TclFile errorFile,		/* If non-NULL, gives the file that receives
				 * errors from the child process. If errorFile
				 * file is not writeable or is NULL, errors
				 * from the child will be discarded. errorFile
				 * may be the same as outputFile. */
    Tcl_Pid *pidPtr)		/* If this function is successful, pidPtr is
				 * filled with the process id of the child
				 * process. */
{
    int result, applType, createFlags;







|




|







919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
				 * arguments have not been converted. */
    TclFile inputFile,		/* If non-NULL, gives the file to use as input
				 * for the child process. If inputFile file is
				 * not readable or is NULL, the child will
				 * receive no standard input. */
    TclFile outputFile,		/* If non-NULL, gives the file that receives
				 * output from the child process. If
				 * outputFile file is not writable or is
				 * NULL, output from the child will be
				 * discarded. */
    TclFile errorFile,		/* If non-NULL, gives the file that receives
				 * errors from the child process. If errorFile
				 * file is not writable or is NULL, errors
				 * from the child will be discarded. errorFile
				 * may be the same as outputFile. */
    Tcl_Pid *pidPtr)		/* If this function is successful, pidPtr is
				 * filled with the process id of the child
				 * process. */
{
    int result, applType, createFlags;
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
    /*
     * For backward compatibility with previous versions of Tcl, we use
     * "file%d" as the base name for pipes even though it would be more
     * natural to use "pipe%d". Use the pointer to keep the channel names
     * unique, in case channels share handles (stdin/stdout).
     */

    sprintf(channelName, "file%" TCL_Z_MODIFIER "x", (size_t) infoPtr);
    infoPtr->channel = Tcl_CreateChannel(&pipeChannelType, channelName,
	    infoPtr, infoPtr->validMask);

    Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
    return infoPtr->channel;
}








|







1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
    /*
     * For backward compatibility with previous versions of Tcl, we use
     * "file%d" as the base name for pipes even though it would be more
     * natural to use "pipe%d". Use the pointer to keep the channel names
     * unique, in case channels share handles (stdin/stdout).
     */

    snprintf(channelName, sizeof(channelName), "file%" TCL_Z_MODIFIER "x", (size_t) infoPtr);
    infoPtr->channel = Tcl_CreateChannel(&pipeChannelType, channelName,
	    infoPtr, infoPtr->validMask);

    Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
    return infoPtr->channel;
}

2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
 */

void
TclWinAddProcess(
    void *hProcess,		/* Handle to process */
    size_t id)		/* Global process identifier */
{
    ProcInfo *procPtr = (ProcInfo*)Tcl_Alloc(sizeof(ProcInfo));

    PipeInit();

    procPtr->hProcess = hProcess;
    procPtr->dwProcessId = id;
    Tcl_MutexLock(&pipeMutex);
    procPtr->nextPtr = procList;







|







2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
 */

void
TclWinAddProcess(
    void *hProcess,		/* Handle to process */
    size_t id)		/* Global process identifier */
{
    ProcInfo *procPtr = (ProcInfo *)Tcl_Alloc(sizeof(ProcInfo));

    PipeInit();

    procPtr->hProcess = hProcess;
    procPtr->dwProcessId = id;
    Tcl_MutexLock(&pipeMutex);
    procPtr->nextPtr = procList;
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
static int
WaitForRead(
    PipeInfo *infoPtr,		/* Pipe state. */
    int blocking)		/* Indicates whether call should be blocking
				 * or not. */
{
    DWORD timeout, count;
    HANDLE *handle = (HANDLE *)((WinFile *) infoPtr->readFile)->handle;

    while (1) {
	/*
	 * Synchronize with the reader thread.
	 */

	/* avoid blocking if pipe-thread exited */







|







2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
static int
WaitForRead(
    PipeInfo *infoPtr,		/* Pipe state. */
    int blocking)		/* Indicates whether call should be blocking
				 * or not. */
{
    DWORD timeout, count;
    HANDLE handle = ((WinFile *) infoPtr->readFile)->handle;

    while (1) {
	/*
	 * Synchronize with the reader thread.
	 */

	/* avoid blocking if pipe-thread exited */
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
    int action)
{
    PipeInfo *infoPtr = (PipeInfo *) instanceData;

    /*
     * We do not access firstPipePtr in the thread structures. This is not for
     * all pipes managed by the thread, but only those we are watching.
     * Removal of the filevent handlers before transfer thus takes care of
     * this structure.
     */

    Tcl_MutexLock(&pipeMutex);
    if (action == TCL_CHANNEL_THREAD_INSERT) {
	/*
	 * We can't copy the thread information from the channel when the







|







3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
    int action)
{
    PipeInfo *infoPtr = (PipeInfo *) instanceData;

    /*
     * We do not access firstPipePtr in the thread structures. This is not for
     * all pipes managed by the thread, but only those we are watching.
     * Removal of the fileevent handlers before transfer thus takes care of
     * this structure.
     */

    Tcl_MutexLock(&pipeMutex);
    if (action == TCL_CHANNEL_THREAD_INSERT) {
	/*
	 * We can't copy the thread information from the channel when the
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
    TCL_UNUSED(Tcl_Obj *) /*extensionObj*/,
    Tcl_Obj *resultingNameObj)
{
    WCHAR name[MAX_PATH];
    char *namePtr;
    HANDLE handle;
    DWORD flags = FILE_ATTRIBUTE_TEMPORARY;
    size_t length;
    int counter, counter2;
    Tcl_DString buf;

    if (!resultingNameObj) {
	flags |= FILE_FLAG_DELETE_ON_CLOSE;
    }








|







3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
    TCL_UNUSED(Tcl_Obj *) /*extensionObj*/,
    Tcl_Obj *resultingNameObj)
{
    WCHAR name[MAX_PATH];
    char *namePtr;
    HANDLE handle;
    DWORD flags = FILE_ATTRIBUTE_TEMPORARY;
    Tcl_Size length;
    int counter, counter2;
    Tcl_DString buf;

    if (!resultingNameObj) {
	flags |= FILE_FLAG_DELETE_ON_CLOSE;
    }

3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
    counter = TclpGetClicks() % 65533;
    counter2 = 1024;			/* Only try this many times! Prevents
					 * an infinite loop. */

    do {
	char number[TCL_INTEGER_SPACE + 4];

	sprintf(number, "%d.TMP", counter);
	counter = (unsigned short) (counter + 1);
	Tcl_DStringInit(&buf);
	Tcl_UtfToWCharDString(number, strlen(number), &buf);
	Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf) + 1);
	memcpy(namePtr, Tcl_DStringValue(&buf), Tcl_DStringLength(&buf) + 1);
	Tcl_DStringFree(&buf);








|







3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
    counter = TclpGetClicks() % 65533;
    counter2 = 1024;			/* Only try this many times! Prevents
					 * an infinite loop. */

    do {
	char number[TCL_INTEGER_SPACE + 4];

	snprintf(number, sizeof(number), "%d.TMP", counter);
	counter = (unsigned short) (counter + 1);
	Tcl_DStringInit(&buf);
	Tcl_UtfToWCharDString(number, strlen(number), &buf);
	Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf) + 1);
	memcpy(namePtr, Tcl_DStringValue(&buf), Tcl_DStringLength(&buf) + 1);
	Tcl_DStringFree(&buf);

Changes to win/tclWinPort.h.

88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
#include <malloc.h>
#include <process.h>
#include <signal.h>
#ifdef HAVE_INTTYPES_H
#   include <inttypes.h>
#endif
#include <limits.h>
#ifdef HAVE_STDINT_H
#   include <stdint.h>
#else
#   include "../compat/stdint.h"
#endif

#ifndef __GNUC__
#    define strncasecmp _strnicmp
#    define strcasecmp _stricmp
#endif

/*
 * Need to block out these includes for building extensions with MetroWerks







<
<
<
<
<
<







88
89
90
91
92
93
94






95
96
97
98
99
100
101
#include <malloc.h>
#include <process.h>
#include <signal.h>
#ifdef HAVE_INTTYPES_H
#   include <inttypes.h>
#endif
#include <limits.h>






#ifndef __GNUC__
#    define strncasecmp _strnicmp
#    define strcasecmp _stricmp
#endif

/*
 * Need to block out these includes for building extensions with MetroWerks
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532

/*
 * The following defines wrap the system memory allocation routines for
 * use by tclAlloc.c.
 */

#define TclpSysAlloc(size)		((void*)HeapAlloc(GetProcessHeap(), \
					    (DWORD)0, (DWORD)size))
#define TclpSysFree(ptr)		(HeapFree(GetProcessHeap(), \
					    (DWORD)0, (HGLOBAL)ptr))
#define TclpSysRealloc(ptr, size)	((void*)HeapReAlloc(GetProcessHeap(), \
					    (DWORD)0, (LPVOID)ptr, (DWORD)size))

/* This type is not defined in the Windows headers */
#define socklen_t       int


/*
 * The following macros have trivial definitions, allowing generic code to







|

|

|







508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526

/*
 * The following defines wrap the system memory allocation routines for
 * use by tclAlloc.c.
 */

#define TclpSysAlloc(size)		((void*)HeapAlloc(GetProcessHeap(), \
					    0, size))
#define TclpSysFree(ptr)		(HeapFree(GetProcessHeap(), \
					    0, (HGLOBAL)ptr))
#define TclpSysRealloc(ptr, size)	((void*)HeapReAlloc(GetProcessHeap(), \
					    0, (LPVOID)ptr, size))

/* This type is not defined in the Windows headers */
#define socklen_t       int


/*
 * The following macros have trivial definitions, allowing generic code to

Changes to win/tclWinReg.c.

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
static int		RegistryObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
			    Tcl_Obj *valueNameObj, Tcl_Obj *dataObj,
			    Tcl_Obj *typeObj, REGSAM mode);

#if (TCL_MAJOR_VERSION < 9) && (TCL_MINOR_VERSION < 7)
# if TCL_UTF_MAX > 3
#   define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c)
#   define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c)
# else
#   define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString
#   define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString
# endif
#endif

static unsigned char *
getByteArrayFromObj(
	Tcl_Obj *objPtr,
	size_t *lengthPtr
) {
    int length;

    unsigned char *result = Tcl_GetByteArrayFromObj(objPtr, &length);
#if TCL_MAJOR_VERSION > 8
    if (sizeof(TCL_HASH_TYPE) > sizeof(int)) {
	/* 64-bit and TIP #494 situation: */
	 *lengthPtr = *(TCL_HASH_TYPE *) objPtr->internalRep.twoPtrValue.ptr1;
    } else
#endif
	/* 32-bit or without TIP #494 */
    *lengthPtr = (size_t) (unsigned) length;
    return result;
}

#ifdef __cplusplus
extern "C" {
#endif
DLLEXPORT int		Registry_Init(Tcl_Interp *interp);
DLLEXPORT int		Registry_Unload(Tcl_Interp *interp, int flags);





#ifdef __cplusplus
}
#endif

/*
 *----------------------------------------------------------------------
 *







|







<
|
<
<
<
<
<
<
|
<
<
<
<
<
<

<
<
<
<






>
>
>
>
>







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
static int		RegistryObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
			    Tcl_Obj *valueNameObj, Tcl_Obj *dataObj,
			    Tcl_Obj *typeObj, REGSAM mode);

#if (TCL_MAJOR_VERSION < 9) && defined(TCL_MINOR_VERSION) && (TCL_MINOR_VERSION < 7)
# if TCL_UTF_MAX > 3
#   define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c)
#   define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c)
# else
#   define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString
#   define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString
# endif

#define Tcl_Size int






#define TCL_INDEX_NONE -1






#endif





#ifdef __cplusplus
extern "C" {
#endif
DLLEXPORT int		Registry_Init(Tcl_Interp *interp);
DLLEXPORT int		Registry_Unload(Tcl_Interp *interp, int flags);
#if TCL_MAJOR_VERSION < 9
/* With those additional entries, "load registry13.dll" works without 3th argument */
DLLEXPORT int		Tclregistry_Init(Tcl_Interp *interp);
DLLEXPORT int		Tclregistry_Unload(Tcl_Interp *interp, int flags);
#endif
#ifdef __cplusplus
}
#endif

/*
 *----------------------------------------------------------------------
 *
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195








196
197
198
199
200
201
202

int
Registry_Init(
    Tcl_Interp *interp)
{
    Tcl_Command cmd;

    if (Tcl_InitStubs(interp, "8.5", 0) == NULL) {
	return TCL_ERROR;
    }

    cmd = Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd,
	    interp, DeleteCmd);
    Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, cmd);
    return Tcl_PkgProvideEx(interp, "registry", "1.3.6", NULL);
}









/*
 *----------------------------------------------------------------------
 *
 * Registry_Unload --
 *
 *	This function removes the registry command.







|






|

>
>
>
>
>
>
>
>







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

int
Registry_Init(
    Tcl_Interp *interp)
{
    Tcl_Command cmd;

    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.7", NULL);
}
#if TCL_MAJOR_VERSION < 9
int
Tclregistry_Init(
    Tcl_Interp *interp)
{
    return Registry_Init(interp);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Registry_Unload --
 *
 *	This function removes the registry command.
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
    Tcl_Obj *objv[3];
    (void)flags;

    /*
     * Unregister the registry package. There is no Tcl_PkgForget()
     */

    objv[0] = Tcl_NewStringObj("package", -1);
    objv[1] = Tcl_NewStringObj("forget", -1);
    objv[2] = Tcl_NewStringObj("registry", -1);
    Tcl_EvalObjv(interp, 3, objv, TCL_EVAL_GLOBAL);

    /*
     * Delete the originally registered command.
     */

    cmd = (Tcl_Command)Tcl_GetAssocData(interp, REGISTRY_ASSOC_KEY, NULL);
    if (cmd != NULL) {
	Tcl_DeleteCommandFromToken(interp, cmd);
    }

    return TCL_OK;
}










/*
 *----------------------------------------------------------------------
 *
 * DeleteCmd --
 *
 *	Cleanup the interp command token so that unloading doesn't try to







|
|
|













>
>
>
>
>
>
>
>
>







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
    Tcl_Obj *objv[3];
    (void)flags;

    /*
     * Unregister the registry package. There is no Tcl_PkgForget()
     */

    objv[0] = Tcl_NewStringObj("package", TCL_INDEX_NONE);
    objv[1] = Tcl_NewStringObj("forget", TCL_INDEX_NONE);
    objv[2] = Tcl_NewStringObj("registry", TCL_INDEX_NONE);
    Tcl_EvalObjv(interp, 3, objv, TCL_EVAL_GLOBAL);

    /*
     * Delete the originally registered command.
     */

    cmd = (Tcl_Command)Tcl_GetAssocData(interp, REGISTRY_ASSOC_KEY, NULL);
    if (cmd != NULL) {
	Tcl_DeleteCommandFromToken(interp, cmd);
    }

    return TCL_OK;
}
#if TCL_MAJOR_VERSION < 9
int
Tclregistry_Unload(
    Tcl_Interp *interp,
    int flags)
{
    return Registry_Unload(interp, flags);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * DeleteCmd --
 *
 *	Cleanup the interp command token so that unloading doesn't try to
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
{
    char *tail, *buffer, *hostName, *keyName;
    const WCHAR *nativeTail;
    HKEY rootKey, subkey;
    DWORD result;
    Tcl_DString buf;
    REGSAM saveMode = mode;


    /*
     * Find the parent of the key being deleted and open it.
     */

    keyName = Tcl_GetString(keyNameObj);
    buffer = (char *)Tcl_Alloc(keyNameObj->length + 1);
    strcpy(buffer, keyName);

    if (ParseKeyName(interp, buffer, &hostName, &rootKey,
	    &keyName) != TCL_OK) {
	Tcl_Free(buffer);
	return TCL_ERROR;
    }

    if (*keyName == '\0') {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("bad key: cannot delete root keys", -1));
	Tcl_SetErrorCode(interp, "WIN_REG", "DEL_ROOT_KEY", NULL);
	Tcl_Free(buffer);
	return TCL_ERROR;
    }

    tail = strrchr(keyName, '\\');
    if (tail) {







>





|
|










|







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
{
    char *tail, *buffer, *hostName, *keyName;
    const WCHAR *nativeTail;
    HKEY rootKey, subkey;
    DWORD result;
    Tcl_DString buf;
    REGSAM saveMode = mode;
    Tcl_Size len;

    /*
     * Find the parent of the key being deleted and open it.
     */

    keyName = Tcl_GetStringFromObj(keyNameObj, &len);
    buffer = (char *)Tcl_Alloc(len + 1);
    strcpy(buffer, keyName);

    if (ParseKeyName(interp, buffer, &hostName, &rootKey,
	    &keyName) != TCL_OK) {
	Tcl_Free(buffer);
	return TCL_ERROR;
    }

    if (*keyName == '\0') {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("bad key: cannot delete root keys", TCL_INDEX_NONE));
	Tcl_SetErrorCode(interp, "WIN_REG", "DEL_ROOT_KEY", NULL);
	Tcl_Free(buffer);
	return TCL_ERROR;
    }

    tail = strrchr(keyName, '\\');
    if (tail) {
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 = OpenSubKey(hostName, rootKey, keyName, mode, 0, &subkey);
    if (result != ERROR_SUCCESS) {
	Tcl_Free(buffer);
	if (result == ERROR_FILE_NOT_FOUND) {
	    return TCL_OK;
	}
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("unable to delete key: ", -1));
	AppendSystemError(interp, result);
	return TCL_ERROR;
    }

    /*
     * Now we recursively delete the key and everything below it.
     */

    Tcl_DStringInit(&buf);
    nativeTail = Tcl_UtfToWCharDString(tail, -1, &buf);
    result = RecursiveDeleteKey(subkey, nativeTail, saveMode);
    Tcl_DStringFree(&buf);

    if (result != ERROR_SUCCESS && result != ERROR_FILE_NOT_FOUND) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("unable to delete key: ", -1));
	AppendSystemError(interp, result);
	result = TCL_ERROR;
    } else {
	result = TCL_OK;
    }

    RegCloseKey(subkey);







|









|





|







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
    result = OpenSubKey(hostName, rootKey, keyName, mode, 0, &subkey);
    if (result != ERROR_SUCCESS) {
	Tcl_Free(buffer);
	if (result == ERROR_FILE_NOT_FOUND) {
	    return TCL_OK;
	}
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("unable to delete key: ", TCL_INDEX_NONE));
	AppendSystemError(interp, result);
	return TCL_ERROR;
    }

    /*
     * Now we recursively delete the key and everything below it.
     */

    Tcl_DStringInit(&buf);
    nativeTail = Tcl_UtfToWCharDString(tail, TCL_INDEX_NONE, &buf);
    result = RecursiveDeleteKey(subkey, nativeTail, saveMode);
    Tcl_DStringFree(&buf);

    if (result != ERROR_SUCCESS && result != ERROR_FILE_NOT_FOUND) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("unable to delete key: ", TCL_INDEX_NONE));
	AppendSystemError(interp, result);
	result = TCL_ERROR;
    } else {
	result = TCL_OK;
    }

    RegCloseKey(subkey);
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
    Tcl_Obj *valueNameObj,	/* Name of value to delete. */
    REGSAM mode)		/* Mode flags to pass. */
{
    HKEY key;
    char *valueName;
    DWORD result;
    Tcl_DString ds;


    /*
     * Attempt to open the key for deletion.
     */

    mode |= KEY_SET_VALUE;
    if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) {
	return TCL_ERROR;
    }

    valueName = Tcl_GetString(valueNameObj);
    Tcl_DStringInit(&ds);
    Tcl_UtfToWCharDString(valueName, valueNameObj->length, &ds);
    result = RegDeleteValueW(key, (const WCHAR *)Tcl_DStringValue(&ds));
    Tcl_DStringFree(&ds);
    if (result != ERROR_SUCCESS) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"unable to delete value \"%s\" from key \"%s\": ",
		Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj)));
	AppendSystemError(interp, result);







>










|

|







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
    Tcl_Obj *valueNameObj,	/* Name of value to delete. */
    REGSAM mode)		/* Mode flags to pass. */
{
    HKEY key;
    char *valueName;
    DWORD result;
    Tcl_DString ds;
    Tcl_Size len;

    /*
     * Attempt to open the key for deletion.
     */

    mode |= KEY_SET_VALUE;
    if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) {
	return TCL_ERROR;
    }

    valueName = Tcl_GetStringFromObj(valueNameObj, &len);
    Tcl_DStringInit(&ds);
    Tcl_UtfToWCharDString(valueName, len, &ds);
    result = RegDeleteValueW(key, (const WCHAR *)Tcl_DStringValue(&ds));
    Tcl_DStringFree(&ds);
    if (result != ERROR_SUCCESS) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"unable to delete value \"%s\" from key \"%s\": ",
		Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj)));
	AppendSystemError(interp, result);
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
    REGSAM mode)		/* Mode flags to pass. */
{
    HKEY key;
    DWORD result, type;
    Tcl_DString ds;
    const char *valueName;
    const WCHAR *nativeValue;


    /*
     * Attempt to open the key for reading.
     */

    mode |= KEY_QUERY_VALUE;
    if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Get the type of the value.
     */

    valueName = Tcl_GetString(valueNameObj);
    Tcl_DStringInit(&ds);
    nativeValue = Tcl_UtfToWCharDString(valueName, valueNameObj->length, &ds);
    result = RegQueryValueExW(key, nativeValue, NULL, &type,
	    NULL, NULL);
    Tcl_DStringFree(&ds);
    RegCloseKey(key);

    if (result != ERROR_SUCCESS) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(







>














|

|







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
    REGSAM mode)		/* Mode flags to pass. */
{
    HKEY key;
    DWORD result, type;
    Tcl_DString ds;
    const char *valueName;
    const WCHAR *nativeValue;
    Tcl_Size len;

    /*
     * Attempt to open the key for reading.
     */

    mode |= KEY_QUERY_VALUE;
    if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Get the type of the value.
     */

    valueName = Tcl_GetStringFromObj(valueNameObj, &len);
    Tcl_DStringInit(&ds);
    nativeValue = Tcl_UtfToWCharDString(valueName, len, &ds);
    result = RegQueryValueExW(key, nativeValue, NULL, &type,
	    NULL, NULL);
    Tcl_DStringFree(&ds);
    RegCloseKey(key);

    if (result != ERROR_SUCCESS) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
     * Set the type into the result. Watch out for unknown types. If we don't
     * know about the type, just use the numeric value.
     */

    if (type > lastType) {
	Tcl_SetObjResult(interp, Tcl_NewIntObj((int) type));
    } else {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(typeNames[type], -1));
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *







|







727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
     * Set the type into the result. Watch out for unknown types. If we don't
     * know about the type, just use the numeric value.
     */

    if (type > lastType) {
	Tcl_SetObjResult(interp, Tcl_NewIntObj((int) type));
    } else {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(typeNames[type], TCL_INDEX_NONE));
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
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
    REGSAM mode)		/* Mode flags to pass. */
{
    HKEY key;
    const char *valueName;
    const WCHAR *nativeValue;
    DWORD result, length, type;
    Tcl_DString data, buf;


    /*
     * Attempt to open the key for reading.
     */

    mode |= KEY_QUERY_VALUE;
    if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Initialize a Dstring to maximum statically allocated size we could get
     * one more byte by avoiding Tcl_DStringSetLength() and just setting
     * length to TCL_DSTRING_STATIC_SIZE, but this should be safer if the
     * implementation of Dstrings changes.
     *
     * This allows short values to be read from the registy in one call.
     * Longer values need a second call with an expanded DString.
     */

    Tcl_DStringInit(&data);
    Tcl_DStringSetLength(&data, TCL_DSTRING_STATIC_SIZE - 1);
    length = TCL_DSTRING_STATIC_SIZE/sizeof(WCHAR) - 1;

    valueName = Tcl_GetString(valueNameObj);
    Tcl_DStringInit(&buf);
    nativeValue = Tcl_UtfToWCharDString(valueName, valueNameObj->length, &buf);

    result = RegQueryValueExW(key, nativeValue, NULL, &type,
	    (BYTE *) Tcl_DStringValue(&data), &length);
    while (result == ERROR_MORE_DATA) {
	/*
	 * The Windows docs say that in this error case, we just need to
	 * expand our buffer and request more data. Required for
	 * HKEY_PERFORMANCE_DATA
	 */

	length = Tcl_DStringLength(&data) * (2 / sizeof(WCHAR));
	Tcl_DStringSetLength(&data, (int) length * sizeof(WCHAR));
	result = RegQueryValueExW(key, nativeValue,
		NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length);
    }
    Tcl_DStringFree(&buf);
    RegCloseKey(key);
    if (result != ERROR_SUCCESS) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(







>
















|







|

|











|







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
    REGSAM mode)		/* Mode flags to pass. */
{
    HKEY key;
    const char *valueName;
    const WCHAR *nativeValue;
    DWORD result, length, type;
    Tcl_DString data, buf;
    Tcl_Size len;

    /*
     * Attempt to open the key for reading.
     */

    mode |= KEY_QUERY_VALUE;
    if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Initialize a Dstring to maximum statically allocated size we could get
     * one more byte by avoiding Tcl_DStringSetLength() and just setting
     * length to TCL_DSTRING_STATIC_SIZE, but this should be safer if the
     * implementation of Dstrings changes.
     *
     * This allows short values to be read from the registry in one call.
     * Longer values need a second call with an expanded DString.
     */

    Tcl_DStringInit(&data);
    Tcl_DStringSetLength(&data, TCL_DSTRING_STATIC_SIZE - 1);
    length = TCL_DSTRING_STATIC_SIZE/sizeof(WCHAR) - 1;

    valueName = Tcl_GetStringFromObj(valueNameObj, &len);
    Tcl_DStringInit(&buf);
    nativeValue = Tcl_UtfToWCharDString(valueName, len, &buf);

    result = RegQueryValueExW(key, nativeValue, NULL, &type,
	    (BYTE *) Tcl_DStringValue(&data), &length);
    while (result == ERROR_MORE_DATA) {
	/*
	 * The Windows docs say that in this error case, we just need to
	 * expand our buffer and request more data. Required for
	 * HKEY_PERFORMANCE_DATA
	 */

	length = Tcl_DStringLength(&data) * (2 / sizeof(WCHAR));
	Tcl_DStringSetLength(&data, length * sizeof(WCHAR));
	result = RegQueryValueExW(key, nativeValue,
		NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length);
    }
    Tcl_DStringFree(&buf);
    RegCloseKey(key);
    if (result != ERROR_SUCCESS) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
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
	Tcl_DStringResult(interp, &buf);
    } else {
	/*
	 * Save binary data as a byte array.
	 */

	Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(
		(BYTE *) Tcl_DStringValue(&data), (int) length));
    }
    Tcl_DStringFree(&data);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * GetValueNames --
 *
 *	This function enumerates the values of the a given key. If the
 *	optional pattern is supplied, then only value names that match the
 *	pattern will be returned.
 *
 * Results:
 *	Returns the list of value names in the result object of the
 *	interpreter, or an error message on failure.
 *







|










|







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
	Tcl_DStringResult(interp, &buf);
    } else {
	/*
	 * Save binary data as a byte array.
	 */

	Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(
		(BYTE *) Tcl_DStringValue(&data), length));
    }
    Tcl_DStringFree(&data);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * GetValueNames --
 *
 *	This function enumerates the values of the given key. If the
 *	optional pattern is supplied, then only value names that match the
 *	pattern will be returned.
 *
 * Results:
 *	Returns the list of value names in the result object of the
 *	interpreter, or an error message on failure.
 *
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
    mode |= KEY_QUERY_VALUE;
    if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) {
	return TCL_ERROR;
    }

    resultPtr = Tcl_NewObj();
    Tcl_DStringInit(&buffer);
    Tcl_DStringSetLength(&buffer, (int) (MAX_KEY_LENGTH * sizeof(WCHAR)));
    index = 0;
    result = TCL_OK;

    if (patternObj) {
	pattern = Tcl_GetString(patternObj);
    } else {
	pattern = NULL;







|







910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
    mode |= KEY_QUERY_VALUE;
    if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) {
	return TCL_ERROR;
    }

    resultPtr = Tcl_NewObj();
    Tcl_DStringInit(&buffer);
    Tcl_DStringSetLength(&buffer, MAX_KEY_LENGTH * sizeof(WCHAR));
    index = 0;
    result = TCL_OK;

    if (patternObj) {
	pattern = Tcl_GetString(patternObj);
    } else {
	pattern = NULL;
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
    REGSAM mode,		/* Access mode. */
    int flags,			/* 0 or REG_CREATE. */
    HKEY *keyPtr)		/* Returned HKEY. */
{
    char *keyName, *buffer, *hostName;
    HKEY rootKey;
    DWORD result;


    keyName = Tcl_GetString(keyNameObj);
    buffer = (char *)Tcl_Alloc(keyNameObj->length + 1);
    strcpy(buffer, keyName);

    result = ParseKeyName(interp, buffer, &hostName, &rootKey, &keyName);
    if (result == TCL_OK) {
	result = OpenSubKey(hostName, rootKey, keyName, mode, flags, keyPtr);
	if (result != ERROR_SUCCESS) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("unable to open key: ", -1));
	    AppendSystemError(interp, result);
	    result = TCL_ERROR;
	} else {
	    result = TCL_OK;
	}
    }

    Tcl_Free(buffer);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * OpenSubKey --
 *
 *	This function opens a given subkey of a root key on the specified
 *	host.
 *
 * Results:
 *	Returns the opened key in the keyPtr and a Windows error code as the
 *	return value.
 *
 * Side effects:







>

|
|







|
















|







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
    REGSAM mode,		/* Access mode. */
    int flags,			/* 0 or REG_CREATE. */
    HKEY *keyPtr)		/* Returned HKEY. */
{
    char *keyName, *buffer, *hostName;
    HKEY rootKey;
    DWORD result;
    Tcl_Size len;

    keyName = Tcl_GetStringFromObj(keyNameObj, &len);
    buffer = (char *)Tcl_Alloc(len + 1);
    strcpy(buffer, keyName);

    result = ParseKeyName(interp, buffer, &hostName, &rootKey, &keyName);
    if (result == TCL_OK) {
	result = OpenSubKey(hostName, rootKey, keyName, mode, flags, keyPtr);
	if (result != ERROR_SUCCESS) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("unable to open key: ", TCL_INDEX_NONE));
	    AppendSystemError(interp, result);
	    result = TCL_ERROR;
	} else {
	    result = TCL_OK;
	}
    }

    Tcl_Free(buffer);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * OpenSubKey --
 *
 *	Opens a given subkey of the given root key on the specified
 *	host.
 *
 * Results:
 *	Returns the opened key in the keyPtr and a Windows error code as the
 *	return value.
 *
 * Side effects:
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

    /*
     * Attempt to open the root key on a remote host if necessary.
     */

    if (hostName) {
	Tcl_DStringInit(&buf);
	hostName = (char *) Tcl_UtfToWCharDString(hostName, -1, &buf);
	result = RegConnectRegistryW((WCHAR *)hostName, rootKey,
		&rootKey);
	Tcl_DStringFree(&buf);
	if (result != ERROR_SUCCESS) {
	    return result;
	}
    }

    /*
     * Now open the specified key with the requested permissions. Note that
     * this key must be closed by the caller.
     */

    if (keyName) {
	Tcl_DStringInit(&buf);
	keyName = (char *) Tcl_UtfToWCharDString(keyName, -1, &buf);
    }
    if (flags & REG_CREATE) {
	DWORD create;

	result = RegCreateKeyExW(rootKey, (WCHAR *)keyName, 0, NULL,
		REG_OPTION_NON_VOLATILE, mode, NULL, keyPtr, &create);
    } else if (rootKey == HKEY_PERFORMANCE_DATA) {







|















|







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

    /*
     * Attempt to open the root key on a remote host if necessary.
     */

    if (hostName) {
	Tcl_DStringInit(&buf);
	hostName = (char *) Tcl_UtfToWCharDString(hostName, TCL_INDEX_NONE, &buf);
	result = RegConnectRegistryW((WCHAR *)hostName, rootKey,
		&rootKey);
	Tcl_DStringFree(&buf);
	if (result != ERROR_SUCCESS) {
	    return result;
	}
    }

    /*
     * Now open the specified key with the requested permissions. Note that
     * this key must be closed by the caller.
     */

    if (keyName) {
	Tcl_DStringInit(&buf);
	keyName = (char *) Tcl_UtfToWCharDString(keyName, TCL_INDEX_NONE, &buf);
    }
    if (flags & REG_CREATE) {
	DWORD create;

	result = RegCreateKeyExW(rootKey, (WCHAR *)keyName, 0, NULL,
		REG_OPTION_NON_VOLATILE, mode, NULL, keyPtr, &create);
    } else if (rootKey == HKEY_PERFORMANCE_DATA) {
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
}

/*
 *----------------------------------------------------------------------
 *
 * ParseKeyName --
 *
 *	This function parses a key name into the host, root, and subkey parts.
 *
 * Results:
 *	The pointers to the start of the host and subkey names are returned in
 *	the hostNamePtr and keyNamePtr variables. The specified root HKEY is
 *	returned in rootKeyPtr. Returns a standard Tcl result.
 *
 * Side effects:







|







1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
}

/*
 *----------------------------------------------------------------------
 *
 * ParseKeyName --
 *
 *	Parses a key name into the host, root, and subkey parts.
 *
 * Results:
 *	The pointers to the start of the host and subkey names are returned in
 *	the hostNamePtr and keyNamePtr variables. The specified root HKEY is
 *	returned in rootKeyPtr. Returns a standard Tcl result.
 *
 * Side effects:
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
	}
    }

    /*
     * Look for a matching root name.
     */

    rootObj = Tcl_NewStringObj(rootName, -1);
    result = Tcl_GetIndexFromObj(interp, rootObj, rootKeyNames, "root name",
	    TCL_EXACT, &index);
    Tcl_DecrRefCount(rootObj);
    if (result != TCL_OK) {
	return TCL_ERROR;
    }
    *rootKeyPtr = rootKeys[index];







|







1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
	}
    }

    /*
     * Look for a matching root name.
     */

    rootObj = Tcl_NewStringObj(rootName, TCL_INDEX_NONE);
    result = Tcl_GetIndexFromObj(interp, rootObj, rootKeyNames, "root name",
	    TCL_EXACT, &index);
    Tcl_DecrRefCount(rootObj);
    if (result != TCL_OK) {
	return TCL_ERROR;
    }
    *rootKeyPtr = rootKeys[index];
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
    mode |= KEY_ENUMERATE_SUB_KEYS | DELETE | KEY_QUERY_VALUE;
    result = RegOpenKeyExW(startKey, keyName, 0, mode, &hKey);
    if (result != ERROR_SUCCESS) {
	return result;
    }

    Tcl_DStringInit(&subkey);
    Tcl_DStringSetLength(&subkey, (int) (MAX_KEY_LENGTH * sizeof(WCHAR)));

    mode = saveMode;
    while (result == ERROR_SUCCESS) {
	/*
	 * Always get index 0 because key deletion changes ordering.
	 */








|







1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
    mode |= KEY_ENUMERATE_SUB_KEYS | DELETE | KEY_QUERY_VALUE;
    result = RegOpenKeyExW(startKey, keyName, 0, mode, &hKey);
    if (result != ERROR_SUCCESS) {
	return result;
    }

    Tcl_DStringInit(&subkey);
    Tcl_DStringSetLength(&subkey, MAX_KEY_LENGTH * sizeof(WCHAR));

    mode = saveMode;
    while (result == ERROR_SUCCESS) {
	/*
	 * Always get index 0 because key deletion changes ordering.
	 */

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
    REGSAM mode)		/* Mode flags to pass. */
{
    int type;
    DWORD result;
    HKEY key;
    const char *valueName;
    Tcl_DString nameBuf;


    if (typeObj == NULL) {
	type = REG_SZ;
    } else if (Tcl_GetIndexFromObj(interp, typeObj, typeNames, "type",
	    0, (int *) &type) != TCL_OK) {
	if (Tcl_GetIntFromObj(NULL, typeObj, (int *) &type) != TCL_OK) {
	    return TCL_ERROR;
	}
	Tcl_ResetResult(interp);
    }
    mode |= KEY_ALL_ACCESS;
    if (OpenKey(interp, keyNameObj, mode, 1, &key) != TCL_OK) {
	return TCL_ERROR;
    }

    valueName = Tcl_GetString(valueNameObj);
    Tcl_DStringInit(&nameBuf);
    valueName = (char *) Tcl_UtfToWCharDString(valueName, valueNameObj->length, &nameBuf);

    if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) {
	int value;

	if (Tcl_GetIntFromObj(interp, dataObj, &value) != TCL_OK) {
	    RegCloseKey(key);
	    Tcl_DStringFree(&nameBuf);
	    return TCL_ERROR;
	}

	value = ConvertDWORD((DWORD) type, (DWORD) value);
	result = RegSetValueExW(key, (WCHAR *) valueName, 0,
		(DWORD) type, (BYTE *) &value, sizeof(DWORD));
    } else if (type == REG_MULTI_SZ) {
	Tcl_DString data, buf;
	int objc, i;
	Tcl_Obj **objv;

	if (Tcl_ListObjGetElements(interp, dataObj, &objc, &objv) != TCL_OK) {
	    RegCloseKey(key);
	    Tcl_DStringFree(&nameBuf);
	    return TCL_ERROR;
	}

	/*
	 * Append the elements as null terminated strings. Note that we must
	 * not assume the length of the string in case there are embedded
	 * nulls, which aren't allowed in REG_MULTI_SZ values.
	 */

	Tcl_DStringInit(&data);
	for (i = 0; i < objc; i++) {
	    const char *bytes = Tcl_GetString(objv[i]);

	    Tcl_DStringAppend(&data, bytes, objv[i]->length);

	    /*
	     * Add a null character to separate this value from the next.
	     */

	    Tcl_DStringAppend(&data, "", 1);	/* NUL-terminated string */
	}

	Tcl_DStringInit(&buf);
	Tcl_UtfToWCharDString(Tcl_DStringValue(&data), Tcl_DStringLength(&data)+1,
		&buf);
	result = RegSetValueExW(key, (WCHAR *) valueName, 0,
		(DWORD) type, (BYTE *) Tcl_DStringValue(&buf),
		(DWORD) Tcl_DStringLength(&buf));
	Tcl_DStringFree(&data);
	Tcl_DStringFree(&buf);
    } else if (type == REG_SZ || type == REG_EXPAND_SZ) {
	Tcl_DString buf;
	const char *data = Tcl_GetString(dataObj);

	Tcl_DStringInit(&buf);
	data = (char *) Tcl_UtfToWCharDString(data, dataObj->length, &buf);

	/*
	 * Include the null in the length, padding if needed for WCHAR.
	 */

	Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1);

	result = RegSetValueExW(key, (WCHAR *) valueName, 0,
		(DWORD) type, (BYTE *) data, (DWORD) Tcl_DStringLength(&buf) + 1);
	Tcl_DStringFree(&buf);
    } else {
	BYTE *data;
	size_t bytelength;

	/*
	 * Store binary data in the registry.
	 */

	data = (BYTE *) getByteArrayFromObj(dataObj, &bytelength);
	result = RegSetValueExW(key, (WCHAR *) valueName, 0,
		(DWORD) type, data, (DWORD) bytelength);
    }

    Tcl_DStringFree(&nameBuf);
    RegCloseKey(key);

    if (result != ERROR_SUCCESS) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("unable to set value: ", -1));
	AppendSystemError(interp, result);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*







>















|

|















|
















|

|


















|


|












|





|









|







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
    REGSAM mode)		/* Mode flags to pass. */
{
    int type;
    DWORD result;
    HKEY key;
    const char *valueName;
    Tcl_DString nameBuf;
    Tcl_Size len;

    if (typeObj == NULL) {
	type = REG_SZ;
    } else if (Tcl_GetIndexFromObj(interp, typeObj, typeNames, "type",
	    0, (int *) &type) != TCL_OK) {
	if (Tcl_GetIntFromObj(NULL, typeObj, (int *) &type) != TCL_OK) {
	    return TCL_ERROR;
	}
	Tcl_ResetResult(interp);
    }
    mode |= KEY_ALL_ACCESS;
    if (OpenKey(interp, keyNameObj, mode, 1, &key) != TCL_OK) {
	return TCL_ERROR;
    }

    valueName = Tcl_GetStringFromObj(valueNameObj, &len);
    Tcl_DStringInit(&nameBuf);
    valueName = (char *) Tcl_UtfToWCharDString(valueName, len, &nameBuf);

    if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) {
	int value;

	if (Tcl_GetIntFromObj(interp, dataObj, &value) != TCL_OK) {
	    RegCloseKey(key);
	    Tcl_DStringFree(&nameBuf);
	    return TCL_ERROR;
	}

	value = ConvertDWORD((DWORD) type, (DWORD) value);
	result = RegSetValueExW(key, (WCHAR *) valueName, 0,
		(DWORD) type, (BYTE *) &value, sizeof(DWORD));
    } else if (type == REG_MULTI_SZ) {
	Tcl_DString data, buf;
	Tcl_Size objc, i;
	Tcl_Obj **objv;

	if (Tcl_ListObjGetElements(interp, dataObj, &objc, &objv) != TCL_OK) {
	    RegCloseKey(key);
	    Tcl_DStringFree(&nameBuf);
	    return TCL_ERROR;
	}

	/*
	 * Append the elements as null terminated strings. Note that we must
	 * not assume the length of the string in case there are embedded
	 * nulls, which aren't allowed in REG_MULTI_SZ values.
	 */

	Tcl_DStringInit(&data);
	for (i = 0; i < objc; i++) {
	    const char *bytes = Tcl_GetStringFromObj(objv[i], &len);

	    Tcl_DStringAppend(&data, bytes, len);

	    /*
	     * Add a null character to separate this value from the next.
	     */

	    Tcl_DStringAppend(&data, "", 1);	/* NUL-terminated string */
	}

	Tcl_DStringInit(&buf);
	Tcl_UtfToWCharDString(Tcl_DStringValue(&data), Tcl_DStringLength(&data)+1,
		&buf);
	result = RegSetValueExW(key, (WCHAR *) valueName, 0,
		(DWORD) type, (BYTE *) Tcl_DStringValue(&buf),
		(DWORD) Tcl_DStringLength(&buf));
	Tcl_DStringFree(&data);
	Tcl_DStringFree(&buf);
    } else if (type == REG_SZ || type == REG_EXPAND_SZ) {
	Tcl_DString buf;
	const char *data = Tcl_GetStringFromObj(dataObj, &len);

	Tcl_DStringInit(&buf);
	data = (char *) Tcl_UtfToWCharDString(data, len, &buf);

	/*
	 * Include the null in the length, padding if needed for WCHAR.
	 */

	Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1);

	result = RegSetValueExW(key, (WCHAR *) valueName, 0,
		(DWORD) type, (BYTE *) data, (DWORD) Tcl_DStringLength(&buf) + 1);
	Tcl_DStringFree(&buf);
    } else {
	BYTE *data;
	Tcl_Size bytelength;

	/*
	 * Store binary data in the registry.
	 */

	data = (BYTE *) Tcl_GetByteArrayFromObj(dataObj, &bytelength);
	result = RegSetValueExW(key, (WCHAR *) valueName, 0,
		(DWORD) type, data, (DWORD) bytelength);
    }

    Tcl_DStringFree(&nameBuf);
    RegCloseKey(key);

    if (result != ERROR_SUCCESS) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("unable to set value: ", TCL_INDEX_NONE));
	AppendSystemError(interp, result);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
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
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument values. */
{
    LRESULT result;
    DWORD_PTR sendResult;
    int timeout = 3000;
    size_t len;
    const char *str;
    Tcl_Obj *objPtr;
    WCHAR *wstr;
    Tcl_DString ds;

    if (objc == 3) {
	str = Tcl_GetString(objv[1]);
	len = objv[1]->length;
	if ((len < 2) || (*str != '-') || strncmp(str, "-timeout", len)) {
	    return TCL_BREAK;
	}
	if (Tcl_GetIntFromObj(interp, objv[2], &timeout) != TCL_OK) {
	    return TCL_ERROR;
	}
    }

    str = Tcl_GetString(objv[0]);
    Tcl_DStringInit(&ds);
    wstr = Tcl_UtfToWCharDString(str, objv[0]->length, &ds);
    if (Tcl_DStringLength(&ds) == 0) {
	wstr = NULL;
    }

    /*
     * Use the ignore the result.
     */







|






|
<








|

|







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
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument values. */
{
    LRESULT result;
    DWORD_PTR sendResult;
    int timeout = 3000;
    Tcl_Size len;
    const char *str;
    Tcl_Obj *objPtr;
    WCHAR *wstr;
    Tcl_DString ds;

    if (objc == 3) {
	str = Tcl_GetStringFromObj(objv[1], &len);

	if ((len < 2) || (*str != '-') || strncmp(str, "-timeout", len)) {
	    return TCL_BREAK;
	}
	if (Tcl_GetIntFromObj(interp, objv[2], &timeout) != TCL_OK) {
	    return TCL_ERROR;
	}
    }

    str = Tcl_GetStringFromObj(objv[0], &len);
    Tcl_DStringInit(&ds);
    wstr = Tcl_UtfToWCharDString(str, len, &ds);
    if (Tcl_DStringLength(&ds) == 0) {
	wstr = NULL;
    }

    /*
     * Use the ignore the result.
     */
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
}

/*
 *----------------------------------------------------------------------
 *
 * AppendSystemError --
 *
 *	This routine formats a Windows system error message and places it into
 *	the interpreter result.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.







|







1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
}

/*
 *----------------------------------------------------------------------
 *
 * AppendSystemError --
 *
 *	Formats a Windows system error message and places it into
 *	the interpreter result.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
	resultPtr = Tcl_DuplicateObj(resultPtr);
    }
    length = FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM
	    | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error,
	    MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (WCHAR *) tMsgPtrPtr,
	    0, NULL);
    if (length == 0) {
	sprintf(msgBuf, "unknown error: %ld", error);
	msg = msgBuf;
    } else {
	char *msgPtr;

	Tcl_DStringInit(&ds);
	Tcl_WCharToUtfDString(tMsgPtr, wcslen(tMsgPtr), &ds);
	LocalFree(tMsgPtr);







|







1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
	resultPtr = Tcl_DuplicateObj(resultPtr);
    }
    length = FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM
	    | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error,
	    MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (WCHAR *) tMsgPtrPtr,
	    0, NULL);
    if (length == 0) {
	snprintf(msgBuf, sizeof(msgBuf), "unknown error: %ld", error);
	msg = msgBuf;
    } else {
	char *msgPtr;

	Tcl_DStringInit(&ds);
	Tcl_WCharToUtfDString(tMsgPtr, wcslen(tMsgPtr), &ds);
	LocalFree(tMsgPtr);
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
	if (msgPtr[length-1] == '\r') {
	    --length;
	}
	msgPtr[length] = 0;
	msg = msgPtr;
    }

    sprintf(id, "%ld", error);
    Tcl_SetErrorCode(interp, "WINDOWS", id, msg, NULL);
    Tcl_AppendToObj(resultPtr, msg, length);
    Tcl_SetObjResult(interp, resultPtr);

    if (length != 0) {
	Tcl_DStringFree(&ds);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * ConvertDWORD --
 *
 *	This function determines whether a DWORD needs to be byte swapped, and
 *	returns the appropriately swapped value.
 *
 * Results:
 *	Returns a converted DWORD.
 *
 * Side effects:
 *	None.







|














|







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
	if (msgPtr[length-1] == '\r') {
	    --length;
	}
	msgPtr[length] = 0;
	msg = msgPtr;
    }

    snprintf(id, sizeof(id), "%ld", error);
    Tcl_SetErrorCode(interp, "WINDOWS", id, msg, NULL);
    Tcl_AppendToObj(resultPtr, msg, length);
    Tcl_SetObjResult(interp, resultPtr);

    if (length != 0) {
	Tcl_DStringFree(&ds);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * ConvertDWORD --
 *
 *	Determines whether a DWORD needs to be byte swapped, and
 *	returns the appropriately swapped value.
 *
 * Results:
 *	Returns a converted DWORD.
 *
 * Side effects:
 *	None.

Changes to win/tclWinSerial.c.

81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
    int watchMask;		/* OR'ed combination of TCL_READABLE,
				 * TCL_WRITABLE, or TCL_EXCEPTION: indicates
				 * which events should be reported. */
    int flags;			/* State flags, see above for a list. */
    int readable;		/* Flag that the channel is readable. */
    int writable;		/* Flag that the channel is writable. */
    int blockTime;		/* Maximum blocktime in msec. */
    unsigned int lastEventTime;	/* Time in milliseconds since last readable
				 * event. */
				/* Next readable event only after blockTime */
    DWORD error;		/* pending error code returned by
				 * ClearCommError() */
    DWORD lastError;		/* last error code, can be fetched with
				 * fconfigure chan -lasterror */
    DWORD sysBufRead;		/* Win32 system buffer size for read ops,







|







81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
    int watchMask;		/* OR'ed combination of TCL_READABLE,
				 * TCL_WRITABLE, or TCL_EXCEPTION: indicates
				 * which events should be reported. */
    int flags;			/* State flags, see above for a list. */
    int readable;		/* Flag that the channel is readable. */
    int writable;		/* Flag that the channel is writable. */
    int blockTime;		/* Maximum blocktime in msec. */
    unsigned long long lastEventTime;	/* Time in milliseconds since last readable
				 * event. */
				/* Next readable event only after blockTime */
    DWORD error;		/* pending error code returned by
				 * ClearCommError() */
    DWORD lastError;		/* last error code, can be fetched with
				 * fconfigure chan -lasterror */
    DWORD sysBufRead;		/* Win32 system buffer size for read ops,
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
    0,			/* WriteTotalTimeoutConstant */
};

/*
 * Declarations for functions used only in this file.
 */

static int		SerialBlockProc(ClientData instanceData, int mode);
static void		SerialCheckProc(ClientData clientData, int flags);
static int		SerialCloseProc(ClientData instanceData,
			    Tcl_Interp *interp, int flags);
static int		SerialEventProc(Tcl_Event *evPtr, int flags);
static void		SerialExitHandler(ClientData clientData);
static int		SerialGetHandleProc(ClientData instanceData,
			    int direction, ClientData *handlePtr);
static ThreadSpecificData *SerialInit(void);
static int		SerialInputProc(ClientData instanceData, char *buf,
			    int toRead, int *errorCode);
static int		SerialOutputProc(ClientData instanceData,
			    const char *buf, int toWrite, int *errorCode);
static void		SerialSetupProc(ClientData clientData, int flags);
static void		SerialWatchProc(ClientData instanceData, int mask);
static void		ProcExitHandler(ClientData clientData);
static int		SerialGetOptionProc(ClientData instanceData,
			    Tcl_Interp *interp, const char *optionName,
			    Tcl_DString *dsPtr);
static int		SerialSetOptionProc(ClientData instanceData,
			    Tcl_Interp *interp, const char *optionName,
			    const char *value);
static DWORD WINAPI	SerialWriterThread(LPVOID arg);
static void		SerialThreadActionProc(ClientData instanceData,
			    int action);
static int		SerialBlockingRead(SerialInfo *infoPtr, LPVOID buf,
			    DWORD bufSize, LPDWORD lpRead, LPOVERLAPPED osPtr);
static int		SerialBlockingWrite(SerialInfo *infoPtr, LPVOID buf,
			    DWORD bufSize, LPDWORD lpWritten,
			    LPOVERLAPPED osPtr);








|
|
|


|
|
|

|

|

|
|
|
|


|



|







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
    0,			/* WriteTotalTimeoutConstant */
};

/*
 * Declarations for functions used only in this file.
 */

static int		SerialBlockProc(void *instanceData, int mode);
static void		SerialCheckProc(void *clientData, int flags);
static int		SerialCloseProc(void *instanceData,
			    Tcl_Interp *interp, int flags);
static int		SerialEventProc(Tcl_Event *evPtr, int flags);
static void		SerialExitHandler(void *clientData);
static int		SerialGetHandleProc(void *instanceData,
			    int direction, void **handlePtr);
static ThreadSpecificData *SerialInit(void);
static int		SerialInputProc(void *instanceData, char *buf,
			    int toRead, int *errorCode);
static int		SerialOutputProc(void *instanceData,
			    const char *buf, int toWrite, int *errorCode);
static void		SerialSetupProc(void *clientData, int flags);
static void		SerialWatchProc(void *instanceData, int mask);
static void		ProcExitHandler(void *clientData);
static int		SerialGetOptionProc(void *instanceData,
			    Tcl_Interp *interp, const char *optionName,
			    Tcl_DString *dsPtr);
static int		SerialSetOptionProc(void *instanceData,
			    Tcl_Interp *interp, const char *optionName,
			    const char *value);
static DWORD WINAPI	SerialWriterThread(LPVOID arg);
static void		SerialThreadActionProc(void *instanceData,
			    int action);
static int		SerialBlockingRead(SerialInfo *infoPtr, LPVOID buf,
			    DWORD bufSize, LPDWORD lpRead, LPOVERLAPPED osPtr);
static int		SerialBlockingWrite(SerialInfo *infoPtr, LPVOID buf,
			    DWORD bufSize, LPDWORD lpWritten,
			    LPOVERLAPPED osPtr);

331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
}

/*
 *----------------------------------------------------------------------
 *
 * SerialBlockTime --
 *
 *	Wrapper to set Tcl's block time in msec
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Updates the maximum blocking time.
 *







|







331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
}

/*
 *----------------------------------------------------------------------
 *
 * SerialBlockTime --
 *
 *	Wrapper to set Tcl's block time in msec.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Updates the maximum blocking time.
 *
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static unsigned int
SerialGetMilliseconds(void)
{
    Tcl_Time time;

    Tcl_GetTime(&time);

    return (time.sec * 1000 + time.usec / 1000);
}

/*
 *----------------------------------------------------------------------
 *
 * SerialSetupProc --
 *







|






|







369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static unsigned long long
SerialGetMilliseconds(void)
{
    Tcl_Time time;

    Tcl_GetTime(&time);

    return ((unsigned long long)time.sec * 1000 + (unsigned long)time.usec / 1000);
}

/*
 *----------------------------------------------------------------------
 *
 * SerialSetupProc --
 *
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
{
    SerialInfo *infoPtr;
    SerialEvent *evPtr;
    int needEvent;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    COMSTAT cStat;
    unsigned int time;

    if (!(flags & TCL_FILE_EVENTS)) {
	return;
    }

    /*
     * Queue events for any ready serials that don't already have events







|







465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
{
    SerialInfo *infoPtr;
    SerialEvent *evPtr;
    int needEvent;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    COMSTAT cStat;
    unsigned long long time;

    if (!(flags & TCL_FILE_EVENTS)) {
	return;
    }

    /*
     * Queue events for any ready serials that don't already have events
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
		     * Force fileevent after serial read error.
		     */

		    if ((cStat.cbInQue > 0) ||
			    (infoPtr->error & SERIAL_READ_ERRORS)) {
			infoPtr->readable = 1;
			time = SerialGetMilliseconds();
			if ((unsigned int) (time - infoPtr->lastEventTime)
				>= (unsigned int) infoPtr->blockTime) {
			    needEvent = 1;
			    infoPtr->lastEventTime = time;
			}
		    }
		}
	    }
	}







|
|







515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
		     * Force fileevent after serial read error.
		     */

		    if ((cStat.cbInQue > 0) ||
			    (infoPtr->error & SERIAL_READ_ERRORS)) {
			infoPtr->readable = 1;
			time = SerialGetMilliseconds();
			if ((time - infoPtr->lastEventTime)
				>= (unsigned long long) infoPtr->blockTime) {
			    needEvent = 1;
			    infoPtr->lastEventTime = time;
			}
		    }
		}
	    }
	}
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
 *	Sets the device into blocking or non-blocking mode.
 *
 *----------------------------------------------------------------------
 */

static int
SerialBlockProc(
    ClientData instanceData,    /* Instance data for channel. */
    int mode)			/* TCL_MODE_BLOCKING or
				 * TCL_MODE_NONBLOCKING. */
{
    int errorCode = 0;
    SerialInfo *infoPtr = (SerialInfo *) instanceData;

    /*







|







557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
 *	Sets the device into blocking or non-blocking mode.
 *
 *----------------------------------------------------------------------
 */

static int
SerialBlockProc(
    void *instanceData,    /* Instance data for channel. */
    int mode)			/* TCL_MODE_BLOCKING or
				 * TCL_MODE_NONBLOCKING. */
{
    int errorCode = 0;
    SerialInfo *infoPtr = (SerialInfo *) instanceData;

    /*
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
 *	Closes the physical channel.
 *
 *----------------------------------------------------------------------
 */

static int
SerialCloseProc(
    ClientData instanceData,    /* Pointer to SerialInfo structure. */
    TCL_UNUSED(Tcl_Interp *),
    int flags)
{
    SerialInfo *serialPtr = (SerialInfo *) instanceData;
    int errorCode = 0, result = 0;
    SerialInfo *infoPtr, **nextPtrPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);







|







596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
 *	Closes the physical channel.
 *
 *----------------------------------------------------------------------
 */

static int
SerialCloseProc(
    void *instanceData,    /* Pointer to SerialInfo structure. */
    TCL_UNUSED(Tcl_Interp *),
    int flags)
{
    SerialInfo *serialPtr = (SerialInfo *) instanceData;
    int errorCode = 0, result = 0;
    SerialInfo *infoPtr, **nextPtrPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
     */

    osPtr->Offset = osPtr->OffsetHigh = 0;
    result = WriteFile(infoPtr->handle, buf, bufSize, lpWritten, osPtr);
    LeaveCriticalSection(&infoPtr->csWrite);

    if (result == FALSE) {
	int err = GetLastError();

	switch (err) {
	case ERROR_IO_PENDING:
	    /*
	     * Write is pending, wait for completion.
	     */








|







792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
     */

    osPtr->Offset = osPtr->OffsetHigh = 0;
    result = WriteFile(infoPtr->handle, buf, bufSize, lpWritten, osPtr);
    LeaveCriticalSection(&infoPtr->csWrite);

    if (result == FALSE) {
	DWORD err = GetLastError();

	switch (err) {
	case ERROR_IO_PENDING:
	    /*
	     * Write is pending, wait for completion.
	     */

851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
 *	Reads input from the actual channel.
 *
 *----------------------------------------------------------------------
 */

static int
SerialInputProc(
    ClientData instanceData,	/* Serial state. */
    char *buf,			/* Where to store data read. */
    int bufSize,		/* How much space is available in the
				 * buffer? */
    int *errorCode)		/* Where to store error code. */
{
    SerialInfo *infoPtr = (SerialInfo *) instanceData;
    DWORD bytesRead = 0;







|







851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
 *	Reads input from the actual channel.
 *
 *----------------------------------------------------------------------
 */

static int
SerialInputProc(
    void *instanceData,	/* Serial state. */
    char *buf,			/* Where to store data read. */
    int bufSize,		/* How much space is available in the
				 * buffer? */
    int *errorCode)		/* Where to store error code. */
{
    SerialInfo *infoPtr = (SerialInfo *) instanceData;
    DWORD bytesRead = 0;
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
		}
	    } else {
		errno = *errorCode = EWOULDBLOCK;
		return -1;
	    }
	} else {
	    /*
	     * BLOCKING mode: Tcl trys to read a full buffer of 4 kBytes here.
	     */

	    if (cStat.cbInQue > 0) {
		if ((DWORD) bufSize > cStat.cbInQue) {
		    bufSize = cStat.cbInQue;
		}
	    } else {
		bufSize = 1;
	    }
	}
    }

    if (bufSize == 0) {
	return bytesRead = 0;
    }

    /*
     * Perform blocking read. Doesn't block in non-blocking mode, because we
     * checked the number of available bytes.
     */








|













|







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
		}
	    } else {
		errno = *errorCode = EWOULDBLOCK;
		return -1;
	    }
	} else {
	    /*
	     * BLOCKING mode: Tcl tries to read a full buffer of 4 kBytes here.
	     */

	    if (cStat.cbInQue > 0) {
		if ((DWORD) bufSize > cStat.cbInQue) {
		    bufSize = cStat.cbInQue;
		}
	    } else {
		bufSize = 1;
	    }
	}
    }

    if (bufSize == 0) {
	return 0;
    }

    /*
     * Perform blocking read. Doesn't block in non-blocking mode, because we
     * checked the number of available bytes.
     */

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
 *	Writes output on the actual channel.
 *
 *----------------------------------------------------------------------
 */

static int
SerialOutputProc(
    ClientData instanceData,	/* Serial state. */
    const char *buf,		/* The data buffer. */
    int toWrite,		/* How many bytes to write? */
    int *errorCode)		/* Where to store error code. */
{
    SerialInfo *infoPtr = (SerialInfo *) instanceData;
    DWORD bytesWritten, timeout;

    *errorCode = 0;

    /*
     * At EXIT Tcl trys to flush all open channels in blocking mode. We avoid
     * blocking output after ExitProc or CloseHandler(chan) has been called by
     * checking the corrresponding variables.
     */

    if (!initialized || TclInExit()) {
	return toWrite;
    }

    /*







|










|

|







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
 *	Writes output on the actual channel.
 *
 *----------------------------------------------------------------------
 */

static int
SerialOutputProc(
    void *instanceData,	/* Serial state. */
    const char *buf,		/* The data buffer. */
    int toWrite,		/* How many bytes to write? */
    int *errorCode)		/* Where to store error code. */
{
    SerialInfo *infoPtr = (SerialInfo *) instanceData;
    DWORD bytesWritten, timeout;

    *errorCode = 0;

    /*
     * At EXIT Tcl tries to flush all open channels in blocking mode. We avoid
     * blocking output after ExitProc or CloseHandler(chan) has been called by
     * checking the corresponding variables.
     */

    if (!initialized || TclInExit()) {
	return toWrite;
    }

    /*
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
SerialWatchProc(
    ClientData instanceData,	/* Serial state. */
    int mask)			/* What events to watch for, OR-ed combination
				 * of TCL_READABLE, TCL_WRITABLE and
				 * TCL_EXCEPTION. */
{
    SerialInfo **nextPtrPtr, *ptr;
    SerialInfo *infoPtr = (SerialInfo *) instanceData;
    int oldMask = infoPtr->watchMask;







|







1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
SerialWatchProc(
    void *instanceData,	/* Serial state. */
    int mask)			/* What events to watch for, OR-ed combination
				 * of TCL_READABLE, TCL_WRITABLE and
				 * TCL_EXCEPTION. */
{
    SerialInfo **nextPtrPtr, *ptr;
    SerialInfo *infoPtr = (SerialInfo *) instanceData;
    int oldMask = infoPtr->watchMask;
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
SerialGetHandleProc(
    ClientData instanceData,	/* The serial state. */
    TCL_UNUSED(int) /*direction*/,
    ClientData *handlePtr)	/* Where to store the handle. */
{
    SerialInfo *infoPtr = (SerialInfo *) instanceData;

    *handlePtr = (ClientData) infoPtr->handle;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * SerialWriterThread --







|

|



|







1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
SerialGetHandleProc(
    void *instanceData,	/* The serial state. */
    TCL_UNUSED(int) /*direction*/,
    void **handlePtr)	/* Where to store the handle. */
{
    SerialInfo *infoPtr = (SerialInfo *) instanceData;

    *handlePtr = (void *) infoPtr->handle;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * SerialWriterThread --
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
    SerialInfo *infoPtr;

    SerialInit();

    infoPtr = (SerialInfo *)Tcl_Alloc(sizeof(SerialInfo));
    memset(infoPtr, 0, sizeof(SerialInfo));

    infoPtr->validMask = permissions;
    infoPtr->handle = handle;
    infoPtr->channel = (Tcl_Channel) NULL;
    infoPtr->readable = 0;
    infoPtr->writable = 1;
    infoPtr->toWrite = infoPtr->writeQueue = 0;
    infoPtr->blockTime = SERIAL_DEFAULT_BLOCKTIME;
    infoPtr->lastEventTime = 0;
    infoPtr->lastError = infoPtr->error = 0;
    infoPtr->threadId = Tcl_GetCurrentThread();
    infoPtr->sysBufRead = 4096;
    infoPtr->sysBufWrite = 4096;

    /*
     * Use the pointer to keep the channel names unique, in case the handles
     * are shared between multiple channels (stdin/stdout).
     */

    sprintf(channelName, "file%" TCL_Z_MODIFIER "x", (size_t) infoPtr);

    infoPtr->channel = Tcl_CreateChannel(&serialChannelType, channelName,
	    infoPtr, permissions);


    SetupComm(handle, infoPtr->sysBufRead, infoPtr->sysBufWrite);
    PurgeComm(handle,







|

















|







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

    SerialInit();

    infoPtr = (SerialInfo *)Tcl_Alloc(sizeof(SerialInfo));
    memset(infoPtr, 0, sizeof(SerialInfo));

    infoPtr->validMask = permissions & (TCL_READABLE|TCL_WRITABLE);
    infoPtr->handle = handle;
    infoPtr->channel = (Tcl_Channel) NULL;
    infoPtr->readable = 0;
    infoPtr->writable = 1;
    infoPtr->toWrite = infoPtr->writeQueue = 0;
    infoPtr->blockTime = SERIAL_DEFAULT_BLOCKTIME;
    infoPtr->lastEventTime = 0;
    infoPtr->lastError = infoPtr->error = 0;
    infoPtr->threadId = Tcl_GetCurrentThread();
    infoPtr->sysBufRead = 4096;
    infoPtr->sysBufWrite = 4096;

    /*
     * Use the pointer to keep the channel names unique, in case the handles
     * are shared between multiple channels (stdin/stdout).
     */

    snprintf(channelName, 16 + TCL_INTEGER_SPACE, "file%" TCL_Z_MODIFIER "x", (size_t) infoPtr);

    infoPtr->channel = Tcl_CreateChannel(&serialChannelType, channelName,
	    infoPtr, permissions);


    SetupComm(handle, infoPtr->sysBufRead, infoPtr->sysBufWrite);
    PurgeComm(handle,
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
    }
    if (error & CE_PTO) {	/* PTO used to signal WRITE-TIMEOUT */
	Tcl_DStringAppendElement(dsPtr, "TIMEOUT");
    }
    if (error & ~((DWORD) (SERIAL_READ_ERRORS | SERIAL_WRITE_ERRORS))) {
	char buf[TCL_INTEGER_SPACE + 1];

	wsprintfA(buf, "%d", error);
	Tcl_DStringAppendElement(dsPtr, buf);
    }
}

/*
 *----------------------------------------------------------------------
 *







|







1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
    }
    if (error & CE_PTO) {	/* PTO used to signal WRITE-TIMEOUT */
	Tcl_DStringAppendElement(dsPtr, "TIMEOUT");
    }
    if (error & ~((DWORD) (SERIAL_READ_ERRORS | SERIAL_WRITE_ERRORS))) {
	char buf[TCL_INTEGER_SPACE + 1];

	snprintf(buf, sizeof(buf), "%ld", error);
	Tcl_DStringAppendElement(dsPtr, buf);
    }
}

/*
 *----------------------------------------------------------------------
 *
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
 *	May modify an option on a device.
 *
 *----------------------------------------------------------------------
 */

static int
SerialSetOptionProc(
    ClientData instanceData,	/* File state. */
    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
    const char *optionName,	/* Which option to set? */
    const char *value)		/* New value for option. */
{
    SerialInfo *infoPtr;
    DCB dcb;
    BOOL result, flag;
    size_t len, vlen;
    Tcl_DString ds;
    const WCHAR *native;
    size_t argc;
    const char **argv;

    infoPtr = (SerialInfo *) instanceData;

    /*
     * Parse options. This would be far easier if we had Tcl_Objs to work with
     * as that would let us use Tcl_GetIndexFromObj()...







|










|







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
 *	May modify an option on a device.
 *
 *----------------------------------------------------------------------
 */

static int
SerialSetOptionProc(
    void *instanceData,	/* File state. */
    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
    const char *optionName,	/* Which option to set? */
    const char *value)		/* New value for option. */
{
    SerialInfo *infoPtr;
    DCB dcb;
    BOOL result, flag;
    size_t len, vlen;
    Tcl_DString ds;
    const WCHAR *native;
    Tcl_Size argc;
    const char **argv;

    infoPtr = (SerialInfo *) instanceData;

    /*
     * Parse options. This would be far easier if we had Tcl_Objs to work with
     * as that would let us use Tcl_GetIndexFromObj()...
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
    }

    /*
     * Option -ttycontrol {DTR 1 RTS 0 BREAK 0}
     */

    if ((len > 4) && (strncmp(optionName, "-ttycontrol", len) == 0)) {
	size_t i;
	int res = TCL_OK;

	if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
	    return TCL_ERROR;
	}
	if ((argc % 2) == 1) {
	    if (interp != NULL) {







|







1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
    }

    /*
     * Option -ttycontrol {DTR 1 RTS 0 BREAK 0}
     */

    if ((len > 4) && (strncmp(optionName, "-ttycontrol", len) == 0)) {
	Tcl_Size i;
	int res = TCL_OK;

	if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
	    return TCL_ERROR;
	}
	if ((argc % 2) == 1) {
	    if (interp != NULL) {
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
 *	reused at any time subsequent to the call.
 *
 *----------------------------------------------------------------------
 */

static int
SerialGetOptionProc(
    ClientData instanceData,	/* File state. */
    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
    const char *optionName,	/* Option to get. */
    Tcl_DString *dsPtr)		/* Where to store value(s). */
{
    SerialInfo *infoPtr;
    DCB dcb;
    size_t len;







|







2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
 *	reused at any time subsequent to the call.
 *
 *----------------------------------------------------------------------
 */

static int
SerialGetOptionProc(
    void *instanceData,	/* File state. */
    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
    const char *optionName,	/* Option to get. */
    Tcl_DString *dsPtr)		/* Where to store value(s). */
{
    SerialInfo *infoPtr;
    DCB dcb;
    size_t len;
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
	parity = 'n';
	if (dcb.Parity <= 4) {
	    parity = "noems"[dcb.Parity];
	}
	stop = (dcb.StopBits == ONESTOPBIT) ? "1" :
		(dcb.StopBits == ONE5STOPBITS) ? "1.5" : "2";

	wsprintfA(buf, "%d,%c,%d,%s", dcb.BaudRate, parity,
		dcb.ByteSize, stop);
	Tcl_DStringAppendElement(dsPtr, buf);
    }

    /*
     * Get option -pollinterval
     */

    if (len == 0) {
	Tcl_DStringAppendElement(dsPtr, "-pollinterval");
    }
    if (len==0 || (len>1 && strncmp(optionName, "-pollinterval", len)==0)) {
	char buf[TCL_INTEGER_SPACE + 1];

	valid = 1;
	wsprintfA(buf, "%d", infoPtr->blockTime);
	Tcl_DStringAppendElement(dsPtr, buf);
    }

    /*
     * Get option -sysbuffer
     */

    if (len == 0) {
	Tcl_DStringAppendElement(dsPtr, "-sysbuffer");
	Tcl_DStringStartSublist(dsPtr);
    }
    if (len==0 || (len>1 && strncmp(optionName, "-sysbuffer", len) == 0)) {
	char buf[TCL_INTEGER_SPACE + 1];
	valid = 1;

	wsprintfA(buf, "%d", infoPtr->sysBufRead);
	Tcl_DStringAppendElement(dsPtr, buf);
	wsprintfA(buf, "%d", infoPtr->sysBufWrite);
	Tcl_DStringAppendElement(dsPtr, buf);
    }
    if (len == 0) {
	Tcl_DStringEndSublist(dsPtr);
    }

    /*







|















|















|

|







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
	parity = 'n';
	if (dcb.Parity <= 4) {
	    parity = "noems"[dcb.Parity];
	}
	stop = (dcb.StopBits == ONESTOPBIT) ? "1" :
		(dcb.StopBits == ONE5STOPBITS) ? "1.5" : "2";

	snprintf(buf, sizeof(buf), "%ld,%c,%d,%s", dcb.BaudRate, parity,
		dcb.ByteSize, stop);
	Tcl_DStringAppendElement(dsPtr, buf);
    }

    /*
     * Get option -pollinterval
     */

    if (len == 0) {
	Tcl_DStringAppendElement(dsPtr, "-pollinterval");
    }
    if (len==0 || (len>1 && strncmp(optionName, "-pollinterval", len)==0)) {
	char buf[TCL_INTEGER_SPACE + 1];

	valid = 1;
	snprintf(buf, sizeof(buf), "%d", infoPtr->blockTime);
	Tcl_DStringAppendElement(dsPtr, buf);
    }

    /*
     * Get option -sysbuffer
     */

    if (len == 0) {
	Tcl_DStringAppendElement(dsPtr, "-sysbuffer");
	Tcl_DStringStartSublist(dsPtr);
    }
    if (len==0 || (len>1 && strncmp(optionName, "-sysbuffer", len) == 0)) {
	char buf[TCL_INTEGER_SPACE + 1];
	valid = 1;

	snprintf(buf, sizeof(buf), "%ld", infoPtr->sysBufRead);
	Tcl_DStringAppendElement(dsPtr, buf);
	snprintf(buf, sizeof(buf), "%ld", infoPtr->sysBufWrite);
	Tcl_DStringAppendElement(dsPtr, buf);
    }
    if (len == 0) {
	Tcl_DStringEndSublist(dsPtr);
    }

    /*
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
	 */

	EnterCriticalSection(&infoPtr->csWrite);
	ClearCommError(infoPtr->handle, &error, &cStat);
	count = (int) cStat.cbOutQue + infoPtr->writeQueue;
	LeaveCriticalSection(&infoPtr->csWrite);

	wsprintfA(buf, "%d", inBuffered + cStat.cbInQue);
	Tcl_DStringAppendElement(dsPtr, buf);
	wsprintfA(buf, "%d", outBuffered + count);
	Tcl_DStringAppendElement(dsPtr, buf);
    }

    /*
     * get option -ttystatus
     *
     * Option is readonly and returned by [fconfigure chan -ttystatus] but not







|

|







2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
	 */

	EnterCriticalSection(&infoPtr->csWrite);
	ClearCommError(infoPtr->handle, &error, &cStat);
	count = (int) cStat.cbOutQue + infoPtr->writeQueue;
	LeaveCriticalSection(&infoPtr->csWrite);

	snprintf(buf, sizeof(buf), "%ld", inBuffered + cStat.cbInQue);
	Tcl_DStringAppendElement(dsPtr, buf);
	snprintf(buf, sizeof(buf), "%d", outBuffered + count);
	Tcl_DStringAppendElement(dsPtr, buf);
    }

    /*
     * get option -ttystatus
     *
     * Option is readonly and returned by [fconfigure chan -ttystatus] but not
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
 *	Changes thread local list of valid channels.
 *
 *----------------------------------------------------------------------
 */

static void
SerialThreadActionProc(
    ClientData instanceData,
    int action)
{
    SerialInfo *infoPtr = (SerialInfo *) instanceData;

    /*
     * We do not access firstSerialPtr in the thread structures. This is not
     * for all serials managed by the thread, but only those we are watching.
     * Removal of the filevent handlers before transfer thus takes care of
     * this structure.
     */

    Tcl_MutexLock(&serialMutex);
    if (action == TCL_CHANNEL_THREAD_INSERT) {
	/*
	 * We can't copy the thread information from the channel when the







|







|







2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
 *	Changes thread local list of valid channels.
 *
 *----------------------------------------------------------------------
 */

static void
SerialThreadActionProc(
    void *instanceData,
    int action)
{
    SerialInfo *infoPtr = (SerialInfo *) instanceData;

    /*
     * We do not access firstSerialPtr in the thread structures. This is not
     * for all serials managed by the thread, but only those we are watching.
     * Removal of the fileevent handlers before transfer thus takes care of
     * this structure.
     */

    Tcl_MutexLock(&serialMutex);
    if (action == TCL_CHANNEL_THREAD_INSERT) {
	/*
	 * We can't copy the thread information from the channel when the

Changes to win/tclWinSock.c.

101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
} address;

#ifndef IN6_ARE_ADDR_EQUAL
#define IN6_ARE_ADDR_EQUAL IN6_ADDR_EQUAL
#endif

/*
 * This structure describes per-instance state of a tcp based channel.
 */

typedef struct TcpState TcpState;

typedef struct TcpFdList {
    TcpState *statePtr;
    SOCKET fd;







|







101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
} address;

#ifndef IN6_ARE_ADDR_EQUAL
#define IN6_ARE_ADDR_EQUAL IN6_ADDR_EQUAL
#endif

/*
 * This structure describes per-instance state of a tcp-based channel.
 */

typedef struct TcpState TcpState;

typedef struct TcpFdList {
    TcpState *statePtr;
    SOCKET fd;
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
				 * This error is still a windows error code.
				 * Access must be protected by semaphore */
    struct TcpState *nextPtr;	/* The next socket on the per-thread socket
				 * list. */
};

/*
 * These bits may be ORed together into the "flags" field of a TcpState
 * structure.
 */

#define TCP_NONBLOCKING		(1<<0)	/* Socket with non-blocking I/O */
#define TCP_ASYNC_CONNECT	(1<<1)	/* Async connect in progress. */
#define SOCKET_EOF		(1<<2)	/* A zero read happened on the
					 * socket. */







|







157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
				 * This error is still a windows error code.
				 * Access must be protected by semaphore */
    struct TcpState *nextPtr;	/* The next socket on the per-thread socket
				 * list. */
};

/*
 * These bits may be OR'ed together into the "flags" field of a TcpState
 * structure.
 */

#define TCP_NONBLOCKING		(1<<0)	/* Socket with non-blocking I/O */
#define TCP_ASYNC_CONNECT	(1<<1)	/* Async connect in progress. */
#define SOCKET_EOF		(1<<2)	/* A zero read happened on the
					 * socket. */
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
static int		TcpConnect(Tcl_Interp *interp,
			    TcpState *state);
static void		InitSockets(void);
static TcpState *	NewSocketInfo(SOCKET socket);
static void		SocketExitHandler(void *clientData);
static LRESULT CALLBACK	SocketProc(HWND hwnd, UINT message, WPARAM wParam,
			    LPARAM lParam);
static int		SocketsEnabled(void);
static void		TcpAccept(TcpFdList *fds, SOCKET newSocket, address addr);
static int		WaitForConnect(TcpState *statePtr, int *errorCodePtr);
static int		WaitForSocketEvent(TcpState *statePtr, int events,
			    int *errorCodePtr);
static void		AddSocketInfoFd(TcpState *statePtr,  SOCKET socket);
static int		FindFDInList(TcpState *statePtr, SOCKET socket);
static DWORD WINAPI	SocketThread(LPVOID arg);







<







230
231
232
233
234
235
236

237
238
239
240
241
242
243
static int		TcpConnect(Tcl_Interp *interp,
			    TcpState *state);
static void		InitSockets(void);
static TcpState *	NewSocketInfo(SOCKET socket);
static void		SocketExitHandler(void *clientData);
static LRESULT CALLBACK	SocketProc(HWND hwnd, UINT message, WPARAM wParam,
			    LPARAM lParam);

static void		TcpAccept(TcpFdList *fds, SOCKET newSocket, address addr);
static int		WaitForConnect(TcpState *statePtr, int *errorCodePtr);
static int		WaitForSocketEvent(TcpState *statePtr, int events,
			    int *errorCodePtr);
static void		AddSocketInfoFd(TcpState *statePtr,  SOCKET socket);
static int		FindFDInList(TcpState *statePtr, SOCKET socket);
static DWORD WINAPI	SocketThread(LPVOID arg);
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
 *
 *----------------------------------------------------------------------
 */

void
InitializeHostName(
    char **valuePtr,
    size_t *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
    WCHAR wbuf[256];
    DWORD length = sizeof(wbuf)/sizeof(WCHAR);
    Tcl_DString ds;

    Tcl_DStringInit(&ds);
    if (GetComputerNameExW(ComputerNamePhysicalDnsFullyQualified, wbuf, &length) != 0) {
	/*
	 * Convert string from native to UTF then change to lowercase.
	 */

	Tcl_UtfToLower(Tcl_WCharToUtfDString(wbuf, TCL_INDEX_NONE, &ds));

    } else {
	if (TclpHasSockets(NULL) == TCL_OK) {
	    /*
	     * The buffer size of 256 is recommended by the MSDN page that
	     * documents gethostname() as being always adequate.
	     */

	    Tcl_DString inDs;

	    Tcl_DStringInit(&inDs);
	    Tcl_DStringSetLength(&inDs, 256);
	    if (gethostname(Tcl_DStringValue(&inDs),
		    Tcl_DStringLength(&inDs)) == 0) {
		Tcl_ExternalToUtfDStringEx(NULL, Tcl_DStringValue(&inDs),
			TCL_INDEX_NONE, TCL_ENCODING_NOCOMPLAIN, &ds);
	    }
	    Tcl_DStringFree(&inDs);
	}
    }

    *encodingPtr = Tcl_GetEncoding(NULL, "utf-8");
    *lengthPtr = Tcl_DStringLength(&ds);
    *valuePtr = (char *)Tcl_Alloc(*lengthPtr + 1);
    memcpy(*valuePtr, Tcl_DStringValue(&ds), *lengthPtr + 1);
    Tcl_DStringFree(&ds);







|















|
|
|
|
|

|

|
|
|
|
|
|
|
|
<







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

void
InitializeHostName(
    char **valuePtr,
    TCL_HASH_TYPE *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
    WCHAR wbuf[256];
    DWORD length = sizeof(wbuf)/sizeof(WCHAR);
    Tcl_DString ds;

    Tcl_DStringInit(&ds);
    if (GetComputerNameExW(ComputerNamePhysicalDnsFullyQualified, wbuf, &length) != 0) {
	/*
	 * Convert string from native to UTF then change to lowercase.
	 */

	Tcl_UtfToLower(Tcl_WCharToUtfDString(wbuf, TCL_INDEX_NONE, &ds));

    } else {
	TclInitSockets();
	/*
	 * The buffer size of 256 is recommended by the MSDN page that
	 * documents gethostname() as being always adequate.
	 */

	Tcl_DString inDs;

	Tcl_DStringInit(&inDs);
	Tcl_DStringSetLength(&inDs, 256);
	if (gethostname(Tcl_DStringValue(&inDs),
		Tcl_DStringLength(&inDs)) == 0) {
	    Tcl_ExternalToUtfDStringEx(NULL, NULL, Tcl_DStringValue(&inDs),
		    TCL_INDEX_NONE, TCL_ENCODING_PROFILE_TCL8, &ds, NULL);
	}
	Tcl_DStringFree(&inDs);

    }

    *encodingPtr = Tcl_GetEncoding(NULL, "utf-8");
    *lengthPtr = Tcl_DStringLength(&ds);
    *valuePtr = (char *)Tcl_Alloc(*lengthPtr + 1);
    memcpy(*valuePtr, Tcl_DStringValue(&ds), *lengthPtr + 1);
    Tcl_DStringFree(&ds);
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
{
    return Tcl_GetString(TclGetProcessGlobalValue(&hostName));
}

/*
 *----------------------------------------------------------------------
 *
 * TclpHasSockets --
 *
 *	This function determines whether sockets are available on the current
 *	system and returns an error in interp if they are not. Note that
 *	interp may be NULL.
 *
 * Results:
 *	Returns TCL_OK if the system supports sockets, or TCL_ERROR with an
 *	error in interp (if non-NULL).
 *
 * Side effects:
 *	If not already prepared, initializes the TSD structure and socket
 *	message handling thread associated to the calling thread for the
 *	subsystem of the driver.
 *
 *----------------------------------------------------------------------
 */

int
TclpHasSockets(
    Tcl_Interp *interp)		/* Where to write an error message if sockets
				 * are not present, or NULL if no such message
				 * is to be written. */
{

    Tcl_MutexLock(&socketMutex);

    InitSockets();
    Tcl_MutexUnlock(&socketMutex);

    if (SocketsEnabled()) {
	return TCL_OK;
    }
    if (interp != NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"sockets are not available on this system", TCL_INDEX_NONE));
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpFinalizeSockets --
 *







|

|
<
<













|
|
<
<
<

>
|
>
|
<
|
|
<

<
<
<
<
<







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
{
    return Tcl_GetString(TclGetProcessGlobalValue(&hostName));
}

/*
 *----------------------------------------------------------------------
 *
 * TclInitSockets --
 *
 *	This function just calls InitSockets(), but is protected by a mutex.


 *
 * Results:
 *	Returns TCL_OK if the system supports sockets, or TCL_ERROR with an
 *	error in interp (if non-NULL).
 *
 * Side effects:
 *	If not already prepared, initializes the TSD structure and socket
 *	message handling thread associated to the calling thread for the
 *	subsystem of the driver.
 *
 *----------------------------------------------------------------------
 */

void
TclInitSockets()



{
    if (!initialized) {
	Tcl_MutexLock(&socketMutex);
	if (!initialized) {
	    InitSockets();

	}
	Tcl_MutexUnlock(&socketMutex);

    }





}

/*
 *----------------------------------------------------------------------
 *
 * TclpFinalizeSockets --
 *
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
 *
 *	There are two modes of operation, defined by errorCodePtr:
 *	 *  non-NULL: Called by explicite read/write command. Block if socket
 *	    is blocking.
 *	    May return two error codes:
 *	     *	EWOULDBLOCK: if connect is still in progress
 *	     *	ENOTCONN: if connect failed. This would be the error message
 *		of a rect or sendto syscall so this is emulated here.
 *	 *  Null: Called by a backround operation. Do not block and don't
 *	    return any error code.
 *
 * Results:
 * 	0 if the connection has completed, -1 if still in progress or there is
 * 	an error.
 *
 * Side effects:







|
|







545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
 *
 *	There are two modes of operation, defined by errorCodePtr:
 *	 *  non-NULL: Called by explicite read/write command. Block if socket
 *	    is blocking.
 *	    May return two error codes:
 *	     *	EWOULDBLOCK: if connect is still in progress
 *	     *	ENOTCONN: if connect failed. This would be the error message
 *		of a recv or sendto syscall so this is emulated here.
 *	 *  Null: Called by a background operation. Do not block and don't
 *	    return any error code.
 *
 * Results:
 * 	0 if the connection has completed, -1 if still in progress or there is
 * 	an error.
 *
 * Side effects:
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
	     * Consume the connect event.
	     */

	    CLEAR_BITS(statePtr->readyEvents, FD_CONNECT);

	    /*
	     * For blocking sockets and foreground processing, disable async
	     * connect as we continue now synchoneously.
	     */

	    if (errorCodePtr != NULL &&
		    !GOT_BITS(statePtr->flags, TCP_NONBLOCKING)) {
		CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT);
	    }

	    /*
	     * Free list lock.
	     */

	    SetEvent(tsdPtr->socketListLock);

	    /*
	     * Continue connect. If switched to synchroneous connect, the
	     * connect is terminated.
	     */

	    result = TcpConnect(NULL, statePtr);

	    /*
	     * Restore event service mode.
	     */

	    (void) Tcl_SetServiceMode(oldMode);

	    /*
	     * Check for Succesfull connect or async connect restart
	     */

	    if (result == TCL_OK) {
		/*
		 * Check for async connect restart (not possible for
		 * foreground blocking operation)
		 */







|














|












|







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
	     * Consume the connect event.
	     */

	    CLEAR_BITS(statePtr->readyEvents, FD_CONNECT);

	    /*
	     * For blocking sockets and foreground processing, disable async
	     * connect as we continue now synchronously.
	     */

	    if (errorCodePtr != NULL &&
		    !GOT_BITS(statePtr->flags, TCP_NONBLOCKING)) {
		CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT);
	    }

	    /*
	     * Free list lock.
	     */

	    SetEvent(tsdPtr->socketListLock);

	    /*
	     * Continue connect. If switched to synchronous connect, the
	     * connect is terminated.
	     */

	    result = TcpConnect(NULL, statePtr);

	    /*
	     * Restore event service mode.
	     */

	    (void) Tcl_SetServiceMode(oldMode);

	    /*
	     * Check for Successful connect or async connect restart
	     */

	    if (result == TCL_OK) {
		/*
		 * Check for async connect restart (not possible for
		 * foreground blocking operation)
		 */
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
    TcpState *statePtr = (TcpState *)instanceData;
    int bytesRead;
    DWORD error;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);

    *errorCodePtr = 0;

    /*
     * Check that WinSock is initialized; do not call it if not, to prevent
     * system crashes. This can happen at exit time if the exit handler for
     * WinSock ran before other exit handlers that want to use sockets.
     */

    if (!SocketsEnabled()) {
	*errorCodePtr = EFAULT;
	return -1;
    }

    /*
     * First check to see if EOF was already detected, to prevent calling the
     * socket stack after the first time EOF is detected.
     */

    if (GOT_BITS(statePtr->flags, SOCKET_EOF)) {
	return 0;







<
<
<
<
<
<
<
<
<
<
<







758
759
760
761
762
763
764











765
766
767
768
769
770
771
    TcpState *statePtr = (TcpState *)instanceData;
    int bytesRead;
    DWORD error;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);

    *errorCodePtr = 0;












    /*
     * First check to see if EOF was already detected, to prevent calling the
     * socket stack after the first time EOF is detected.
     */

    if (GOT_BITS(statePtr->flags, SOCKET_EOF)) {
	return 0;
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
	    break;
	}

	error = WSAGetLastError();

	/*
	 * If an RST comes, then ignore the error and report an EOF just like
	 * on unix.
	 */

	if (error == WSAECONNRESET) {
	    SET_BITS(statePtr->flags, SOCKET_EOF);
	    bytesRead = 0;
	    break;
	}







|







822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
	    break;
	}

	error = WSAGetLastError();

	/*
	 * If an RST comes, then ignore the error and report an EOF just like
	 * on Unix.
	 */

	if (error == WSAECONNRESET) {
	    SET_BITS(statePtr->flags, SOCKET_EOF);
	    bytesRead = 0;
	    break;
	}
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
    TcpState *statePtr = (TcpState *)instanceData;
    int written;
    DWORD error;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);

    *errorCodePtr = 0;

    /*
     * Check that WinSock is initialized; do not call it if not, to prevent
     * system crashes. This can happen at exit time if the exit handler for
     * WinSock ran before other exit handlers that want to use sockets.
     */

    if (!SocketsEnabled()) {
	*errorCodePtr = EFAULT;
	return -1;
    }

    /*
     * Check if there is an async connect running.
     * For blocking sockets terminate connect, otherwise do one step.
     * For a non blocking socket return EWOULDBLOCK if connect not terminated
     */

    if (WaitForConnect(statePtr, errorCodePtr) != 0) {







<
<
<
<
<
<
<
<
<
<
<







890
891
892
893
894
895
896











897
898
899
900
901
902
903
    TcpState *statePtr = (TcpState *)instanceData;
    int written;
    DWORD error;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);

    *errorCodePtr = 0;












    /*
     * Check if there is an async connect running.
     * For blocking sockets terminate connect, otherwise do one step.
     * For a non blocking socket return EWOULDBLOCK if connect not terminated
     */

    if (WaitForConnect(statePtr, errorCodePtr) != 0) {
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
{
    TcpState *statePtr = (TcpState *)instanceData;
    /* TIP #218 */
    int errorCode = 0;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    /*
     * Check that WinSock is initialized; do not call it if not, to prevent
     * system crashes. This can happen at exit time if the exit handler for
     * WinSock ran before other exit handlers that want to use sockets.
     */

    if (SocketsEnabled()) {
	/*
	 * Clean up the OS socket handle. The default Windows setting for a
	 * socket is SO_DONTLINGER, which does a graceful shutdown in the
	 * background.
	 */

	while (statePtr->sockets != NULL) {
	    TcpFdList *thisfd = statePtr->sockets;

	    statePtr->sockets = thisfd->next;
	    if (closesocket(thisfd->fd) == SOCKET_ERROR) {
		Tcl_WinConvertError((DWORD) WSAGetLastError());
		errorCode = Tcl_GetErrno();
	    }
	    Tcl_Free(thisfd);
	}
    }

    if (statePtr->addrlist != NULL) {
        freeaddrinfo(statePtr->addrlist);
    }
    if (statePtr->myaddrlist != NULL) {
        freeaddrinfo(statePtr->myaddrlist);







<
<
<
<
<
<
<
|
|
|
|

|
|

|
|
|
|
|
|
<







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
{
    TcpState *statePtr = (TcpState *)instanceData;
    /* TIP #218 */
    int errorCode = 0;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    /*







     * Clean up the OS socket handle. The default Windows setting for a
     * socket is SO_DONTLINGER, which does a graceful shutdown in the
     * background.
     */

    while (statePtr->sockets != NULL) {
	TcpFdList *thisfd = statePtr->sockets;

	statePtr->sockets = thisfd->next;
	if (closesocket(thisfd->fd) == SOCKET_ERROR) {
	    Tcl_WinConvertError((DWORD) WSAGetLastError());
	    errorCode = Tcl_GetErrno();
	}
	Tcl_Free(thisfd);

    }

    if (statePtr->addrlist != NULL) {
        freeaddrinfo(statePtr->addrlist);
    }
    if (statePtr->myaddrlist != NULL) {
        freeaddrinfo(statePtr->myaddrlist);
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
    SOCKET sock;
    size_t len = 0;

    if (optionName != NULL) {
	len = strlen(optionName);
    }

    /*
     * Check that WinSock is initialized; do not call it if not, to prevent
     * system crashes. This can happen at exit time if the exit handler for
     * WinSock ran before other exit handlers that want to use sockets.
     */

    if (!SocketsEnabled()) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "winsock is not initialized", -1));
	}
	return TCL_ERROR;
    }

    sock = statePtr->sockets->fd;

    if ((len > 1) && (optionName[1] == 'k') &&
	    (strncmp(optionName, "-keepalive", len) == 0)) {
	BOOL boolVar;
	int rtn;








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







1131
1132
1133
1134
1135
1136
1137














1138
1139
1140
1141
1142
1143
1144
    SOCKET sock;
    size_t len = 0;

    if (optionName != NULL) {
	len = strlen(optionName);
    }















    sock = statePtr->sockets->fd;

    if ((len > 1) && (optionName[1] == 'k') &&
	    (strncmp(optionName, "-keepalive", len) == 0)) {
	BOOL boolVar;
	int rtn;

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
    TcpState *statePtr = (TcpState *)instanceData;
    char host[NI_MAXHOST], port[NI_MAXSERV];
    SOCKET sock;
    size_t len = 0;
    int reverseDNS = 0;
#define SUPPRESS_RDNS_VAR "::tcl::unsupported::noReverseDNS"

    /*
     * Check that WinSock is initialized; do not call it if not, to prevent
     * system crashes. This can happen at exit time if the exit handler for
     * WinSock ran before other exit handlers that want to use sockets.
     */

    if (!SocketsEnabled()) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "winsock is not initialized", -1));
	}
	return TCL_ERROR;
    }

    /*
     * Go one step in async connect
     *
     * If any error is thrown save it as backround error to report eventually
     * below.
     */

    if (!GOT_BITS(statePtr->flags, TCP_ASYNC_TEST_MODE)) {
	WaitForConnect(statePtr, NULL);
    }








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



|







1216
1217
1218
1219
1220
1221
1222














1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
    TcpState *statePtr = (TcpState *)instanceData;
    char host[NI_MAXHOST], port[NI_MAXSERV];
    SOCKET sock;
    size_t len = 0;
    int reverseDNS = 0;
#define SUPPRESS_RDNS_VAR "::tcl::unsupported::noReverseDNS"















    /*
     * Go one step in async connect
     *
     * If any error is thrown save it as background error to report eventually
     * below.
     */

    if (!GOT_BITS(statePtr->flags, TCP_ASYNC_TEST_MODE)) {
	WaitForConnect(statePtr, NULL);
    }

1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
		 * In case of a failed async connect, eventually report the
		 * connect error only once.  Do not report the system error,
		 * as this comes again and again.
		 */

		if (statePtr->connectError != 0) {
		    Tcl_DStringAppend(dsPtr,
			    Tcl_ErrnoMsg(statePtr->connectError), -1);
		    statePtr->connectError = 0;
		}
	    } else {
		/*
		 * Report an eventual last error of the socket system.
		 */








|







1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
		 * In case of a failed async connect, eventually report the
		 * connect error only once.  Do not report the system error,
		 * as this comes again and again.
		 */

		if (statePtr->connectError != 0) {
		    Tcl_DStringAppend(dsPtr,
			    Tcl_ErrnoMsg(statePtr->connectError), TCL_INDEX_NONE);
		    statePtr->connectError = 0;
		}
	    } else {
		/*
		 * Report an eventual last error of the socket system.
		 */

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

		/*
		 * Return error message.
		 */

		if (err) {
		    Tcl_WinConvertError(err);
		    Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()), -1);
		}
	    }
	}
	return TCL_OK;
    }

    if ((len > 1) && (optionName[1] == 'c') &&
	    (strncmp(optionName, "-connecting", len) == 0)) {
	Tcl_DStringAppend(dsPtr,
		GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)
		? "1" : "0", -1);
        return TCL_OK;
    }

    if (interp != NULL
	    && Tcl_GetVar(interp, SUPPRESS_RDNS_VAR, 0) != NULL) {
	reverseDNS = NI_NUMERICHOST;
    }







|










|







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

		/*
		 * Return error message.
		 */

		if (err) {
		    Tcl_WinConvertError(err);
		    Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()), TCL_INDEX_NONE);
		}
	    }
	}
	return TCL_OK;
    }

    if ((len > 1) && (optionName[1] == 'c') &&
	    (strncmp(optionName, "-connecting", len) == 0)) {
	Tcl_DStringAppend(dsPtr,
		GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)
		? "1" : "0", TCL_INDEX_NONE);
        return TCL_OK;
    }

    if (interp != NULL
	    && Tcl_GetVar(interp, SUPPRESS_RDNS_VAR, 0) != NULL) {
	reverseDNS = NI_NUMERICHOST;
    }
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
		    statePtr->addr->ai_addrlen);

	    error = WSAGetLastError();
	    Tcl_WinConvertError(error);

	    if (async_connect && error == WSAEWOULDBLOCK) {
		/*
		 * Asynchroneous connect
		 *
		 * Remember that we jump back behind this next round
		 */

		SET_BITS(statePtr->flags, TCP_ASYNC_PENDING);
		return TCL_OK;








|







1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
		    statePtr->addr->ai_addrlen);

	    error = WSAGetLastError();
	    Tcl_WinConvertError(error);

	    if (async_connect && error == WSAEWOULDBLOCK) {
		/*
		 * Asynchronous connect
		 *
		 * Remember that we jump back behind this next round
		 */

		SET_BITS(statePtr->flags, TCP_ASYNC_PENDING);
		return TCL_OK;

1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
     * Async connect terminated
     */

    CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT);

    if (Tcl_GetErrno() == 0) {
	/*
	 * Succesfully connected
	 *
	 * Set up the select mask for read/write events.
	 */

	statePtr->selectEvents = FD_READ | FD_WRITE | FD_CLOSE;

	/*







|







1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
     * Async connect terminated
     */

    CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT);

    if (Tcl_GetErrno() == 0) {
	/*
	 * Successfully connected
	 *
	 * Set up the select mask for read/write events.
	 */

	statePtr->selectEvents = FD_READ | FD_WRITE | FD_CLOSE;

	/*
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
	     * Free list lock.
	     */

	    SetEvent(tsdPtr->socketListLock);
	}

	/*
	 * Error message on synchroneous connect
	 */

	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "couldn't open socket: %s", Tcl_PosixError(interp)));
	}
	return TCL_ERROR;







|







1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
	     * Free list lock.
	     */

	    SetEvent(tsdPtr->socketListLock);
	}

	/*
	 * Error message on synchronous connect
	 */

	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "couldn't open socket: %s", Tcl_PosixError(interp)));
	}
	return TCL_ERROR;
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
				 * connect. */
{
    TcpState *statePtr;
    const char *errorMsg = NULL;
    struct addrinfo *addrlist = NULL, *myaddrlist = NULL;
    char channelName[SOCK_CHAN_LENGTH];

    if (TclpHasSockets(interp) != TCL_OK) {
	return NULL;
    }

    /*
     * Check that WinSock is initialized; do not call it if not, to prevent
     * system crashes. This can happen at exit time if the exit handler for
     * WinSock ran before other exit handlers that want to use sockets.
     */

    if (!SocketsEnabled()) {
	return NULL;
    }

    /*
     * Do the name lookups for the local and remote addresses.
     */

    if (!TclCreateSocketAddress(interp, &addrlist, host, port, 0, &errorMsg)
            || !TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1,







<
<
<
<
<
<
<
<
<
<
|
<
<







1939
1940
1941
1942
1943
1944
1945










1946


1947
1948
1949
1950
1951
1952
1953
				 * connect. */
{
    TcpState *statePtr;
    const char *errorMsg = NULL;
    struct addrinfo *addrlist = NULL, *myaddrlist = NULL;
    char channelName[SOCK_CHAN_LENGTH];











    TclInitSockets();



    /*
     * Do the name lookups for the local and remote addresses.
     */

    if (!TclCreateSocketAddress(interp, &addrlist, host, port, 0, &errorMsg)
            || !TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1,
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
     * Create a new client socket and wrap it in a channel.
     */
    if (TcpConnect(interp, statePtr) != TCL_OK) {
	TcpCloseProc(statePtr, NULL);
	return NULL;
    }

    sprintf(channelName, SOCK_TEMPLATE, statePtr);

    statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    statePtr, (TCL_READABLE | TCL_WRITABLE));
    if (TCL_ERROR == Tcl_SetChannelOption(NULL, statePtr->channel,
	    "-translation", "auto crlf")) {
	Tcl_CloseEx(NULL, statePtr->channel, 0);
	return NULL;







|







1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
     * Create a new client socket and wrap it in a channel.
     */
    if (TcpConnect(interp, statePtr) != TCL_OK) {
	TcpCloseProc(statePtr, NULL);
	return NULL;
    }

    snprintf(channelName, sizeof(channelName), SOCK_TEMPLATE, statePtr);

    statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    statePtr, (TCL_READABLE | TCL_WRITABLE));
    if (TCL_ERROR == Tcl_SetChannelOption(NULL, statePtr->channel,
	    "-translation", "auto crlf")) {
	Tcl_CloseEx(NULL, statePtr->channel, 0);
	return NULL;
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
Tcl_MakeTcpClientChannel(
    void *sock)		/* The socket to wrap up into a channel. */
{
    TcpState *statePtr;
    char channelName[SOCK_CHAN_LENGTH];
    ThreadSpecificData *tsdPtr;

    if (TclpHasSockets(NULL) != TCL_OK) {
	return NULL;
    }

    tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);

    /*
     * Set kernel space buffering and non-blocking.
     */

    TclSockMinimumBuffers(sock, TCP_BUFFER_SIZE);

    statePtr = NewSocketInfo((SOCKET) sock);

    /*
     * Start watching for read/write events on the socket.
     */

    statePtr->selectEvents = FD_READ | FD_CLOSE | FD_WRITE;
    SendSelectMessage(tsdPtr, SELECT, statePtr);

    sprintf(channelName, SOCK_TEMPLATE, statePtr);
    statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    statePtr, (TCL_READABLE | TCL_WRITABLE));
    Tcl_SetChannelOption(NULL, statePtr->channel, "-translation", "auto crlf");
    return statePtr->channel;
}

/*







|
<
<


















|







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
Tcl_MakeTcpClientChannel(
    void *sock)		/* The socket to wrap up into a channel. */
{
    TcpState *statePtr;
    char channelName[SOCK_CHAN_LENGTH];
    ThreadSpecificData *tsdPtr;

    TclInitSockets();



    tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);

    /*
     * Set kernel space buffering and non-blocking.
     */

    TclSockMinimumBuffers(sock, TCP_BUFFER_SIZE);

    statePtr = NewSocketInfo((SOCKET) sock);

    /*
     * Start watching for read/write events on the socket.
     */

    statePtr->selectEvents = FD_READ | FD_CLOSE | FD_WRITE;
    SendSelectMessage(tsdPtr, SELECT, statePtr);

    snprintf(channelName, sizeof(channelName), SOCK_TEMPLATE, statePtr);
    statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    statePtr, (TCL_READABLE | TCL_WRITABLE));
    Tcl_SetChannelOption(NULL, statePtr->channel, "-translation", "auto crlf");
    return statePtr->channel;
}

/*
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
    struct addrinfo *addrPtr;	/* Socket address to listen on. */
    TcpState *statePtr = NULL;	/* The returned value. */
    char channelName[SOCK_CHAN_LENGTH];
    u_long flag = 1;		/* Indicates nonblocking mode. */
    const char *errorMsg = NULL;
    int optvalue, port;

    if (TclpHasSockets(interp) != TCL_OK) {
	return NULL;
    }

    /*
     * Check that WinSock is initialized; do not call it if not, to prevent
     * system crashes. This can happen at exit time if the exit handler for
     * WinSock ran before other exit handlers that want to use sockets.
     */

    if (!SocketsEnabled()) {
	return NULL;
    }

    /*
     * Construct the addresses for each end of the socket.
     */

    if (TclSockGetPort(interp, service, "tcp", &port) != TCL_OK) {
	errorMsg = "invalid port number";







<
<
<
<
<
<
<
<
<
<
|
<
<







2079
2080
2081
2082
2083
2084
2085










2086


2087
2088
2089
2090
2091
2092
2093
    struct addrinfo *addrPtr;	/* Socket address to listen on. */
    TcpState *statePtr = NULL;	/* The returned value. */
    char channelName[SOCK_CHAN_LENGTH];
    u_long flag = 1;		/* Indicates nonblocking mode. */
    const char *errorMsg = NULL;
    int optvalue, port;











    TclInitSockets();



    /*
     * Construct the addresses for each end of the socket.
     */

    if (TclSockGetPort(interp, service, "tcp", &port) != TCL_OK) {
	errorMsg = "invalid port number";
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
    }

    if (statePtr != NULL) {
	ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);

	statePtr->acceptProc = acceptProc;
	statePtr->acceptProcData = acceptProcData;
	sprintf(channelName, SOCK_TEMPLATE, statePtr);
	statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
		statePtr, 0);
	/*
	 * Set up the select mask for connection request events.
	 */

	statePtr->selectEvents = FD_ACCEPT;







|







2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
    }

    if (statePtr != NULL) {
	ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);

	statePtr->acceptProc = acceptProc;
	statePtr->acceptProcData = acceptProcData;
	snprintf(channelName, sizeof(channelName), SOCK_TEMPLATE, statePtr);
	statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
		statePtr, 0);
	/*
	 * Set up the select mask for connection request events.
	 */

	statePtr->selectEvents = FD_ACCEPT;
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
    /*
     * Select on read/write events and create the channel.
     */

    newInfoPtr->selectEvents = (FD_READ | FD_WRITE | FD_CLOSE);
    SendSelectMessage(tsdPtr, SELECT, newInfoPtr);

    sprintf(channelName, SOCK_TEMPLATE, newInfoPtr);
    newInfoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    newInfoPtr, (TCL_READABLE | TCL_WRITABLE));
    if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-translation",
	    "auto crlf") == TCL_ERROR) {
	Tcl_CloseEx(NULL, newInfoPtr->channel, 0);
	return;
    }







|







2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
    /*
     * Select on read/write events and create the channel.
     */

    newInfoPtr->selectEvents = (FD_READ | FD_WRITE | FD_CLOSE);
    SendSelectMessage(tsdPtr, SELECT, newInfoPtr);

    snprintf(channelName, sizeof(channelName), SOCK_TEMPLATE, newInfoPtr);
    newInfoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    newInfoPtr, (TCL_READABLE | TCL_WRITABLE));
    if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-translation",
	    "auto crlf") == TCL_ERROR) {
	Tcl_CloseEx(NULL, newInfoPtr->channel, 0);
	return;
    }
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
    /*
     * Wait for the thread to signal when the window has been created and if
     * it is ready to go.
     */

    WaitForSingleObject(tsdPtr->readyEvent, INFINITE);

    if (tsdPtr->hwnd == NULL) {
	goto initFailure;	/* Trouble creating the window. */
    }

    Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL);
    return;

  initFailure:
    TclpFinalizeSockets();
    initialized = -1;
    return;
}

/*
 *----------------------------------------------------------------------
 *
 * SocketsEnabled --
 *
 *	Check that the WinSock was successfully initialized.
 *
 * Warning:
 *	This check was useful in times of Windows98 where WinSock may
 *	not be available. This is not the case any more.
 *	This function may be removed with TCL 9.0
 *
 * Results:
 *	1 if it is.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
SocketsEnabled(void)
{
    int enabled;

    Tcl_MutexLock(&socketMutex);
    enabled = (initialized == 1);
    Tcl_MutexUnlock(&socketMutex);
    return enabled;
}


/*
 *----------------------------------------------------------------------
 *
 * SocketExitHandler --
 *
 *	Callback invoked during exit clean up to delete the socket







|
<
<
<
|
|
|
<
<
<
<
|
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
|

<







2410
2411
2412
2413
2414
2415
2416
2417



2418
2419
2420




2421
2422




















2423








2424
2425

2426
2427
2428
2429
2430
2431
2432
    /*
     * Wait for the thread to signal when the window has been created and if
     * it is ready to go.
     */

    WaitForSingleObject(tsdPtr->readyEvent, INFINITE);

    if (tsdPtr->hwnd != NULL) {



	Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL);
	return;
    }





  initFailure:




















    Tcl_Panic("InitSockets failed");








    return;
}


/*
 *----------------------------------------------------------------------
 *
 * SocketExitHandler --
 *
 *	Callback invoked during exit clean up to delete the socket
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
	/*
	 * Get statePtr lock.
	 */

	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);

	/*
	 * Check if event occured.
	 */

	event_found = GOT_BITS(statePtr->readyEvents, events);

	/*
	 * Free list lock.
	 */

	SetEvent(tsdPtr->socketListLock);

	/*
	 * Exit loop if event occured.
	 */

	if (event_found) {
	    break;
	}

	/*







|











|







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
	/*
	 * Get statePtr lock.
	 */

	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);

	/*
	 * Check if event occurred.
	 */

	event_found = GOT_BITS(statePtr->readyEvents, events);

	/*
	 * Free list lock.
	 */

	SetEvent(tsdPtr->socketListLock);

	/*
	 * Exit loop if event occurred.
	 */

	if (event_found) {
	    break;
	}

	/*
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
 *	interest in a socket event, and the event has occurred.
 *
 * Results:
 *	0 on success.
 *
 * Side effects:
 *	The flags for the given socket are updated to reflect the event that
 *	occured.
 *
 *----------------------------------------------------------------------
 */

static LRESULT CALLBACK
SocketProc(
    HWND hwnd,







|







3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
 *	interest in a socket event, and the event has occurred.
 *
 * Results:
 *	0 on success.
 *
 * Side effects:
 *	The flags for the given socket are updated to reflect the event that
 *	occurred.
 *
 *----------------------------------------------------------------------
 */

static LRESULT CALLBACK
SocketProc(
    HWND hwnd,
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
}

/*
 *----------------------------------------------------------------------
 *
 * FindFDInList --
 *
 *	Return true, if the given file descriptior is contained in the
 *	file descriptor list.
 *
 * Results:
 *	true if found.
 *
 * Side effects:
 *







|







3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
}

/*
 *----------------------------------------------------------------------
 *
 * FindFDInList --
 *
 *	Return true, if the given file descriptor is contained in the
 *	file descriptor list.
 *
 * Results:
 *	true if found.
 *
 * Side effects:
 *
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400

    if (action == TCL_CHANNEL_THREAD_INSERT) {
	/*
	 * Ensure that socket subsystem is initialized in this thread, or else
	 * sockets will not work.
	 */

	Tcl_MutexLock(&socketMutex);
	InitSockets();
	Tcl_MutexUnlock(&socketMutex);

	tsdPtr = TCL_TSD_INIT(&dataKey);

	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
	statePtr->nextPtr = tsdPtr->socketList;
	tsdPtr->socketList = statePtr;








<
|
<







3252
3253
3254
3255
3256
3257
3258

3259

3260
3261
3262
3263
3264
3265
3266

    if (action == TCL_CHANNEL_THREAD_INSERT) {
	/*
	 * Ensure that socket subsystem is initialized in this thread, or else
	 * sockets will not work.
	 */


	TclInitSockets();


	tsdPtr = TCL_TSD_INIT(&dataKey);

	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
	statePtr->nextPtr = tsdPtr->socketList;
	tsdPtr->socketList = statePtr;

Changes to win/tclWinTest.c.

18
19
20
21
22
23
24
25
26
27

28
29
30
31
32
33
34
#else
#   include "tclTomMath.h"
#endif

/*
 * For TestplatformChmod on Windows
 */
#ifdef _WIN32
#include <aclapi.h>
#endif


/*
 * MinGW 3.4.2 does not define this.
 */
#ifndef INHERITED_ACE
#define INHERITED_ACE (0x10)
#endif







<

<
>







18
19
20
21
22
23
24

25

26
27
28
29
30
31
32
33
#else
#   include "tclTomMath.h"
#endif

/*
 * For TestplatformChmod on Windows
 */

#include <aclapi.h>

#include <sddl.h>

/*
 * MinGW 3.4.2 does not define this.
 */
#ifndef INHERITED_ACE
#define INHERITED_ACE (0x10)
#endif
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

    /* SMASH! */
    RaiseException(exceptions[cmd], EXCEPTION_NONCONTINUABLE, 0, NULL);

    return TCL_OK;
}





static int
TestplatformChmod(
    const char *nativePath,
    int pmode)
{








    static const SECURITY_INFORMATION infoBits = OWNER_SECURITY_INFORMATION





	    | GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION;

    /* don't reset change permissions mask (WRITE_DAC, allow test-cases restore it to cleanup) */




    static const DWORD readOnlyMask = FILE_DELETE_CHILD | FILE_ADD_FILE
	    | FILE_ADD_SUBDIRECTORY | FILE_WRITE_EA | FILE_APPEND_DATA
	    | FILE_WRITE_DATA
	    | DELETE;

    /*
     * References to security functions (only available on NT and later).
     */




    const BOOL set_readOnly = !(pmode & 0222);
    BOOL acl_readOnly_found = FALSE, curAclPresent, curAclDefaulted;
    SID_IDENTIFIER_AUTHORITY userSidAuthority = {
	SECURITY_WORLD_SID_AUTHORITY
    };

    BYTE *secDesc = 0;


    DWORD secDescLen, attr, newAclSize;
    ACL_SIZE_INFORMATION ACLSize;
    PACL curAcl, newAcl = 0;

    WORD j;
    SID *userSid = 0;
    char *userDomain = 0;
    int res = 0;


    /*
     * Process the chmod request.
     */

    attr = GetFileAttributesA(nativePath);



    /*
     * nativePath not found
     */

    if (attr == 0xFFFFFFFF) {
	res = -1;

	goto done;
    }

    /*
     * If nativePath is not a directory, there is no special handling.
     */



    if (!(attr & FILE_ATTRIBUTE_DIRECTORY)) {


	goto done;
    }








    /*
     * Set the result to error, if the ACL change is successful it will be
     * reset to 0.

     */







    res = -1;






    /*
     * Read the security descriptor for the directory. Note the first call
     * obtains the size of the security descriptor.
     */


    if (!GetFileSecurityA(nativePath, infoBits, NULL, 0, &secDescLen)) {


	DWORD secDescLen2 = 0;





	if (GetLastError() != ERROR_INSUFFICIENT_BUFFER) {
	    goto done;
	}






	secDesc = (BYTE *)Tcl_Alloc(secDescLen);
	if (!GetFileSecurityA(nativePath, infoBits,
		(PSECURITY_DESCRIPTOR) secDesc, secDescLen, &secDescLen2)
		|| (secDescLen < secDescLen2)) {



	    goto done;
	}

    }


    /*

     * Get the World SID.
     */


    userSid = (SID *)Tcl_Alloc(GetSidLengthRequired((UCHAR) 1));
    InitializeSid(userSid, &userSidAuthority, (BYTE) 1);
    *(GetSidSubAuthority(userSid, 0)) = SECURITY_WORLD_RID;








    /*
     * If curAclPresent == false then curAcl and curAclDefaulted not valid.
     */

    if (!GetSecurityDescriptorDacl((PSECURITY_DESCRIPTOR) secDesc,


	    &curAclPresent, &curAcl, &curAclDefaulted)) {
	goto done;
    }
    if (!curAclPresent || !curAcl) {
	ACLSize.AclBytesInUse = 0;
	ACLSize.AceCount = 0;
    } else if (!GetAclInformation(curAcl, &ACLSize, sizeof(ACLSize),
	    AclSizeInformation)) {

	goto done;
    }


    /*
     * Allocate memory for the new ACL.
     */




    newAclSize = ACLSize.AclBytesInUse + sizeof(ACCESS_DENIED_ACE)






	    + GetLengthSid(userSid) - sizeof(DWORD);
    newAcl = (PACL) Tcl_Alloc(newAclSize);

    /*
     * Initialize the new ACL.
     */







    if (!InitializeAcl(newAcl, newAclSize, ACL_REVISION)) {
	goto done;
    }

    /*
     * Add denied to make readonly, this will be known as a "read-only tag".
     */

    if (set_readOnly && !AddAccessDeniedAce(newAcl, ACL_REVISION,
	    readOnlyMask, userSid)) {
	goto done;
    }

    acl_readOnly_found = FALSE;
    for (j = 0; j < ACLSize.AceCount; j++) {
	LPVOID pACE2;
	ACE_HEADER *phACE2;

	if (!GetAce(curAcl, j, &pACE2)) {
	    goto done;
	}

	phACE2 = (ACE_HEADER *) pACE2;

	/*
	 * Do NOT propagate inherited ACEs.
	 */

	if (phACE2->AceFlags & INHERITED_ACE) {
	    continue;
	}

	/*
	 * Skip the "read-only tag" restriction (either added above, or it is
	 * being removed).
	 */

	if (phACE2->AceType == ACCESS_DENIED_ACE_TYPE) {
	    ACCESS_DENIED_ACE *pACEd = (ACCESS_DENIED_ACE *) phACE2;

	    if (pACEd->Mask == readOnlyMask
		    && EqualSid(userSid, (PSID) &pACEd->SidStart)) {
		acl_readOnly_found = TRUE;
		continue;
	    }
	}

	/*
	 * Copy the current ACE from the old to the new ACL.
	 */

	if (!AddAce(newAcl, ACL_REVISION, MAXDWORD, (PACL *) pACE2,
		((PACE_HEADER) pACE2)->AceSize)) {
	    goto done;
	}
    }

    /*
     * Apply the new ACL. Note PROTECTED_DACL_SECURITY_INFORMATION can be used
     * to remove inherited ACL (we need to overwrite the default ACL's in this case)
     */

    if (set_readOnly == acl_readOnly_found || SetNamedSecurityInfoA(
	    (LPSTR) nativePath, SE_FILE_OBJECT,
	    DACL_SECURITY_INFORMATION /*| PROTECTED_DACL_SECURITY_INFORMATION*/,




	    NULL, NULL, newAcl, NULL) == ERROR_SUCCESS) {
	res = 0;
    }

  done:
    if (secDesc) {
	Tcl_Free(secDesc);



    }
    if (newAcl) {
	Tcl_Free(newAcl);
    }
    if (userSid) {
	Tcl_Free(userSid);
    }
    if (userDomain) {
	Tcl_Free(userDomain);
    }

    if (res != 0) {
	return res;
    }

    /*
     * Run normal chmod command.

     */

    return chmod(nativePath, pmode);
}

/*
 *---------------------------------------------------------------------------
 *
 * TestchmodCmd --
 *







>
>
>
>





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

<
<
<
>
>
>

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

|
<
<


>
>
|
<
<
<

|
|
>



|
|
<
>
>
|
<
>
>


>
>
>
>
>
>
>
|

<
<
>

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

>
>
>
|


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


>
|
>

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

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

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




<
<
<
|
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<









|
|
|
>
>
>
>
|




|
|
>
>
>




|
|
<
<
<






<
|
>
|

<







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

    /* SMASH! */
    RaiseException(exceptions[cmd], EXCEPTION_NONCONTINUABLE, 0, NULL);

    return TCL_OK;
}

/*
 * This "chmod" works sufficiently for test script purposes. Do not expect
 * it to be exact emulation of Unix chmod (not sure if that's even possible)
 */
static int
TestplatformChmod(
    const char *nativePath,
    int pmode)
{
    /*
     * Note FILE_DELETE_CHILD missing from dirWriteMask because we do
     * not want overriding of child's delete setting when testing
     */
    static const DWORD dirWriteMask =
	FILE_WRITE_ATTRIBUTES | FILE_WRITE_EA |
	FILE_ADD_FILE | FILE_ADD_SUBDIRECTORY | STANDARD_RIGHTS_WRITE | DELETE |
	SYNCHRONIZE;
    static const DWORD dirReadMask =
	FILE_READ_ATTRIBUTES | FILE_READ_EA | FILE_LIST_DIRECTORY |
	STANDARD_RIGHTS_READ | SYNCHRONIZE;
    /* Note - default user privileges allow ignoring TRAVERSE setting */
    static const DWORD dirExecuteMask =
	FILE_TRAVERSE | STANDARD_RIGHTS_READ | SYNCHRONIZE;

    static const DWORD fileWriteMask =
	FILE_WRITE_ATTRIBUTES | FILE_WRITE_EA | FILE_WRITE_DATA |
	FILE_APPEND_DATA | STANDARD_RIGHTS_WRITE | DELETE | SYNCHRONIZE;
    static const DWORD fileReadMask =
	FILE_READ_ATTRIBUTES | FILE_READ_EA | FILE_READ_DATA |
	STANDARD_RIGHTS_READ | SYNCHRONIZE;
    static const DWORD fileExecuteMask =

	FILE_EXECUTE | STANDARD_RIGHTS_READ | SYNCHRONIZE;





    DWORD attr, newAclSize;
    PACL newAcl = NULL;
    int res = 0;

    HANDLE hToken = NULL;




    int i;
    int nSids = 0;
    struct {
	PSID pSid;
	DWORD mask;
	DWORD sidLen;

    } aceEntry[3];
    DWORD dw;


    int isDir;
    TOKEN_USER *pTokenUser = NULL;

    res = -1; /* Assume failure */



    attr = GetFileAttributesA(nativePath);
    if (attr == 0xFFFFFFFF) {
	goto done; /* Not found */
    }




    isDir = (attr & FILE_ATTRIBUTE_DIRECTORY) != 0;

    if (!OpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, &hToken)) {
	goto done;
    }

    /* Get process SID */
    if (!GetTokenInformation(hToken, TokenUser, NULL, 0, &dw) &&

	GetLastError() != ERROR_INSUFFICIENT_BUFFER) {
	goto done;
    }

    pTokenUser = (TOKEN_USER *)Tcl_Alloc(dw);
    if (!GetTokenInformation(hToken, TokenUser, pTokenUser, dw, &dw)) {
	goto done;
    }
    aceEntry[nSids].sidLen = GetLengthSid(pTokenUser->User.Sid);
    aceEntry[nSids].pSid = Tcl_Alloc(aceEntry[nSids].sidLen);
    if (!CopySid(aceEntry[nSids].sidLen,
		 aceEntry[nSids].pSid,
		 pTokenUser->User.Sid)) {
	Tcl_Free(aceEntry[nSids].pSid); /* Since we have not ++'ed nSids */
	goto done;
    }
    /*


     * Always include DACL modify rights so we don't get locked out
     */
    aceEntry[nSids].mask = READ_CONTROL | WRITE_DAC | WRITE_OWNER | SYNCHRONIZE |
			   FILE_READ_ATTRIBUTES | FILE_WRITE_ATTRIBUTES;
    if (pmode & 0700) {
	/* Owner permissions. Assumes current process is owner */
	if (pmode & 0400) {
	    aceEntry[nSids].mask |= isDir ? dirReadMask : fileReadMask;
	}

	if (pmode & 0200) {
	    aceEntry[nSids].mask |= isDir ? dirWriteMask : fileWriteMask;
	}
	if (pmode & 0100) {
	    aceEntry[nSids].mask |= isDir ? dirExecuteMask : fileExecuteMask;
	}




    }
    ++nSids;

    if (pmode & 0070) {
	/* Group permissions. */

	TOKEN_PRIMARY_GROUP *pTokenGroup;

	/* Get primary group SID */
	if (!GetTokenInformation(
		hToken, TokenPrimaryGroup, NULL, 0, &dw) &&
		GetLastError() != ERROR_INSUFFICIENT_BUFFER) {
	    goto done;
	}
	pTokenGroup = (TOKEN_PRIMARY_GROUP *)Tcl_Alloc(dw);
	if (!GetTokenInformation(hToken, TokenPrimaryGroup, pTokenGroup, dw, &dw)) {
	    Tcl_Free(pTokenGroup);
	    goto done;
	}
	aceEntry[nSids].sidLen = GetLengthSid(pTokenGroup->PrimaryGroup);
	aceEntry[nSids].pSid = Tcl_Alloc(aceEntry[nSids].sidLen);



	if (!CopySid(aceEntry[nSids].sidLen, aceEntry[nSids].pSid, pTokenGroup->PrimaryGroup)) {
	    Tcl_Free(pTokenGroup);
	    Tcl_Free(aceEntry[nSids].pSid); /* Since we have not ++'ed nSids */
	    goto done;
	}
	Tcl_Free(pTokenGroup);

	/* Generate mask for group ACL */


	aceEntry[nSids].mask = 0;
	if (pmode & 0040) {

	    aceEntry[nSids].mask |= isDir ? dirReadMask : fileReadMask;
	}



	if (pmode & 0020) {
	    aceEntry[nSids].mask |= isDir ? dirWriteMask : fileWriteMask;
	}
	if (pmode & 0010) {
	    aceEntry[nSids].mask |= isDir ? dirExecuteMask : fileExecuteMask;
	}
	++nSids;
    }




    if (pmode & 0007) {
	/* World permissions */
	PSID pWorldSid;
	if (!ConvertStringSidToSidA("S-1-1-0", &pWorldSid)) {
	    goto done;
	}
	aceEntry[nSids].sidLen = GetLengthSid(pWorldSid);
	aceEntry[nSids].pSid = Tcl_Alloc(aceEntry[nSids].sidLen);
	if (!CopySid(aceEntry[nSids].sidLen, aceEntry[nSids].pSid, pWorldSid)) {

	    LocalFree(pWorldSid);
	    Tcl_Free(aceEntry[nSids].pSid); /* Since we have not ++'ed nSids */
	    goto done;
	}
	LocalFree(pWorldSid);


	/* Generate mask for world ACL */

	aceEntry[nSids].mask = 0;
	if (pmode & 0004) {
	    aceEntry[nSids].mask |= isDir ? dirReadMask : fileReadMask;
	}

	if (pmode & 0002) {
	    aceEntry[nSids].mask |= isDir ? dirWriteMask : fileWriteMask;
	}
	if (pmode & 0001) {
	    aceEntry[nSids].mask |= isDir ? dirExecuteMask : fileExecuteMask;
	}
	++nSids;

    }

    /* Allocate memory and initialize the new ACL. */

    newAclSize = sizeof(ACL);
    /* Add in size required for each ACE entry in the ACL */
    for (i = 0; i < nSids; ++i) {
	newAclSize +=
	    offsetof(ACCESS_ALLOWED_ACE, SidStart) + aceEntry[i].sidLen;
    }
    newAcl = (PACL)Tcl_Alloc(newAclSize);
    if (!InitializeAcl(newAcl, newAclSize, ACL_REVISION)) {
	goto done;
    }




    for (i = 0; i < nSids; ++i) {




	if (!AddAccessAllowedAce(newAcl, ACL_REVISION, aceEntry[i].mask, aceEntry[i].pSid)) {








































	    goto done;
	}
    }

    /*
     * Apply the new ACL. Note PROTECTED_DACL_SECURITY_INFORMATION can be used
     * to remove inherited ACL (we need to overwrite the default ACL's in this case)
     */

    if (SetNamedSecurityInfoA((LPSTR)nativePath,
			      SE_FILE_OBJECT,
			      DACL_SECURITY_INFORMATION |
				  PROTECTED_DACL_SECURITY_INFORMATION,
			      NULL,
			      NULL,
			      newAcl,
			      NULL) == ERROR_SUCCESS) {
	res = 0;
    }

  done:
    if (pTokenUser) {
	Tcl_Free(pTokenUser);
    }
    if (hToken) {
	CloseHandle(hToken);
    }
    if (newAcl) {
	Tcl_Free(newAcl);
    }
    for (i = 0; i < nSids; ++i) {
	Tcl_Free(aceEntry[i].pSid);



    }

    if (res != 0) {
	return res;
    }


    /* Run normal chmod command */
    return chmod(nativePath, pmode);



}

/*
 *---------------------------------------------------------------------------
 *
 * TestchmodCmd --
 *

Changes to win/tclWinThrd.c.

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

int
TclpThreadCreate(
    Tcl_ThreadId *idPtr,	/* Return, the ID of the thread. */
    Tcl_ThreadCreateProc *proc,	/* Main() function of the thread. */
    ClientData clientData,	/* The one argument to Main(). */
    size_t stackSize,		/* Size of stack for the new thread. */
    int flags)			/* Flags controlling behaviour of the new
				 * thread. */
{
    WinThread *winThreadPtr;		/* Per-thread startup info */
    HANDLE tHandle;

    winThreadPtr = (WinThread *)Tcl_Alloc(sizeof(WinThread));
    winThreadPtr->lpStartAddress = (LPTHREAD_START_ROUTINE) proc;
    winThreadPtr->lpParameter = clientData;
    winThreadPtr->fpControl = _controlfp(0, 0);

    EnterCriticalSection(&joinLock);

    *idPtr = 0; /* must initialize as Tcl_Thread is a pointer and
                 * on WIN64 sizeof void* != sizeof unsigned
		 */

#if defined(_MSC_VER) || defined(__MSVCRT__)
    tHandle = (HANDLE) _beginthreadex(NULL, (unsigned) stackSize,
	    (Tcl_ThreadCreateProc*) TclWinThreadStart, winThreadPtr,
	    0, (unsigned *)idPtr);
#else
    tHandle = CreateThread(NULL, (DWORD) stackSize,
	    TclWinThreadStart, winThreadPtr, 0, (LPDWORD)idPtr);
#endif

    if (tHandle == NULL) {
	LeaveCriticalSection(&joinLock);
	return TCL_ERROR;
    } else {







|
|


















|



|







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

int
TclpThreadCreate(
    Tcl_ThreadId *idPtr,	/* Return, the ID of the thread. */
    Tcl_ThreadCreateProc *proc,	/* Main() function of the thread. */
    void *clientData,	/* The one argument to Main(). */
    TCL_HASH_TYPE stackSize,	/* Size of stack for the new thread. */
    int flags)			/* Flags controlling behaviour of the new
				 * thread. */
{
    WinThread *winThreadPtr;		/* Per-thread startup info */
    HANDLE tHandle;

    winThreadPtr = (WinThread *)Tcl_Alloc(sizeof(WinThread));
    winThreadPtr->lpStartAddress = (LPTHREAD_START_ROUTINE) proc;
    winThreadPtr->lpParameter = clientData;
    winThreadPtr->fpControl = _controlfp(0, 0);

    EnterCriticalSection(&joinLock);

    *idPtr = 0; /* must initialize as Tcl_Thread is a pointer and
                 * on WIN64 sizeof void* != sizeof unsigned
		 */

#if defined(_MSC_VER) || defined(__MSVCRT__)
    tHandle = (HANDLE) _beginthreadex(NULL, (unsigned)stackSize,
	    (Tcl_ThreadCreateProc*) TclWinThreadStart, winThreadPtr,
	    0, (unsigned *)idPtr);
#else
    tHandle = CreateThread(NULL, (DWORD)stackSize,
	    TclWinThreadStart, winThreadPtr, 0, (LPDWORD)idPtr);
#endif

    if (tHandle == NULL) {
	LeaveCriticalSection(&joinLock);
	return TCL_ERROR;
    } else {
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545

    DeleteCriticalSection(&initLock);
}

#if TCL_THREADS

/* locally used prototype */
static void		FinalizeConditionEvent(ClientData data);

/*
 *----------------------------------------------------------------------
 *
 * Tcl_MutexLock --
 *
 *	This procedure is invoked to lock a mutex. This is a self initializing







|







531
532
533
534
535
536
537
538
539
540
541
542
543
544
545

    DeleteCriticalSection(&initLock);
}

#if TCL_THREADS

/* locally used prototype */
static void		FinalizeConditionEvent(void *data);

/*
 *----------------------------------------------------------------------
 *
 * Tcl_MutexLock --
 *
 *	This procedure is invoked to lock a mutex. This is a self initializing
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
	TclpGlobalUnlock();
    }
    csPtr = *((CRITICAL_SECTION **)mutexPtr);
    winCondPtr = *((WinCondition **)condPtr);
    if (timePtr == NULL) {
	wtime = INFINITE;
    } else {
	wtime = timePtr->sec * 1000 + timePtr->usec / 1000;
    }

    /*
     * Queue the thread on the condition, using the per-condition lock for
     * serialization.
     */








|







721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
	TclpGlobalUnlock();
    }
    csPtr = *((CRITICAL_SECTION **)mutexPtr);
    winCondPtr = *((WinCondition **)condPtr);
    if (timePtr == NULL) {
	wtime = INFINITE;
    } else {
	wtime = (DWORD)timePtr->sec * 1000 + (DWORD)timePtr->usec / 1000;
    }

    /*
     * Queue the thread on the condition, using the per-condition lock for
     * serialization.
     */

773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
     */

    if (timeout) {
	if (tsdPtr->flags & WIN_THREAD_RUNNING) {
	    timeout = 0;
	} else {
	    /*
	     * When dequeuing, we can leave the tsdPtr->nextPtr and
	     * tsdPtr->prevPtr with dangling pointers because they are
	     * reinitialilzed w/out reading them when the thread is enqueued
	     * later.
	     */

	    if (winCondPtr->firstPtr == tsdPtr) {
		winCondPtr->firstPtr = tsdPtr->nextPtr;
	    } else {
		tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr;







|

|







773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
     */

    if (timeout) {
	if (tsdPtr->flags & WIN_THREAD_RUNNING) {
	    timeout = 0;
	} else {
	    /*
	     * When dequeueing, we can leave the tsdPtr->nextPtr and
	     * tsdPtr->prevPtr with dangling pointers because they are
	     * reinitialized w/out reading them when the thread is enqueued
	     * later.
	     */

	    if (winCondPtr->firstPtr == tsdPtr) {
		winCondPtr->firstPtr = tsdPtr->nextPtr;
	    } else {
		tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr;
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
 *	The per-thread event is closed.
 *
 *----------------------------------------------------------------------
 */

static void
FinalizeConditionEvent(
    ClientData data)
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) data;

    tsdPtr->flags = WIN_THREAD_UNINIT;
    CloseHandle(tsdPtr->condEvent);
}








|







876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
 *	The per-thread event is closed.
 *
 *----------------------------------------------------------------------
 */

static void
FinalizeConditionEvent(
    void *data)
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) data;

    tsdPtr->flags = WIN_THREAD_UNINIT;
    CloseHandle(tsdPtr->condEvent);
}


Changes to win/tclWinTime.c.

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

	/*
	 * If calibration cycle occurred after we get curCounter
	 */

	if (curCounter.QuadPart <= perfCounterLastCall) {
	    /*
	     * Calibrated file-time is saved from posix in 100-ns ticks
	     */

	    return fileTimeLastCall / 10;
	}

	/*
	 * If it appears to be more than 1.1 seconds since the last trip
	 * through the calibration loop, the performance counter may have
	 * jumped forward. (See MSDN Knowledge Base article Q274323 for a
	 * description of the hardware problem that makes this test
	 * necessary.) If the counter jumps, we don't want to use it directly.
	 * Instead, we must return system time. Eventually, the calibration
	 * loop should recover.
	 */

	if (curCounter.QuadPart - perfCounterLastCall <
		11 * curCounterFreq * timeInfo.calibrationInterv / 10) {
	    /*
	     * Calibrated file-time is saved from posix in 100-ns ticks.
	     */

	    return NativeCalc100NsTicks(fileTimeLastCall,
		    perfCounterLastCall, curCounterFreq,
		    curCounter.QuadPart) / 10;
	}
    }







|


















|







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

	/*
	 * If calibration cycle occurred after we get curCounter
	 */

	if (curCounter.QuadPart <= perfCounterLastCall) {
	    /*
	     * Calibrated file-time is saved from Posix in 100-ns ticks
	     */

	    return fileTimeLastCall / 10;
	}

	/*
	 * If it appears to be more than 1.1 seconds since the last trip
	 * through the calibration loop, the performance counter may have
	 * jumped forward. (See MSDN Knowledge Base article Q274323 for a
	 * description of the hardware problem that makes this test
	 * necessary.) If the counter jumps, we don't want to use it directly.
	 * Instead, we must return system time. Eventually, the calibration
	 * loop should recover.
	 */

	if (curCounter.QuadPart - perfCounterLastCall <
		11 * curCounterFreq * timeInfo.calibrationInterv / 10) {
	    /*
	     * Calibrated file-time is saved from Posix in 100-ns ticks.
	     */

	    return NativeCalc100NsTicks(fileTimeLastCall,
		    perfCounterLastCall, curCounterFreq,
		    curCounter.QuadPart) / 10;
	}
    }
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
    GetSystemTimeAsFileTime(&curFileTime);
    QueryPerformanceCounter(&timeInfo.perfCounterLastCall);
    QueryPerformanceFrequency(&timeInfo.curCounterFreq);
    timeInfo.fileTimeLastCall.LowPart = curFileTime.dwLowDateTime;
    timeInfo.fileTimeLastCall.HighPart = curFileTime.dwHighDateTime;

    /*
     * Calibrated file-time will be saved from posix in 100-ns ticks.
     */

    timeInfo.fileTimeLastCall.QuadPart -= timeInfo.posixEpoch.QuadPart;

    ResetCounterSamples(timeInfo.fileTimeLastCall.QuadPart,
	    timeInfo.perfCounterLastCall.QuadPart,
	    timeInfo.curCounterFreq.QuadPart);







|







778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
    GetSystemTimeAsFileTime(&curFileTime);
    QueryPerformanceCounter(&timeInfo.perfCounterLastCall);
    QueryPerformanceFrequency(&timeInfo.curCounterFreq);
    timeInfo.fileTimeLastCall.LowPart = curFileTime.dwLowDateTime;
    timeInfo.fileTimeLastCall.HighPart = curFileTime.dwHighDateTime;

    /*
     * Calibrated file-time will be saved from Posix in 100-ns ticks.
     */

    timeInfo.fileTimeLastCall.QuadPart -= timeInfo.posixEpoch.QuadPart;

    ResetCounterSamples(timeInfo.fileTimeLastCall.QuadPart,
	    timeInfo.perfCounterLastCall.QuadPart,
	    timeInfo.curCounterFreq.QuadPart);
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
    long long vt1;		/* Tcl time one second from now. */
    long long tdiff;		/* Difference between system clock and Tcl
				 * time. */
    long long driftFreq;	/* Frequency needed to drift virtual time into
				 * step over 1 second. */

    /*
     * Sample performance counter and system time (from posix epoch).
     */

    GetSystemTimeAsFileTime(&curSysTime);
    curFileTime.LowPart = curSysTime.dwLowDateTime;
    curFileTime.HighPart = curSysTime.dwHighDateTime;
    curFileTime.QuadPart -= timeInfo.posixEpoch.QuadPart;








|







853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
    long long vt1;		/* Tcl time one second from now. */
    long long tdiff;		/* Difference between system clock and Tcl
				 * time. */
    long long driftFreq;	/* Frequency needed to drift virtual time into
				 * step over 1 second. */

    /*
     * Sample performance counter and system time (from Posix epoch).
     */

    GetSystemTimeAsFileTime(&curSysTime);
    curFileTime.LowPart = curSysTime.dwLowDateTime;
    curFileTime.HighPart = curSysTime.dwHighDateTime;
    curFileTime.QuadPart -= timeInfo.posixEpoch.QuadPart;

878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
	return;
    }
    QueryPerformanceCounter(&curPerfCounter);

    lastFileTime.QuadPart = curFileTime.QuadPart;

    /*
     * We devide by timeInfo.curCounterFreq.QuadPart in several places. That
     * value should always be positive on a correctly functioning system. But
     * it is good to be defensive about such matters. So if something goes
     * wrong and the value does goes to zero, we clear the
     * timeInfo.perfCounterAvailable in order to cause the calibration thread
     * to shut itself down, then return without additional processing.
     */








|







878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
	return;
    }
    QueryPerformanceCounter(&curPerfCounter);

    lastFileTime.QuadPart = curFileTime.QuadPart;

    /*
     * We divide by timeInfo.curCounterFreq.QuadPart in several places. That
     * value should always be positive on a correctly functioning system. But
     * it is good to be defensive about such matters. So if something goes
     * wrong and the value does goes to zero, we clear the
     * timeInfo.perfCounterAvailable in order to cause the calibration thread
     * to shut itself down, then return without additional processing.
     */

Changes to win/tclsh.rc.

40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
BEGIN
    BLOCK "StringFileInfo"
    BEGIN
        BLOCK "040904b0"
        BEGIN
            VALUE "FileDescription", "Tclsh Application\0"
            VALUE "OriginalFilename", "tclsh" STRINGIFY(TCL_MAJOR_VERSION) STRINGIFY(TCL_MINOR_VERSION) SUFFIX ".exe\0"
            VALUE "CompanyName", "ActiveState Corporation\0"
            VALUE "FileVersion", TCL_PATCH_LEVEL
            VALUE "LegalCopyright", "Copyright \251 2000 by ActiveState Corporation, et al\0"
            VALUE "ProductName", "Tcl " TCL_VERSION " for Windows\0"
            VALUE "ProductVersion", TCL_PATCH_LEVEL
        END
    END
    BLOCK "VarFileInfo"
    BEGIN
        VALUE "Translation", 0x409, 1200







<

|







40
41
42
43
44
45
46

47
48
49
50
51
52
53
54
55
BEGIN
    BLOCK "StringFileInfo"
    BEGIN
        BLOCK "040904b0"
        BEGIN
            VALUE "FileDescription", "Tclsh Application\0"
            VALUE "OriginalFilename", "tclsh" STRINGIFY(TCL_MAJOR_VERSION) STRINGIFY(TCL_MINOR_VERSION) SUFFIX ".exe\0"

            VALUE "FileVersion", TCL_PATCH_LEVEL
            VALUE "LegalCopyright", "Copyright \251 1987-2022 Regents of the University of California and other parties\0"
            VALUE "ProductName", "Tcl " TCL_VERSION " for Windows\0"
            VALUE "ProductVersion", TCL_PATCH_LEVEL
        END
    END
    BLOCK "VarFileInfo"
    BEGIN
        VALUE "Translation", 0x409, 1200